source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWGAPI1.m@ 1800

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

initial load of FOIAVistA 6/30/08 version

File size: 8.2 KB
Line 
1ORWGAPI1 ; SLC/STAFF - Graph Items ;12/21/05 08:15
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**215**;Dec 17, 1997
3 ;
4AA(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
5 ; FMT,OLDEST,NEWEST not used
6 N ITEM,FILE,NUM,REF,RESULT
7 K ^TMP("ORWGRPC DC",$J)
8 S ITEM=""
9 F S ITEM=$O(^PXRMINDX(63,"PI",DFN,ITEM)) Q:ITEM="" D
10 . I $E(ITEM)="A" Q
11 . I $E(ITEM)="M" Q
12 . S RESULT=$$AALAB^ORWGAPIA(ITEM)
13 . I RESULT="" Q
14 . S RESULT="68^"_RESULT
15 . S ^TMP("ORWGRPC DC",$J,RESULT)=""
16 S RESULT=""
17 F S RESULT=$O(^TMP("ORWGRPC DC",$J,RESULT)) Q:RESULT="" S CNT=CNT+1 D
18 . D SETUP^ORWGAPIU(.ITEMS,RESULT,TMP,.CNT)
19 K ^TMP("ORWGRPC DC",$J)
20 Q
21 ;
22AP(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
23 N DATE,ITEM,OK,RESULT
24 S ITEM="A"
25 F S ITEM=$O(^PXRMINDX(63,"PI",DFN,ITEM)) Q:ITEM="" Q:ITEM]"AZ" D
26 . S OK=0
27 . I FMT=6 D
28 .. S DATE=OLDEST
29 .. F S DATE=$O(^PXRMINDX(63,"PI",DFN,ITEM,DATE)) Q:DATE="" Q:DATE>NEWEST D Q:OK
30 ... S CNT=CNT+1
31 ... S OK=1
32 ... S RESULT="63AP"_U_ITEM
33 . I FMT=3 D
34 .. S DATE=$O(^PXRMINDX(63,"PI",DFN,ITEM,""),-1)
35 .. I 'DATE Q
36 .. S OK=1
37 .. S CNT=CNT+1
38 .. S RESULT="63AP^"_ITEM_"^^"_$$ITEMPRFX^ORWGAPIU(ITEM)_": "_$$EVALUE^ORWGAPIU(ITEM,63,.01)_"^^"_DATE
39 . I FMT=0 D
40 .. S OK=1
41 .. S CNT=CNT+1
42 .. S RESULT="63AP^"_ITEM_U_$$ITEMPRFX^ORWGAPIU(ITEM)_": "_$$EVALUE^ORWGAPIU(ITEM,63,.01)
43 . I OK D SETUP^ORWGAPIU(.ITEMS,RESULT,TMP,.CNT)
44 Q
45 ;
46BCMA(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
47 N DATE,DRUG,ITEM,NUM,RESULT
48 K ^TMP("ORWGRPC TEMP",$J)
49 I FMT=6 D
50 . S DATE=OLDEST
51 . F S DATE=$O(^PSB(53.79,"AADT",DFN,DATE)) Q:DATE<1 Q:DATE>NEWEST D
52 .. S NUM=0
53 .. F S NUM=$O(^PSB(53.79,"AADT",DFN,DATE,NUM)) Q:NUM<1 D
54 ... S ITEM=$P($G(^PSB(53.79,NUM,0)),U,8) I 'ITEM Q
55 ... I $D(^TMP("ORWGRPC TEMP",$J,ITEM)) Q
56 ... S ^TMP("ORWGRPC TEMP",$J,ITEM)=""
57 ... S CNT=CNT+1
58 ... S RESULT="53.79^"_ITEM
59 ... D SETUP^ORWGAPIU(.ITEMS,RESULT,TMP,.CNT)
60 I FMT'=6 D
61 . S ITEM=""
62 . F S ITEM=$O(^PSB(53.79,"AOIP",DFN,ITEM)) Q:ITEM="" D
63 .. S DATE=$O(^PSB(53.79,"AOIP",DFN,ITEM,""),-1)
64 .. I 'DATE Q
65 .. S NUM=$O(^PSB(53.79,"AOIP",DFN,ITEM,DATE,""),-1)
66 .. I 'NUM Q
67 .. S CNT=CNT+1
68 .. I FMT=3 S RESULT="53.79^"_ITEM_"^^"_$$POINAME^ORWGAPIA(ITEM)_"^^"_DATE
69 .. I FMT=0 S RESULT="53.79^"_ITEM_U_$$POINAME^ORWGAPIA(ITEM)
70 .. S DRUG=$$DRUG^ORWGAPIA(NUM)
71 .. I DRUG S RESULT=RESULT_U_$$DRGCLASS^ORWGAPIA(DRUG)
72 .. D SETUP^ORWGAPIU(.ITEMS,RESULT,TMP,.CNT)
73 K ^TMP("ORWGRPC TEMP",$J)
74 Q
75 ;
76DC(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
77 ; FMT,OLDEST,NEWEST not used
78 N DATA,DATE,DATE1,DRUG,ITEM,FILE,NUM,REF,RESULT K DATA
79 K ^TMP("ORWGRPC DC",$J)
80 F FILE=52,55 D
81 . S ITEM=""
82 . F S ITEM=$O(^PXRMINDX(FILE,"PI",DFN,ITEM)) Q:ITEM="" D
83 .. S RESULT=$$DRGCLASS^ORWGAPIA(ITEM)
84 .. I RESULT="" Q
85 .. S RESULT="50.605^"_RESULT
86 .. S ^TMP("ORWGRPC DC",$J,RESULT)=""
87 S ITEM=""
88 F S ITEM=$O(^PSB(53.79,"AOIP",DFN,ITEM)) Q:ITEM="" D
89 . S DATE=$O(^PSB(53.79,"AOIP",DFN,ITEM,""),-1)
90 . I 'DATE Q
91 . S NUM=$O(^PSB(53.79,"AOIP",DFN,ITEM,DATE,""),-1)
92 . I 'NUM Q
93 . S DRUG=$$DRUG^ORWGAPIA(NUM)
94 . I 'DRUG Q
95 . S RESULT=$$DRGCLASS^ORWGAPIA(DRUG)
96 . I 'RESULT Q
97 . S RESULT="50.605^"_RESULT
98 . S ^TMP("ORWGRPC DC",$J,RESULT)=""
99 S ITEM=""
100 F S ITEM=$O(^PXRMINDX("55NVA","PI",DFN,ITEM)) Q:ITEM="" D
101 . S DATE=$O(^PXRMINDX("55NVA","PI",DFN,ITEM,""),-1)
102 . I 'DATE Q
103 . S DATE1=$O(^PXRMINDX("55NVA","PI",DFN,ITEM,DATE,""),-1)
104 . I '$L(DATE1) Q
105 . S REF=$O(^PXRMINDX("55NVA","PI",DFN,ITEM,DATE,DATE1,""),-1)
106 . I '$L(REF) Q
107 . D RXNVA^ORWGAPIA(REF,.DATA)
108 . S DRUG=+$G(DATA("DISPENSE DRUG"))
109 . I 'DRUG Q
110 . S RESULT=$$DRGCLASS^ORWGAPIA(DRUG)
111 . I 'RESULT Q
112 . S RESULT="50.605^"_RESULT
113 . S ^TMP("ORWGRPC DC",$J,RESULT)=""
114 S RESULT=""
115 F S RESULT=$O(^TMP("ORWGRPC DC",$J,RESULT)) Q:RESULT="" S CNT=CNT+1 D
116 . D SETUP^ORWGAPIU(.ITEMS,RESULT,TMP,.CNT)
117 K ^TMP("ORWGRPC DC",$J)
118 Q
119 ;
120LAB(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
121 N DATE,ITEM,OK,RESULT
122 S ITEM=0
123 F S ITEM=$O(^PXRMINDX(63,"PI",DFN,ITEM)) Q:ITEM<1 D
124 . S OK=0
125 . I FMT=6 D
126 .. S DATE=OLDEST
127 .. F S DATE=$O(^PXRMINDX(63,"PI",DFN,ITEM,DATE)) Q:DATE="" Q:DATE>NEWEST D Q:OK
128 ... S CNT=CNT+1
129 ... S OK=1
130 ... S RESULT=63_U_ITEM
131 . I FMT=3 D
132 .. S DATE=$O(^PXRMINDX(63,"PI",DFN,ITEM,""),-1)
133 .. I 'DATE Q
134 .. S CNT=CNT+1
135 .. S OK=1
136 .. S RESULT=63_U_ITEM_"^^"_$$EVALUE^ORWGAPIU(ITEM,63,.01)_"^^"_DATE
137 . I FMT=0 D
138 .. S CNT=CNT+1
139 .. S OK=1
140 .. S RESULT=63_U_ITEM_U_$$EVALUE^ORWGAPIU(ITEM,63,.01)
141 . I OK D
142 .. S RESULT=RESULT_U_$$AALAB^ORWGAPIA(ITEM)
143 .. D SETUP^ORWGAPIU(.ITEMS,RESULT,TMP,.CNT)
144 Q
145 ;
146MI(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
147 N DATE,ITEM,OK,RESULT
148 S ITEM="M"
149 F S ITEM=$O(^PXRMINDX(63,"PI",DFN,ITEM)) Q:ITEM="" Q:ITEM]"MZ" D
150 . S OK=0
151 . I FMT=6 D
152 .. S DATE=OLDEST
153 .. F S DATE=$O(^PXRMINDX(63,"PI",DFN,ITEM,DATE)) Q:DATE="" Q:DATE>NEWEST D Q:OK
154 ... S CNT=CNT+1
155 ... S OK=1
156 ... S RESULT="63MI"_U_ITEM
157 . I FMT=3 D
158 .. S DATE=$O(^PXRMINDX(63,"PI",DFN,ITEM,""),-1)
159 .. I 'DATE Q
160 .. S CNT=CNT+1
161 .. S OK=1
162 .. S RESULT="63MI^"_ITEM_"^^"_$$ITEMPRFX^ORWGAPIU(ITEM)_": "_$$EVALUE^ORWGAPIU(ITEM,63,.01)_"^^"_DATE
163 . I FMT=0 D
164 .. S CNT=CNT+1
165 .. S OK=1
166 .. S RESULT="63MI^"_ITEM_U_$$ITEMPRFX^ORWGAPIU(ITEM)_": "_$$EVALUE^ORWGAPIU(ITEM,63,.01)
167 . I OK D SETUP^ORWGAPIU(.ITEMS,RESULT,TMP,.CNT)
168 Q
169 ;
170MED(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
171 D MED1^ORWGAPID(.ITEMS,DFN,FMT,OLDEST,NEWEST,.CNT,.TMP)
172 Q
173 ;
174NOTES(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
175 N DATE,DOC,DOCCLASS,DOCIEN,DOCTYPE,DUMMY,RESULT,RESULTS,TITLE K DUMMY
176 K ^TMP("ORWGRPC TEMP",$J),^TMP("TIUR",$J)
177 S CNT=$G(CNT)
178 I FMT=6 D
179 . F DOCTYPE="P","D","C" D
180 .. S DOCCLASS=$$DOCCLASS^ORWGAPIA(DOCTYPE)
181 .. K ^TMP("TIUR",$J)
182 .. D TIU^ORWGAPIA(.DUMMY,DOCCLASS,5,DFN,$G(OLDEST),$G(NEWEST))
183 .. S DOC=0
184 .. F S DOC=$O(^TMP("TIUR",$J,DOC)) Q:DOC<1 D
185 ... S RESULTS=^TMP("TIUR",$J,DOC)
186 ... S TITLE=$P(RESULTS,U,2)
187 ... S DATE=$P(RESULTS,U,3)
188 ... I '$L(TITLE) Q
189 ... S ^TMP("ORWGRPC TEMP",$J,TITLE,DATE)=RESULTS
190 I FMT'=6 D
191 . F DOCTYPE="P","D","C" D
192 .. S DOCCLASS=$$DOCCLASS^ORWGAPIA(DOCTYPE)
193 .. K ^TMP("TIUR",$J)
194 .. D TIU^ORWGAPIA(.DUMMY,DOCCLASS,5,DFN)
195 .. S DOC=0
196 .. F S DOC=$O(^TMP("TIUR",$J,DOC)) Q:DOC<1 D
197 ... S RESULTS=^TMP("TIUR",$J,DOC)
198 ... S TITLE=$P(RESULTS,U,2)
199 ... S DATE=$P(RESULTS,U,3)
200 ... I '$L(TITLE) Q
201 ... S ^TMP("ORWGRPC TEMP",$J,TITLE,DATE)=RESULTS
202 S TITLE=""
203 F S TITLE=$O(^TMP("ORWGRPC TEMP",$J,TITLE)) Q:TITLE="" D
204 . S CNT=CNT+1
205 . I FMT=6 S RESULT=8925_U_TITLE
206 . I FMT=3 D
207 .. S DATE=+$O(^TMP("ORWGRPC TEMP",$J,TITLE,""),-1)
208 .. S DOCIEN=+$G(^TMP("ORWGRPC TEMP",$J,TITLE,DATE))
209 .. S RESULT=8925_U_TITLE_"^^"_TITLE_"^^"
210 .. S RESULT=RESULT_DATE
211 .. S RESULT=RESULT_U_$$TITLE^ORWGAPIA(DOCIEN)
212 . I FMT=0 S RESULT=8925_U_TITLE_U_TITLE
213 . S RESULT=$$UP^ORWGAPIX(RESULT)
214 . D SETUP^ORWGAPIU(.ITEMS,RESULT,TMP,.CNT)
215 K ^TMP("ORWGRPC TEMP",$J),^TMP("TIUR",$J)
216 Q
217 ;
218NVAE(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
219 N DATA,DATE,DATE1,DRUG,ITEM,OK,REF,RESULT K DATA
220 S ITEM=""
221 F S ITEM=$O(^PXRMINDX("55NVA","PI",DFN,ITEM)) Q:ITEM="" D
222 . S OK=0
223 . I FMT=6 D
224 .. S DATE=OLDEST
225 .. F S DATE=$O(^PXRMINDX("55NVA","PI",DFN,ITEM,DATE)) Q:DATE="" Q:DATE>NEWEST D Q:OK
226 ... S CNT=CNT+1
227 ... S OK=1
228 ... S RESULT="55NVAE"_U_ITEM
229 . I FMT'=6 D
230 .. S DATE=$O(^PXRMINDX("55NVA","PI",DFN,ITEM,""),-1)
231 .. I 'DATE Q
232 .. S DATE1=$O(^PXRMINDX("55NVA","PI",DFN,ITEM,DATE,""),-1)
233 .. I '$L(DATE1) Q
234 .. S REF=$O(^PXRMINDX("55NVA","PI",DFN,ITEM,DATE,DATE1,""),-1)
235 .. I '$L(REF) Q
236 .. D RXNVA^ORWGAPIA(REF,.DATA)
237 .. S DRUG=+$G(DATA("DISPENSE DRUG"))
238 .. S CNT=CNT+1
239 .. S OK=1
240 .. I FMT=3 S RESULT="55NVAE"_U_ITEM_"^^"_$$EVALUE^ORWGAPIU(ITEM,"55NVA",.01)_"^^"_DATE
241 .. I FMT=0 S RESULT="55NVAE"_U_ITEM_U_$$EVALUE^ORWGAPIU(ITEM,"55NVA",.01)
242 .. I DRUG S RESULT=RESULT_U_$$DRGCLASS^ORWGAPIA(DRUG)
243 . I OK D SETUP^ORWGAPIU(.ITEMS,RESULT,TMP,.CNT)
244 Q
245 ;
246NVA(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
247 D NVA1^ORWGAPID(.ITEMS,DFN,FMT,OLDEST,NEWEST,.CNT,.TMP)
248 Q
249 ;
250TITLE(ITEMS,DFN,FMT,OLDEST,NEWEST,CNT,TMP) ; from ORWGAPIR
251 ; FMT,OLDEST,NEWEST not used
252 N ITEM,FILE,NUM,REF,RESULT
253 K ^TMP("ORWGRPC DC",$J)
254 S ITEM=""
255 F S ITEM=$O(^PXRMINDX(63,"PI",DFN,ITEM)) Q:ITEM="" D
256 . I $E(ITEM)="A" Q
257 . I $E(ITEM)="M" Q
258 . S RESULT=$$AALAB^ORWGAPIA(ITEM)
259 . I RESULT="" Q
260 . S RESULT="68^"_RESULT
261 . S ^TMP("ORWGRPC DC",$J,RESULT)=""
262 S RESULT=""
263 F S RESULT=$O(^TMP("ORWGRPC DC",$J,RESULT)) Q:RESULT="" S CNT=CNT+1 D
264 . D SETUP^ORWGAPIU(.ITEMS,RESULT,TMP,.CNT)
265 K ^TMP("ORWGRPC DC",$J)
266 Q
267 ;
Note: See TracBrowser for help on using the repository browser.