APCLW6 ; IHS/CMI/LAB - AGE BUCKET/DIAGNOSIS REPORT ;
;;2.0;IHS PCC SUITE;**10**;MAY 14, 2009;Build 88
;
START ;
W !!,"***** PATIENTS MOVING UP OR DOWN 2 PERCENTILES IN THE BMI CURVE *****",!!
W !,"This report will prompt you to enter a date range. The report will"
W !,"list all patients who have moved from the normal to the "
W !,"NHANES 85th-94th Percentile or have moved from the NHANES 85th-94th"
W !,"Percentile to the NHANES >= 95th Percentile in the date range"
W !,"that you specify."
W !
D EXIT
S APCLSEAT="",APCLCMS=""
S APCLTYPE=""
;
DATES K APCLED,APCLBD
K DIR W ! S DIR(0)="DO^::EXP",DIR("A")="Enter Beginning Visit Date"
D ^DIR Q:Y<1 S APCLBD=Y
K DIR S DIR(0)="DO^:DT:EXP",DIR("A")="Enter Ending Visit Date"
D ^DIR Q:Y<1 S APCLED=Y
;
I APCLED<APCLBD D G DATES
. W !!,$C(7),"Sorry, Ending Date MUST not be earlier than Beginning Date."
ST ;
S DIR(0)="S^S:Search Template of Patients;P:All Patients within an age range"
S DIR("A")=" Select List " D ^DIR K DIR S:$D(DUOUT) DIRUT=1
G:$D(DIRUT) EXIT
S APCLTYPE=Y
I APCLTYPE="S" D TEMPLATE G:APCLSEAT="" START
I APCLTYPE="P" D AGE I APCLLOWA=""!(APCLHGHA="")!(APCLBEG="") G DATES
;
SEX ;
S DIR(0)="S^M:Males;F:Females;B:Both",DIR("A")="Do you want the report to include",DIR("B")="B" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
G:$D(DIRUT) START
S APCLSEX=Y
ZIS ;
DEMO ;
D DEMOCHK^APCLUTL(.APCLDEMO)
I APCLDEMO=-1 G SEX
S XBRC="^APCLW61",XBRP="^APCLW6P",XBNS="APCL",XBRX="EXIT^APCLW6"
D ^XBDBQUE
D EXIT
Q
AGE ;
S (APCLLOWA,APCLHGHA,APCLBEG)=""
S DIR(0)="N^2:74:0",DIR("A")="Enter the low age",DIR("B")="" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
Q:$D(DIRUT)
S APCLLOWA=Y
S DIR(0)="N^"_APCLLOWA_":74:0",DIR("A")="Enter the high age",DIR("B")="" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
Q:$D(DIRUT)
S APCLHGHA=Y
W !!,"When determining which patients are in the ",APCLLOWA," to ",APCLHGHA," age range"
W !,"should the age of the patient be calculated based on the beginning"
W !,"or ending date of the time period?",!
S APCLBEG=""
S DIR(0)="S^B:Beginning of Time Period ("_$$FMTE^XLFDT(APCLBD)_");E:End of Time Period ("_$$FMTE^XLFDT(APCLED)_"):",DIR("A")="Calculate Age based on what date",DIR("B")="B" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
G:$D(DIRUT) AGE
S APCLBEG=Y
Q
EXIT ;
D EN^XBVK("APCL")
D KILL^AUPNPAT
K B,D,DA,DFN,DIC,DIR,DIRUT,J,K,M,P,R,S,T,V,X,X1,X2,Y,Z
K DIR,DA,DIC,J,K,M,S,X,Y,APCLSEAT,APCLTYPE
Q
;
TEMPLATE ;If Template was selected
S APCLSEAT=""
;
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 K APCLTYPE Q
S APCLSEAT=+Y
Q
APCLW6 ; IHS/CMI/LAB - AGE BUCKET/DIAGNOSIS REPORT ;
+1 ;;2.0;IHS PCC SUITE;**10**;MAY 14, 2009;Build 88
+2 ;
START ;
+1 WRITE !!,"***** PATIENTS MOVING UP OR DOWN 2 PERCENTILES IN THE BMI CURVE *****",!!
+2 WRITE !,"This report will prompt you to enter a date range. The report will"
+3 WRITE !,"list all patients who have moved from the normal to the "
+4 WRITE !,"NHANES 85th-94th Percentile or have moved from the NHANES 85th-94th"
+5 WRITE !,"Percentile to the NHANES >= 95th Percentile in the date range"
+6 WRITE !,"that you specify."
+7 WRITE !
+8 DO EXIT
+9 SET APCLSEAT=""
SET APCLCMS=""
+10 SET APCLTYPE=""
+11 ;
DATES KILL APCLED,APCLBD
+1 KILL DIR
WRITE !
SET DIR(0)="DO^::EXP"
SET DIR("A")="Enter Beginning Visit Date"
+2 DO ^DIR
IF Y<1
QUIT
SET APCLBD=Y
+3 KILL DIR
SET DIR(0)="DO^:DT:EXP"
SET DIR("A")="Enter Ending Visit Date"
+4 DO ^DIR
IF Y<1
QUIT
SET APCLED=Y
+5 ;
+6 IF APCLED<APCLBD
Begin DoDot:1
+7 WRITE !!,$CHAR(7),"Sorry, Ending Date MUST not be earlier than Beginning Date."
End DoDot:1
GOTO DATES
ST ;
+1 SET DIR(0)="S^S:Search Template of Patients;P:All Patients within an age range"
+2 SET DIR("A")=" Select List "
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+3 IF $DATA(DIRUT)
GOTO EXIT
+4 SET APCLTYPE=Y
+5 IF APCLTYPE="S"
DO TEMPLATE
IF APCLSEAT=""
GOTO START
+6 IF APCLTYPE="P"
DO AGE
IF APCLLOWA=""!(APCLHGHA="")!(APCLBEG="")
GOTO DATES
+7 ;
SEX ;
+1 SET DIR(0)="S^M:Males;F:Females;B:Both"
SET DIR("A")="Do you want the report to 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
ZIS ;
DEMO ;
+1 DO DEMOCHK^APCLUTL(.APCLDEMO)
+2 IF APCLDEMO=-1
GOTO SEX
+3 SET XBRC="^APCLW61"
SET XBRP="^APCLW6P"
SET XBNS="APCL"
SET XBRX="EXIT^APCLW6"
+4 DO ^XBDBQUE
+5 DO EXIT
+6 QUIT
AGE ;
+1 SET (APCLLOWA,APCLHGHA,APCLBEG)=""
+2 SET DIR(0)="N^2:74:0"
SET DIR("A")="Enter the low age"
SET DIR("B")=""
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+3 IF $DATA(DIRUT)
QUIT
+4 SET APCLLOWA=Y
+5 SET DIR(0)="N^"_APCLLOWA_":74:0"
SET DIR("A")="Enter the high age"
SET DIR("B")=""
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+6 IF $DATA(DIRUT)
QUIT
+7 SET APCLHGHA=Y
+8 WRITE !!,"When determining which patients are in the ",APCLLOWA," to ",APCLHGHA," age range"
+9 WRITE !,"should the age of the patient be calculated based on the beginning"
+10 WRITE !,"or ending date of the time period?",!
+11 SET APCLBEG=""
+12 SET DIR(0)="S^B:Beginning of Time Period ("_$$FMTE^XLFDT(APCLBD)_");E:End of Time Period ("_$$FMTE^XLFDT(APCLED)_"):"
SET DIR("A")="Calculate Age based on what date"
SET DIR("B")="B"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+13 IF $DATA(DIRUT)
GOTO AGE
+14 SET APCLBEG=Y
+15 QUIT
EXIT ;
+1 DO EN^XBVK("APCL")
+2 DO KILL^AUPNPAT
+3 KILL B,D,DA,DFN,DIC,DIR,DIRUT,J,K,M,P,R,S,T,V,X,X1,X2,Y,Z
+4 KILL DIR,DA,DIC,J,K,M,S,X,Y,APCLSEAT,APCLTYPE
+5 QUIT
+6 ;
TEMPLATE ;If Template was selected
+1 SET APCLSEAT=""
+2 ;
+3 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
+4 IF Y=-1
KILL APCLTYPE
QUIT
+5 SET APCLSEAT=+Y
+6 QUIT
