OCXOZ13 ;SLC/RJS,CLA - Order Check Scan ;DEC 27,2007 at 06:00
 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,221**;Dec 17,1997
 ;;  ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
 ;
 ; ***************************************************************
 ; ** Warning: This routine is automatically generated by the   **
 ; ** Rule Compiler (^OCXOCMP) and ANY changes to this routine  **
 ; ** will be lost the next time the rule compiler executes.    **
 ; ***************************************************************
 ;
 Q
 ;
R71R1A ; Verify all Event/Elements of  Rule #71 'OPIOID MEDICATIONS'  Relation #1 'OPIOID MED ORDER AND DUP OPIOID MEDS'
 ;  Called from EL138+5^OCXOZ0I, and EL139+5^OCXOZ0I.
 ;
 Q:$G(OCXOERR)
 ;
 ;      Local Extrinsic Functions
 ; MCE138( ---------->  Verify Event/Element: 'DUP OPIOID MEDS'
 ; MCE139( ---------->  Verify Event/Element: 'OPIOID MED ORDER'
 ;
 Q:$G(^OCXS(860.2,71,"INACT"))
 ;
 I $$MCE139 D 
 .I $$MCE138 D R71R1B^OCXOZ14
 Q
 ;
MCE138() ; Verify Event/Element: DUP OPIOID MEDS
 ;
 ;  OCXDF(158) -> DUPLICATE OPIOID MEDICATIONS TEXT data field
 ;  OCXDF(157) -> DUPLICATE OPIOID MEDICATIONS FLAG data field
 ;  OCXDF(37) -> PATIENT IEN data field
 ;
 N OCXRES
 S OCXDF(37)=$G(DFN) I $L(OCXDF(37)) S OCXRES(138,37)=OCXDF(37)
 Q:'(OCXDF(37)) 0 I $D(^TMP("OCXCHK",$J,OCXDF(37),138)) Q $G(^TMP("OCXCHK",$J,OCXDF(37),138))
 S OCXRES(138)=0,OCXDF(157)=$P($$OPIOID(OCXDF(37)),"^",1) I $L(OCXDF(157)) S OCXRES(138,157)=OCXDF(157) I (OCXDF(157))
 E  Q 0
 S OCXDF(158)=$P($$OPIOID(OCXDF(37)),"^",2),OCXRES(138)=11 M ^TMP("OCXCHK",$J,OCXDF(37),138)=OCXRES(138)
 Q +OCXRES(138)
 ;
MCE139() ; Verify Event/Element: OPIOID MED ORDER
 ;
 ;  OCXDF(37) -> PATIENT IEN data field
 ;
 N OCXRES
 S OCXDF(37)=$G(DFN) I $L(OCXDF(37)) S OCXRES(139,37)=OCXDF(37)
 Q:'(OCXDF(37)) 0 I $D(^TMP("OCXCHK",$J,OCXDF(37),139)) Q $G(^TMP("OCXCHK",$J,OCXDF(37),139))
 Q 0
 ;
OPIOID(ORPT) ;determine if pat is receiving opioid med
 ; rtn 1^opioid drug 1, opioid drug 2, opioid drug3, ...
 N ORDG,ORTN,ORNUM,ORDI,ORDCLAS,ORDERS,ORTEXT,DUP,DUPI,DUPJ,DUPLEN
 S ORDG=0,ORTN=0,DUPI=0,DUPLEN=20
 K ^TMP("ORR",$J)
 S ORDG=$O(^ORD(100.98,"B","RX",ORDG))
 D EN^ORQ1(ORPT_";DPT(",ORDG,2,"","","",0,0)
 N J,HOR,SEQ,X S J=1,HOR=0,SEQ=0
 S HOR=$O(^TMP("ORR",$J,HOR)) Q:+HOR<1 ORTN
 F  S SEQ=$O(^TMP("ORR",$J,HOR,SEQ)) Q:+SEQ<1  D
 .S X=^TMP("ORR",$J,HOR,SEQ)
 .S ORNUM=+$P(X,";")
 .Q:ORNUM=+$G(ORIFN)  ;quit if dup med order # = current order #
 .S ORDI=$$VALUE^ORCSAVE2(ORNUM,"DRUG")
 .I +$G(ORDI)>0 D
 ..S ORDCLAS=$P(^PSDRUG(ORDI,0),U,2)  ;va drug class
 ..I ($G(ORDCLAS)="CN101")!($G(ORDCLAS)="CN102") D  ;opioid classes
 ...S ORTEXT=$$FULLTEXT^ORQOR1(ORNUM)
 ...S ORTEXT=$P(ORTEXT,U)_" ["_$P(ORTEXT,U,2)_"]"
 ...S DUPI=DUPI+1,DUP(DUPI)=" ["_DUPI_"] "_ORTEXT
 ...S ORTN=1
 I DUPI>0 D
 .S DUPLEN=$P(215/DUPI,".")
 .F DUPJ=1:1:DUPI D
 ..I DUPJ=1 S ORDERS=$E(DUP(DUPJ),1,DUPLEN)
 ..E  S ORDERS=ORDERS_", "_$E(DUP(DUPJ),1,DUPLEN)
 K ^TMP("ORR",$J)
 Q ORTN_U_$G(ORDERS)
 ;