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
Q
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
Q
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
Q
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
