source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/OCXOZ0S.m@ 1678

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

initial load of FOIAVistA 6/30/08 version
File size: 8.0 KB
Line 
1OCXOZ0S ;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 ;
13R44R1B ; Send Order Check, Notication messages and/or Execute code for Rule #44 'ORDER REQUIRES ELECTRONIC SIGNATURE' Relation #1 'ELECTRONIC SIGNATURE'
14 ; Called from R44R1A+10^OCXOZ0R.
15 ;
16 Q:$G(OCXOERR)
17 ;
18 ; Local Extrinsic Functions
19 ; NEWRULE( ---------> NEW RULE MESSAGE
20 ;
21 Q:$D(OCXRULE("R44R1B"))
22 ;
23 N OCXNMSG,OCXCMSG,OCXPORD,OCXFORD,OCXDATA,OCXNUM,OCXDUZ,OCXQUIT,OCXLOGS,OCXLOGD
24 S OCXCMSG=""
25 S OCXNMSG="Order requires electronic signature."
26 ;
27 Q:$G(OCXOERR)
28 ;
29 ; Send Notification
30 ;
31 S (OCXDUZ,OCXDATA)="",OCXNUM=0
32 I ($G(OCXOSRC)="GENERIC HL7 MESSAGE ARRAY") D
33 .S OCXDATA=$G(^TMP("OCXSWAP",$J,"OCXODATA","ORC",2))_"|"_$G(^TMP("OCXSWAP",$J,"OCXODATA","ORC",3))
34 .S OCXDATA=$TR(OCXDATA,"^","@"),OCXNUM=+OCXDATA
35 I ($G(OCXOSRC)="CPRS ORDER PROTOCOL") D
36 .I $P($G(OCXORD),U,3) S OCXDUZ(+$P(OCXORD,U,3))=""
37 .S OCXNUM=+$P(OCXORD,U,2)
38 S:($G(OCXOSRC)="CPRS ORDER PRESCAN") OCXNUM=+$P(OCXPSD,"|",5)
39 S OCXRULE("R44R1B")=""
40 I $$NEWRULE(DFN,OCXNUM,44,1,12,OCXNMSG) D I 1
41 .D:($G(OCXTRACE)<5) EN^ORB3(12,DFN,OCXNUM,.OCXDUZ,OCXNMSG,.OCXDATA)
42 Q
43 ;
44R48R1A ; Verify all Event/Elements of Rule #48 'SITE FLAGGED ORDER' Relation #1 'NEW SITE FLAGGED ORDER AND INPATIENT'
45 ; Called from EL58+5^OCXOZ0H, and EL127+5^OCXOZ0H.
46 ;
47 Q:$G(OCXOERR)
48 ;
49 ; Local Extrinsic Functions
50 ; MCE127( ----------> Verify Event/Element: 'INPATIENT'
51 ; MCE58( -----------> Verify Event/Element: 'NEW SITE FLAGGED ORDER'
52 ;
53 Q:$G(^OCXS(860.2,48,"INACT"))
54 ;
55 I $$MCE58 D
56 .I $$MCE127 D R48R1B
57 Q
58 ;
59R48R1B ; Send Order Check, Notication messages and/or Execute code for Rule #48 'SITE FLAGGED ORDER' Relation #1 'NEW SITE FLAGGED ORDER AND INPATIENT'
60 ; Called from R48R1A+12.
61 ;
62 Q:$G(OCXOERR)
63 ;
64 ; Local Extrinsic Functions
65 ; GETDATA( ---------> GET DATA FROM THE ACTIVE DATA FILE
66 ; INT2DT( ----------> CONVERT DATE FROM OCX FORMAT TO READABLE FORMAT
67 ; NEWRULE( ---------> NEW RULE MESSAGE
68 ;
69 Q:$D(OCXRULE("R48R1B"))
70 ;
71 N OCXNMSG,OCXCMSG,OCXPORD,OCXFORD,OCXDATA,OCXNUM,OCXDUZ,OCXQUIT,OCXLOGS,OCXLOGD
72 S OCXCMSG=""
73 S OCXNMSG="["_$$GETDATA(DFN,"58^127",147)_"] Order placed: "_$$GETDATA(DFN,"58^127",96)_" "_$$INT2DT($$GETDATA(DFN,"58^127",9),0)_"."
74 ;
75 Q:$G(OCXOERR)
76 ;
77 ; Send Notification
78 ;
79 S (OCXDUZ,OCXDATA)="",OCXNUM=0
80 I ($G(OCXOSRC)="GENERIC HL7 MESSAGE ARRAY") D
81 .S OCXDATA=$G(^TMP("OCXSWAP",$J,"OCXODATA","ORC",2))_"|"_$G(^TMP("OCXSWAP",$J,"OCXODATA","ORC",3))
82 .S OCXDATA=$TR(OCXDATA,"^","@"),OCXNUM=+OCXDATA
83 I ($G(OCXOSRC)="CPRS ORDER PROTOCOL") D
84 .I $P($G(OCXORD),U,3) S OCXDUZ(+$P(OCXORD,U,3))=""
85 .S OCXNUM=+$P(OCXORD,U,2)
86 S:($G(OCXOSRC)="CPRS ORDER PRESCAN") OCXNUM=+$P(OCXPSD,"|",5)
87 S OCXRULE("R48R1B")=""
88 I $$NEWRULE(DFN,OCXNUM,48,1,41,OCXNMSG) D I 1
89 .D:($G(OCXTRACE)<5) EN^ORB3(41,DFN,OCXNUM,.OCXDUZ,OCXNMSG,.OCXDATA)
90 Q
91 ;
92R48R2A ; Verify all Event/Elements of Rule #48 'SITE FLAGGED ORDER' Relation #2 'NEW SITE FLAGGED ORDER AND OUTPATIENT'
93 ; Called from EL58+6^OCXOZ0H, and EL128+5^OCXOZ0H.
94 ;
95 Q:$G(OCXOERR)
96 ;
97 ; Local Extrinsic Functions
98 ; MCE128( ----------> Verify Event/Element: 'OUTPATIENT'
99 ; MCE58( -----------> Verify Event/Element: 'NEW SITE FLAGGED ORDER'
100 ;
101 Q:$G(^OCXS(860.2,48,"INACT"))
102 ;
103 I $$MCE58 D
104 .I $$MCE128 D R48R2B^OCXOZ0T
105 Q
106 ;
107CKSUM(STR) ; Compiler Function: GENERATE STRING CHECKSUM
108 ;
109 N CKSUM,PTR,ASC S CKSUM=0
110 S STR=$TR(STR,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
111 F PTR=$L(STR):-1:1 S ASC=$A(STR,PTR)-42 I (ASC>0),(ASC<51) S CKSUM=CKSUM*2+ASC
112 Q +CKSUM
113 ;
114GETDATA(DFN,OCXL,OCXDFI) ; This Local Extrinsic Function returns runtime data
115 ;
116 N OCXE,VAL,PC S VAL=""
117 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)
118 Q VAL
119 ;
120INT2DT(OCXDT,OCXF) ; This Local Extrinsic Function converts an OCX internal format
121 ; date into an Externl Format (Human Readable) date. 'OCXF=SHORT FORMAT OCXF=LONG FORMAT
122 ;
123 Q:'$L($G(OCXDT)) "" S OCXF=+$G(OCXF)
124 N OCXYR,OCXLPYR,OCXMON,OCXDAY,OCXHR,OCXMIN,OCXSEC,OCXCYR
125 S (OCXYR,OCXLPYR,OCXMON,OCXDAY,OCXHR,OCXMIN,OCXSEC,OCXAP)=""
126 S OCXSEC=$E(OCXDT#60+100,2,3),OCXDT=OCXDT\60
127 S OCXMIN=$E(OCXDT#60+100,2,3),OCXDT=OCXDT\60
128 S OCXHR=$E(OCXDT#24+100,2,3),OCXDT=OCXDT\24
129 S OCXCYR=($H\1461)*4+1841+(($H#1461)\365)
130 S OCXYR=(OCXDT\1461)*4+1841,OCXDT=OCXDT#1461
131 S OCXLPYR=(OCXDT\365),OCXDT=OCXDT-(OCXLPYR*365),OCXYR=OCXYR+OCXLPYR
132 S OCXCNT="031^059^090^120^151^181^212^243^273^304^334^365"
133 S:(OCXLPYR=3) OCXCNT="031^060^091^121^152^182^213^244^274^305^335^366"
134 F OCXMON=1:1:12 Q:(OCXDT<$P(OCXCNT,U,OCXMON))
135 S OCXDAY=OCXDT-$P(OCXCNT,U,OCXMON-1)+1
136 I OCXF S OCXMON=$P("January^February^March^April^May^June^July^August^September^October^November^December",U,OCXMON)
137 E S OCXMON=$E(OCXMON+100,2,3)
138 S OCXAP=$S('OCXHR:"Midnight",(OCXHR=12):"Noon",(OCXHR<12):"AM",1:"PM")
139 I OCXF S OCXHR=OCXHR#12 S:'OCXHR OCXHR=12
140 Q:'OCXF $E(OCXMON+100,2,3)_"/"_$E(OCXDAY+100,2,3)_$S((OCXCYR=OCXYR):" "_OCXHR_":"_OCXMIN,1:"/"_$E(OCXYR,3,4))
141 Q:(OCXHR+OCXMIN+OCXSEC) OCXMON_" "_OCXDAY_","_OCXYR_" at "_OCXHR_":"_OCXMIN_"."_OCXSEC_" "_OCXAP
142 Q OCXMON_" "_OCXDAY_","_OCXYR
143 ;
144MCE127() ; Verify Event/Element: INPATIENT
145 ;
146 ;
147 N OCXRES
148 I $L(OCXDF(37)) S OCXRES(127,37)=OCXDF(37)
149 Q:'(OCXDF(37)) 0 I $D(^TMP("OCXCHK",$J,OCXDF(37),127)) Q $G(^TMP("OCXCHK",$J,OCXDF(37),127))
150 Q 0
151 ;
152MCE128() ; Verify Event/Element: OUTPATIENT
153 ;
154 ;
155 N OCXRES
156 I $L(OCXDF(37)) S OCXRES(128,37)=OCXDF(37)
157 Q:'(OCXDF(37)) 0 I $D(^TMP("OCXCHK",$J,OCXDF(37),128)) Q $G(^TMP("OCXCHK",$J,OCXDF(37),128))
158 Q 0
159 ;
160MCE58() ; Verify Event/Element: NEW SITE FLAGGED ORDER
161 ;
162 ;
163 N OCXRES
164 I $L(OCXDF(37)) S OCXRES(58,37)=OCXDF(37)
165 Q:'(OCXDF(37)) 0 I $D(^TMP("OCXCHK",$J,OCXDF(37),58)) Q $G(^TMP("OCXCHK",$J,OCXDF(37),58))
166 Q 0
167 ;
168NEWRULE(OCXDFN,OCXORD,OCXRUL,OCXREL,OCXNOTF,OCXMESS) ; Has this rule already been triggered for this order number
169 ;
170 ;
171 Q:'$G(OCXDFN) 0 Q:'$G(OCXRUL) 0
172 Q:'$G(OCXREL) 0 Q:'$G(OCXNOTF) 0 Q:'$L($G(OCXMESS)) 0
173 S OCXORD=+$G(OCXORD),OCXDFN=+OCXDFN
174 ;
175 N OCXNDX,OCXDATA,OCXDFI,OCXELE,OCXGR,OCXTIME,OCXCKSUM,OCXTSP,OCXTSPL
176 ;
177 S OCXTIME=(+$H)
178 S OCXCKSUM=$$CKSUM(OCXMESS)
179 ;
180 S OCXTSP=($H*86400)+$P($H,",",2)
181 S OCXTSPL=($G(^OCXD(860.7,"AT",OCXTIME,OCXDFN,OCXRUL,+OCXORD,OCXCKSUM))+$G(OCXTSPI,300))
182 ;
183 Q:(OCXTSPL>OCXTSP) 0
184 ;
185 K OCXDATA
186 S OCXDATA(OCXDFN,0)=OCXDFN
187 S OCXDATA("B",OCXDFN,OCXDFN)=""
188 S OCXDATA("AT",OCXTIME,OCXDFN,OCXRUL,+OCXORD,OCXCKSUM)=OCXTSP
189 ;
190 S OCXGR="^OCXD(860.7"
191 D SETAP(OCXGR_")",0,.OCXDATA,OCXDFN)
192 ;
193 K OCXDATA
194 S OCXDATA(OCXRUL,0)=OCXRUL_U_(OCXTIME)_U_(+OCXORD)
195 S OCXDATA(OCXRUL,"M")=OCXMESS
196 S OCXDATA("B",OCXRUL,OCXRUL)=""
197 S OCXGR=OCXGR_","_OCXDFN_",1"
198 D SETAP(OCXGR_")","860.71P",.OCXDATA,OCXRUL)
199 ;
200 K OCXDATA
201 S OCXDATA(OCXREL,0)=OCXREL
202 S OCXDATA("B",OCXREL,OCXREL)=""
203 S OCXGR=OCXGR_","_OCXRUL_",1"
204 D SETAP(OCXGR_")","860.712",.OCXDATA,OCXREL)
205 ;
206 S OCXELE=0 F S OCXELE=$O(^OCXS(860.2,OCXRUL,"C","C",OCXELE)) Q:'OCXELE D
207 .;
208 .N OCXGR1
209 .S OCXGR1=OCXGR_","_OCXREL_",1"
210 .K OCXDATA
211 .S OCXDATA(OCXELE,0)=OCXELE
212 .S OCXDATA(OCXELE,"TIME")=OCXTIME
213 .S OCXDATA(OCXELE,"LOG")=$G(OCXOLOG)
214 .S OCXDATA("B",OCXELE,OCXELE)=""
215 .K ^OCXD(860.7,OCXDFN,1,OCXRUL,1,OCXREL,1,OCXELE)
216 .D SETAP(OCXGR1_")","860.7122P",.OCXDATA,OCXELE)
217 .;
218 .S OCXDFI=0 F S OCXDFI=$O(^TMP("OCXCHK",$J,OCXDFN,OCXELE,OCXDFI)) Q:'OCXDFI D
219 ..N OCXGR2
220 ..S OCXGR2=OCXGR1_","_OCXELE_",1"
221 ..K OCXDATA
222 ..S OCXDATA(OCXDFI,0)=OCXDFI
223 ..S OCXDATA(OCXDFI,"VAL")=^TMP("OCXCHK",$J,OCXDFN,OCXELE,OCXDFI)
224 ..S OCXDATA("B",OCXDFI,OCXDFI)=""
225 ..D SETAP(OCXGR2_")","860.71223P",.OCXDATA,OCXDFI)
226 ;
227 Q 1
228 ;
229SETAP(ROOT,DD,DATA,DA) ; Set Rule Event data
230 M @ROOT=DATA
231 I +$G(DD) S @ROOT@(0)="^"_($G(DD))_"^"_($P($G(@ROOT@(0)),U,3)+1)_"^"_$G(DA)
232 I '$G(DD) S $P(@ROOT@(0),U,3,4)=($P($G(@ROOT@(0)),U,3)+1)_"^"_$G(DA)
233 ;
234 Q
235 ;
236 ;
Note: See TracBrowser for help on using the repository browser.