source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/OCXOZ0Z.m@ 1657

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

initial load of FOIAVistA 6/30/08 version
File size: 8.5 KB
Line 
1OCXOZ0Z ;SLC/RJS,CLA - Order Check Scan ;SEP 4,2007 at 23:12
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,221**;Dec 17,1997
3 ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
4 ;
5 ; ***************************************************************
6 ; ** Warning: This routine is automatically generated by the **
7 ; ** Rule Compiler (^OCXOCMP) and ANY changes to this routine **
8 ; ** will be lost the next time the rule compiler executes. **
9 ; ***************************************************************
10 ;
11 Q
12 ;
13R62R1A ; Verify all Event/Elements of Rule #62 'FOOD/DRUG INTERACTION' Relation #1 'INPATIENT FOOD DRUG REACTION'
14 ; Called from EL84+5^OCXOZ0I.
15 ;
16 Q:$G(OCXOERR)
17 ;
18 ; Local Extrinsic Functions
19 ; MCE84( -----------> Verify Event/Element: 'INPATIENT FOOD-DRUG REACTION'
20 ;
21 Q:$G(^OCXS(860.2,62,"INACT"))
22 ;
23 I $$MCE84 D R62R1B
24 Q
25 ;
26R62R1B ; Send Order Check, Notication messages and/or Execute code for Rule #62 'FOOD/DRUG INTERACTION' Relation #1 'INPATIENT FOOD DRUG REACTION'
27 ; Called from R62R1A+10.
28 ;
29 Q:$G(OCXOERR)
30 ;
31 ; Local Extrinsic Functions
32 ; GETDATA( ---------> GET DATA FROM THE ACTIVE DATA FILE
33 ; NEWRULE( ---------> NEW RULE MESSAGE
34 ;
35 Q:$D(OCXRULE("R62R1B"))
36 ;
37 N OCXNMSG,OCXCMSG,OCXPORD,OCXFORD,OCXDATA,OCXNUM,OCXDUZ,OCXQUIT,OCXLOGS,OCXLOGD
38 S OCXCMSG=""
39 S OCXNMSG="["_$$GETDATA(DFN,"84^",147)_"] "_$$GETDATA(DFN,"84^",82)_" ordered - adjust diet accordingly."
40 ;
41 Q:$G(OCXOERR)
42 ;
43 ; Send Notification
44 ;
45 S (OCXDUZ,OCXDATA)="",OCXNUM=0
46 I ($G(OCXOSRC)="GENERIC HL7 MESSAGE ARRAY") D
47 .S OCXDATA=$G(^TMP("OCXSWAP",$J,"OCXODATA","ORC",2))_"|"_$G(^TMP("OCXSWAP",$J,"OCXODATA","ORC",3))
48 .S OCXDATA=$TR(OCXDATA,"^","@"),OCXNUM=+OCXDATA
49 I ($G(OCXOSRC)="CPRS ORDER PROTOCOL") D
50 .I $P($G(OCXORD),U,3) S OCXDUZ(+$P(OCXORD,U,3))=""
51 .S OCXNUM=+$P(OCXORD,U,2)
52 S:($G(OCXOSRC)="CPRS ORDER PRESCAN") OCXNUM=+$P(OCXPSD,"|",5)
53 S OCXRULE("R62R1B")=""
54 I $$NEWRULE(DFN,OCXNUM,62,1,55,OCXNMSG) D I 1
55 .D:($G(OCXTRACE)<5) EN^ORB3(55,DFN,OCXNUM,.OCXDUZ,OCXNMSG,.OCXDATA)
56 Q
57 ;
58R63R1A ; Verify all Event/Elements of Rule #63 'GLUCOPHAGE - CONTRAST MEDIA' Relation #1 'IF PROC USES NON-BARIUM MEDIA AND PATIENT TAKING G...'
59 ; Called from EL91+5^OCXOZ0I, and EL106+5^OCXOZ0I.
60 ;
61 Q:$G(OCXOERR)
62 ;
63 ; Local Extrinsic Functions
64 ; MCE106( ----------> Verify Event/Element: 'RADIOLOGY PROCEDURE CONTAINS NON-BARIUM CONTRAST MEDIA'
65 ; MCE91( -----------> Verify Event/Element: 'PATIENT WITH GLUCOPHAGE MED'
66 ;
67 Q:$G(^OCXS(860.2,63,"INACT"))
68 ;
69 I $$MCE106 D
70 .I $$MCE91 D R63R1B
71 Q
72 ;
73R63R1B ; Send Order Check, Notication messages and/or Execute code for Rule #63 'GLUCOPHAGE - CONTRAST MEDIA' Relation #1 'IF PROC USES NON-BARIUM MEDIA AND PATIENT TAKING G...'
74 ; Called from R63R1A+12.
75 ;
76 Q:$G(OCXOERR)
77 ;
78 Q:$D(OCXRULE("R63R1B"))
79 ;
80 N OCXNMSG,OCXCMSG,OCXPORD,OCXFORD,OCXDATA,OCXNUM,OCXDUZ,OCXQUIT,OCXLOGS,OCXLOGD
81 I ($G(OCXOSRC)="CPRS ORDER PRESCAN") S OCXCMSG=(+OCXPSD)_"^23^^Procedure uses intravenous contrast media and patient is taking metformin." I 1
82 E S OCXCMSG="Procedure uses intravenous contrast media and patient is taking metformin."
83 S OCXNMSG=""
84 ;
85 Q:$G(OCXOERR)
86 ;
87 ; Send Order Check Message
88 ;
89 S OCXOCMSG($O(OCXOCMSG(999999),-1)+1)=OCXCMSG
90 Q
91 ;
92R65R1A ; Verify all Event/Elements of Rule #65 'POLYPHARMACY' Relation #1 'POLYPHARMACY'
93 ; Called from EL95+5^OCXOZ0I.
94 ;
95 Q:$G(OCXOERR)
96 ;
97 ; Local Extrinsic Functions
98 ; MCE95( -----------> Verify Event/Element: 'POLYPHARMACY'
99 ;
100 Q:$G(^OCXS(860.2,65,"INACT"))
101 ;
102 I $$MCE95 D R65R1B
103 Q
104 ;
105R65R1B ; Send Order Check, Notication messages and/or Execute code for Rule #65 'POLYPHARMACY' Relation #1 'POLYPHARMACY'
106 ; Called from R65R1A+10.
107 ;
108 Q:$G(OCXOERR)
109 ;
110 ; Local Extrinsic Functions
111 ; GETDATA( ---------> GET DATA FROM THE ACTIVE DATA FILE
112 ;
113 Q:$D(OCXRULE("R65R1B"))
114 ;
115 N OCXNMSG,OCXCMSG,OCXPORD,OCXFORD,OCXDATA,OCXNUM,OCXDUZ,OCXQUIT,OCXLOGS,OCXLOGD
116 I ($G(OCXOSRC)="CPRS ORDER PRESCAN") S OCXCMSG=(+OCXPSD)_"^26^^Potential polypharmacy - patient currently receiving "_$$GETDATA(DFN,"95^",109)_" medications." I 1
117 E S OCXCMSG="Potential polypharmacy - patient currently receiving "_$$GETDATA(DFN,"95^",109)_" medications."
118 S OCXNMSG=""
119 ;
120 Q:$G(OCXOERR)
121 ;
122 ; Send Order Check Message
123 ;
124 S OCXOCMSG($O(OCXOCMSG(999999),-1)+1)=OCXCMSG
125 Q
126 ;
127R66R1A ; Verify all Event/Elements of Rule #66 'LAB RESULTS' Relation #1 'HL7 LAB RESULTS'
128 ; Called from EL5+6^OCXOZ0H.
129 ;
130 Q:$G(OCXOERR)
131 ;
132 ; Local Extrinsic Functions
133 ; MCE5( ------------> Verify Event/Element: 'HL7 FINAL LAB RESULT'
134 ;
135 Q:$G(^OCXS(860.2,66,"INACT"))
136 ;
137 I $$MCE5 D R66R1B^OCXOZ10
138 Q
139 ;
140CKSUM(STR) ; Compiler Function: GENERATE STRING CHECKSUM
141 ;
142 N CKSUM,PTR,ASC S CKSUM=0
143 S STR=$TR(STR,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
144 F PTR=$L(STR):-1:1 S ASC=$A(STR,PTR)-42 I (ASC>0),(ASC<51) S CKSUM=CKSUM*2+ASC
145 Q +CKSUM
146 ;
147GETDATA(DFN,OCXL,OCXDFI) ; This Local Extrinsic Function returns runtime data
148 ;
149 N OCXE,VAL,PC S VAL=""
150 F PC=1:1:$L(OCXL,U) S OCXE=$P(OCXL,U,PC) I OCXE S VAL=$G(^TMP("OCXCHK",$J,DFN,OCXE,OCXDFI)) Q:$L(VAL)
151 Q VAL
152 ;
153MCE106() ; Verify Event/Element: RADIOLOGY PROCEDURE CONTAINS NON-BARIUM CONTRAST MEDIA
154 ;
155 ; OCXDF(37) -> PATIENT IEN data field
156 ;
157 N OCXRES
158 S OCXDF(37)=$G(DFN) I $L(OCXDF(37)) S OCXRES(106,37)=OCXDF(37)
159 Q:'(OCXDF(37)) 0 I $D(^TMP("OCXCHK",$J,OCXDF(37),106)) Q $G(^TMP("OCXCHK",$J,OCXDF(37),106))
160 Q 0
161 ;
162MCE5() ; Verify Event/Element: HL7 FINAL LAB RESULT
163 ;
164 ;
165 N OCXRES
166 I $L(OCXDF(37)) S OCXRES(5,37)=OCXDF(37)
167 Q:'(OCXDF(37)) 0 I $D(^TMP("OCXCHK",$J,OCXDF(37),5)) Q $G(^TMP("OCXCHK",$J,OCXDF(37),5))
168 Q 0
169 ;
170MCE84() ; Verify Event/Element: INPATIENT FOOD-DRUG REACTION
171 ;
172 ;
173 N OCXRES
174 I $L(OCXDF(37)) S OCXRES(84,37)=OCXDF(37)
175 Q:'(OCXDF(37)) 0 I $D(^TMP("OCXCHK",$J,OCXDF(37),84)) Q $G(^TMP("OCXCHK",$J,OCXDF(37),84))
176 Q 0
177 ;
178MCE91() ; Verify Event/Element: PATIENT WITH GLUCOPHAGE MED
179 ;
180 ; OCXDF(103) -> PATIENT CURRENTLY ON GLUCOPHAGE data field
181 ; OCXDF(37) -> PATIENT IEN data field
182 ;
183 N OCXRES
184 S OCXDF(37)=$G(DFN) I $L(OCXDF(37)) S OCXRES(91,37)=OCXDF(37)
185 Q:'(OCXDF(37)) 0 I $D(^TMP("OCXCHK",$J,OCXDF(37),91)) Q $G(^TMP("OCXCHK",$J,OCXDF(37),91))
186 S OCXRES(91)=0,OCXDF(103)=$P($$TAKEMED^ORKPS(OCXDF(37),"^GLUCOPHAGE^METFORMIN^AVANDAMET^METAGLIP"),"^",1) I $L(OCXDF(103)) S OCXRES(91,103)=OCXDF(103) I (OCXDF(103))
187 E Q 0
188 S OCXRES(91)=11 M ^TMP("OCXCHK",$J,OCXDF(37),91)=OCXRES(91)
189 Q +OCXRES(91)
190 ;
191MCE95() ; Verify Event/Element: POLYPHARMACY
192 ;
193 ; OCXDF(37) -> PATIENT IEN data field
194 ;
195 N OCXRES
196 S OCXDF(37)=$G(DFN) I $L(OCXDF(37)) S OCXRES(95,37)=OCXDF(37)
197 Q:'(OCXDF(37)) 0 I $D(^TMP("OCXCHK",$J,OCXDF(37),95)) Q $G(^TMP("OCXCHK",$J,OCXDF(37),95))
198 Q 0
199 ;
200NEWRULE(OCXDFN,OCXORD,OCXRUL,OCXREL,OCXNOTF,OCXMESS) ; Has this rule already been triggered for this order number
201 ;
202 ;
203 Q:'$G(OCXDFN) 0 Q:'$G(OCXRUL) 0
204 Q:'$G(OCXREL) 0 Q:'$G(OCXNOTF) 0 Q:'$L($G(OCXMESS)) 0
205 S OCXORD=+$G(OCXORD),OCXDFN=+OCXDFN
206 ;
207 N OCXNDX,OCXDATA,OCXDFI,OCXELE,OCXGR,OCXTIME,OCXCKSUM,OCXTSP,OCXTSPL
208 ;
209 S OCXTIME=(+$H)
210 S OCXCKSUM=$$CKSUM(OCXMESS)
211 ;
212 S OCXTSP=($H*86400)+$P($H,",",2)
213 S OCXTSPL=($G(^OCXD(860.7,"AT",OCXTIME,OCXDFN,OCXRUL,+OCXORD,OCXCKSUM))+$G(OCXTSPI,300))
214 ;
215 Q:(OCXTSPL>OCXTSP) 0
216 ;
217 K OCXDATA
218 S OCXDATA(OCXDFN,0)=OCXDFN
219 S OCXDATA("B",OCXDFN,OCXDFN)=""
220 S OCXDATA("AT",OCXTIME,OCXDFN,OCXRUL,+OCXORD,OCXCKSUM)=OCXTSP
221 ;
222 S OCXGR="^OCXD(860.7"
223 D SETAP(OCXGR_")",0,.OCXDATA,OCXDFN)
224 ;
225 K OCXDATA
226 S OCXDATA(OCXRUL,0)=OCXRUL_U_(OCXTIME)_U_(+OCXORD)
227 S OCXDATA(OCXRUL,"M")=OCXMESS
228 S OCXDATA("B",OCXRUL,OCXRUL)=""
229 S OCXGR=OCXGR_","_OCXDFN_",1"
230 D SETAP(OCXGR_")","860.71P",.OCXDATA,OCXRUL)
231 ;
232 K OCXDATA
233 S OCXDATA(OCXREL,0)=OCXREL
234 S OCXDATA("B",OCXREL,OCXREL)=""
235 S OCXGR=OCXGR_","_OCXRUL_",1"
236 D SETAP(OCXGR_")","860.712",.OCXDATA,OCXREL)
237 ;
238 S OCXELE=0 F S OCXELE=$O(^OCXS(860.2,OCXRUL,"C","C",OCXELE)) Q:'OCXELE D
239 .;
240 .N OCXGR1
241 .S OCXGR1=OCXGR_","_OCXREL_",1"
242 .K OCXDATA
243 .S OCXDATA(OCXELE,0)=OCXELE
244 .S OCXDATA(OCXELE,"TIME")=OCXTIME
245 .S OCXDATA(OCXELE,"LOG")=$G(OCXOLOG)
246 .S OCXDATA("B",OCXELE,OCXELE)=""
247 .K ^OCXD(860.7,OCXDFN,1,OCXRUL,1,OCXREL,1,OCXELE)
248 .D SETAP(OCXGR1_")","860.7122P",.OCXDATA,OCXELE)
249 .;
250 .S OCXDFI=0 F S OCXDFI=$O(^TMP("OCXCHK",$J,OCXDFN,OCXELE,OCXDFI)) Q:'OCXDFI D
251 ..N OCXGR2
252 ..S OCXGR2=OCXGR1_","_OCXELE_",1"
253 ..K OCXDATA
254 ..S OCXDATA(OCXDFI,0)=OCXDFI
255 ..S OCXDATA(OCXDFI,"VAL")=^TMP("OCXCHK",$J,OCXDFN,OCXELE,OCXDFI)
256 ..S OCXDATA("B",OCXDFI,OCXDFI)=""
257 ..D SETAP(OCXGR2_")","860.71223P",.OCXDATA,OCXDFI)
258 ;
259 Q 1
260 ;
261SETAP(ROOT,DD,DATA,DA) ; Set Rule Event data
262 M @ROOT=DATA
263 I +$G(DD) S @ROOT@(0)="^"_($G(DD))_"^"_($P($G(@ROOT@(0)),U,3)+1)_"^"_$G(DA)
264 I '$G(DD) S $P(@ROOT@(0),U,3,4)=($P($G(@ROOT@(0)),U,3)+1)_"^"_$G(DA)
265 ;
266 Q
267 ;
268 ;
Note: See TracBrowser for help on using the repository browser.