source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWGAPI2.m@ 1800

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

revised back to 6/30/08 version

File size: 8.2 KB
Line 
1ORWGAPI2 ; SLC/STAFF - Graph API Items ;12/21/05 08:16
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**215**;Dec 17, 1997
3 ;
4ADMITS(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
5 N DATE,DATE2,DISCH,LINE,LST,NUM,OK,RESULT K LST
6 K ^TMP("ORWGRPC TEMP",$J)
7 D ADMITLST^ORWPT(.LST,DFN)
8 S OK=0
9 S NUM=0
10 F S NUM=$O(LST(NUM)) Q:NUM<1 D Q:OK
11 . S LINE=LST(NUM)
12 . S DATE=$P(LINE,U)
13 . S DISCH=$P(LINE,U,5)
14 . S DATE2=$$DISCH^ORWGAPIA(DISCH)
15 . I DATE2="" S DATE2=DATE2\1
16 . I FMT=6 D Q
17 .. I DATE>NEWEST Q
18 .. I DATE2>0,DATE2<OLDEST Q
19 .. I $D(^TMP("ORWGRPC TEMP",$J,"ADMIT")) Q
20 .. S ^TMP("ORWGRPC TEMP",$J,"ADMIT")=""
21 .. S CNT=CNT+1
22 .. S OK=1
23 .. S RESULT="405^ADMIT"
24 . I FMT=3 D Q
25 .. I $D(^TMP("ORWGRPC TEMP",$J,"ADMIT")) Q
26 .. S ^TMP("ORWGRPC TEMP",$J,"ADMIT")=""
27 .. S CNT=CNT+1
28 .. S OK=1
29 .. S RESULT="405^ADMIT^^ADMIT^^"_DATE
30 . I FMT=0 D Q
31 .. S ^TMP("ORWGRPC TEMP",$J,"ADMIT")=""
32 .. S CNT=CNT+1
33 .. S OK=1
34 .. S RESULT="405^ADMIT^ADMIT"
35 I OK D SETUP^ORWGAPIU(.ITEMS,RESULT,TMP,.CNT)
36 K ^TMP("ORWGRPC TEMP",$J)
37 Q
38 ;
39ADVERSE(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
40 N DATE,IEN,ITEM,RESULT
41 K ^TMP("ORWGRPC SORT",$J),^TMP("ORWGRPC TEMP",$J)
42 S IEN=0
43 F S IEN=$O(^GMR(120.8,"B",DFN,IEN)) Q:IEN<1 D
44 . I '$D(^GMR(120.8,IEN,0)) Q
45 . I $G(^GMR(120.8,IEN,"ER")) Q
46 . I '$P(^GMR(120.8,IEN,0),U,12) Q
47 . S DATE=+$P($G(^GMR(120.8,IEN,0)),U,4) I 'DATE Q
48 . S ITEM=$P(^GMR(120.8,IEN,0),U,2) I '$L(ITEM) Q
49 . S ^TMP("ORWGRPC SORT",$J,DATE,ITEM)="" ;ADVERSE
50 I FMT=6 D
51 . S DATE=OLDEST
52 . F S DATE=$O(^TMP("ORWGRPC SORT",$J,DATE)) Q:DATE<1 Q:DATE>NEWEST D
53 .. S ITEM=""
54 .. F S ITEM=$O(^TMP("ORWGRPC SORT",$J,DATE,ITEM)) Q:ITEM="" D
55 ... I $D(^TMP("ORWGRPC TEMP",$J,ITEM)) Q
56 ... S ^TMP("ORWGRPC TEMP",$J,ITEM)=""
57 ... S CNT=CNT+1
58 ... S RESULT="120.8^"_ITEM
59 ... D SETUP^ORWGAPIU(.ITEMS,RESULT,TMP,.CNT)
60 I FMT'=6 D
61 . S DATE=0
62 . F S DATE=$O(^TMP("ORWGRPC SORT",$J,DATE)) Q:DATE<1 D
63 .. S ITEM=""
64 .. F S ITEM=$O(^TMP("ORWGRPC SORT",$J,DATE,ITEM)) Q:ITEM="" D
65 ... I $D(^TMP("ORWGRPC TEMP",$J,ITEM)) Q
66 ... S ^TMP("ORWGRPC TEMP",$J,ITEM)=""
67 ... S CNT=CNT+1
68 ... I FMT=3 S RESULT="120.8^"_ITEM_"^^"_ITEM_"^^"_DATE
69 ... I FMT=0 S RESULT="120.8^"_ITEM_U_ITEM
70 ... D SETUP^ORWGAPIU(.ITEMS,RESULT,TMP,.CNT)
71 K ^TMP("ORWGRPC SORT",$J),^TMP("ORWGRPC TEMP",$J)
72 Q
73 ;
74PL(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
75 N DATE,ICD9,OK,PRIORITY,RESULT,STATUS
76 K ^TMP("ORWGRPC TEMP",$J)
77 S STATUS=""
78 F S STATUS=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS)) Q:STATUS="" D
79 . S PRIORITY=""
80 . F S PRIORITY=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY)) Q:PRIORITY="" D
81 .. S ICD9=""
82 .. F S ICD9=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY,ICD9)) Q:ICD9="" D
83 ... S OK=0
84 ... I FMT=6 D
85 .... S DATE=OLDEST
86 .... F S DATE=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY,ICD9,DATE)) Q:DATE="" Q:DATE>NEWEST D Q:OK
87 ..... S CNT=CNT+1
88 ..... S OK=1
89 ..... S RESULT=9000011_U_ICD9
90 ... I FMT=3 D
91 .... S DATE=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY,ICD9,""),-1)
92 .... I DATE S ^TMP("ORWGRPC TEMP",$J,ICD9,DATE)=""
93 ... I FMT=0 D
94 .... S CNT=CNT+1
95 .... S OK=1
96 .... S RESULT=9000011_U_ICD9_U_$$EVALUE^ORWGAPIU(ICD9,9000011,.01)
97 ... I OK D SETUP^ORWGAPIU(.ITEMS,RESULT,TMP,.CNT)
98 I FMT=3 D
99 . S ICD9=""
100 . F S ICD9=$O(^TMP("ORWGRPC TEMP",$J,ICD9)) Q:ICD9="" D
101 .. S DATE=$O(^TMP("ORWGRPC TEMP",$J,ICD9,""),-1)
102 .. I 'DATE Q
103 .. S CNT=CNT+1
104 .. S RESULT=9000011_U_ICD9_"^^"_$$EVALUE^ORWGAPIU(ICD9,9000011,.01)_"^^"_DATE
105 .. D SETUP^ORWGAPIU(.ITEMS,RESULT,TMP,.CNT)
106 K ^TMP("ORWGRPC TEMP",$J)
107 Q
108 ;
109PLX(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
110 D PLX2^ORWGAPID(.ITEMS,DFN,FMT,OLDEST,NEWEST,.CNT,.TMP)
111 Q
112 ;
113REG(ITEMS,DFN,FILE,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
114 N DATE,ICD,ITEM,NUM,OK,RESULT
115 K ^TMP("ORWGRPC TEMP",$J)
116 I $E(FILE,3,4)="DX" S ICD="ICD9"
117 I $E(FILE,3,4)="OP" S ICD="ICD0"
118 S NUM=""
119 F S NUM=$O(^PXRMINDX(45,ICD,"PNI",DFN,NUM)) Q:NUM="" D
120 . S ITEM=""
121 . F S ITEM=$O(^PXRMINDX(45,ICD,"PNI",DFN,NUM,ITEM)) Q:ITEM="" D
122 .. S OK=0
123 .. I FMT=6 D
124 ... S DATE=OLDEST
125 ... F S DATE=$O(^PXRMINDX(45,ICD,"PNI",DFN,NUM,ITEM,DATE)) Q:DATE="" Q:DATE>NEWEST D Q:OK
126 .... S CNT=CNT+1
127 .... S OK=1
128 .... S RESULT=FILE_U_ITEM
129 .. I FMT=3 D
130 ... S DATE=$O(^PXRMINDX(45,ICD,"PNI",DFN,NUM,ITEM,""),-1)
131 ... I DATE S ^TMP("ORWGRPC TEMP",$J,ITEM,DATE)=""
132 .. I FMT=0 D
133 ... S CNT=CNT+1
134 ... S OK=1
135 ... S RESULT=FILE_U_ITEM_U_$$EVALUE^ORWGAPIU(ITEM,45_";"_ICD,.01)
136 .. I OK D SETUP^ORWGAPIU(.ITEMS,RESULT,TMP,.CNT)
137 I FMT=3 D
138 . S ITEM=""
139 . F S ITEM=$O(^TMP("ORWGRPC TEMP",$J,ITEM)) Q:ITEM="" D
140 .. S DATE=$O(^TMP("ORWGRPC TEMP",$J,ITEM,""),-1)
141 .. I 'DATE Q
142 .. S CNT=CNT+1
143 .. S RESULT=FILE_U_ITEM_"^^"_$$EVALUE^ORWGAPIU(ITEM,45_";"_ICD,.01)_"^^"_DATE
144 .. D SETUP^ORWGAPIU(.ITEMS,RESULT,TMP,.CNT)
145 K ^TMP("ORWGRPC TEMP",$J)
146 Q
147 ;
148SURGERY(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
149 N CASE,DATE,PROC,RESULT,RESULTS,SURG,SURGPROC K SURG,SURGPROC
150 D SURG^ORWGAPIA(.SURG,DFN)
151 K SURG(0),SURG(1)
152 I FMT=6 D
153 . S CASE=0
154 . F S CASE=$O(SURG(CASE)) Q:CASE<1 D
155 .. S RESULTS=SURG(CASE)
156 .. S PROC=$P(RESULTS,U,3)
157 .. I '$L(PROC) Q
158 .. S DATE=$P(RESULTS,U,5)
159 .. I DATE>NEWEST Q
160 .. I DATE<OLDEST Q
161 .. I $D(SURGPROC(PROC)) Q
162 .. S SURGPROC(PROC)=""
163 .. S CNT=CNT+1
164 .. S RESULT=130_U_PROC
165 .. D SETUP^ORWGAPIU(.ITEMS,RESULT,TMP,.CNT)
166 I FMT'=6 D
167 . S CASE=0
168 . F S CASE=$O(SURG(CASE)) Q:CASE<1 D
169 .. S RESULTS=SURG(CASE)
170 .. S PROC=$P(RESULTS,U,3)
171 .. I '$L(PROC) Q
172 .. S SURGPROC(PROC)=RESULTS
173 . K SURG S PROC=""
174 . F S PROC=$O(SURGPROC(PROC)) Q:PROC="" D
175 .. S CNT=CNT+1
176 .. I FMT=3 S RESULT=130_U_PROC_"^^"_PROC_"^^"_$P(SURGPROC(PROC),U,5)
177 .. I FMT=0 S RESULT=130_U_PROC_U_PROC
178 .. D SETUP^ORWGAPIU(.ITEMS,RESULT,TMP,.CNT)
179 Q
180 ;
181TREAT(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR ***** change to inverse dates
182 N DATE,IEN,ITEM,OLDEST1,RESULT
183 K ^TMP("ORWGRPC TEMP",$J)
184 I FMT=6 D
185 . S OLDEST1=9999999-OLDEST
186 . S DATE=9999999-NEWEST
187 . F S DATE=$O(^AUPNVTRT("AA",DFN,DATE)) Q:DATE<1 Q:DATE>OLDEST1 D
188 .. S IEN=0
189 .. F S IEN=$O(^AUPNVTRT("AA",DFN,DATE,IEN)) Q:IEN<1 D
190 ... S ITEM=+$G(^AUPNVTRT(IEN,0)) I 'ITEM Q
191 ... I $D(^TMP("ORWGRPC TEMP",$J,ITEM)) Q
192 ... S ^TMP("ORWGRPC TEMP",$J,ITEM)=""
193 ... S CNT=CNT+1
194 ... S RESULT="9000010.15^"_ITEM
195 ... D SETUP^ORWGAPIU(.ITEMS,RESULT,TMP,.CNT)
196 I FMT'=6 D
197 . S OLDEST1=9999999-OLDEST
198 . S DATE=9999999-NEWEST
199 . F S DATE=$O(^AUPNVTRT("AA",DFN,DATE)) Q:DATE<1 Q:DATE>OLDEST D
200 .. S IEN=0
201 .. F S IEN=$O(^AUPNVTRT("AA",DFN,DATE,IEN)) Q:IEN<1 D
202 ... S ITEM=+$G(^AUPNVTRT(IEN,0)) I 'ITEM Q
203 ... I $D(^TMP("ORWGRPC TEMP",$J,ITEM)) Q
204 ... S ^TMP("ORWGRPC TEMP",$J,ITEM)=""
205 ... S CNT=CNT+1
206 ... I FMT=3 S RESULT="9000010.15^"_ITEM_"^^"_$$EVALUE^ORWGAPIU(ITEM,9000010.15)_"^^"_DATE
207 ... I FMT=0 S RESULT="9000010.15^"_ITEM_U_$$EVALUE^ORWGAPIU(ITEM,9000010.15)
208 ... D SETUP^ORWGAPIU(.ITEMS,RESULT,TMP,.CNT)
209 K ^TMP("ORWGRPC TEMP",$J)
210 Q
211 ;
212VISITS(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
213 N DATE,DATE2,ITEM,NODE,NUM,OK,RESULT
214 K ^TMP("ORWGRPC TEMP",$J)
215 I FMT=6 D
216 . S DATE=0
217 . F S DATE=$O(^AUPNVSIT("AET",DFN,DATE)) Q:DATE<1 Q:DATE>NEWEST D
218 .. S ITEM=""
219 .. F S ITEM=$O(^AUPNVSIT("AET",DFN,DATE,ITEM)) Q:ITEM="" D
220 ... S NODE=""
221 ... F S NODE=$O(^AUPNVSIT("AET",DFN,DATE,ITEM,NODE)) Q:NODE="" D
222 .... S NUM=0
223 .... F S NUM=$O(^AUPNVSIT("AET",DFN,DATE,ITEM,NODE,NUM)) Q:NUM="" D
224 ..... S DATE2=+$P($G(^AUPNVSIT(NUM,0)),U,18)
225 ..... I 'DATE2 S DATE2=DATE+.01
226 ..... I +$E($P(DATE2,".",2),1,2)>24 S DATE2=(DATE\1)+.2359
227 ..... S ^TMP("ORWGRPC TEMP",$J,ITEM,DATE)=DATE2
228 . S ITEM=0
229 . F S ITEM=$O(^TMP("ORWGRPC TEMP",$J,ITEM)) Q:ITEM<1 D
230 .. S OK=0
231 .. S DATE=0
232 .. F S DATE=$O(^TMP("ORWGRPC TEMP",$J,ITEM,DATE)) Q:DATE<1 Q:DATE>NEWEST D Q:OK
233 ... S DATE2=$G(^TMP("ORWGRPC TEMP",$J,ITEM,DATE))
234 ... I DATE2<OLDEST Q
235 ... S CNT=CNT+1
236 ... S OK=1
237 ... S RESULT="9000010^"_ITEM
238 ... D SETUP^ORWGAPIU(.ITEMS,RESULT,TMP,.CNT)
239 I FMT'=6 D
240 . S DATE=0
241 . F S DATE=$O(^AUPNVSIT("AET",DFN,DATE)) Q:DATE<1 D
242 .. S ITEM=0
243 .. F S ITEM=$O(^AUPNVSIT("AET",DFN,DATE,ITEM)) Q:ITEM<1 D
244 ... I $D(^TMP("ORWGRPC TEMP",$J,ITEM)) Q
245 ... S ^TMP("ORWGRPC TEMP",$J,ITEM)=""
246 ... S CNT=CNT+1
247 ... I FMT=3 S RESULT="9000010^"_ITEM_"^^"_$$EVALUE^ORWGAPIU(ITEM,9000010,.22)_"^^"_DATE
248 ... I FMT=0 S RESULT="9000010^"_ITEM_U_$$EVALUE^ORWGAPIU(ITEM,9000010,.22)
249 ... D SETUP^ORWGAPIU(.ITEMS,RESULT,TMP,.CNT)
250 K ^TMP("ORWGRPC TEMP",$J)
251 Q
252 ;
Note: See TracBrowser for help on using the repository browser.