APCLW2 ; IHS/CMI/LAB - AGE BUCKET/DIAGNOSIS REPORT ;
;;2.0;IHS PCC SUITE;**10**;MAY 14, 2009;Build 88
;
START ;
W !!?15,"***** RISK FOR OVERWEIGHT PREVALENCE REPORT *****",!!
D @APCLRPT
;
S APCLTYPE=""
S APCLSEAT=""
K DIR,X,Y
S DIR(0)="S^S:Search Template of Patients;P:Search All Patients"
S DIR("A")=" Select List " D ^DIR K DIR S:$D(DUOUT) DIRUT=1
G:$D(DIRUT) EXIT
S APCLTYPE=Y
I APCLTYPE="S" G TEMPLATE
G:$D(DUOUT) START
;
SEX ;
S DIR(0)="S^M:Males;F:Females;B:Both",DIR("A")="Report should include",DIR("B")="B" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
G:$D(DIRUT) START
S APCLSEX=Y
;
INDBEN ;
W !
S DIR(0)="Y",DIR("A")="Do you wish to include ONLY Indian/Alaska Native Beneficiaries",DIR("B")="N" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
G:$D(DIRUT) SEX
S APCLIBEN=Y
;
AGE ;
W !
K APCLAGER
S DIR(0)="FO^1:7",DIR("A")="Enter a Range of Ages (e.g. 5-12) [HIT RETURN TO INCLUDE ALL RANGES]" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DUOUT) G INDBEN
I Y="" W !!,"No age range entered. All ages will be included." G BMIR
I Y'?1.3N1"-"1.3N W !!,$C(7),$C(7),"Enter an age range in the format nnn-nnn. E.g. 2-5, 12-74, 5-20." G AGE
I $P(Y,"-")<2 W !,$C(7),"Cannot run for patients under 2." G AGE
I $P(Y,"-",2)>74 W !,$C(7),"Cannot run for patients over 74." G AGE
S APCLAGER=Y
I APCLRPT'="T" G REPORT
BMIR ;range of BMIs
K APCLBMIR
W !!,"If you want to include only patients whose BMI is within a certain range"
W !,"please enter that range below. For example to include only patients"
W !,"whose BMI is between 30 and 40 enter 30-40. To include only patients"
W !,"whose BMI is over 25 enter 25-99.",!
S DIR(0)="FO^1:7",DIR("A")="Enter a Range of BMIs (e.g. 25-50) [HIT RETURN TO INCLUDE ALL BMI values]" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
I $D(DUOUT) G AGE
I Y="" W !!,"No BMI range entered. All BMI values will be included." G REPORT
I Y'?1.3N1"-"1.3N W !!,$C(7),$C(7),"Enter a BMI range in the format nnn-nnn. E.g. 20-25, 30.5-99." G BMIR
I $P(Y,"-")<1 W !,$C(7),"Cannot run for BMI values under 1." G AGE
I $P(Y,"-",2)>99 W !,$C(7),"Cannot run for BMI values over 99." G AGE
S APCLBMIR=Y
REPORT ;
S APCLRTYP=""
S DIR(0)="S^R:Report (Printed);S:Sort Template",DIR("A")="Type of Output",DIR("B")="R" KILL DA D ^DIR KILL DIR
G:$D(DIRUT) AGE
S APCLRTYP=Y
I APCLRTYP="S" G STMP
SORT ;
S DIR(0)="S^P:Patient Name;A:Age of Patient;B:BMI",DIR("A")="Sort the report by",DIR("B")="P" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
G:$D(DIRUT) AGE
S APCLSORT=Y
IDENT ;
S DIR(0)="Y",DIR("A")="Do you wish to suppress patient identifying data (name,chart #)",DIR("B")="N" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
G:$D(DIRUT) SORT
S APCLIDEN=Y
G ZIS
STMP ;
K APCLSTMP,APCLSNAM
D ^APCLSTMP
I $G(APCLSTMP)="" G REPORT
ZIS ;
DEMO ;
D DEMOCHK^APCLUTL(.APCLDEMO)
I APCLDEMO=-1 G STMP
S XBRC="^APCLW21",XBRP="^APCLW2P",XBNS="APCL",XBRX="EXIT^APCLW2"
D ^XBDBQUE
D EXIT
Q
EXIT ;
K APCLSORT,APCLIDEN,APCLAGER,APCLSEX,APCL1YR,APCL3YR,APCL80,APCLA,APCLAGE,APCLAGER,APCLBD,APCLBHGH,APCLBMI,APCLBTH,APCLCHT,APCLCWT,APCLDT,APCLER,APCLGHT,APCLGRAN,APCLGWT,APCLHGHA,APCLHRN
K APCLJOB,APCLLENG,APCLMGI,APCLMHT,APCLMWT,APCLNAME,APCLNN,APCLOBE,APCLOVR,APCLPG,APCLQUIT,APCLREF,APCLROHT,APCLROWT,APCLRPT,APCLSEX,APCLSEXP,APCLSORT,APCLSRT,APCLTEXT,APCLX,APCLY,APCLIBEN,APCLCLAS
K DIR,DA,DIC,J,K,M,S,X,Y,APCLSEAT,APCLTYPE
Q
;
V ;
W ?26,"LIST OF PATIENTS AT NHANES 85-94TH PERCENTILE"
W !,"This report will produce a listing of all patients of the age and sex ",!,"that you specify, who are, based on the BMI, considered overweight.",!
Q
B ;
W ?24,"LIST OF PATIENTS >=NHANES 95TH PERCENTILE"
W !,"This report will produce a listing of all patients of the age and sex ",!,"that you specify, who are, based on the BMI, considered obese.",!
Q
C ;
W ?18,"COMBINED LIST OF PATIENTS NHANES 85-100TH PERCENTILE"
W !,"This report will produce a listing of all patients of the age and sex ",!,"that you specify, who are, based on the BMI, considered overweight or obese.",!
Q
T ;
W ?33,"PATIENT LIST"
W !,"This report will produce a listing of all patients of the age and sex ",!,"that you specify. The report will list their weight, height and BMI.",!
Q
E ;
W ?5,"LIST OF PATIENTS WITH POTENTIAL HEIGHT OR WEIGHT ERROR"
W !,"This report will produce a listing of all patients of the age and sex ",!,"that you specify, whose BMI falls below or exceeds the reasonable data check",!,"limits as shown in the BMI Standard reference table.",!
W "These patient records should be checked for possible inaccurate height or ",!,"weight entries.",!
Q
;
TEMPLATE ;If Template was selected
;
W ! S DIC("S")="I $P(^(0),U,4)=9000001!($P(^(0),U,4)=2)" S DIC="^DIBT(",DIC("A")="Enter Patient SEARCH TEMPLATE name: ",DIC(0)="AEMQ" D ^DIC K DIC,DA,DR,DICR
I Y=-1 S APCLQUIT="" K APCLTYPE G START
S APCLSEAT=+Y
G:$D(DIRUT) START
G SEX
;
APCLW2 ; IHS/CMI/LAB - AGE BUCKET/DIAGNOSIS REPORT ;
+1 ;;2.0;IHS PCC SUITE;**10**;MAY 14, 2009;Build 88
+2 ;
START ;
+1 WRITE !!?15,"***** RISK FOR OVERWEIGHT PREVALENCE REPORT *****",!!
+2 DO @APCLRPT
+3 ;
+4 SET APCLTYPE=""
+5 SET APCLSEAT=""
+6 KILL DIR,X,Y
+7 SET DIR(0)="S^S:Search Template of Patients;P:Search All Patients"
+8 SET DIR("A")=" Select List "
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+9 IF $DATA(DIRUT)
GOTO EXIT
+10 SET APCLTYPE=Y
+11 IF APCLTYPE="S"
GOTO TEMPLATE
+12 IF $DATA(DUOUT)
GOTO START
+13 ;
SEX ;
+1 SET DIR(0)="S^M:Males;F:Females;B:Both"
SET DIR("A")="Report should include"
SET DIR("B")="B"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
GOTO START
+3 SET APCLSEX=Y
+4 ;
INDBEN ;
+1 WRITE !
+2 SET DIR(0)="Y"
SET DIR("A")="Do you wish to include ONLY Indian/Alaska Native Beneficiaries"
SET DIR("B")="N"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+3 IF $DATA(DIRUT)
GOTO SEX
+4 SET APCLIBEN=Y
+5 ;
AGE ;
+1 WRITE !
+2 KILL APCLAGER
+3 SET DIR(0)="FO^1:7"
SET DIR("A")="Enter a Range of Ages (e.g. 5-12) [HIT RETURN TO INCLUDE ALL RANGES]"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+4 IF $DATA(DUOUT)
GOTO INDBEN
+5 IF Y=""
WRITE !!,"No age range entered. All ages will be included."
GOTO BMIR
+6 IF Y'?1.3N1"-"1.3N
WRITE !!,$CHAR(7),$CHAR(7),"Enter an age range in the format nnn-nnn. E.g. 2-5, 12-74, 5-20."
GOTO AGE
+7 IF $PIECE(Y,"-")<2
WRITE !,$CHAR(7),"Cannot run for patients under 2."
GOTO AGE
+8 IF $PIECE(Y,"-",2)>74
WRITE !,$CHAR(7),"Cannot run for patients over 74."
GOTO AGE
+9 SET APCLAGER=Y
+10 IF APCLRPT'="T"
GOTO REPORT
BMIR ;range of BMIs
+1 KILL APCLBMIR
+2 WRITE !!,"If you want to include only patients whose BMI is within a certain range"
+3 WRITE !,"please enter that range below. For example to include only patients"
+4 WRITE !,"whose BMI is between 30 and 40 enter 30-40. To include only patients"
+5 WRITE !,"whose BMI is over 25 enter 25-99.",!
+6 SET DIR(0)="FO^1:7"
SET DIR("A")="Enter a Range of BMIs (e.g. 25-50) [HIT RETURN TO INCLUDE ALL BMI values]"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+7 IF $DATA(DUOUT)
GOTO AGE
+8 IF Y=""
WRITE !!,"No BMI range entered. All BMI values will be included."
GOTO REPORT
+9 IF Y'?1.3N1"-"1.3N
WRITE !!,$CHAR(7),$CHAR(7),"Enter a BMI range in the format nnn-nnn. E.g. 20-25, 30.5-99."
GOTO BMIR
+10 IF $PIECE(Y,"-")<1
WRITE !,$CHAR(7),"Cannot run for BMI values under 1."
GOTO AGE
+11 IF $PIECE(Y,"-",2)>99
WRITE !,$CHAR(7),"Cannot run for BMI values over 99."
GOTO AGE
+12 SET APCLBMIR=Y
REPORT ;
+1 SET APCLRTYP=""
+2 SET DIR(0)="S^R:Report (Printed);S:Sort Template"
SET DIR("A")="Type of Output"
SET DIR("B")="R"
KILL DA
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
GOTO AGE
+4 SET APCLRTYP=Y
+5 IF APCLRTYP="S"
GOTO STMP
SORT ;
+1 SET DIR(0)="S^P:Patient Name;A:Age of Patient;B:BMI"
SET DIR("A")="Sort the report by"
SET DIR("B")="P"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
GOTO AGE
+3 SET APCLSORT=Y
IDENT ;
+1 SET DIR(0)="Y"
SET DIR("A")="Do you wish to suppress patient identifying data (name,chart #)"
SET DIR("B")="N"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
GOTO SORT
+3 SET APCLIDEN=Y
+4 GOTO ZIS
STMP ;
+1 KILL APCLSTMP,APCLSNAM
+2 DO ^APCLSTMP
+3 IF $GET(APCLSTMP)=""
GOTO REPORT
ZIS ;
DEMO ;
+1 DO DEMOCHK^APCLUTL(.APCLDEMO)
+2 IF APCLDEMO=-1
GOTO STMP
+3 SET XBRC="^APCLW21"
SET XBRP="^APCLW2P"
SET XBNS="APCL"
SET XBRX="EXIT^APCLW2"
+4 DO ^XBDBQUE
+5 DO EXIT
+6 QUIT
EXIT ;
+1 KILL APCLSORT,APCLIDEN,APCLAGER,APCLSEX,APCL1YR,APCL3YR,APCL80,APCLA,APCLAGE,APCLAGER,APCLBD,APCLBHGH,APCLBMI,APCLBTH,APCLCHT,APCLCWT,APCLDT,APCLER,APCLGHT,APCLGRAN,APCLGWT,APCLHGHA,APCLHRN
+2 KILL APCLJOB,APCLLENG,APCLMGI,APCLMHT,APCLMWT,APCLNAME,APCLNN,APCLOBE,APCLOVR,APCLPG,APCLQUIT,APCLREF,APCLROHT,APCLROWT,APCLRPT,APCLSEX,APCLSEXP,APCLSORT,APCLSRT,APCLTEXT,APCLX,APCLY,APCLIBEN,APCLCLAS
+3 KILL DIR,DA,DIC,J,K,M,S,X,Y,APCLSEAT,APCLTYPE
+4 QUIT
+5 ;
V ;
+1 WRITE ?26,"LIST OF PATIENTS AT NHANES 85-94TH PERCENTILE"
+2 WRITE !,"This report will produce a listing of all patients of the age and sex ",!,"that you specify, who are, based on the BMI, considered overweight.",!
+3 QUIT
B ;
+1 WRITE ?24,"LIST OF PATIENTS >=NHANES 95TH PERCENTILE"
+2 WRITE !,"This report will produce a listing of all patients of the age and sex ",!,"that you specify, who are, based on the BMI, considered obese.",!
+3 QUIT
C ;
+1 WRITE ?18,"COMBINED LIST OF PATIENTS NHANES 85-100TH PERCENTILE"
+2 WRITE !,"This report will produce a listing of all patients of the age and sex ",!,"that you specify, who are, based on the BMI, considered overweight or obese.",!
+3 QUIT
T ;
+1 WRITE ?33,"PATIENT LIST"
+2 WRITE !,"This report will produce a listing of all patients of the age and sex ",!,"that you specify. The report will list their weight, height and BMI.",!
+3 QUIT
E ;
+1 WRITE ?5,"LIST OF PATIENTS WITH POTENTIAL HEIGHT OR WEIGHT ERROR"
+2 WRITE !,"This report will produce a listing of all patients of the age and sex ",!,"that you specify, whose BMI falls below or exceeds the reasonable data check",!,"limits as shown in the BMI Standard reference table.",!
+3 WRITE "These patient records should be checked for possible inaccurate height or ",!,"weight entries.",!
+4 QUIT
+5 ;
TEMPLATE ;If Template was selected
+1 ;
+2 WRITE !
SET DIC("S")="I $P(^(0),U,4)=9000001!($P(^(0),U,4)=2)"
SET DIC="^DIBT("
SET DIC("A")="Enter Patient SEARCH TEMPLATE name: "
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC,DA,DR,DICR
+3 IF Y=-1
SET APCLQUIT=""
KILL APCLTYPE
GOTO START
+4 SET APCLSEAT=+Y
+5 IF $DATA(DIRUT)
GOTO START
+6 GOTO SEX
+7 ;
