- Timestamp:
- Dec 4, 2009, 12:11:15 AM (15 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/OCXOZ0Q.m
r613 r623 1 OCXOZ0Q ;SLC/RJS,CLA - Order Check Scan ;NOV 8,2009 at 18:442 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,221,243**;Dec 17,1997;Build 242 3 4 5 6 7 8 9 10 11 12 13 R35R1A 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 R35R1B 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 R38R1A 64 65 66 67 68 69 70 71 72 73 74 75 76 R38R1B 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 R38R2A 109 110 111 112 113 114 115 116 117 118 119 120 121 R38R2B 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 CKSUM(STR) 154 155 156 157 158 159 160 GETDATA(DFN,OCXL,OCXDFI) 161 162 163 164 165 166 MCE100() 167 168 169 170 171 172 173 174 MCE126() 175 176 177 178 179 180 181 182 MCE20() 183 184 185 186 187 188 189 190 MCE40() 191 192 193 194 195 196 197 198 MCE6() 199 200 201 202 203 204 205 206 NEWRULE(OCXDFN,OCXORD,OCXRUL,OCXREL,OCXNOTF,OCXMESS) 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 SETAP(ROOT,DD,DATA,DA) 268 269 270 271 272 273 274 1 OCXOZ0Q ;SLC/RJS,CLA - Order Check Scan ;DEC 27,2007 at 06:00 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 ; 13 R35R1A ; Verify all Event/Elements of Rule #35 'LAB ORDER CANCELLED' Relation #1 '(CANCEL OR REQCANCEL) AND CANCELED BY NON-ORIG ORD...' 14 ; Called from EL100+8^OCXOZ0G, and EL20+5^OCXOZ0H, and EL40+5^OCXOZ0H. 15 ; 16 Q:$G(OCXOERR) 17 ; 18 ; Local Extrinsic Functions 19 ; MCE100( ----------> Verify Event/Element: 'CANCELED BY NON-ORIG ORDERING PROVIDER' 20 ; MCE20( -----------> Verify Event/Element: 'HL7 LAB ORDER CANCELLED' 21 ; MCE40( -----------> Verify Event/Element: 'HL7 LAB REQUEST CANCELLED' 22 ; 23 Q:$G(^OCXS(860.2,35,"INACT")) 24 ; 25 I $$MCE20 D 26 .I $$MCE100 D R35R1B 27 I $$MCE40 D 28 .I $$MCE100 D R35R1B 29 Q 30 ; 31 R35R1B ; Send Order Check, Notication messages and/or Execute code for Rule #35 'LAB ORDER CANCELLED' Relation #1 '(CANCEL OR REQCANCEL) AND CANCELED BY NON-ORIG ORD...' 32 ; Called from R35R1A+13. 33 ; 34 Q:$G(OCXOERR) 35 ; 36 ; Local Extrinsic Functions 37 ; GETDATA( ---------> GET DATA FROM THE ACTIVE DATA FILE 38 ; NEWRULE( ---------> NEW RULE MESSAGE 39 ; 40 Q:$D(OCXRULE("R35R1B")) 41 ; 42 N OCXNMSG,OCXCMSG,OCXPORD,OCXFORD,OCXDATA,OCXNUM,OCXDUZ,OCXQUIT,OCXLOGS,OCXLOGD 43 S OCXCMSG="" 44 S OCXNMSG="Lab order canceled: "_$$GETDATA(DFN,"20^40^100",105) 45 ; 46 Q:$G(OCXOERR) 47 ; 48 ; Send Notification 49 ; 50 S (OCXDUZ,OCXDATA)="",OCXNUM=0 51 I ($G(OCXOSRC)="GENERIC HL7 MESSAGE ARRAY") D 52 .S OCXDATA=$G(^TMP("OCXSWAP",$J,"OCXODATA","ORC",2))_"|"_$G(^TMP("OCXSWAP",$J,"OCXODATA","ORC",3)) 53 .S OCXDATA=$TR(OCXDATA,"^","@"),OCXNUM=+OCXDATA 54 I ($G(OCXOSRC)="CPRS ORDER PROTOCOL") D 55 .I $P($G(OCXORD),U,3) S OCXDUZ(+$P(OCXORD,U,3))="" 56 .S OCXNUM=+$P(OCXORD,U,2) 57 S:($G(OCXOSRC)="CPRS ORDER PRESCAN") OCXNUM=+$P(OCXPSD,"|",5) 58 S OCXRULE("R35R1B")="" 59 I $$NEWRULE(DFN,OCXNUM,35,1,42,OCXNMSG) D I 1 60 .D:($G(OCXTRACE)<5) EN^ORB3(42,DFN,OCXNUM,.OCXDUZ,OCXNMSG,.OCXDATA) 61 Q 62 ; 63 R38R1A ; Verify all Event/Elements of Rule #38 'NEW ORDER PLACED' Relation #1 'NEW' 64 ; Called from EL6+5^OCXOZ0H. 65 ; 66 Q:$G(OCXOERR) 67 ; 68 ; Local Extrinsic Functions 69 ; MCE6( ------------> Verify Event/Element: 'HL7 NEW OERR ORDER' 70 ; 71 Q:$G(^OCXS(860.2,38,"INACT")) 72 ; 73 I $$MCE6 D R38R1B 74 Q 75 ; 76 R38R1B ; Send Order Check, Notication messages and/or Execute code for Rule #38 'NEW ORDER PLACED' Relation #1 'NEW' 77 ; Called from R38R1A+10. 78 ; 79 Q:$G(OCXOERR) 80 ; 81 ; Local Extrinsic Functions 82 ; GETDATA( ---------> GET DATA FROM THE ACTIVE DATA FILE 83 ; NEWRULE( ---------> NEW RULE MESSAGE 84 ; 85 Q:$D(OCXRULE("R38R1B")) 86 ; 87 N OCXNMSG,OCXCMSG,OCXPORD,OCXFORD,OCXDATA,OCXNUM,OCXDUZ,OCXQUIT,OCXLOGS,OCXLOGD 88 S OCXCMSG="" 89 S OCXNMSG="["_$$GETDATA(DFN,"6^",147)_"] New order(s) placed." 90 ; 91 Q:$G(OCXOERR) 92 ; 93 ; Send Notification 94 ; 95 S (OCXDUZ,OCXDATA)="",OCXNUM=0 96 I ($G(OCXOSRC)="GENERIC HL7 MESSAGE ARRAY") D 97 .S OCXDATA=$G(^TMP("OCXSWAP",$J,"OCXODATA","ORC",2))_"|"_$G(^TMP("OCXSWAP",$J,"OCXODATA","ORC",3)) 98 .S OCXDATA=$TR(OCXDATA,"^","@"),OCXNUM=+OCXDATA 99 I ($G(OCXOSRC)="CPRS ORDER PROTOCOL") D 100 .I $P($G(OCXORD),U,3) S OCXDUZ(+$P(OCXORD,U,3))="" 101 .S OCXNUM=+$P(OCXORD,U,2) 102 S:($G(OCXOSRC)="CPRS ORDER PRESCAN") OCXNUM=+$P(OCXPSD,"|",5) 103 S OCXRULE("R38R1B")="" 104 I $$NEWRULE(DFN,OCXNUM,38,1,50,OCXNMSG) D I 1 105 .D:($G(OCXTRACE)<5) EN^ORB3(50,DFN,OCXNUM,.OCXDUZ,OCXNMSG,.OCXDATA) 106 Q 107 ; 108 R38R2A ; Verify all Event/Elements of Rule #38 'NEW ORDER PLACED' Relation #2 'DCED' 109 ; Called from EL126+5^OCXOZ0H. 110 ; 111 Q:$G(OCXOERR) 112 ; 113 ; Local Extrinsic Functions 114 ; MCE126( ----------> Verify Event/Element: 'HL7 DCED OERR ORDER' 115 ; 116 Q:$G(^OCXS(860.2,38,"INACT")) 117 ; 118 I $$MCE126 D R38R2B 119 Q 120 ; 121 R38R2B ; Send Order Check, Notication messages and/or Execute code for Rule #38 'NEW ORDER PLACED' Relation #2 'DCED' 122 ; Called from R38R2A+10. 123 ; 124 Q:$G(OCXOERR) 125 ; 126 ; Local Extrinsic Functions 127 ; GETDATA( ---------> GET DATA FROM THE ACTIVE DATA FILE 128 ; NEWRULE( ---------> NEW RULE MESSAGE 129 ; 130 Q:$D(OCXRULE("R38R2B")) 131 ; 132 N OCXNMSG,OCXCMSG,OCXPORD,OCXFORD,OCXDATA,OCXNUM,OCXDUZ,OCXQUIT,OCXLOGS,OCXLOGD 133 S OCXCMSG="" 134 S OCXNMSG="["_$$GETDATA(DFN,"126^",147)_"] New DC order(s) placed." 135 ; 136 Q:$G(OCXOERR) 137 ; 138 ; Send Notification 139 ; 140 S (OCXDUZ,OCXDATA)="",OCXNUM=0 141 I ($G(OCXOSRC)="GENERIC HL7 MESSAGE ARRAY") D 142 .S OCXDATA=$G(^TMP("OCXSWAP",$J,"OCXODATA","ORC",2))_"|"_$G(^TMP("OCXSWAP",$J,"OCXODATA","ORC",3)) 143 .S OCXDATA=$TR(OCXDATA,"^","@"),OCXNUM=+OCXDATA 144 I ($G(OCXOSRC)="CPRS ORDER PROTOCOL") D 145 .I $P($G(OCXORD),U,3) S OCXDUZ(+$P(OCXORD,U,3))="" 146 .S OCXNUM=+$P(OCXORD,U,2) 147 S:($G(OCXOSRC)="CPRS ORDER PRESCAN") OCXNUM=+$P(OCXPSD,"|",5) 148 S OCXRULE("R38R2B")="" 149 I $$NEWRULE(DFN,OCXNUM,38,2,62,OCXNMSG) D I 1 150 .D:($G(OCXTRACE)<5) EN^ORB3(62,DFN,OCXNUM,.OCXDUZ,OCXNMSG,.OCXDATA) 151 Q 152 ; 153 CKSUM(STR) ; Compiler Function: GENERATE STRING CHECKSUM 154 ; 155 N CKSUM,PTR,ASC S CKSUM=0 156 S STR=$TR(STR,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ") 157 F PTR=$L(STR):-1:1 S ASC=$A(STR,PTR)-42 I (ASC>0),(ASC<51) S CKSUM=CKSUM*2+ASC 158 Q +CKSUM 159 ; 160 GETDATA(DFN,OCXL,OCXDFI) ; This Local Extrinsic Function returns runtime data 161 ; 162 N OCXE,VAL,PC S VAL="" 163 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) 164 Q VAL 165 ; 166 MCE100() ; Verify Event/Element: CANCELED BY NON-ORIG ORDERING PROVIDER 167 ; 168 ; 169 N OCXRES 170 I $L(OCXDF(37)) S OCXRES(100,37)=OCXDF(37) 171 Q:'(OCXDF(37)) 0 I $D(^TMP("OCXCHK",$J,OCXDF(37),100)) Q $G(^TMP("OCXCHK",$J,OCXDF(37),100)) 172 Q 0 173 ; 174 MCE126() ; Verify Event/Element: HL7 DCED OERR ORDER 175 ; 176 ; 177 N OCXRES 178 I $L(OCXDF(37)) S OCXRES(126,37)=OCXDF(37) 179 Q:'(OCXDF(37)) 0 I $D(^TMP("OCXCHK",$J,OCXDF(37),126)) Q $G(^TMP("OCXCHK",$J,OCXDF(37),126)) 180 Q 0 181 ; 182 MCE20() ; Verify Event/Element: HL7 LAB ORDER CANCELLED 183 ; 184 ; 185 N OCXRES 186 I $L(OCXDF(37)) S OCXRES(20,37)=OCXDF(37) 187 Q:'(OCXDF(37)) 0 I $D(^TMP("OCXCHK",$J,OCXDF(37),20)) Q $G(^TMP("OCXCHK",$J,OCXDF(37),20)) 188 Q 0 189 ; 190 MCE40() ; Verify Event/Element: HL7 LAB REQUEST CANCELLED 191 ; 192 ; 193 N OCXRES 194 I $L(OCXDF(37)) S OCXRES(40,37)=OCXDF(37) 195 Q:'(OCXDF(37)) 0 I $D(^TMP("OCXCHK",$J,OCXDF(37),40)) Q $G(^TMP("OCXCHK",$J,OCXDF(37),40)) 196 Q 0 197 ; 198 MCE6() ; Verify Event/Element: HL7 NEW OERR ORDER 199 ; 200 ; 201 N OCXRES 202 I $L(OCXDF(37)) S OCXRES(6,37)=OCXDF(37) 203 Q:'(OCXDF(37)) 0 I $D(^TMP("OCXCHK",$J,OCXDF(37),6)) Q $G(^TMP("OCXCHK",$J,OCXDF(37),6)) 204 Q 0 205 ; 206 NEWRULE(OCXDFN,OCXORD,OCXRUL,OCXREL,OCXNOTF,OCXMESS) ; Has this rule already been triggered for this order number 207 ; 208 ; 209 Q:'$G(OCXDFN) 0 Q:'$G(OCXRUL) 0 210 Q:'$G(OCXREL) 0 Q:'$G(OCXNOTF) 0 Q:'$L($G(OCXMESS)) 0 211 S OCXORD=+$G(OCXORD),OCXDFN=+OCXDFN 212 ; 213 N OCXNDX,OCXDATA,OCXDFI,OCXELE,OCXGR,OCXTIME,OCXCKSUM,OCXTSP,OCXTSPL 214 ; 215 S OCXTIME=(+$H) 216 S OCXCKSUM=$$CKSUM(OCXMESS) 217 ; 218 S OCXTSP=($H*86400)+$P($H,",",2) 219 S OCXTSPL=($G(^OCXD(860.7,"AT",OCXTIME,OCXDFN,OCXRUL,+OCXORD,OCXCKSUM))+$G(OCXTSPI,300)) 220 ; 221 Q:(OCXTSPL>OCXTSP) 0 222 ; 223 K OCXDATA 224 S OCXDATA(OCXDFN,0)=OCXDFN 225 S OCXDATA("B",OCXDFN,OCXDFN)="" 226 S OCXDATA("AT",OCXTIME,OCXDFN,OCXRUL,+OCXORD,OCXCKSUM)=OCXTSP 227 ; 228 S OCXGR="^OCXD(860.7" 229 D SETAP(OCXGR_")",0,.OCXDATA,OCXDFN) 230 ; 231 K OCXDATA 232 S OCXDATA(OCXRUL,0)=OCXRUL_U_(OCXTIME)_U_(+OCXORD) 233 S OCXDATA(OCXRUL,"M")=OCXMESS 234 S OCXDATA("B",OCXRUL,OCXRUL)="" 235 S OCXGR=OCXGR_","_OCXDFN_",1" 236 D SETAP(OCXGR_")","860.71P",.OCXDATA,OCXRUL) 237 ; 238 K OCXDATA 239 S OCXDATA(OCXREL,0)=OCXREL 240 S OCXDATA("B",OCXREL,OCXREL)="" 241 S OCXGR=OCXGR_","_OCXRUL_",1" 242 D SETAP(OCXGR_")","860.712",.OCXDATA,OCXREL) 243 ; 244 S OCXELE=0 F S OCXELE=$O(^OCXS(860.2,OCXRUL,"C","C",OCXELE)) Q:'OCXELE D 245 .; 246 .N OCXGR1 247 .S OCXGR1=OCXGR_","_OCXREL_",1" 248 .K OCXDATA 249 .S OCXDATA(OCXELE,0)=OCXELE 250 .S OCXDATA(OCXELE,"TIME")=OCXTIME 251 .S OCXDATA(OCXELE,"LOG")=$G(OCXOLOG) 252 .S OCXDATA("B",OCXELE,OCXELE)="" 253 .K ^OCXD(860.7,OCXDFN,1,OCXRUL,1,OCXREL,1,OCXELE) 254 .D SETAP(OCXGR1_")","860.7122P",.OCXDATA,OCXELE) 255 .; 256 .S OCXDFI=0 F S OCXDFI=$O(^TMP("OCXCHK",$J,OCXDFN,OCXELE,OCXDFI)) Q:'OCXDFI D 257 ..N OCXGR2 258 ..S OCXGR2=OCXGR1_","_OCXELE_",1" 259 ..K OCXDATA 260 ..S OCXDATA(OCXDFI,0)=OCXDFI 261 ..S OCXDATA(OCXDFI,"VAL")=^TMP("OCXCHK",$J,OCXDFN,OCXELE,OCXDFI) 262 ..S OCXDATA("B",OCXDFI,OCXDFI)="" 263 ..D SETAP(OCXGR2_")","860.71223P",.OCXDATA,OCXDFI) 264 ; 265 Q 1 266 ; 267 SETAP(ROOT,DD,DATA,DA) ; Set Rule Event data 268 M @ROOT=DATA 269 I +$G(DD) S @ROOT@(0)="^"_($G(DD))_"^"_($P($G(@ROOT@(0)),U,3)+1)_"^"_$G(DA) 270 I '$G(DD) S $P(@ROOT@(0),U,3,4)=($P($G(@ROOT@(0)),U,3)+1)_"^"_$G(DA) 271 ; 272 Q 273 ; 274 ;
Note:
See TracChangeset
for help on using the changeset viewer.
