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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMG2R2 3058 printed Sep 23, 2025@19:21:39 Page 2
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
