Routine: APCLW2P

APCLW2P ; 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

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

 I APCLRTYP="S" W !!,"Search Template ",$P($G(^DIBT(APCLSTMP,0)),U)," has been created.",!,"A total of ",APCLGRAN," patients were added to the template.",! G DONE

 S APCLSRT="" F  S APCLSRT=$O(^XTMP("APCLW2",APCLJOB,APCLBTH,"PATS",APCLSRT)) Q:APCLSRT=""!($D(APCLQUIT))  D PAT

 G:$D(APCLQUIT) DONE

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

 W !!,"TOTAL NUMBER OF PATIENTS: ",APCLGRAN

 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 since age 19 and 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-8) 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)"

DONE D DONE^APCLOSUT

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

PAT ;

 S DFN=0 F  S DFN=$O(^XTMP("APCLW2",APCLJOB,APCLBTH,"PATS",APCLSRT,DFN)) Q:DFN'=+DFN!($D(APCLQUIT))  S R=^XTMP("APCLW2",APCLJOB,APCLBTH,"PATS",APCLSRT,DFN) D

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

 .W ! I 'APCLIDEN W $E($P(R,U),1,15),?17,$J($P(R,U,2),6)

 .W ?25,$J($P(R,U,3),5,1),?33,$J($P(R,U,4),5,1),?40,$E($P(R,U,5),4,5),"/",$E($P(R,U,5),6,7),"/",(1700+$E($P(R,U,5),1,3)),?51,$P(R,U,6),?57,$P(R,U,7),?61,$J($P(R,U,8),5,1),?70,$P(R,U,9),?77,$P(R,U,10) ; - 4 digit yr

 .;IHS/CMI/LAB

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 ?22,"RISK FOR OVERWEIGHT PATIENT LISTING "

 ;S APCLTEXT=$S(APCLRPT="T":"PATIENT LISTING",APCLRPT="V":"LIST OF OVERWEIGHT PATIENTS",APCLRPT="B":"LIST OF OBESE PATIENTS",APCLRPT="C":"LIST OF OVERWEIGHT/OBESE PATIENTS",APCLRPT="E":"LIST OF PATIENTS WITH BMI OUTSIDE EDIT RANGE",1:"HUH")

 S APCLTEXT="" I APCLRPT="E" S APCLTEXT="LIST OF PATIENTS WITH BMI OUTSIDE EDIT RANGE"

 S APCLLENG=$L(APCLTEXT)

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

 S APCLTEXT="Report includes: "_$S(APCLSEX="B":"MALES & FEMALES",APCLSEX="F":"FEMALES",APCLSEX="M":"MALES",1:"HUH")_" / "_$S('$D(APCLAGER):"ALL AGES",1:"AGES: "_APCLAGER)

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

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

 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

 W !,?66,"(AT RISK",!?41,"DATE OF",?69,"FOR)"

 W !,"PATIENT NAME",?17,"HRN #",?25," HT",?33," WT",?41,"WEIGHT",?51,"AGE",?56,"SEX",?61," BMI",?67,"OVERWT",?75,"OBESE"

 W !,APCL80

APCLW2P   ; 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        DO HEAD

           IF APCLGRAN=0

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

               GOTO DONE

 +5        IF APCLRTYP="S"

               WRITE !!,"Search Template ",$PIECE($GET(^DIBT(APCLSTMP,0)),U)," has been created.",!,"A total of ",APCLGRAN," patients were added to the template.",!

               GOTO DONE

 +6        SET APCLSRT=""

FOR

               SET APCLSRT=$ORDER(^XTMP("APCLW2",APCLJOB,APCLBTH,"PATS",APCLSRT))

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

                   QUIT

               DO PAT

 +7        IF $DATA(APCLQUIT)

               GOTO DONE

 +8        IF $Y>(IOSL-15)

               DO HEAD

               IF $DATA(APCLQUIT)

                   GOTO DONE

 +9        WRITE !!,"TOTAL NUMBER OF PATIENTS: ",APCLGRAN

 +10       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."

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

 +12       WRITE !?6,"- ages 20-74 must have ht since age 19 and wt taken in the past 3 yrs"

 +13       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."

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

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

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

 +17       IF $Y>(IOSL-8)

               DO HEAD

               IF $DATA(APCLQUIT)

                   QUIT

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

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

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

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

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

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

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

DONE       DO DONE^APCLOSUT

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

 +2        QUIT

PAT       ;

 +1        SET DFN=0

FOR

               SET DFN=$ORDER(^XTMP("APCLW2",APCLJOB,APCLBTH,"PATS",APCLSRT,DFN))

               IF DFN'=+DFN!($DATA(APCLQUIT))

                   QUIT

               SET R=^XTMP("APCLW2",APCLJOB,APCLBTH,"PATS",APCLSRT,DFN)

               Begin DoDot:1

 +2                IF $Y>(IOSL-4)

                       DO HEAD

                       IF $DATA(APCLQUIT)

                           QUIT

 +3                WRITE !

                   IF 'APCLIDEN

                       WRITE $EXTRACT($PIECE(R,U),1,15),?17,$JUSTIFY($PIECE(R,U,2),6)

 +4       ; - 4 digit yr

                  WRITE ?25,$JUSTIFY($PIECE(R,U,3),5,1),?33,$JUSTIFY($PIECE(R,U,4),5,1),?40,$EXTRACT($PIECE(R,U,5),4,5),"/",$EXTRACT($PIECE(R,U,5),6,7),"/",(1700+$EXTRACT($PIECE(R,U,5),1,3)),?51,$PIECE(R,U,6),?57,...

                   ... $PIECE(R,U,7),?61,$JUSTIFY($PIECE(R,U,8),5,1),?70,$PIECE(R,U,9),?77,$PIECE(R,U,10)

 +5       ;IHS/CMI/LAB

               End DoDot:1

 +6        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 ?22,"RISK FOR OVERWEIGHT PATIENT LISTING "

 +6       ;S APCLTEXT=$S(APCLRPT="T":"PATIENT LISTING",APCLRPT="V":"LIST OF OVERWEIGHT PATIENTS",APCLRPT="B":"LIST OF OBESE PATIENTS",APCLRPT="C":"LIST OF OVERWEIGHT/OBESE PATIENTS",APCLRPT="E":"LIST OF PATIENTS WITH BMI OUTSIDE EDIT RANGE",1:"HUH")

 +7        SET APCLTEXT=""

           IF APCLRPT="E"

               SET APCLTEXT="LIST OF PATIENTS WITH BMI OUTSIDE EDIT RANGE"

 +8        SET APCLLENG=$LENGTH(APCLTEXT)

 +9        IF $LENGTH(APCLTEXT)

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

 +10       SET APCLTEXT="Report includes: "_$SELECT(APCLSEX="B":"MALES & FEMALES",APCLSEX="F":"FEMALES",APCLSEX="M":"MALES",1:"HUH")_" / "_$SELECT('$DATA(APCLAGER):"ALL AGES",1:"AGES: "_APCLAGER)

 +11       SET APCLLENG=$LENGTH(APCLTEXT)

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

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

 +13       SET APCLLENG=$LENGTH(APCLTEXT)

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

 +14      ;

 +15       IF APCLSEAT'=""

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

 +16       IF APCLSEAT'=""

               SET APCLLENG=$LENGTH(APCLTEXT)

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

 +17       WRITE !,?66,"(AT RISK",!?41,"DATE OF",?69,"FOR)"

 +18       WRITE !,"PATIENT NAME",?17,"HRN #",?25," HT",?33," WT",?41,"WEIGHT",?51,"AGE",?56,"SEX",?61," BMI",?67,"OVERWT",?75,"OBESE"

 +19       WRITE !,APCL80

 +20       QUIT

APCLW2P.m