| 1 | OCXOZ13 ;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 | ; | 
|---|
| 13 | R71R1A ; Verify all Event/Elements of  Rule #71 'OPIOID MEDICATIONS'  Relation #1 'OPIOID MED ORDER AND DUP OPIOID MEDS' | 
|---|
| 14 | ;  Called from EL138+5^OCXOZ0I, and EL139+5^OCXOZ0I. | 
|---|
| 15 | ; | 
|---|
| 16 | Q:$G(OCXOERR) | 
|---|
| 17 | ; | 
|---|
| 18 | ;      Local Extrinsic Functions | 
|---|
| 19 | ; MCE138( ---------->  Verify Event/Element: 'DUP OPIOID MEDS' | 
|---|
| 20 | ; MCE139( ---------->  Verify Event/Element: 'OPIOID MED ORDER' | 
|---|
| 21 | ; | 
|---|
| 22 | Q:$G(^OCXS(860.2,71,"INACT")) | 
|---|
| 23 | ; | 
|---|
| 24 | I $$MCE139 D | 
|---|
| 25 | .I $$MCE138 D R71R1B^OCXOZ14 | 
|---|
| 26 | Q | 
|---|
| 27 | ; | 
|---|
| 28 | MCE138() ; Verify Event/Element: DUP OPIOID MEDS | 
|---|
| 29 | ; | 
|---|
| 30 | ;  OCXDF(158) -> DUPLICATE OPIOID MEDICATIONS TEXT data field | 
|---|
| 31 | ;  OCXDF(157) -> DUPLICATE OPIOID MEDICATIONS FLAG data field | 
|---|
| 32 | ;  OCXDF(37) -> PATIENT IEN data field | 
|---|
| 33 | ; | 
|---|
| 34 | N OCXRES | 
|---|
| 35 | S OCXDF(37)=$G(DFN) I $L(OCXDF(37)) S OCXRES(138,37)=OCXDF(37) | 
|---|
| 36 | Q:'(OCXDF(37)) 0 I $D(^TMP("OCXCHK",$J,OCXDF(37),138)) Q $G(^TMP("OCXCHK",$J,OCXDF(37),138)) | 
|---|
| 37 | S OCXRES(138)=0,OCXDF(157)=$P($$OPIOID(OCXDF(37)),"^",1) I $L(OCXDF(157)) S OCXRES(138,157)=OCXDF(157) I (OCXDF(157)) | 
|---|
| 38 | E  Q 0 | 
|---|
| 39 | S OCXDF(158)=$P($$OPIOID(OCXDF(37)),"^",2),OCXRES(138)=11 M ^TMP("OCXCHK",$J,OCXDF(37),138)=OCXRES(138) | 
|---|
| 40 | Q +OCXRES(138) | 
|---|
| 41 | ; | 
|---|
| 42 | MCE139() ; Verify Event/Element: OPIOID MED ORDER | 
|---|
| 43 | ; | 
|---|
| 44 | ;  OCXDF(37) -> PATIENT IEN data field | 
|---|
| 45 | ; | 
|---|
| 46 | N OCXRES | 
|---|
| 47 | S OCXDF(37)=$G(DFN) I $L(OCXDF(37)) S OCXRES(139,37)=OCXDF(37) | 
|---|
| 48 | Q:'(OCXDF(37)) 0 I $D(^TMP("OCXCHK",$J,OCXDF(37),139)) Q $G(^TMP("OCXCHK",$J,OCXDF(37),139)) | 
|---|
| 49 | Q 0 | 
|---|
| 50 | ; | 
|---|
| 51 | OPIOID(ORPT) ;determine if pat is receiving opioid med | 
|---|
| 52 | ; rtn 1^opioid drug 1, opioid drug 2, opioid drug3, ... | 
|---|
| 53 | N ORDG,ORTN,ORNUM,ORDI,ORDCLAS,ORDERS,ORTEXT,DUP,DUPI,DUPJ,DUPLEN | 
|---|
| 54 | S ORDG=0,ORTN=0,DUPI=0,DUPLEN=20 | 
|---|
| 55 | K ^TMP("ORR",$J) | 
|---|
| 56 | S ORDG=$O(^ORD(100.98,"B","RX",ORDG)) | 
|---|
| 57 | D EN^ORQ1(ORPT_";DPT(",ORDG,2,"","","",0,0) | 
|---|
| 58 | N J,HOR,SEQ,X S J=1,HOR=0,SEQ=0 | 
|---|
| 59 | S HOR=$O(^TMP("ORR",$J,HOR)) Q:+HOR<1 ORTN | 
|---|
| 60 | F  S SEQ=$O(^TMP("ORR",$J,HOR,SEQ)) Q:+SEQ<1  D | 
|---|
| 61 | .S X=^TMP("ORR",$J,HOR,SEQ) | 
|---|
| 62 | .S ORNUM=+$P(X,";") | 
|---|
| 63 | .Q:ORNUM=+$G(ORIFN)  ;quit if dup med order # = current order # | 
|---|
| 64 | .S ORDI=$$VALUE^ORCSAVE2(ORNUM,"DRUG") | 
|---|
| 65 | .I +$G(ORDI)>0 D | 
|---|
| 66 | ..S ORDCLAS=$P(^PSDRUG(ORDI,0),U,2)  ;va drug class | 
|---|
| 67 | ..I ($G(ORDCLAS)="CN101")!($G(ORDCLAS)="CN102") D  ;opioid classes | 
|---|
| 68 | ...S ORTEXT=$$FULLTEXT^ORQOR1(ORNUM) | 
|---|
| 69 | ...S ORTEXT=$P(ORTEXT,U)_" ["_$P(ORTEXT,U,2)_"]" | 
|---|
| 70 | ...S DUPI=DUPI+1,DUP(DUPI)=" ["_DUPI_"] "_ORTEXT | 
|---|
| 71 | ...S ORTN=1 | 
|---|
| 72 | I DUPI>0 D | 
|---|
| 73 | .S DUPLEN=$P(215/DUPI,".") | 
|---|
| 74 | .F DUPJ=1:1:DUPI D | 
|---|
| 75 | ..I DUPJ=1 S ORDERS=$E(DUP(DUPJ),1,DUPLEN) | 
|---|
| 76 | ..E  S ORDERS=ORDERS_", "_$E(DUP(DUPJ),1,DUPLEN) | 
|---|
| 77 | K ^TMP("ORR",$J) | 
|---|
| 78 | Q ORTN_U_$G(ORDERS) | 
|---|
| 79 | ; | 
|---|