source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/OREVNTX1.m@ 1211

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

revised back to 6/30/08 version

File size: 8.8 KB
Line 
1OREVNTX1 ; SLC/JLI - Event delayed orders RPC's ;9/19/02 13:35
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**141,165,149**;Dec 17, 1997
3 ;
4PUTEVNT(ORY,DFN,EVT,ORIFN) ; Save new patient delayed events to file 100.2
5 S ORY=$$NEW^OREVNT(DFN,EVT,ORIFN)
6 Q
7 ;
8GTEVT(ORY,PTEVT) ; Return Event infomation based on PTEVT ptr #100.2
9 ;EVTID ptr #100.5
10 Q:'+PTEVT
11 N EVTID,EVTTYPE,EVTNAME,EVTDISP,EVTDLG,PRTEVT
12 S (EVTTYPE,EVTNAME,EVTDISP,PRTEVT)=""
13 S EVTDLG=0
14 I '$P(^ORE(100.2,+$G(PTEVT),0),U,2) Q
15 S EVTID=$$EVT^OREVNTX(PTEVT)
16 S PRTEVT=$P(^ORD(100.5,EVTID,0),U,12)
17 I PRTEVT S EVTTYPE=$P(^ORD(100.5,PRTEVT,0),U,2)
18 E S EVTTYPE=$P(^ORD(100.5,EVTID,0),U,2)
19 I $D(^ORD(100.5,EVTID,0)) D
20 . S EVTNAME=$P(^ORD(100.5,EVTID,0),U,1)
21 . S EVTDISP=$P(^ORD(100.5,EVTID,0),U,8)
22 . S EVTDLG=$P(^ORD(100.5,EVTID,0),U,4)
23 S ORY=EVTTYPE_U_EVTID_U_EVTNAME_U_EVTDISP_U_EVTDLG
24 Q
25GTEVT1(ORY,EVT) ; Return Event information based on EVT ptr #100.5
26 ;EVT ptr #100.5
27 Q:'+EVT
28 N EVTTYPE,EVTNAME,EVTDISP,EVTDLG,PRTEVT
29 S (EVTDLG,PRTEVT)=0
30 S PRTEVT=$P(^ORD(100.5,+EVT,0),U,12)
31 I PRTEVT>0 S EVTTYPE=$P(^ORD(100.5,PRTEVT,0),U,2)
32 E S EVTTYPE=$P(^ORD(100.5,+EVT,0),U,2)
33 S EVTNAME=$P($G(^ORD(100.5,+EVT,0)),U,1)
34 S EVTDISP=$P($G(^ORD(100.5,+EVT,0)),U,8)
35 S EVTDLG=$P($G(^ORD(100.5,+EVT,0)),U,4)
36 S ORY=EVTTYPE_U_EVT_U_EVTNAME_U_EVTDISP_U_EVTDLG
37 Q
38 ;
39EVT(ORY,PTEVT) ; Return Event ptr #100.5, given PTEVT ptr #100.2
40 Q:'+PTEVT
41 S ORY=$$EVT^OREVNTX(PTEVT)
42 Q
43 ;
44EXISTS(ORY,DFN,EVT) ;Returns PtEvtID ptr #100.2 if patient already has delayed orders
45 I '+EVT S ORY=0 Q
46 N PTEVT S (PTEVT,ORY)=0
47 S PTEVT=$O(^ORE(100.2,"AE",+DFN,+EVT,PTEVT))
48 I PTEVT>0 S ORY=PTEVT
49 Q
50 ;
51TYPEXT(ORY,DFN,EVT) ; does EVT has delayed orders?
52 ; 1 if Patient DFN has delayed orders for EVT
53 ; 2 if Parent/Sibling event has delayed orders
54 ; 0 if No delayed orders for EVT
55 Q:'+EVT
56 S ORY=$$EXISTS^OREVNTX(DFN,EVT)
57 Q
58 ;
59MATCH(ORY,DFN,EVT) ;If Pt's current data match selected event
60 ;DFN: patient DFN
61 ;EVT: ptr to #100.5
62 S ORY=0
63 Q:('+DFN)!('+EVT)
64 S ORY=$$MATCH^OREVNT(DFN,EVT)
65 N TS,TSNM
66 S TS=$S($G(ORTS):+ORTS,1:+$G(^DPT(DFN,.103)))
67 S TSNM=$P($G(^DIC(45.7,TS,0)),U)
68 S:ORY ORY=ORY_U_TSNM
69 Q
70 ;
71NAME(ORY,PTEVT) ; Return Event name from #100.5, given PTEVT ptr #100.2
72 I PTEVT'>0 S ORY="" Q
73 S ORY=$$NAME^OREVNTX(PTEVT)
74 Q
75 ;
76DIV(ORY,PTEVT) ; Return division for PTEVT ptr #100.2
77 Q:'+PTEVT
78 S ORY=$$DIV^OREVNTX(PTEVT)
79 Q
80 ;
81DIV1(ORY,EVT) ; Return division for EVT ptr #100.5
82 Q:'+EVT
83 S ORY=+$P($G(^ORD(100.5,+EVT,0)),U,3) S:ORY<1 ORY=+$G(DUZ(2))
84 Q
85 ;
86LOC(ORY,PTEVT) ; Return default hospital location ^SC( for PTEVT ptr #100.2
87 Q:'+PTEVT
88 S ORY=$$LOC^OREVNTX(PTEVT)
89 S ORY=+ORY
90 Q
91 ;
92LOC1(ORY,EVT) ; Return default hospital location ^SC( for EVT ptr #100.5
93 Q:'+EVT
94 S ORY=+$P($G(^ORD(100.5,+EVT,0)),U,9) S:ORY<1 ORY=+$G(ORL)
95 Q
96 ;
97CHGEVT(ORY,NEWEVT,ORIDS) ; Change order's event
98 N ORI
99 S ORI=0
100 F S ORI=$O(ORIDS(ORI)) Q:'+ORI D
101 . D CHGEVT^OREVNTX(+$G(ORIDS(ORI)),NEWEVT)
102 Q
103 ;
104EMPTY(ORY,PTEVT) ; Return 1 if PTEVT doesn't have any orders
105 Q:'+PTEVT
106 S ORY=$$EMPTY^OREVNTX(PTEVT)
107 Q
108 ;
109DELPTEVT(ORY,PTEVT) ; Delete Patient Event in #100.2
110 Q:'+PTEVT
111 D CANCEL^OREVNTX(PTEVT)
112 Q
113 ;
114UPDTOR(ORY,PTIFN,ORIFN,PTEVT) ; If delayed order was DCed, then update the EVENT and "AEVNT"
115 Q ;Don't ever need to do this!
116CURSPE(ORY,PTIFN) ; Return current treating specialty
117 Q:'PTIFN
118 N SPCID
119 I $D(^DPT(PTIFN,.103)) D
120 . S SPCID=$G(^DPT(PTIFN,.103))
121 . S:SPCID ORY=$P($G(^DIC(45.7,SPCID,0)),U)_U_SPCID
122 Q
123DFLTEVT(ORY,PVIFN) ; Return default release event based on provider IFN
124 N CMEVTLST,IDX
125 S CMEVTLST="",IDX=0
126 D GETLST^OREV3(.CMEVTLST)
127 F S IDX=$O(CMEVTLST(IDX)) Q:'IDX D
128 . I $P($G(CMEVTLST(IDX)),U,2) S ORY=$P($G(CMEVTLST(IDX)),U) Q
129 Q
130CMEVTS(ORY,CLOC) ;Return common event list
131 N IDX,X0,X,LOC
132 S:CLOC>0 LOC=CLOC
133 S IDX=0,ORY=""
134 D GETLST^OREV3(.ORY)
135 F S IDX=$O(ORY(IDX)) Q:'IDX D
136 . S X0=""
137 . S:$L($G(^ORD(100.5,+ORY(IDX),0))) X0=$G(^(0))
138 . I '$L($P(X0,U,2)) D
139 .. S X=$P(X0,U,12) S:X $P(X0,U,2)=$P($G(^ORD(100.5,+X,0)),U,2)
140 . S:$L(X0) ORY(IDX)=+ORY(IDX)_U_X0
141 Q
142 ;
143DELDFLT(ORY,PVIFN) ; Delete default release event
144 Q:'PVIFN
145 N ORERR
146 S ORERR=""
147 D DEL^XPAR(PVIFN_";VA(200,","OREVNT DEFAULT",1,.ORERR)
148 Q
149WRLSTED(LST,LOC,EVTID) ; Return list of dialogs for writing event delayed orders
150 ; .Y(n): DlgName^ListBox Text
151WRLST1 N ANENT
152 S LOC=+$G(LOC)_";SC(" I 'LOC S LOC=""
153 S ANENT="ALL^USR.`"_DUZ_"^"_LOC_$S($G(^VA(200,DUZ,5)):"^SRV.`"_+$G(^(5)),1:"")
154 N MNU,SEQ,IEN,ITM,TXT,FID,DGRP,X,TYP
155 S MNU=$$GET^XPAR(ANENT,"ORWDX WRITE ORDERS EVENT LIST",EVTID,"I") Q:'MNU
156 S SEQ=0 F S SEQ=$O(^ORD(101.41,MNU,10,"B",SEQ)) Q:'SEQ D
157 . S IEN=0 F S IEN=$O(^ORD(101.41,MNU,10,"B",SEQ,IEN)) Q:'IEN D
158 . . S X=$G(^ORD(101.41,MNU,10,IEN,0)),ITM=+$P(X,U,2),TXT=$P(X,U,4)
159 . . S X=$G(^ORD(101.41,ITM,5)),FID=+$P(X,U,5)
160 . . S X=$G(^ORD(101.41,ITM,0)),TYP=$P(X,U,4),DGRP=+$P(X,U,5)
161 . . S:'$L(TXT) TXT=$P(X,U,2)
162 . . I TYP="M" S:'FID FID=1001
163 . . S LST(SEQ)=ITM_";"_FID_";"_DGRP_";"_TYP_U_TXT
164 Q
165 ;
166GETDLG(LST,DLGID) ; Return dialog infomation based on the DLGID
167 N DIEN,DFID,DTXT,DTYP,DGRP,X0,X5
168 S DLGID=+DLGID
169 Q:'DLGID
170 S X0=^ORD(101.41,DLGID,0),X5=$G(^(5))
171 S DGRP=+$P(X0,U,5),DFID=+$P(X5,U,5),DTXT=$P(X5,U,4),DTYP=$P(X0,U,4)
172 S:'$L(DTXT) DTXT=$P(X0,U,2)
173 I $P(X0,U,4)="M" S:'DFID DFID=1001
174 S LST=DLGID_";"_DFID_";"_DGRP_";"_DTYP_U_DTXT
175 Q
176DONE(LST,PTEVT) ; Terminate PTEvt
177 Q:'PTEVT
178 D DONE^OREVNTX(PTEVT)
179 D ACTLOG^OREVNTX(PTEVT,"MN")
180 Q
181SETDFLT(ORY,EVT) ;Set personal default event
182 N ERR,VAL S ERR=""
183 Q:'$D(^ORD(100.5,EVT,0))
184 S VAL=$P(^ORD(100.5,EVT,0),U)
185 D EN^XPAR(DUZ_";VA(200,","OREVNT DEFAULT",1,VAL,ERR)
186 S ORY=ERR
187 Q
188CPACT(ORY,EVT) ; Return True/False to display active orders for copy
189 ; EVT ptr to #100.5
190 Q:'EVT
191 S ORY=0
192 Q:'$D(^ORD(100.5,EVT,0))
193 S ORY=$P(^ORD(100.5,EVT,0),U,11)
194 Q
195PRMPTID(ORY,PRTNM) ;Return event prompt IEN for OR GTX EVENT
196 S:$D(^ORD(101.41,"B","OR GTX EVENT")) ORY=$O(^("OR GTX EVENT",0))
197 Q
198ISDCOD(ORY,ORIFN) ;True: the order need to be filtered out
199 N PAS,X3,X0,ORGRPLST,THEGRP,IDX,ODGRP
200 S (ORY,IDX)=0
201 Q:'$D(^OR(100,+ORIFN,0))
202 S X0=$G(^OR(100,+ORIFN,0))
203 S ODGRP=$P(X0,U,11)
204 D GETLST^XPAR(.ORGRPLST,"ALL","OREVNT EXCLUDE DGRP")
205 F S IDX=$O(ORGRPLST(IDX)) Q:'IDX!ORY D
206 . S THEGRP=$P($G(ORGRPLST(IDX)),U,2)
207 . I $$GRPCHK(THEGRP,ODGRP) S ORY=1
208 I ORY Q
209 S PAS=";1;"
210 S:$D(^OR(100,+ORIFN,3)) X3=^OR(100,+ORIFN,3)
211 S:(PAS'[(";"_$P(X3,U,3)_";")) ORY=0
212 Q
213DEFLTS(ORY,EVTID) ;Return default specialty for EVTID(#100.5)
214 Q:'+EVTID
215 N PRTEVT
216 S PRTEVT=0
217 S PRTEVT=$P(^ORD(100.5,+EVTID,0),U,12)
218 I PRTEVT>0 S EVTID=PRTEVT
219 S ORY=$$DEFTS^ORCDADT(EVTID)
220 Q
221 ;
222MULTS(ORY,EVTID) ;Return specialty list for the EVTID(#100.5)
223 Q:'+EVTID
224 N I,CNT,X,Y S (I,CNT)=0
225 N PRTEVT
226 S PRTEVT=0
227 S PRTEVT=$P(^ORD(100.5,+EVTID,0),U,12)
228 I PRTEVT>0 S EVTID=PRTEVT
229 F S I=$O(^ORD(100.5,+$G(EVTID),"TS",I)) Q:I<1 S X=+$G(^(I,0)) D
230 . S Y=$$GET1^DIQ(45.7,X_",",.01)
231 . S CNT=CNT+1,ORY(CNT)=X_U_Y
232 Q
233 ;
234PRTIDS(ORY,IDS) ;Return some prompt ids from #101.41
235 ; treating specialty Id^attending provider id
236 N IDX,ORTS,ORATT
237 S (ORY,ORTS,ORATT)=""
238 S IDX=$O(^ORD(101.41,"B","OR GTX TREATING SPECIALTY",0))
239 S:$D(^ORD(101.41,IDX,1)) ORTS=$P($G(^ORD(101.41,IDX,1)),U,2,3)
240 S IDX=$O(^ORD(101.41,"B","OR GTX PROVIDER",0))
241 S:$D(^ORD(101.41,IDX,1)) ORATT=$P($G(^ORD(101.41,IDX,1)),U,2,3)
242 S ORY=ORTS_"~"_ORATT
243 Q
244 ;
245DFLTDLG(ORY,EVTID) ;Return event default dialog IEN
246 S ORY=0
247 Q:'$D(^ORD(100.5,+EVTID,0))
248 S ORY=$P(^ORD(100.5,+EVTID,0),U,4)
249 Q
250AUTHMREL(ORY,USER) ;1: user can manual release delayed orders 0: can't
251 S ORY=$$CANREL^OREV3
252 Q
253HAVEPRT(ORY,PTEVT) ;return parent patient event from #100.2
254 Q:'+PTEVT
255 S ORY=""
256 S:$L($G(^ORE(100.2,PTEVT,1))) ORY=$P(^(1),U,5)
257 Q
258GRPCHK(DG,AGRP) ;If an order's group belong to DG group
259 N RST
260 S RST=0
261 N ORGRP
262 D GRP^ORQ1(DG)
263 S RST=$S($D(ORGRP(AGRP)):1,1:0)
264 Q RST
265ODPTEVID(ORY,ORID) ;Return PtEvtID based on the ORID
266 Q:'$D(^OR(100,+ORID,0))
267 S ORY=$P($G(^OR(100,+ORID,0)),U,17)
268 Q
269COMP(ORY,PTEVT) ;Return 1 or 0 if PTEVT completed or not
270 Q:'+PTEVT
271 S ORY=$$COMP^OREVNTX(+PTEVT)
272 Q
273ISHDORD(ORY,ORID) ;Return 1 if it's on-hold med order
274 Q:'+ORID
275 Q:'$D(^OR(100,+ORID,0))
276 N STS,HDSTS,ODGP,INPT,OUPT,MEDS,IVMD
277 S HDSTS=$O(^ORD(100.01,"B","HOLD",0))
278 S STS=$P($G(^OR(100,+ORID,3)),U,3)
279 S INPT=$O(^ORD(100.98,"B","UD RX",0))
280 S OUPT=$O(^ORD(100.98,"B","O RX",0))
281 S MEDS=$O(^ORD(100.98,"B","RX",0))
282 S IVMD=$O(^ORD(100.98,"B","IV RX",0))
283 S ODGP=$P(^OR(100,+ORID,0),U,11)
284 I (U_INPT_U_OUPT_U_MEDS_U_IVMD_U[U_ODGP_U),(HDSTS=STS) S ORY=1
285 Q
286ISPASS(ORY,PTEVTID,EVTTYPE) ;Return 1 if it's a pass event
287 S ORY=$$EVT^OREVNTX(PTEVTID)
288 S ORY=$P($G(^ORD(100.5,+ORY,0)),U,7)
289 I EVTTYPE="T",ORY,ORY<4 S ORY=1
290 E S ORY=0
291 Q
292ISPASS1(ORY,EVTID,EVTTYPE) ;Return 1 if it's a pass event
293 S ORY=$P($G(^ORD(100.5,+EVTID,0)),U,7)
294 I EVTTYPE="T",ORY,ORY<4 S ORY=1
295 E S ORY=0
296 Q
297DLGIEN(ORY,DLGNAME) ;Return Order Dialog IEN based on name
298 Q:'$D(^ORD(101.41,"B",DLGNAME))
299 S ORY=$O(^ORD(101.41,"B",DLGNAME,0))
300 Q
301GETSTS(ORY,ORDID) ;Return Order status
302 Q:'+ORDID
303 Q:'$D(^OR(100,+ORDID,0))
304 S ORY=$P($G(^OR(100,+ORDID,3)),U,3)
305 Q
Note: See TracBrowser for help on using the repository browser.