source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWGAPIA.m@ 1540

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

initial load of FOIAVistA 6/30/08 version

File size: 9.4 KB
Line 
1ORWGAPIA ; SLC/STAFF - Graph Application Calls ;11/1/06 12:49
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**215,251,260**;Dec 17, 1997;Build 26
3 ;
4AA(IEN) ; $$(ien) -> external display of accession area
5 Q $P($G(^LRO(68,IEN,0)),U)
6AALAB(TEST) ; $$(lab test) -> accession ien^acc name^acc abbrev
7 N AA,DIV
8 S TEST=+$G(TEST)
9 S DIV=+$G(DUZ(2))
10 S AA=+$P($G(^LAB(60,+TEST,8,DIV,0)),U,2)
11 I AA Q AA_U_$$ACCLAB(AA)
12 S AA=+$P($G(^LAB(60,+TEST,8,+$O(^LAB(60,+TEST,8,0)),0)),U,2)
13 I AA Q AA_U_$$ACCLAB(AA)
14 Q ""
15ACC(DATA) ; API - get accession areas - from ORWGAPI
16 N CNT,IEN,TMP,RESULT,ZERO
17 D RETURN^ORWGAPIU(.TMP,.DATA)
18 S CNT=0
19 S IEN=0
20 F S IEN=$O(^LRO(68,IEN)) Q:IEN<1 D
21 . S ZERO=$G(^LRO(68,IEN,0)) I '$L(ZERO) Q
22 . S RESULT="68^"_IEN_U_$P(ZERO,U)_U_$P(ZERO,U,11)
23 . D SETUP^ORWGAPIU(.DATA,RESULT,TMP,.CNT)
24 Q
25ACCLAB(AA) ; $$(accession ien) -> acc name^acc abbrev
26 N ZERO
27 S ZERO=$G(^LRO(68,AA,0)) I '$L(ZERO) Q ""
28 Q "lab - "_$P(ZERO,U)_U_$P(ZERO,U,11)
29ADDDRUG(NUM1) ; $$(additive) -> drug in 50 else ""
30 N RESULT K ^TMP($J,"RX")
31 I '$G(IEN) Q ""
32 D ZERO^PSS52P6(IEN,,,"RX")
33 S RESULT=$P($G(^TMP($J,"RX",IEN,1)),U)
34 K ^TMP($J,"RX")
35 Q RESULT
36ALLG(IEN) ; $$(ien) -> external display of allergies
37 I IEN Q $P($G(^GMRD(120.83,IEN,0)),U) ; this is for rxn, allergy is free text
38 Q IEN
39CPT(NODE,ORVALUE) ; from ORWGAPI4
40 D VCPT^PXPXRM(NODE,.ORVALUE)
41 Q
42DC(IEN) ; $$(ien) -> external display of drug class
43 N RESULT K ^TMP($J,"RX")
44 I '$G(IEN) Q ""
45 D IEN^PSN50P65(IEN,,"RX")
46 S RESULT=$G(^TMP($J,"RX",IEN,1))
47 K ^TMP($J,"RX")
48 Q RESULT
49DISCH(IEN) ; $$(pt movement ien) -> discharge date
50 Q $P($G(^DGPM(+$P($G(^DGPM(+$G(IEN),0)),U,17),0)),U)
51DOCCLASS(DOCTYPE) ; $$(doc type) -> ien of tiu doc class
52 N CONSULTS
53 S DOCTYPE=$E(DOCTYPE,1)
54 I DOCTYPE="P" Q 3
55 I DOCTYPE="D" Q 244
56 I DOCTYPE="C" D CNSLCLAS^TIUSRVD(.CONSULTS) Q CONSULTS
57 Q 0
58DRGCLASS(DRUG) ; $$(drug) -> drug class^classification
59 N RESULT K ^TMP($J,"RX")
60 I '$G(DRUG) Q ""
61 D DATA^PSS50(DRUG,,,,,"RX")
62 S RESULT=+$G(^TMP($J,"RX",DRUG,25))
63 K ^TMP($J,"RX")
64 Q RESULT_U_"drug - "_$$DC(RESULT)
65DRUG(NUM) ; $$(bcma entry) -> drug in 50 else ""
66 N DONE,DRUG,NUM1
67 S DONE=0,NUM=+$G(NUM)
68 S NUM1=0
69 F S NUM1=$O(^PSB(53.79,NUM,.5,"B",NUM1)) Q:NUM1<1 S DONE=1 Q
70 I DONE Q NUM1
71 S DRUG=0
72 S NUM1=0
73 F S NUM1=$O(^PSB(53.79,NUM,.6,"B",NUM1)) Q:NUM1<1 D I DONE Q
74 . S DRUG=$$ADDDRUG(NUM1)
75 . I DRUG S DONE=1
76 I DONE Q DRUG
77 S DRUG=0
78 S NUM1=0
79 F S NUM1=$O(^PSB(53.79,NUM,.7,"B",NUM1)) Q:NUM1<1 D I DONE Q
80 . S DRUG=$$SOLDRUG(NUM1)
81 . I DRUG S DONE=1
82 I DONE Q DRUG
83 Q ""
84DRUGC(VALUES) ; API - get drug classes - from ORWGAPI
85 N CLASS,IEN,NUM,ROOT K VALUES
86 S NUM=0
87 S ROOT=$$ROOT^PSN50P65(1)
88 S CLASS=""
89 F S CLASS=$O(@ROOT@(CLASS)) Q:CLASS="" D
90 . S IEN=0
91 . F S IEN=$O(@ROOT@(CLASS,IEN)) Q:IEN="" D
92 .. S NUM=NUM+1
93 .. S VALUES(NUM)="50.605^"_IEN_U_CLASS
94 M ^TMP("ORWGRPC",$J)=VALUES K VALUES
95 Q
96EDU(NODE,ORVALUE) ; from ORWGAPI4
97 D VPEDU^PXPXRM(NODE,.ORVALUE)
98 Q
99EXAM(NODE,ORVALUE) ; from ORWGAPI4
100 D VXAM^PXPXRM(NODE,.ORVALUE)
101 Q
102GETTIU(ORDATA,IEN) ; from ORWGAPID
103 D TGET^TIUSRVR1(.ORDATA,IEN)
104 Q
105HF(NODE,ORVALUE) ; from ORWGAPI4
106 D VHF^PXPXRM(NODE,.ORVALUE)
107 Q
108ICD0(IEN) ; $$(ien) -> external display of IDC0
109 Q $P($G(^ICD0(IEN,0)),U)_" "_$P($G(^ICD0(IEN,0)),U,4)
110ICD9(IEN) ; $$(ien) -> external display of IDC9
111 Q $P($G(^ICD9(IEN,0)),U)_" "_$P($G(^ICD9(IEN,0)),U,3)
112ICPT(IEN,CSD) ; $$(ien) -> external display of CPT
113 N X S X=$$CPT^ICPTCOD($G(IEN),$G(CSD))
114 Q $P(X,U,2)_" "_$E($P(X,U,3),1,30)
115IMM(NODE,ORVALUE) ; from ORWGAPI4
116 D VIMM^PXPXRM(NODE,.ORVALUE)
117 Q
118INSIG(NODE) ; $$(node) -> sig
119 N DFN,DNUM,IEN,LNUM,SIG,SUB ; replace this code in v27 with INSIG^ORWGAPIX
120 S DFN=+$G(NODE)
121 S SUB=$P($G(NODE),";",2)
122 S IEN=+$P($G(NODE),";",3)
123 S SIG=""
124 I SUB=5 D
125 . S LNUM=$G(^PS(55,DFN,5,IEN,0))
126 . S DNUM=$G(^PS(55,DFN,5,IEN,.2))
127 . I $L(DNUM),$L(LNUM) D
128 .. S SIG=" Give: "_$$EXT^ORWGAPIX($P(LNUM,U,3),55.06,3)
129 .. S SIG=SIG_" "_$$EXT^ORWGAPIX($P(LNUM,U,7),55.06,7)
130 I SUB="IV" D
131 . S LNUM=$G(^PS(55,DFN,"IV",IEN,0))
132 . S DNUM=$G(^PS(55,DFN,"IV",IEN,.2))
133 . I $L(DNUM),$L(LNUM) D
134 .. S SIG=" Give: "_$P(DNUM,U,2)
135 .. S SIG=SIG_" "_$$EXT^ORWGAPIX($P(LNUM,U,2),55.01,.02)_" "_$P(LNUM,U,9)
136 Q SIG
137ISA(USER,CLASS,ORERR) ; $$(user,user class,err) -> 1 if user in class, else 0
138 Q $$ISA^USRLM(USER,CLASS,.ORERR)
139LAB(ORVALUE,NODE,ITEM) ; from ORWGAPI3
140 D LRPXRM^LRPXAPI(.ORVALUE,NODE,ITEM,"VSC")
141 Q
142LABNAME(Y) ; $$(item ien) -> item name
143 I $P(Y,";")="A",$P(Y,";",2)="S" Q $P(Y,".",2,99)
144 Q $$ITEMNM^LRPXAPIU(Y)
145LABSUM(ORDATA,DFN,DATE1,DATE2,ORSUB) ; from ORWGAPID
146 D EN^LR7OSUM(.ORDATA,DFN,DATE1,DATE2,,80,.ORSUB)
147 Q
148LOS(DGPMIFN) ; $$(pt movement ien) -> length of stay
149 N X D ^DGPMLOS
150 Q +$P($G(X),U,5)
151LRDFN(DFN) ; $$(dfn) -> lrdfn
152 Q $$LRDFN^LRPXAPIU(DFN)
153LRIDT(LRDT) ; $$(date) -> inverse date
154 Q $$LRIDT^LRPXAPIU(LRDT)
155MEDICINE(ARRAY,DFN) ;
156 N DATE,FILE,IEN,NAME,NUM,REF,VALUES,XREF
157 K ARRAY,^TMP("MCAR",$J),^TMP("OR",$J,"MCAR")
158 D FILE^ORWGAPIU(690,.REF,.XREF)
159 I '$L(REF) Q
160 I $E(REF,$L(REF))="," S REF=$E(REF,1,$L(REF)-1)_")"
161 I $E(REF,$L(REF))="(" S REF=$P(REF,"(")
162 D EN^MCARPS2(DFN)
163 S NUM=0
164 F S NUM=$O(^TMP("OR",$J,"MCAR","OT",NUM)) Q:NUM<1 D
165 . S VALUES=^TMP("OR",$J,"MCAR","OT",NUM)
166 . S DATE=$$DATETFM^ORWGAPIU($P(VALUES,U,6))
167 . S NAME=$P(VALUES,U) I '$L(NAME) Q
168 . S IEN=+$O(@REF@(XREF,NAME,""))
169 . I DATE,IEN S ARRAY(IEN,DATE)=NAME
170 K ^TMP("MCAR",$J),^TMP("OR",$J,"MCAR")
171 Q
172MEDVAL(VAL) ;
173 N IEN,NAME,NAMES,REF,SEQ,XREF K NAMES,VAL
174 D FILE^ORWGAPIU(690,.REF,.XREF)
175 I '$L(REF) Q
176 I $E(REF,$L(REF))="," S REF=$E(REF,1,$L(REF)-1)_")"
177 I $E(REF,$L(REF))="(" S REF=$P(REF,"(")
178 S NAME=""
179 F S NAME=$O(@REF@(XREF,NAME)) Q:NAME="" D
180 . S IEN=0
181 . F S IEN=$O(@REF@(XREF,NAME,IEN)) Q:IEN<1 D
182 .. S NAMES(IEN)=NAME
183 S SEQ=0
184 S IEN=0
185 F S IEN=$O(NAMES(IEN)) Q:IEN<1 D
186 . S SEQ=SEQ+1
187 . S VAL(SEQ)=690_U_IEN_U_NAMES(IEN)
188 Q
189MH(ORVALUE,NODE) ; from ORWGAPI4
190 D ENDAS^YTAPI10(.ORVALUE,NODE)
191 Q
192NVASIG(NODE) ; $$(node) -> sig on non-va drug
193 N RESULTS,SIG K RESULTS
194 I '$L(NODE) Q ""
195 D RXNVA(NODE,.RESULTS)
196 S SIG=RESULTS("DOSAGE")
197 S SIG=SIG_" "_RESULTS("MEDICATION ROUTE")
198 S SIG=SIG_" "_RESULTS("SCHEDULE")
199 Q SIG
200OITEM(DATA) ; API - get order display groups - from ORWGAPI
201 N CNT,IEN,RESULT,TMP,ZERO
202 D RETURN^ORWGAPIU(.TMP,.DATA)
203 S CNT=0
204 S IEN=0
205 F S IEN=$O(^ORD(100.98,IEN)) Q:IEN<1 D
206 . S ZERO=$G(^ORD(100.98,IEN,0)) I '$L(ZERO) Q
207 . S RESULT="100.98^"_IEN_U_$P(ZERO,U)_U_$P(ZERO,U,3)
208 . D SETUP^ORWGAPIU(.DATA,RESULT,TMP,.CNT)
209 Q
210POINAME(IEN) ; $$(poi entry) - > name and dosage form else ""
211 N NAME,RESULT K ^TMP($J,"RX")
212 I '$G(IEN) Q ""
213 D ZERO^PSS50P7(IEN,,,"RX")
214 S NAME=$P($G(^TMP($J,"RX",IEN,.01)),U)
215 S NAME=NAME_" "_$P($G(^TMP($J,"BOB",IEN,.02)),U,2)
216 K ^TMP($J,"RX")
217 I NAME'=" " Q NAME
218 Q ""
219POV(NODE,ORVALUE) ; from ORWGAPI4
220 D VPOV^PXPXRM(NODE,.ORVALUE)
221 Q
222PROB(GMPLLEX,GMPLSTAT,GMPLICD,GMPLODAT,GMPLXDAT,NODE) ; from ORWGAPI4
223 N GMPLPNAM,GMPLDLM,GMPLTXT,GMPLCOND,GMPLPRV,GMPLPRIO
224 D CALL2^GMPLUTL3(NODE)
225 Q
226PTF(NODE,ORVALUE) ; from ORWGAPI3, ORWGAPI4
227 D PTF^DGPTPXRM(NODE,.ORVALUE)
228 Q
229RAD(NODE,ORVALUE) ; from ORWGAPI3
230 D EN1^RAPXRM(NODE,.ORVALUE)
231 Q
232RXIN(NODE,ORVALUE) ; from ORWGAPI3
233 D OEL^PSJPXRM1(NODE,.ORVALUE)
234 Q
235RXNVA(NODE,ORVALUE,XSTART,XSTOP) ; from ORWGAPI1, ORWGAPI3, ORWGAPID
236 S XSTART=1,XSTOP=1
237 D NVA^PSOPXRM1(NODE,.ORVALUE)
238 I '$G(ORVALUE("START DATE")) D
239 . S ORVALUE("START DATE")=$G(ORVALUE("DOCUMENTED DATE"))
240 . S XSTART=0
241 I '$G(ORVALUE("DISCONTINUED DATE")) D
242 . S XSTOP=0
243 Q
244RXOUT(NODE,ORVALUE) ; from ORWGAPI3
245 D PSRX^PSOPXRM1(NODE,.ORVALUE)
246 Q
247SIG(DFN,RXIEN) ; $$(dfn,prescription ien) -> sig
248 N LNUM,SIG K ^TMP($J,"RX")
249 S RXIEN=+$G(RXIEN)
250 D RX^PSO52API(DFN,"RX",RXIEN,,"M",,)
251 S SIG=""
252 S LNUM=0
253 F S LNUM=$O(^TMP($J,"RX",DFN,RXIEN,"M",LNUM)) Q:LNUM<1 D
254 . S SIG=SIG_$G(^TMP($J,"RX",DFN,RXIEN,"M",LNUM,0))_" "
255 I $L(SIG) S SIG=" Sig: "_$$LOW^ORWGAPIX(SIG)
256 K ^TMP($J,"RX")
257 Q SIG
258SKIN(NODE,ORVALUE) ; from ORWGAPI4
259 D VSKIN^PXPXRM(NODE,.ORVALUE)
260 Q
261SOLDRUG(NUM1) ; $$(iv solution) -> drug in 50 else ""
262 N RESULT K ^TMP($J,"RX")
263 I '$G(IEN) Q ""
264 D ZERO^PSS52P7(IEN,,,"RX")
265 S RESULT=$P($G(^TMP($J,"RX",IEN,1)),U)
266 K ^TMP($J,"RX")
267 Q RESULT
268SURG(ORSURG,DFN) ; from ORWGAPI2, ORWGAPI4
269 D GET^SROGTSR(.ORSURG,DFN)
270 Q
271TAX(IEN) ; $$(ien) -> external display of reminder taxonomy
272 Q $P($G(^PXD(811.2,+$G(IEN),0)),U)
273TITLE(DOCTYPE) ; $$(document type) -> parent ien^parent^parent abbrev
274 N IEN,RESULTS K RESULTS
275 S DOCTYPE=+$G(^TIU(8925,+$G(DOCTYPE),0))
276 S IEN=+$$DOCCLASS^TIULC1(DOCTYPE) I 'IEN Q ""
277 D GETDATA^ORWGAPIX(.RESULTS,8925.1,".01;.02",IEN)
278 I '$L($G(RESULTS(.01))) Q ""
279 Q IEN_U_"note - "_RESULTS(.01)_U_$G(RESULTS(.02))
280TIU(ORVALUE,DOCIEN,ONE,DFN,OLDEST,NEWEST) ; from ORWGAPI1, ORWGAPI3
281 D CONTEXT^TIUSRVLO(.ORVALUE,DOCIEN,ONE,DFN,$G(OLDEST),$G(NEWEST))
282 Q
283TIUTITLE(DATA) ; API - get tiu document titles - from ORWGAPI
284 N CNT,IEN,RESULT,RESULTS,TMP
285 D RETURN^ORWGAPIU(.TMP,.DATA)
286 S CNT=0
287 S IEN=0
288 F S IEN=$O(^TIU(8925.1,IEN)) Q:IEN<1 D
289 . I $P($G(^TIU(8925.1,IEN,0)),U,4)'="DOC" Q
290 . K RESULTS
291 . D GETDATA^ORWGAPIX(.RESULTS,8925.1,".01;.02",IEN)
292 . I '$L($G(RESULTS(.01))) Q
293 . S RESULT="8925.1^"_IEN_U_RESULTS(.01)_U_$G(RESULTS(.02))
294 . D SETUP^ORWGAPIU(.DATA,RESULT,TMP,.CNT)
295 Q
296VITAL(ORVALUE,NODE) ; from ORWGAPI4
297 D EN^GMVPXRM(.ORVALUE,NODE)
298 Q
299 ; $$(dfn) -> 1 if patient has data else 0
300ADMITX(DFN) ;
301 Q $O(^DGPM("C",+$G(DFN),0))>0
302ALLERGYX(DFN) ;
303 Q $O(^GMR(120.8,"B",+$G(DFN),0))>0
304BCMAX(DFN) ;
305 Q $O(^PSB(53.79,"B",+$G(DFN),0))>0
306NOTEX(DFN) ;
307 Q $O(^TIU(8925,"C",+$G(DFN),0))>0
308NVAX(DFN) ;
309 Q $L($O(^PXRMINDX("55NVA","PI",+$G(DFN),"")))>0
310SURGX(DFN) ;
311 Q $O(^SRF("B",+$G(DFN),0))>0
312TREATX(DFN) ;
313 Q $L($O(^AUPNVTRT("AA",+$G(DFN),"")))>0
314VISITX(DFN) ;
315 Q $O(^AUPNVSIT("AET",+$G(DFN),0))>0
Note: See TracBrowser for help on using the repository browser.