APCLBMIR ; IHS/CMI/LAB - print BMI reference table ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;
;
W:$D(IOF) @IOF
W !!,"BMI Standard Reference Table Print",!
ZIS ;
S DIR(0)="S^P:PRINT Output;B:BROWSE Output on Screen",DIR("A")="Do you wish to ",DIR("B")="P" K DA D ^DIR K DIR
I $D(DIRUT) G XIT
I $G(Y)="B" D BROWSE,XIT Q
S XBRC="",XBRP="PRINT^APCLBMIR",XBNS="APCL",XBRX="XIT^APCLBMIR"
D ^XBDBQUE
XIT ;
D EN^XBVK("APCL"),^XBFMK
Q
;
BROWSE ;
S XBRP="VIEWR^XBLM(""PRINT^APCLBMIR"")"
S XBNS="APCL",XBRC="",XBRX="XIT^APCLBMIR",XBIOP=0 D ^XBDBQUE
Q
;
G:'APCLPG HEADER1
K DIR I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S APCLQUIT=1 Q
W:$D(IOF) @IOF S APCLPG=APCLPG+1
W !,"BMI Standard Reference Data",?50,$$FMTE^XLFDT(DT),?70,"Page ",APCLPG,!
W !?33,"BMI",?44,"BMI",!?5,"Low-High",?34,">=",?45,">=",?54,"DATA CHECK LIMITS",!?5,"Ages",?18,"SEX",?31,"(OVERWT)",?43,"(OBESE)",?55,"BMI >",?65,"BMI <"
W !,$TR($J("",80)," ","-")
Q
PRINT ;EP - called from xbdbque
S (APCLPG,APCLQUIT)=0 D HEADER
S APCLX=0 F S APCLX=$O(^APCLBMI("B",APCLX)) Q:APCLX'=+APCLX!(APCLQUIT) D
.S (APCLY,APCLC)=0 F S APCLY=$O(^APCLBMI("B",APCLX,APCLY)) Q:APCLY'=+APCLY!(APCLQUIT) S APCLC=APCLC+1 D
..I $Y>(IOSL-4) D HEADER Q:APCLQUIT
..W !
..W:APCLC=1 !?5,$P(^APCLBMI(APCLY,0),U),"-",$P(^APCLBMI(APCLY,0),U,2)
..W ?18,$$VAL^XBDIQ1(9001003.9,APCLY,.03)
..W ?32,$J($P(^APCLBMI(APCLY,0),U,4),4,1),?44,$J($P(^APCLBMI(APCLY,0),U,5),4,1),?57,$J($P(^APCLBMI(APCLY,0),U,7),4,1),?66,$J($P(^APCLBMI(APCLY,0),U,6),4,1)
..;W ?32,$$VAL^XBDIQ1(9001003.9,APCLY,.04),?43,$$VAL^XBDIQ1(9001003.9,APCLY,.05),?57,$$VAL^XBDIQ1(9001003.9,APCLY,.07),?66,$$VAL^XBDIQ1(9001003.9,APCLY,.06)
..Q
.Q
Q:APCLQUIT
I $Y>(IOSL-15) D HEADER Q:APCLQUIT
W !!,"NOTE: To make sure data is accurate and to eliminate data entry error, table",!,"excludes patient records whose BMI falls above or below the ","""","Data Check Limits","""",!,"specified above."
W !!,"Ages 2-10: 'At Risk for Overweight' is defined as BMI >=85th% but <95th%",!?12,"'Overweight' is defined as BMI >= 95th%"
W !,"(per National Center for Health Statistics in collaboration with the National",!,"Center for Chronic Disease Prevention and Health Promotion (2000)."
W !!,"Ages 20-74: 'Overweight' is defined as BMI >=25.0 but <30.0.",!?13,"'Obese' is defined as BMI >=30.0"
W !,"(per Clinical Guidelines on the Identification, Evaluation",!,"and Treatment of Overweight and Obesity in Adults. Bethesda, Md: NHLBI, 1998)"
EOP ;EP - End of page.
Q:$E(IOST)'="C"
Q:$D(ZTQUEUED)!'(IOT="TRM")!$D(IO("S"))
NEW DIR
K DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
S DIR("A")="End of report. Press Enter",DIR(0)="E" D ^DIR
Q
;----------
Q
APCLBMIR ; IHS/CMI/LAB - print BMI reference table ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;
+3 ;
+4 IF $DATA(IOF)
WRITE @IOF
+5 WRITE !!,"BMI Standard Reference Table Print",!
ZIS ;
+1 SET DIR(0)="S^P:PRINT Output;B:BROWSE Output on Screen"
SET DIR("A")="Do you wish to "
SET DIR("B")="P"
KILL DA
DO ^DIR
KILL DIR
+2 IF $DATA(DIRUT)
GOTO XIT
+3 IF $GET(Y)="B"
DO BROWSE
DO XIT
QUIT
+4 SET XBRC=""
SET XBRP="PRINT^APCLBMIR"
SET XBNS="APCL"
SET XBRX="XIT^APCLBMIR"
+5 DO ^XBDBQUE
XIT ;
+1 DO EN^XBVK("APCL")
DO ^XBFMK
+2 QUIT
+3 ;
BROWSE ;
+1 SET XBRP="VIEWR^XBLM(""PRINT^APCLBMIR"")"
+2 SET XBNS="APCL"
SET XBRC=""
SET XBRX="XIT^APCLBMIR"
SET XBIOP=0
DO ^XBDBQUE
+3 QUIT
+4 ;
+1 IF 'APCLPG
GOTO HEADER1
+2 KILL DIR
IF $EXTRACT(IOST)="C"
IF IO=IO(0)
WRITE !
SET DIR(0)="EO"
DO ^DIR
KILL DIR
IF Y=0!(Y="^")!($DATA(DTOUT))
SET APCLQUIT=1
QUIT
+1 IF $DATA(IOF)
WRITE @IOF
SET APCLPG=APCLPG+1
+2 WRITE !,"BMI Standard Reference Data",?50,$$FMTE^XLFDT(DT),?70,"Page ",APCLPG,!
+3 WRITE !?33,"BMI",?44,"BMI",!?5,"Low-High",?34,">=",?45,">=",?54,"DATA CHECK LIMITS",!?5,"Ages",?18,"SEX",?31,"(OVERWT)",?43,"(OBESE)",?55,"BMI >",?65,"BMI <"
+4 WRITE !,$TRANSLATE($JUSTIFY("",80)," ","-")
+5 QUIT
PRINT ;EP - called from xbdbque
+1 SET (APCLPG,APCLQUIT)=0
DO HEADER
+2 SET APCLX=0
FOR
SET APCLX=$ORDER(^APCLBMI("B",APCLX))
IF APCLX'=+APCLX!(APCLQUIT)
QUIT
Begin DoDot:1
+3 SET (APCLY,APCLC)=0
FOR
SET APCLY=$ORDER(^APCLBMI("B",APCLX,APCLY))
IF APCLY'=+APCLY!(APCLQUIT)
QUIT
SET APCLC=APCLC+1
Begin DoDot:2
+4 IF $Y>(IOSL-4)
DO HEADER
IF APCLQUIT
QUIT
+5 WRITE !
+6 IF APCLC=1
WRITE !?5,$PIECE(^APCLBMI(APCLY,0),U),"-",$PIECE(^APCLBMI(APCLY,0),U,2)
+7 WRITE ?18,$$VAL^XBDIQ1(9001003.9,APCLY,.03)
+8 WRITE ?32,$JUSTIFY($PIECE(^APCLBMI(APCLY,0),U,4),4,1),?44,$JUSTIFY($PIECE(^APCLBMI(APCLY,0),U,5),4,1),?57,$JUSTIFY($PIECE(^APCLBMI(APCLY,0),U,7),4,1),?66,$JUSTIFY($PIECE(^APCLBMI(APCLY,0),U,6),4,1)
+9 ;W ?32,$$VAL^XBDIQ1(9001003.9,APCLY,.04),?43,$$VAL^XBDIQ1(9001003.9,APCLY,.05),?57,$$VAL^XBDIQ1(9001003.9,APCLY,.07),?66,$$VAL^XBDIQ1(9001003.9,APCLY,.06)
+10 QUIT
End DoDot:2
+11 QUIT
End DoDot:1
+12 IF APCLQUIT
QUIT
+13 IF $Y>(IOSL-15)
DO HEADER
IF APCLQUIT
QUIT
+14 WRITE !!,"NOTE: To make sure data is accurate and to eliminate data entry error, table",!,"excludes patient records whose BMI falls above or below the ","""","Data Check Limits","""",!,"specified above."
+15 WRITE !!,"Ages 2-10: 'At Risk for Overweight' is defined as BMI >=85th% but <95th%",!?12,"'Overweight' is defined as BMI >= 95th%"
+16 WRITE !,"(per National Center for Health Statistics in collaboration with the National",!,"Center for Chronic Disease Prevention and Health Promotion (2000)."
+17 WRITE !!,"Ages 20-74: 'Overweight' is defined as BMI >=25.0 but <30.0.",!?13,"'Obese' is defined as BMI >=30.0"
+18 WRITE !,"(per Clinical Guidelines on the Identification, Evaluation",!,"and Treatment of Overweight and Obesity in Adults. Bethesda, Md: NHLBI, 1998)"
EOP ;EP - End of page.
+1 IF $EXTRACT(IOST)'="C"
QUIT
+2 IF $DATA(ZTQUEUED)!'(IOT="TRM")!$DATA(IO("S"))
QUIT
+3 NEW DIR
+4 KILL DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
+5 SET DIR("A")="End of report. Press Enter"
SET DIR(0)="E"
DO ^DIR
+6 QUIT
+7 ;----------
+8 QUIT
