Routine: APCLW1P

APCLW1P ; IHS/CMI/LAB - print dx by age ;

 ;;2.0;IHS PCC SUITE;;MAY 14, 2009

START ;

 S APCL80="",$P(APCL80,"-",80)=""

 S (APCLPG,APCLSEXP)=0

 K APCLQUIT

 I APCLBTUP=0 D HEAD W !,"NO PATIENT DATA TO REPORT",! G DONE

 F APCLSEXP="F","M","B" Q:$D(APCLQUIT)  D AGE

DONE D DONE^APCLOSUT

 K ^XTMP("APCLW1",APCLJOB,APCLBTH),APCLJOB,APCLBTH

AGE ;

 I APCLSEX'="B"&(APCLSEXP'=APCLSEX) Q

 D HEAD Q:$D(APCLQUIT)

 S APCLAGEP=0 F  S APCLAGEP=$O(^XTMP("APCLW1",APCLJOB,APCLBTH,"TOTAL USABLE PATS",APCLSEXP,APCLAGEP)) Q:APCLAGEP=""!($D(APCLQUIT))  D

 .I APCLAGEG="G" S APCLPAGE=$P(APCLBIN,";",APCLAGEP)

 .E  S APCLPAGE=APCLAGEP

 .I $Y>(IOSL-4) D HEAD Q:$D(APCLQUIT)

 .W !,APCLPAGE S P=^XTMP("APCLW1",APCLJOB,APCLBTH,"TOTAL USABLE PATS",APCLSEXP,APCLAGEP) W ?8,$J(P,6)

 .I P=0 D  Q

 ..F X=18,27,43,50,57,63,71,77 W ?X,"-"

 .S X=^XTMP("APCLW1",APCLJOB,APCLBTH,"TOTAL BMI",APCLSEXP,APCLAGEP),B=$J((X/P),5,1) W ?16,$J(B,6)

 .S X=$J(^XTMP("APCLW1",APCLJOB,APCLBTH,"LOW",APCLSEXP,APCLAGEP),5,1),Y=$J(^XTMP("APCLW1",APCLJOB,APCLBTH,"HIGH",APCLSEXP,APCLAGEP),5,1),R=X_"-"_Y W ?24,$J(R,6)

 .S X=^XTMP("APCLW1",APCLJOB,APCLBTH,"OVERWEIGHT",APCLSEXP,APCLAGEP),V=$J(((X/P)*100),5,1) W ?38,$J(X,6),?47,V

 .S B=^XTMP("APCLW1",APCLJOB,APCLBTH,"OBESE",APCLSEXP,APCLAGEP),V=$J(((B/P)*100),5,1) W ?52,$J(B,6),?60,V

 .S V=$J((((X+B)/P)*100),5,1) W ?66,$J((X+B),6),?74,V

 I $Y>(IOSL-4) D HEAD Q:$D(APCLQUIT)

 S T="APCL"_APCLSEXP_"TUP" W !!,"TOTAL:  ",?8,$J(@T,6)

 I @T=0 D  Q

 .F X=18,27,43,50,57,63,71,77 W ?X,"-"

 S Z="APCL"_APCLSEXP_"BMI",B=$J((@Z/@T),5,1) W ?16,$J(B,6)

 S Z="APCL"_APCLSEXP_"LOW",X=$J(@Z,5,1),Z="APCL"_APCLSEXP_"HGH",Y=$J(@Z,5,1) W ?24,X_"-"_Y

 S Z="APCL"_APCLSEXP_"OVR",V=$J(((@Z/@T)*100),5,1) W ?38,$J(@Z,6),?47,V

 S Y="APCL"_APCLSEXP_"OBE",V=$J(((@Y/@T)*100),5,1) W ?52,$J(@Y,6),?60,V

 S V=$J((((@Y+@Z)/@T)*100),5,1) W ?66,$J((@Y+@Z),6),?74,V

 I $Y>(IOSL-15) D HEAD Q:$D(APCLQUIT)

 W !!,"*  Usable Patient Records are defined as:",!?4,"1). Having a visit within the past 3 years (active users)",!?4,"2). Having current height and weight measurements recorded."

 W !?6,"- ages 2-19 must have ht and wt taken on the same day within the past year"

 W !?6,"- ages 20-74 must have ht taken after age 19/wt taken in the past 3 yrs"

 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.",!,"See the BMI Standard Reference Table for a list of these limits."

 W !,"Prenatal patients are also excluded."

 W !,"*****   Values identified on this report as errors are 'possible' errors that"

 W !,"        deserve review but are not 'validated true errors'.",!

 I $Y>(IOSL-9) D HEAD Q:$D(APCLQUIT)

 W !,"Ages 2-19:  'At Risk for Overweight' is defined as BMI >=85th% but <95th%"

 W !?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."

 W !?13,"'Obese' is defined as BMI >=30.0"

 W !,"(per Clinical Guidelines on the Identification, Evaluation,"

 W !," and Treatment of Overweight and Obesity in Adults. Bethesda, Md: NHlBI, 1998)"

HEAD I 'APCLPG G HEAD1

 I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S APCLQUIT="" Q

HEAD1 ;

 W:$D(IOF) @IOF S APCLPG=APCLPG+1

W !

 S X=$P(^DIC(4,DUZ(2),0),"^")

 W !,$P(^VA(200,DUZ,0),"^",2),?(80-$L(X)/2),X,?71,"Page ",APCLPG,!

 W ?21,"RISK FOR OVERWEIGHT PREVALENCE REPORT",!

 S X="As of Date: "_APCLDT W ?(80-$L(X))/2,X

 S APCLTEXT="Report includes: "_$S(APCLSEXP="B":"TOTAL POPULATION (MALES/FEMALES)",APCLSEXP="M":"MALES",APCLSEXP="F":"FEMALES",1:"NO USABLE PATIENT RECORDS")

 S APCLLENG=$L(APCLTEXT)

 W !?(80-APCLLENG)/2,APCLTEXT

 S APCLTEXT="Report Includes: "_$S(APCLIBEN=1:"INDIAN/ALASKA NATIVES ONLY",APCLIBEN'=1:"ALL BENEFICIARIES",1:"HUH")

 S APCLLENG=$L(APCLTEXT) W !?(80-APCLLENG)/2,APCLTEXT

 I APCLSEAT'="" S APCLTEXT="Search Template of Patients: "_$P(^DIBT(APCLSEAT,0),U)

 I APCLSEAT'="" S APCLLENG=$L(APCLTEXT) W !?(80-APCLLENG)/2,APCLTEXT

 I APCLCMS'="" S APCLTEXT="CMS Register: "_$P(^ACM(41.1,APCLCMS,0),U)

 I APCLCMS'="" S APCLLENG=$L(APCLTEXT) W !?(80-APCLLENG)/2,APCLTEXT

 W !!?7,"TOTAL #",!?7,"PATIENT",?15,"AVERAGE",?40,"(AT RISK FOR)"

 W !,"AGE",?7,"RECORDS",?17,"BMI",?25,"RANGE",?42,"OVERWEIGHT)",?57," OBESE",?70,"COMBINED"

 W !?7,"USED*",?36,"       #      %",?57,"#",?63,"%",?71,"#",?77,"%"

 W !,APCL80

APCLW1P   ; IHS/CMI/LAB - print dx by age ;

 +1       ;;2.0;IHS PCC SUITE;;MAY 14, 2009

START     ;

 +1        SET APCL80=""

           SET $PIECE(APCL80,"-",80)=""

 +2        SET (APCLPG,APCLSEXP)=0

 +3        KILL APCLQUIT

 +4        IF APCLBTUP=0

               DO HEAD

               WRITE !,"NO PATIENT DATA TO REPORT",!

               GOTO DONE

 +5        FOR APCLSEXP="F","M","B"

               IF $DATA(APCLQUIT)

                   QUIT

               DO AGE

DONE       DO DONE^APCLOSUT

 +1        KILL ^XTMP("APCLW1",APCLJOB,APCLBTH),APCLJOB,APCLBTH

 +2        QUIT

AGE       ;

 +1        IF APCLSEX'="B"&(APCLSEXP'=APCLSEX)

               QUIT

 +2        DO HEAD

           IF $DATA(APCLQUIT)

               QUIT

 +3        SET APCLAGEP=0

FOR

               SET APCLAGEP=$ORDER(^XTMP("APCLW1",APCLJOB,APCLBTH,"TOTAL USABLE PATS",APCLSEXP,APCLAGEP))

               IF APCLAGEP=""!($DATA(APCLQUIT))

                   QUIT

               Begin DoDot:1

 +4                IF APCLAGEG="G"

                       SET APCLPAGE=$PIECE(APCLBIN,";",APCLAGEP)

 +5               IF '$TEST

                       SET APCLPAGE=APCLAGEP

 +6                IF $Y>(IOSL-4)

                       DO HEAD

                       IF $DATA(APCLQUIT)

                           QUIT

 +7                WRITE !,APCLPAGE

                   SET P=^XTMP("APCLW1",APCLJOB,APCLBTH,"TOTAL USABLE PATS",APCLSEXP,APCLAGEP)

                   WRITE ?8,$JUSTIFY(P,6)

 +8                IF P=0

                       Begin DoDot:2

 +9                        FOR X=18,27,43,50,57,63,71,77

                               WRITE ?X,"-"

                       End DoDot:2

                       QUIT

 +10               SET X=^XTMP("APCLW1",APCLJOB,APCLBTH,"TOTAL BMI",APCLSEXP,APCLAGEP)

                   SET B=$JUSTIFY((X/P),5,1)

                   WRITE ?16,$JUSTIFY(B,6)

 +11               SET X=$JUSTIFY(^XTMP("APCLW1",APCLJOB,APCLBTH,"LOW",APCLSEXP,APCLAGEP),5,1)

                   SET Y=$JUSTIFY(^XTMP("APCLW1",APCLJOB,APCLBTH,"HIGH",APCLSEXP,APCLAGEP),5,1)

                   SET R=X_"-"_Y

                   WRITE ?24,$JUSTIFY(R,6)

 +12               SET X=^XTMP("APCLW1",APCLJOB,APCLBTH,"OVERWEIGHT",APCLSEXP,APCLAGEP)

                   SET V=$JUSTIFY(((X/P)*100),5,1)

                   WRITE ?38,$JUSTIFY(X,6),?47,V

 +13               SET B=^XTMP("APCLW1",APCLJOB,APCLBTH,"OBESE",APCLSEXP,APCLAGEP)

                   SET V=$JUSTIFY(((B/P)*100),5,1)

                   WRITE ?52,$JUSTIFY(B,6),?60,V

 +14               SET V=$JUSTIFY((((X+B)/P)*100),5,1)

                   WRITE ?66,$JUSTIFY((X+B),6),?74,V

               End DoDot:1

 +15       IF $Y>(IOSL-4)

               DO HEAD

               IF $DATA(APCLQUIT)

                   QUIT

 +16       SET T="APCL"_APCLSEXP_"TUP"

           WRITE !!,"TOTAL:  ",?8,$JUSTIFY(@T,6)

 +17       IF @T=0

               Begin DoDot:1

 +18               FOR X=18,27,43,50,57,63,71,77

                       WRITE ?X,"-"

               End DoDot:1

               QUIT

 +19       SET Z="APCL"_APCLSEXP_"BMI"

           SET B=$JUSTIFY((@Z/@T),5,1)

           WRITE ?16,$JUSTIFY(B,6)

 +20       SET Z="APCL"_APCLSEXP_"LOW"

           SET X=$JUSTIFY(@Z,5,1)

           SET Z="APCL"_APCLSEXP_"HGH"

           SET Y=$JUSTIFY(@Z,5,1)

           WRITE ?24,X_"-"_Y

 +21       SET Z="APCL"_APCLSEXP_"OVR"

           SET V=$JUSTIFY(((@Z/@T)*100),5,1)

           WRITE ?38,$JUSTIFY(@Z,6),?47,V

 +22       SET Y="APCL"_APCLSEXP_"OBE"

           SET V=$JUSTIFY(((@Y/@T)*100),5,1)

           WRITE ?52,$JUSTIFY(@Y,6),?60,V

 +23       SET V=$JUSTIFY((((@Y+@Z)/@T)*100),5,1)

           WRITE ?66,$JUSTIFY((@Y+@Z),6),?74,V

 +24       IF $Y>(IOSL-15)

               DO HEAD

               IF $DATA(APCLQUIT)

                   QUIT

 +25       WRITE !!,"*  Usable Patient Records are defined as:",!?4,"1). Having a visit within the past 3 years (active users)",!?4,"2). Having current height and weight measurements recorded."

 +26       WRITE !?6,"- ages 2-19 must have ht and wt taken on the same day within the past year"

 +27       WRITE !?6,"- ages 20-74 must have ht taken after age 19/wt taken in the past 3 yrs"

 +28       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.",!,"See the BMI Standard Reference Table for a list of these limits."

 +29       WRITE !,"Prenatal patients are also excluded."

 +30       WRITE !,"*****   Values identified on this report as errors are 'possible' errors that"

 +31       WRITE !,"        deserve review but are not 'validated true errors'.",!

 +32       IF $Y>(IOSL-9)

               DO HEAD

               IF $DATA(APCLQUIT)

                   QUIT

 +33       WRITE !,"Ages 2-19:  'At Risk for Overweight' is defined as BMI >=85th% but <95th%"

 +34       WRITE !?12,"'Overweight' is defined as BMI >= 95th%"

 +35       WRITE !,"(per National Center for Health Statistics in collaboration with the National",!,"Center for Chronic Disease Prevention and Health Promotion (2000)."

 +36       WRITE !!,"Ages 20-74:  'Overweight' is defined as BMI >=25.0 but <30.0."

 +37       WRITE !?13,"'Obese' is defined as BMI >=30.0"

 +38       WRITE !,"(per Clinical Guidelines on the Identification, Evaluation,"

 +39       WRITE !," and Treatment of Overweight and Obesity in Adults. Bethesda, Md: NHlBI, 1998)"

 +40       QUIT

HEAD       IF 'APCLPG

               GOTO HEAD1

 +1        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=""

                       QUIT

HEAD1     ;

 +1        IF $DATA(IOF)

               WRITE @IOF

           SET APCLPG=APCLPG+1

 +2        WRITE !

 +3        SET X=$PIECE(^DIC(4,DUZ(2),0),"^")

 +4        WRITE !,$PIECE(^VA(200,DUZ,0),"^",2),?(80-$LENGTH(X)/2),X,?71,"Page ",APCLPG,!

 +5        WRITE ?21,"RISK FOR OVERWEIGHT PREVALENCE REPORT",!

 +6        SET X="As of Date: "_APCLDT

           WRITE ?(80-$LENGTH(X))/2,X

 +7        SET APCLTEXT="Report includes: "_$SELECT(APCLSEXP="B":"TOTAL POPULATION (MALES/FEMALES)",APCLSEXP="M":"MALES",APCLSEXP="F":"FEMALES",1:"NO USABLE PATIENT RECORDS")

 +8        SET APCLLENG=$LENGTH(APCLTEXT)

 +9        WRITE !?(80-APCLLENG)/2,APCLTEXT

 +10       SET APCLTEXT="Report Includes: "_$SELECT(APCLIBEN=1:"INDIAN/ALASKA NATIVES ONLY",APCLIBEN'=1:"ALL BENEFICIARIES",1:"HUH")

 +11       SET APCLLENG=$LENGTH(APCLTEXT)

           WRITE !?(80-APCLLENG)/2,APCLTEXT

 +12      ;

 +13       IF APCLSEAT'=""

               SET APCLTEXT="Search Template of Patients: "_$PIECE(^DIBT(APCLSEAT,0),U)

 +14       IF APCLSEAT'=""

               SET APCLLENG=$LENGTH(APCLTEXT)

               WRITE !?(80-APCLLENG)/2,APCLTEXT

 +15       IF APCLCMS'=""

               SET APCLTEXT="CMS Register: "_$PIECE(^ACM(41.1,APCLCMS,0),U)

 +16       IF APCLCMS'=""

               SET APCLLENG=$LENGTH(APCLTEXT)

               WRITE !?(80-APCLLENG)/2,APCLTEXT

 +17       WRITE !!?7,"TOTAL #",!?7,"PATIENT",?15,"AVERAGE",?40,"(AT RISK FOR)"

 +18       WRITE !,"AGE",?7,"RECORDS",?17,"BMI",?25,"RANGE",?42,"OVERWEIGHT)",?57," OBESE",?70,"COMBINED"

 +19       WRITE !?7,"USED*",?36,"       #      %",?57,"#",?63,"%",?71,"#",?77,"%"

 +20       WRITE !,APCL80

 +21       QUIT

APCLW1P.m