| 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 |  ;
 | 
|---|