PXRMG2R2.m

PXRMG2R2 ;SLC/JVS -GEC #2-REPORT PROMPTS ;2/13/05  20:05

 ;;2.0;CLINICAL REMINDERS;**2**;Feb 04, 2005

 Q

 ;

HOME ;#8 Start of Home Help Eligibility Programs Report

 ;^DISV(  = DBIA #510

 N POP,DIROUT,DIRUT,DUOUT,LOCNP,MENU,PROV,Y

 N REPORT

 ;

 S TPAT=1

HOMEYER D YER Q:$D(DIROUT)!($D(DIRUT))

HOMEQTR D QTR Q:$D(DIROUT)  I $D(DIRUT) K DIRUT G HOMEYER

HOMENAT ;D NAT Q:$D(DIROUT)!($D(DIRUT))  I $D(DIRUT) K DIRUT G HOMEQTR

HOMEPAT D PAT^PXRMGECP Q:$D(DIROUT)  I $D(DIRUT) K DIRUT G HOMEQTR

HOMTPAT I DFNONLY=0 D TPAT Q:$D(DIROUT)  I $D(DIRUT) K DIRUT G HOMEPAT

HOMEIOO D HOMEIO Q:$D(DIROUT)

 Q

HOMEIO ;=====Select IO device

 N ZTRTN,ZTDESC,ZTSAVE

 ;I REPORT="N" S DFNONLY=0 W !!,"Please wait..." D EN^PXRMG2E2,WRITE^PXRMG2E2

 ;I REPORT="N" Q

 N %ZIS

 S %ZIS="QM" D ^%ZIS

 I POP Q

 I $D(IO("Q")) D

 .S ZTRTN="PRINT^PXRMG2R2"

 .S ZTDESC="GEC HOME HELP ELIGIBILITY REPORT"

 .S ZTSAVE("*")=""

 .D ^%ZTLOAD

 ;=====Call Report

 E  W !,"Please wait ..." D EN^PXRMG2E2,EN^PXRMG2R1

 D HOME^%ZIS

 D ^%ZISC

 S:'$D(DIRUT)&('$D(DUOUT))&('$D(DIROUT)) DIR(0)="E" D ^DIR K DIR(0),Y

 Q

 ;=============================================================

PRINT ;Call for printed report

 D EN^PXRMG2E2,ENP^PXRMG2R1

 Q

NAT ;Select National

 W !

 S DIR("A",1)="Select Local or National Report"

 S DIR("A")="REPORT or ^ to exit"

 I $D(^DISV(DUZ,"PXRMGEC","REPORT")) S DIR("B")=$G(^DISV(DUZ,"PXRMGEC","REPORT"))

 S DIR(0)="S^L:LOCAL;N:NATIONAL"

 D ^DIR

 K DIR("A"),DIR("B"),DIR(0)

 Q:$D(DIROUT)!($D(DIRUT))

 S ^DISV(DUZ,"PXRMGEC","REPORT")=X

 S REPORT=Y

 Q

TPAT ;Select Test patients

 W !

 S DIR("A",1)="Select Show Test Patients in this Report?"

 S DIR("A")="Y or N or ^ to exit"

 I $D(^DISV(DUZ,"PXRMGEC","TPAT")) S DIR("B")=$G(^DISV(DUZ,"PXRMGEC","TPAT"))

 S DIR(0)="S^Y:YES;N:NO"

 D ^DIR

 K DIR("A"),DIR("B"),DIR(0)

 Q:$D(DIROUT)!($D(DIRUT))

 S ^DISV(DUZ,"PXRMGEC","TPAT")=X

 I Y="Y" S Y=1

 I Y="N" S Y=0

 S TPAT=Y

 Q

 ;

YER ;Select Year

 W !

 S DIR("A",1)="Select a year for the report (i.e.2005)"

 S DIR("A")="YEAR or ^ to exit"

 I $D(^DISV(DUZ,"PXRMGEC","YEAR")) S DIR("B")=$G(^DISV(DUZ,"PXRMGEC","YEAR"))

 S DIR(0)="N^2004:2030:0"

 D ^DIR

 K DIR("A"),DIR("B"),DIR(0)

 Q:$D(DIROUT)!($D(DIRUT))

 S ^DISV(DUZ,"PXRMGEC","YEAR")=X

 S YEAR=Y

 Q

 ;

QTR ;Select Quarter

 N Z

 W !

 S DIR("A",1)="Select a Fiscal QUARTER in the year "_YEAR_" (i.e.2)"

 S DIR("A",2)="     Fiscal Years start in October."

 S DIR("A",3)="Fiscal Quarter 1 same as Calendar Quarter 4"

 S DIR("A",4)="Fiscal Quarter 2 same as Calendar Quarter 1"

 S DIR("A",5)="Fiscal Quarter 3 same as Calendar Quarter 2"

 S DIR("A",6)="Fiscal Quarter 4 same as Calendar Quarter 3"

 S DIR("A",7)=""

 S DIR("A")="Fiscal Quarter or ^ to exit"

 I $D(^DISV(DUZ,"PXRMGEC","QUARTER")) S DIR("B")=$G(^DISV(DUZ,"PXRMGEC","QUARTER"))

 S DIR(0)="N^1:4:0"

 D ^DIR

 K DIR("A"),DIR("B"),DIR(0)

 Q:$D(DIROUT)!($D(DIRUT))

 S ^DISV(DUZ,"PXRMGEC","QUARTER")=X

 I Y=1 S Z=4

 I Y=2 S Z=1

 I Y=3 S Z=2

 I Y=4 S Z=3

 S FQUARTER=Y

 S QUARTER=Z

 Q

PXRMG2R2  ;SLC/JVS -GEC #2-REPORT PROMPTS ;2/13/05  20:05

 +1       ;;2.0;CLINICAL REMINDERS;**2**;Feb 04, 2005

 +2        QUIT 

 +3       ;

HOME      ;#8 Start of Home Help Eligibility Programs Report

 +1       ;^DISV(  = DBIA #510

 +2        NEW POP,DIROUT,DIRUT,DUOUT,LOCNP,MENU,PROV,Y

 +3        NEW REPORT

 +4       ;

 +5        SET TPAT=1

HOMEYER    DO YER

           IF $DATA(DIROUT)!($DATA(DIRUT))

               QUIT 

HOMEQTR    DO QTR

           IF $DATA(DIROUT)

               QUIT 

           IF $DATA(DIRUT)

               KILL DIRUT

               GOTO HOMEYER

HOMENAT   ;D NAT Q:$D(DIROUT)!($D(DIRUT))  I $D(DIRUT) K DIRUT G HOMEQTR

HOMEPAT    DO PAT^PXRMGECP

           IF $DATA(DIROUT)

               QUIT 

           IF $DATA(DIRUT)

               KILL DIRUT

               GOTO HOMEQTR

HOMTPAT    IF DFNONLY=0

               DO TPAT

               IF $DATA(DIROUT)

                   QUIT 

               IF $DATA(DIRUT)

                   KILL DIRUT

                   GOTO HOMEPAT

HOMEIOO    DO HOMEIO

           IF $DATA(DIROUT)

               QUIT 

 +1        QUIT 

HOMEIO    ;=====Select IO device

 +1        NEW ZTRTN,ZTDESC,ZTSAVE

 +2       ;I REPORT="N" S DFNONLY=0 W !!,"Please wait..." D EN^PXRMG2E2,WRITE^PXRMG2E2

 +3       ;I REPORT="N" Q

 +4        NEW %ZIS

 +5        SET %ZIS="QM"

           DO ^%ZIS

 +6        IF POP

               QUIT 

 +7        IF $DATA(IO("Q"))

               Begin DoDot:1

 +8                SET ZTRTN="PRINT^PXRMG2R2"

 +9                SET ZTDESC="GEC HOME HELP ELIGIBILITY REPORT"

 +10               SET ZTSAVE("*")=""

 +11               DO ^%ZTLOAD

               End DoDot:1

 +12      ;=====Call Report

 +13      IF '$TEST

               WRITE !,"Please wait ..."

               DO EN^PXRMG2E2

               DO EN^PXRMG2R1

 +14       DO HOME^%ZIS

 +15       DO ^%ZISC

 +16       IF '$DATA(DIRUT)&('$DATA(DUOUT))&('$DATA(DIROUT))

               SET DIR(0)="E"

           DO ^DIR

           KILL DIR(0),Y

 +17       QUIT 

 +18      ;=============================================================

PRINT     ;Call for printed report

 +1        DO EN^PXRMG2E2

           DO ENP^PXRMG2R1

 +2        QUIT 

NAT       ;Select National

 +1        WRITE !

 +2        SET DIR("A",1)="Select Local or National Report"

 +3        SET DIR("A")="REPORT or ^ to exit"

 +4        IF $DATA(^DISV(DUZ,"PXRMGEC","REPORT"))

               SET DIR("B")=$GET(^DISV(DUZ,"PXRMGEC","REPORT"))

 +5        SET DIR(0)="S^L:LOCAL;N:NATIONAL"

 +6        DO ^DIR

 +7        KILL DIR("A"),DIR("B"),DIR(0)

 +8        IF $DATA(DIROUT)!($DATA(DIRUT))

               QUIT 

 +9        SET ^DISV(DUZ,"PXRMGEC","REPORT")=X

 +10       SET REPORT=Y

 +11       QUIT 

TPAT      ;Select Test patients

 +1        WRITE !

 +2        SET DIR("A",1)="Select Show Test Patients in this Report?"

 +3        SET DIR("A")="Y or N or ^ to exit"

 +4        IF $DATA(^DISV(DUZ,"PXRMGEC","TPAT"))

               SET DIR("B")=$GET(^DISV(DUZ,"PXRMGEC","TPAT"))

 +5        SET DIR(0)="S^Y:YES;N:NO"

 +6        DO ^DIR

 +7        KILL DIR("A"),DIR("B"),DIR(0)

 +8        IF $DATA(DIROUT)!($DATA(DIRUT))

               QUIT 

 +9        SET ^DISV(DUZ,"PXRMGEC","TPAT")=X

 +10       IF Y="Y"

               SET Y=1

 +11       IF Y="N"

               SET Y=0

 +12       SET TPAT=Y

 +13       QUIT 

 +14      ;

YER       ;Select Year

 +1        WRITE !

 +2        SET DIR("A",1)="Select a year for the report (i.e.2005)"

 +3        SET DIR("A")="YEAR or ^ to exit"

 +4        IF $DATA(^DISV(DUZ,"PXRMGEC","YEAR"))

               SET DIR("B")=$GET(^DISV(DUZ,"PXRMGEC","YEAR"))

 +5        SET DIR(0)="N^2004:2030:0"

 +6        DO ^DIR

 +7        KILL DIR("A"),DIR("B"),DIR(0)

 +8        IF $DATA(DIROUT)!($DATA(DIRUT))

               QUIT 

 +9        SET ^DISV(DUZ,"PXRMGEC","YEAR")=X

 +10       SET YEAR=Y

 +11       QUIT 

 +12      ;

QTR       ;Select Quarter

 +1        NEW Z

 +2        WRITE !

 +3        SET DIR("A",1)="Select a Fiscal QUARTER in the year "_YEAR_" (i.e.2)"

 +4        SET DIR("A",2)="     Fiscal Years start in October."

 +5        SET DIR("A",3)="Fiscal Quarter 1 same as Calendar Quarter 4"

 +6        SET DIR("A",4)="Fiscal Quarter 2 same as Calendar Quarter 1"

 +7        SET DIR("A",5)="Fiscal Quarter 3 same as Calendar Quarter 2"

 +8        SET DIR("A",6)="Fiscal Quarter 4 same as Calendar Quarter 3"

 +9        SET DIR("A",7)=""

 +10       SET DIR("A")="Fiscal Quarter or ^ to exit"

 +11       IF $DATA(^DISV(DUZ,"PXRMGEC","QUARTER"))

               SET DIR("B")=$GET(^DISV(DUZ,"PXRMGEC","QUARTER"))

 +12       SET DIR(0)="N^1:4:0"

 +13       DO ^DIR

 +14       KILL DIR("A"),DIR("B"),DIR(0)

 +15       IF $DATA(DIROUT)!($DATA(DIRUT))

               QUIT 

 +16       SET ^DISV(DUZ,"PXRMGEC","QUARTER")=X

 +17       IF Y=1

               SET Z=4

 +18       IF Y=2

               SET Z=1

 +19       IF Y=3

               SET Z=2

 +20       IF Y=4

               SET Z=3

 +21       SET FQUARTER=Y

 +22       SET QUARTER=Z

 +23       QUIT