source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWGAPI4.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 9.2 KB
Line 
1ORWGAPI4 ; SLC/STAFF - Graph Data ;8/21/06 07:52
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**215,260**;Dec 17, 1997;Build 26
3 ;
4ADMIT(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
5 N DATE,DATE2,DISCH,LINE,LST,NUM,RESULT,VALUE K LST
6 S ITEM=$G(ITEM,"ADMIT")
7 D ADMITLST^ORWPT(.LST,DFN)
8 S NUM=0
9 F S NUM=$O(LST(NUM)) Q:NUM<1 D
10 . S LINE=LST(NUM)
11 . S DATE=$P(LINE,U)
12 . I DATE>START Q
13 . S DISCH=$P(LINE,U,5)
14 . S DATE2=$$DISCH^ORWGAPIA(DISCH)
15 . I DATE2="" D
16 .. S DATE2=$$FMADD^ORWGAPIX(DATE,$$LOS^ORWGAPIA(DISCH)+1)
17 .. I DATE2=-1 S DATE2=$$FMADD^ORWGAPIX(DT,1) ; just make it today + 1
18 .. S DATE2=DATE2\1
19 . S VALUE=$P(LINE,U,3)_" "_$P(LINE,U,4)_U_$P(LINE,U,5,6)
20 . S CNT=CNT+1
21 . S RESULT=405_U_ITEM_U_DATE_U_DATE2_U_VALUE
22 . D SETUP^ORWGAPIU(.DATA,RESULT,TMP,.CNT)
23 Q
24 ;
25EDU(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
26 N DATE,DATE2,NODE,RESULT,VALUE K VALUE
27 S DATE="",DATE2="",CNT=$G(CNT)
28 F S DATE=$O(^PXRMINDX(9000010.16,"PI",DFN,ITEM,DATE)) Q:DATE="" D
29 . I DATE>START Q
30 . S NODE=""
31 . F S NODE=$O(^PXRMINDX(9000010.16,"PI",DFN,ITEM,DATE,NODE)) Q:NODE="" D
32 .. D EDU^ORWGAPIA(NODE,.VALUE)
33 .. S VALUE=VALUE("VALUE"),VALUE=VALUE_U_$$EVALUE^ORWGAPIU(VALUE,9000010.16,.06)
34 .. S RESULT=9000010.16_U_ITEM_U_DATE_"^^" ;_VALUE
35 .. S RESULT=9000010.16_U_ITEM_U_DATE_U_DATE2_U ;_VALUE
36 .. D SETUP^ORWGAPIU(.DATA,RESULT,TMP,.CNT)
37 Q
38 ;
39EXAM(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
40 N DATE,DATE2,NODE,RESULT,VALUE K VALUE
41 S DATE="",DATE2="",CNT=$G(CNT)
42 F S DATE=$O(^PXRMINDX(9000010.13,"PI",DFN,ITEM,DATE)) Q:DATE="" D
43 . I DATE>START Q
44 . S NODE=""
45 . F S NODE=$O(^PXRMINDX(9000010.13,"PI",DFN,ITEM,DATE,NODE)) Q:NODE="" D
46 .. D EXAM^ORWGAPIA(NODE,.VALUE)
47 .. S VALUE=$G(VALUE("VALUE")),VALUE=VALUE_U_$$EVALUE^ORWGAPIU(VALUE,9000010.13,.04)
48 .. S RESULT=9000010.13_U_ITEM_U_DATE_U_DATE2_U_VALUE
49 .. D SETUP^ORWGAPIU(.DATA,RESULT,TMP,.CNT)
50 Q
51 ;
52HF(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
53 N DATE,DATE2,NODE,RESULT,VALUE K VALUE
54 S DATE="",DATE2="",CNT=$G(CNT)
55 F S DATE=$O(^PXRMINDX(9000010.23,"PI",DFN,ITEM,DATE)) Q:DATE="" D
56 . I DATE>START Q
57 . S NODE=""
58 . F S NODE=$O(^PXRMINDX(9000010.23,"PI",DFN,ITEM,DATE,NODE)) Q:NODE="" D
59 .. D HF^ORWGAPIA(NODE,.VALUE)
60 .. S VALUE=VALUE("VALUE"),VALUE=VALUE_U_$$EVALUE^ORWGAPIU(VALUE,9000010.23,.04)
61 .. S RESULT=9000010.23_U_ITEM_U_DATE_U_DATE2_U_VALUE
62 .. D SETUP^ORWGAPIU(.DATA,RESULT,TMP,.CNT)
63 Q
64 ;
65IMM(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
66 N DATE,DATE2,NODE,RESULT,VALUE K VALUE
67 S DATE="",DATE2="",CNT=$G(CNT)
68 F S DATE=$O(^PXRMINDX(9000010.11,"PI",DFN,ITEM,DATE)) Q:DATE="" D
69 . I DATE>START Q
70 . S NODE=""
71 . F S NODE=$O(^PXRMINDX(9000010.11,"PI",DFN,ITEM,DATE,NODE)) Q:NODE="" D
72 .. D IMM^ORWGAPIA(NODE,.VALUE)
73 .. S VALUE=$G(VALUE("VALUE")),VALUE=VALUE_U_$$EVALUE^ORWGAPIU(VALUE,9000010.11,.04)
74 .. S CNT=CNT+1
75 .. S RESULT=9000010.11_U_ITEM_U_DATE_U_DATE2_U_VALUE
76 .. D SETUP^ORWGAPIU(.DATA,RESULT,TMP,.CNT)
77 Q
78 ;
79MH(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
80 N DATE,DATE2,NODE,RESULT,VALUE K VALUE
81 S DATE="",DATE2="",CNT=$G(CNT)
82 F S DATE=$O(^PXRMINDX(601.2,"PI",DFN,ITEM,DATE)) Q:DATE="" D
83 . I DATE>START Q
84 . S NODE=""
85 . F S NODE=$O(^PXRMINDX(601.2,"PI",DFN,ITEM,DATE,NODE)) Q:NODE="" D
86 .. D MH^ORWGAPIA(.VALUE,NODE) S VALUE=$P($G(VALUE(2)),U,2,3)
87 .. S RESULT=601.2_U_ITEM_U_DATE_U_DATE2_U ;_VALUE
88 .. D SETUP^ORWGAPIU(.DATA,RESULT,TMP,.CNT)
89 Q
90 ;
91OP(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
92 N DATE,DATE2,NODE,NUM,RESULT,VALUE K VALUE
93 S DATE2="",CNT=$G(CNT)
94 S NUM=""
95 F S NUM=$O(^PXRMINDX(45,"ICD0","PNI",DFN,NUM)) Q:NUM="" D
96 . S DATE=""
97 . F S DATE=$O(^PXRMINDX(45,"ICD0","PNI",DFN,NUM,ITEM,DATE)) Q:DATE="" D
98 .. I DATE>START Q
99 .. S NODE=""
100 .. F S NODE=$O(^PXRMINDX(45,"ICD0","PNI",DFN,NUM,ITEM,DATE,NODE)) Q:NODE="" D
101 ... D PTF^ORWGAPIA(NODE,.VALUE) S VALUE=$G(VALUE("DISCHARGE STATUS"))
102 ... S RESULT=45_"OP"_U_ITEM_U_DATE_U_DATE2_U ;_VALUE
103 ... D SETUP^ORWGAPIU(.DATA,RESULT,TMP,.CNT)
104 Q
105 ;
106POV(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
107 N DATE,DATE2,NODE,RESULT,TYPE,VALUE K VALUE
108 S DATE2="",CNT=$G(CNT)
109 S TYPE=""
110 F S TYPE=$O(^PXRMINDX(9000010.07,"PPI",DFN,TYPE)) Q:TYPE="" D
111 . S DATE=""
112 . F S DATE=$O(^PXRMINDX(9000010.07,"PPI",DFN,TYPE,ITEM,DATE)) Q:DATE="" D
113 .. I DATE>START Q
114 .. S NODE=""
115 .. F S NODE=$O(^PXRMINDX(9000010.07,"PPI",DFN,TYPE,ITEM,DATE,NODE)) Q:NODE="" D
116 ... D POV^ORWGAPIA(NODE,.VALUE)
117 ... S VALUE=VALUE("CLINICAL TERM"),VALUE=VALUE_U_$$EVALUE^ORWGAPIU(VALUE,9000010.07,.15)
118 ... S CNT=CNT+1
119 ... S RESULT=9000010.07_U_ITEM_U_DATE_U_DATE2_U_VALUE
120 ... D SETUP^ORWGAPIU(.DATA,RESULT,TMP,.CNT)
121 Q
122 ;
123PROB(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
124 N DATE,DATE2,DTONSET,DTRESOLV,ICD9,NODE,PRIORITY,PROB,PROBDX,PSTATUS,RESULT,STATUS,VALUE
125 K ^TMP("ORWGRPC TEMP",$J)
126 S DATE2="",CNT=$G(CNT)
127 S STATUS=""
128 F S STATUS=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS)) Q:STATUS="" D
129 . S PRIORITY=""
130 . F S PRIORITY=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY)) Q:PRIORITY="" D
131 .. S DATE=""
132 .. F S DATE=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY,ITEM,DATE)) Q:DATE="" D
133 ... I DATE>START Q
134 ... S NODE=""
135 ... F S NODE=$O(^PXRMINDX(9000011,"PSPI",DFN,STATUS,PRIORITY,ITEM,DATE,NODE)) Q:NODE="" D
136 .... S ^TMP("ORWGRPC TEMP",$J,ITEM,DATE,NODE)=""
137 S ICD9=""
138 F S ICD9=$O(^TMP("ORWGRPC TEMP",$J,ICD9)) Q:ICD9="" D
139 . S DATE=""
140 . F S DATE=$O(^TMP("ORWGRPC TEMP",$J,ICD9,DATE)) Q:DATE="" D
141 .. S NODE=""
142 .. F S NODE=$O(^TMP("ORWGRPC TEMP",$J,ICD9,DATE,NODE)) Q:NODE="" D
143 ... D PROB^ORWGAPIA(.PROB,.PSTATUS,.PROBDX,.DTONSET,.DTRESOLV,NODE)
144 ... S RESULT=9000011_U_ITEM_U_DTONSET_U_DATE2_U_$$EXT^ORWGAPIX(PSTATUS,9000011,.12)
145 ... D SETUP^ORWGAPIU(.DATA,RESULT,TMP,.CNT)
146 K ^TMP("ORWGRPC TEMP",$J)
147 Q
148 ;
149PROBX(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
150 D PROBX4^ORWGAPID(.DATA,ITEM,START,DFN,.CNT,.TMP)
151 Q
152 ;
153PROC(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
154 N DATE,DATE2,NODE,RESULT,TYPE,VALUE K VALUE
155 S DATE2="",CNT=$G(CNT)
156 S TYPE=""
157 F S TYPE=$O(^PXRMINDX(9000010.18,"PPI",DFN,TYPE)) Q:TYPE="" D
158 . S DATE=""
159 . F S DATE=$O(^PXRMINDX(9000010.18,"PPI",DFN,TYPE,ITEM,DATE)) Q:DATE="" D
160 .. I DATE>START Q
161 .. S NODE=""
162 .. F S NODE=$O(^PXRMINDX(9000010.18,"PPI",DFN,TYPE,ITEM,DATE,NODE)) Q:NODE="" D
163 ... D CPT^ORWGAPIA(NODE,.VALUE)
164 ... S VALUE=VALUE("PRINCIPAL PROCEDURE"),VALUE=VALUE_U_$$EVALUE^ORWGAPIU(VALUE,9000010.18,.07)
165 ... S RESULT=9000010.18_U_ITEM_U_DATE_U_DATE2_U_VALUE
166 ... D SETUP^ORWGAPIU(.DATA,RESULT,TMP,.CNT)
167 Q
168 ;
169SKIN(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
170 N DATE,DATE2,NODE,RESULT,VALUE K VALUE
171 S DATE="",DATE2="",CNT=$G(CNT)
172 F S DATE=$O(^PXRMINDX(9000010.12,"PI",DFN,ITEM,DATE)) Q:DATE="" D
173 . I DATE>START Q
174 . S NODE=""
175 . F S NODE=$O(^PXRMINDX(9000010.12,"PI",DFN,ITEM,DATE,NODE)) Q:NODE="" D
176 .. D SKIN^ORWGAPIA(NODE,.VALUE)
177 .. S VALUE=$G(VALUE("VALUE")),VALUE=VALUE_U_$$EVALUE^ORWGAPIU(VALUE,9000010.12,.04)
178 .. S CNT=CNT+1
179 .. S RESULT=9000010.12_U_ITEM_U_DATE_U_DATE2_U_VALUE
180 .. D SETUP^ORWGAPIU(.DATA,RESULT,TMP,.CNT)
181 Q
182 ;
183SURG(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
184 N CASE,DATE,DATE2,NUM,PROC,RESULT,RESULTS,SURG,SURGPROC,VALUE K SURG,SURGPROC
185 S DATE2="",CNT=$G(CNT)
186 D SURG^ORWGAPIA(.SURG,DFN)
187 K SURG(0),SURG(1)
188 S ITEM=$$UP^ORWGAPIX(ITEM)
189 S NUM=0
190 S CASE=0
191 F S CASE=$O(SURG(CASE)) Q:CASE<1 D
192 . S RESULTS=SURG(CASE)
193 . S PROC=$P(RESULTS,U,3)
194 . I '$L(PROC) Q
195 . S PROC=$$UP^ORWGAPIX(PROC)
196 . I PROC'=ITEM Q
197 . S NUM=NUM+1
198 . S SURGPROC(PROC,NUM)=RESULTS
199 K SURG
200 S PROC=""
201 F S PROC=$O(SURGPROC(PROC)) Q:PROC="" D
202 . S NUM=0
203 . F S NUM=$O(SURGPROC(PROC,NUM)) Q:NUM<1 D
204 .. S RESULTS=SURGPROC(PROC,NUM)
205 .. S DATE=$P(RESULTS,U,5)
206 .. I DATE>START Q
207 .. S VALUE=""
208 .. S RESULT=130_U_PROC_U_DATE_U_DATE2_U_VALUE
209 .. S CNT=CNT+1
210 .. D SETUP^ORWGAPIU(.DATA,RESULT,TMP,.CNT)
211 Q
212 ;
213TREAT(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
214 N DATE,DATE2,NODE,RESULT,VALUE
215 S DATE="",DATE2="",CNT=$G(CNT)
216 S NODE=""
217 F S NODE=$O(^AUPNVTRT("C",DFN,NODE)) Q:NODE="" D
218 . I '$D(^AUPNVTRT("B",ITEM,NODE)) Q
219 . S DATE=+$G(^AUPNVSIT(+$P($G(^AUPNVTRT(NODE,0)),U,3),0)) I 'DATE Q
220 . I DATE>START Q
221 . S VALUE=+$P($G(^AUPNVTRT(NODE,0)),U,4)
222 . S CNT=CNT+1
223 . S RESULT=9000010.15_U_ITEM_U_DATE_U_DATE2_U_VALUE
224 . D SETUP^ORWGAPIU(.DATA,RESULT,TMP,.CNT)
225 Q
226 ;
227VISIT(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
228 N DATE,DATE2,NODE,NUM,RESULT,VALUE
229 S DATE="",DATE2="",CNT=$G(CNT)
230 F S DATE=$O(^AUPNVSIT("AET",DFN,DATE)) Q:DATE="" D
231 . I DATE>START Q
232 . S NODE=""
233 . F S NODE=$O(^AUPNVSIT("AET",DFN,DATE,ITEM,NODE)) Q:NODE="" D
234 .. S NUM=0
235 .. F S NUM=$O(^AUPNVSIT("AET",DFN,DATE,ITEM,NODE,NUM)) Q:NUM="" D
236 ... S DATE2=+$P($G(^AUPNVSIT(NUM,0)),U,18)
237 ... I 'DATE2 S DATE2=DATE+.01
238 ... I +$E($P(DATE2,".",2),1,2)>24 S DATE2=(DATE\1)+.2359
239 ... S VALUE=""
240 ... S CNT=CNT+1
241 ... S RESULT=9000010_U_ITEM_U_DATE_U_DATE2_U_VALUE
242 ... D SETUP^ORWGAPIU(.DATA,RESULT,TMP,.CNT)
243 Q
244 ;
245VITAL(DATA,ITEM,START,DFN,CNT,TMP) ; from ORWGAPIR
246 I ITEM=99999 D BMIDATA^ORWGAPIX(.DATA,ITEM,START,DFN,.CNT,TMP) Q
247 N DATE,DATE2,NODE,RESULT,VALUE K VALUE
248 S DATE="",DATE2="",CNT=$G(CNT)
249 F S DATE=$O(^PXRMINDX(120.5,"PI",DFN,ITEM,DATE)) Q:DATE="" D
250 . I DATE>START Q
251 . S NODE=""
252 . F S NODE=$O(^PXRMINDX(120.5,"PI",DFN,ITEM,DATE,NODE)) Q:NODE="" D
253 .. D VITAL^ORWGAPIA(.VALUE,NODE) S VALUE=$P($G(VALUE(7)),U)
254 .. I $P($G(VALUE(3)),U,2)="PAIN",VALUE=99 S VALUE="(99)"
255 .. S RESULT=120.5_U_ITEM_U_DATE_U_DATE2_U_VALUE
256 .. D SETUP^ORWGAPIU(.DATA,RESULT,TMP,.CNT)
257 Q
258 ;
Note: See TracBrowser for help on using the repository browser.