source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMG2R2.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 2.9 KB
RevLine 
[613]1PXRMG2R2 ;SLC/JVS -GEC #2-REPORT PROMPTS ;2/13/05 20:05
2 ;;2.0;CLINICAL REMINDERS;**2**;Feb 04, 2005
3 Q
4 ;
5HOME ;#8 Start of Home Help Eligibility Programs Report
6 ;^DISV( = DBIA #510
7 N POP,DIROUT,DIRUT,DUOUT,LOCNP,MENU,PROV,Y
8 N REPORT
9 ;
10 S TPAT=1
11HOMEYER D YER Q:$D(DIROUT)!($D(DIRUT))
12HOMEQTR D QTR Q:$D(DIROUT) I $D(DIRUT) K DIRUT G HOMEYER
13HOMENAT ;D NAT Q:$D(DIROUT)!($D(DIRUT)) I $D(DIRUT) K DIRUT G HOMEQTR
14HOMEPAT D PAT^PXRMGECP Q:$D(DIROUT) I $D(DIRUT) K DIRUT G HOMEQTR
15HOMTPAT I DFNONLY=0 D TPAT Q:$D(DIROUT) I $D(DIRUT) K DIRUT G HOMEPAT
16HOMEIOO D HOMEIO Q:$D(DIROUT)
17 Q
18HOMEIO ;=====Select IO device
19 N ZTRTN,ZTDESC,ZTSAVE
20 ;I REPORT="N" S DFNONLY=0 W !!,"Please wait..." D EN^PXRMG2E2,WRITE^PXRMG2E2
21 ;I REPORT="N" Q
22 N %ZIS
23 S %ZIS="QM" D ^%ZIS
24 I POP Q
25 I $D(IO("Q")) D
26 .S ZTRTN="PRINT^PXRMG2R2"
27 .S ZTDESC="GEC HOME HELP ELIGIBILITY REPORT"
28 .S ZTSAVE("*")=""
29 .D ^%ZTLOAD
30 ;=====Call Report
31 E W !,"Please wait ..." D EN^PXRMG2E2,EN^PXRMG2R1
32 D HOME^%ZIS
33 D ^%ZISC
34 S:'$D(DIRUT)&('$D(DUOUT))&('$D(DIROUT)) DIR(0)="E" D ^DIR K DIR(0),Y
35 Q
36 ;=============================================================
37PRINT ;Call for printed report
38 D EN^PXRMG2E2,ENP^PXRMG2R1
39 Q
40NAT ;Select National
41 W !
42 S DIR("A",1)="Select Local or National Report"
43 S DIR("A")="REPORT or ^ to exit"
44 I $D(^DISV(DUZ,"PXRMGEC","REPORT")) S DIR("B")=$G(^DISV(DUZ,"PXRMGEC","REPORT"))
45 S DIR(0)="S^L:LOCAL;N:NATIONAL"
46 D ^DIR
47 K DIR("A"),DIR("B"),DIR(0)
48 Q:$D(DIROUT)!($D(DIRUT))
49 S ^DISV(DUZ,"PXRMGEC","REPORT")=X
50 S REPORT=Y
51 Q
52TPAT ;Select Test patients
53 W !
54 S DIR("A",1)="Select Show Test Patients in this Report?"
55 S DIR("A")="Y or N or ^ to exit"
56 I $D(^DISV(DUZ,"PXRMGEC","TPAT")) S DIR("B")=$G(^DISV(DUZ,"PXRMGEC","TPAT"))
57 S DIR(0)="S^Y:YES;N:NO"
58 D ^DIR
59 K DIR("A"),DIR("B"),DIR(0)
60 Q:$D(DIROUT)!($D(DIRUT))
61 S ^DISV(DUZ,"PXRMGEC","TPAT")=X
62 I Y="Y" S Y=1
63 I Y="N" S Y=0
64 S TPAT=Y
65 Q
66 ;
67YER ;Select Year
68 W !
69 S DIR("A",1)="Select a year for the report (i.e.2005)"
70 S DIR("A")="YEAR or ^ to exit"
71 I $D(^DISV(DUZ,"PXRMGEC","YEAR")) S DIR("B")=$G(^DISV(DUZ,"PXRMGEC","YEAR"))
72 S DIR(0)="N^2004:2030:0"
73 D ^DIR
74 K DIR("A"),DIR("B"),DIR(0)
75 Q:$D(DIROUT)!($D(DIRUT))
76 S ^DISV(DUZ,"PXRMGEC","YEAR")=X
77 S YEAR=Y
78 Q
79 ;
80QTR ;Select Quarter
81 N Z
82 W !
83 S DIR("A",1)="Select a Fiscal QUARTER in the year "_YEAR_" (i.e.2)"
84 S DIR("A",2)=" Fiscal Years start in October."
85 S DIR("A",3)="Fiscal Quarter 1 same as Calendar Quarter 4"
86 S DIR("A",4)="Fiscal Quarter 2 same as Calendar Quarter 1"
87 S DIR("A",5)="Fiscal Quarter 3 same as Calendar Quarter 2"
88 S DIR("A",6)="Fiscal Quarter 4 same as Calendar Quarter 3"
89 S DIR("A",7)=""
90 S DIR("A")="Fiscal Quarter or ^ to exit"
91 I $D(^DISV(DUZ,"PXRMGEC","QUARTER")) S DIR("B")=$G(^DISV(DUZ,"PXRMGEC","QUARTER"))
92 S DIR(0)="N^1:4:0"
93 D ^DIR
94 K DIR("A"),DIR("B"),DIR(0)
95 Q:$D(DIROUT)!($D(DIRUT))
96 S ^DISV(DUZ,"PXRMGEC","QUARTER")=X
97 I Y=1 S Z=4
98 I Y=2 S Z=1
99 I Y=3 S Z=2
100 I Y=4 S Z=3
101 S FQUARTER=Y
102 S QUARTER=Z
103 Q
Note: See TracBrowser for help on using the repository browser.