Routine: APCLBMIR

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

BROWSE ;

 S XBRP="VIEWR^XBLM(""PRINT^APCLBMIR"")"

 S XBNS="APCL",XBRC="",XBRX="XIT^APCLBMIR",XBIOP=0 D ^XBDBQUE

HEADER ;EP

 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

HEADER1 ;

 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)," ","-")

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

 ;----------

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       ;

HEADER    ;EP

 +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

HEADER1   ;

 +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

APCLBMIR.m