source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMGECO.m@ 1806

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

initial load of WorldVistAEHR

File size: 4.9 KB
Line 
1PXRMGECO ;SLC/JVS GEC-Prompts Cont'd ;6/19/03 20:56
2 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
3 Q
4 ;^DISV( = DBIA #510
5 N POP,DIROUT,DIRUT,DUOUT,LOCNP,MENU,PROV,Y
6 N DETAIL,FORMAT
7 ;
8SUM ;#8 Start of Summary (Scoring) report
9 ;
10SUMBDT D BDT^PXRMGECP Q:$D(DIROUT)!($D(DIRUT))
11SUMEDT D EDT^PXRMGECP Q:$D(DIROUT) I $D(DIRUT) K DIRUT G SUMBDT
12SUMPAT D PAT^PXRMGECP Q:$D(DIROUT) I $D(DIRUT) K DIRUT G SUMEDT
13SUMFOR D FOR^PXRMGECP Q:$D(DIROUT) I $D(DIRUT) K DIRUT G SUMPAT
14SUMIOO D SUMIO Q:$D(DIROUT)
15 Q
16SUMIO ;=====Select IO device
17 N %ZIS
18 S %ZIS="QM" D ^%ZIS
19 I POP Q
20 I $D(IO("Q")) D
21 .S ZTRTN="SUM^PXRMGECM"
22 .S ZTDESC="GEC SUMMARY(SCORING) REPORT"
23 .S ZTSAVE("*")=""
24 .D ^%ZTLOAD
25 ;=====Call Report
26 E D SUM^PXRMGECN
27 D HOME^%ZIS
28 D ^%ZISC
29 S:'$D(DIRUT)&('$D(DUOUT))&('$D(DIROUT)) DIR(0)="E" D ^DIR K DIR(0),Y
30 Q
31 ;
32RS ;#7 Start List and array of GEC Categories
33 ;
34 N CAT,CATNA,CNT,STAY,NUM,CATIEN,CATARY,BDT,EDT,CATDA
35 N SYN,IEN,RPT7
36 W @IOF
37 W "GEC Referral Service Categories"
38 S CNT=0
39 S SYN="GECFC" F S SYN=$O(^AUTTHF("D",SYN)) Q:SYN'["GECFC" D
40 .S IEN=0 F S IEN=$O(^AUTTHF("D",SYN,IEN)) Q:IEN="" D
41 ..Q:$P($G(^AUTTHF(IEN,0)),"^",11)=1
42 ..;
43 ..S CATNA=$P($P($G(^AUTTHF(IEN,0)),"^",1)," ",3,7)
44 ..S CATARY(CATNA,IEN)=""
45 S CATNA="" F S CATNA=$O(CATARY(CATNA)) Q:CATNA="" D
46 .S CAT=$O(CATARY(CATNA,0))
47 .S CNT=CNT+1
48 .S CATDA(CNT,CAT)=""
49 .W:CNT#2=1 !,CNT,?4,CATNA
50 .W:CNT#2=0 ?35,CNT,?39,CATNA
51 ;
52RSSC ;=====Select Referred Service Categories
53 W !
54 S DIR("A",1)="Select Categories from the list above using"
55 S DIR("A",2)="Commas and/or Dashes for ranges of numbers."
56 S DIR("A")="Select Categories or ^ to exit"
57 I $D(^DISV(DUZ,"PXRMGEC","RSSC")) S DIR("B")=$G(^DISV(DUZ,"PXRMGEC","RSSC"))
58 S DIR(0)="L^1:"_CNT
59 D ^DIR
60 K DIR("A"),DIR("B"),DIR(0)
61 Q:$D(DIROUT)
62 Q:$D(DIRUT)
63 S ^DISV(DUZ,"PXRMGEC","RSSC")=X
64 N LEN,IME,MEY
65 S LEN=$L(Y,",")
66 S MEY=0 F IME=1:1:LEN-1 S MEY=$P(Y,",",IME) D
67 .S CATMEY(MEY)=""
68 S STAY=0 F S STAY=$O(CATDA(STAY)) Q:STAY="" D
69 .I '$D(CATMEY(STAY)) K CATDA(STAY)
70 S NUM=0 F S NUM=$O(CATDA(NUM)) Q:NUM="" D
71 .S CATIEN($O(CATDA(NUM,0)))=""
72 K CATDA,CATMEY
73RSBDT D BDT^PXRMGECP Q:$D(DIROUT)!$D(DIRUT)
74RSEDT D EDT^PXRMGECP Q:$D(DIROUT) I $D(DIRUT) K DIRUT G RSBDT
75RSPAT D PAT^PXRMGECP Q:$D(DIROUT) I $D(DIRUT) K DIRUT G RSEDT
76RSFOR D FOR^PXRMGECP Q:$D(DIROUT) I $D(DIRUT) K DIRUT G RSPAT
77RSIOO S RPT7=1 D CATIO^PXRMGECP Q:$D(DIROUT)
78 Q
79 ;
80 ;================================================================
81LOC ;By Location in the Hospital
82LOCDIC ;====Select Location
83 ;DBIA #10040 Supported
84 N Y,DIC
85 S DIC="^SC("
86 S DIC(0)="QAMEZ"
87 D ^DIC
88 I Y>0 S LOCNP=$P(Y(0),"^",1)
89 K DIC,DIC(0),Y
90 Q
91 ;
92LOCDIR ; #5 Start of Location Report
93 ;--Returns LOCNP equal to Location Name
94 N BDT,EDT
95 W @IOF
96 K DIR
97 I $D(^DISV(DUZ,"PXRMGEC","LOCDIR")) S DIR("B")=$G(^DISV(DUZ,"PXRMGEC","LOCDIR"))
98 S DIR(0)="S^A:All Locations;S:Single Location"
99 D ^DIR
100 K DIR("A"),DIR("B"),DIR(0)
101 Q:$D(DIRUT)!($D(DUOUT))
102 Q:$D(DIROUT)
103 S ^DISV(DUZ,"PXRMGEC","LOCDIR")=X
104 I Y="A" S LOCNP=1
105 I Y="S" D LOCDIC
106 ;
107LOCBDT D BDT^PXRMGECP Q:$D(DIROUT)!($D(DIRUT))
108LOCEDT D EDT^PXRMGECP Q:$D(DIROUT) I $D(DIRUT) K DIRUT G LOCBDT
109LOCFOR D FOR^PXRMGECP Q:$D(DIROUT) I $D(DIRUT) K DIRUT G LOCEDT
110LOCIOO D LOCIO Q:$D(DIROUT)
111 Q
112LOCIO ;=====Select IO device
113 N %ZIS
114 S %ZIS="QM" D ^%ZIS
115 I POP Q
116 I $D(IO("Q")) D
117 .S ZTRTN="LOC^PXRMGECQ"
118 .S ZTDESC="GEC LOCATION REPORT"
119 .S ZTSAVE("*")=""
120 .D ^%ZTLOAD
121 ;=====Call Report
122 E D LOC^PXRMGECR
123 D HOME^%ZIS
124 D ^%ZISC
125 S:'$D(DIRUT)&('$D(DUOUT))&('$D(DIROUT)) DIR(0)="E" D ^DIR K DIR(0),Y
126 Q
127 ;
128CT ; #6 Start Referral Count Totals
129 ; makes 4 different reports
130 ;
131 N SOR
132CTSOR D SOR Q:$D(DIROUT)!($D(DIRUT))
133CTBDT D BDT^PXRMGECP Q:$D(DIROUT) I $D(DIRUT) K DIRUT G CTSOR
134CTEDT D EDT^PXRMGECP Q:$D(DIROUT) I $D(DIRUT) K DIRUT G CTBDT
135CTFOR D FOR^PXRMGECP Q:$D(DIROUT) I $D(DIRUT) K DIRUT G CTEDT
136CTIOO D CTIO Q:$D(DIROUT)
137 Q
138 ;
139SOR ;======Sort Type
140 ;--Return SOR as Type of report
141 S DIR("A")="Select Sort Type or ^ to exit"
142 I $D(^DISV(DUZ,"PXRMGEC","SOR")) S DIR("B")=$G(^DISV(DUZ,"PXRMGEC","SOR"))
143 S DIR(0)="S^PA:Patient;PR:Provider;L:Location;D:Date"
144 D ^DIR
145 K DIR("A"),DIR("B"),DIR(0)
146 Q:$D(DIRUT)!($D(DIROUT))
147 S ^DISV(DUZ,"PXRMGEC","SOR")=X
148 S SOR=Y
149 Q
150 ;
151CTIO ;=====Select IO device
152 N %ZIS
153 S %ZIS="QM" D ^%ZIS
154 I POP Q
155 ;=====Call Report
156 I SOR="PA" D
157 .I $D(IO("Q")) D
158 ..S ZTRTN="CTP^PXRMGECT"
159 ..S ZTDESC="GEC COUNT TOTALS REPORTS"
160 ..S ZTSAVE("*")=""
161 ..D ^%ZTLOAD
162 .E D CTP^PXRMGECS
163 I SOR="PR" D
164 .I $D(IO("Q")) D
165 ..S ZTRTN="CTDR^PXRMGECT"
166 ..S ZTDESC="GEC COUNT TOTALS REPORTS"
167 ..S ZTSAVE("*")=""
168 ..D ^%ZTLOAD
169 .E D CTDR^PXRMGECS
170 I SOR="L" D
171 .I $D(IO("Q")) D
172 ..S ZTRTN="CTL^PXRMGECT"
173 ..S ZTDESC="GEC COUNT TOTALS REPORTS"
174 ..S ZTSAVE("*")=""
175 ..D ^%ZTLOAD
176 .E D CTL^PXRMGECS
177 I SOR="D" D
178 .I $D(IO("Q")) D
179 ..S ZTRTN="CTD^PXRMGECT"
180 ..S ZTDESC="GEC COUNT TOTALS REPORTS"
181 ..S ZTSAVE("*")=""
182 ..D ^%ZTLOAD
183 .E D CTD^PXRMGECS
184 D ^%ZISC
185 S:'$D(DIRUT)&('$D(DUOUT))&('$D(DIROUT)) DIR(0)="E" D ^DIR K DIR(0),Y
186 Q
187 ;
Note: See TracBrowser for help on using the repository browser.