APCLW6.m

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