OCXOZ14 ;SLC/RJS,CLA - Order Check Scan ;JAN 28,2014 at 03:37
;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,221,243**;Dec 17,1997;Build 242
;; ;;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
Q
;
R71R1B ; Send Order Check, Notication messages and/or Execute code for Rule #71 'OPIOID MEDICATIONS' Relation #1 'OPIOID MED ORDER AND DUP OPIOID MEDS'
; Called from R71R1A+12.
;
Q:$G(OCXOERR)
;
; Local Extrinsic Functions
; GETDATA( ---------> GET DATA FROM THE ACTIVE DATA FILE
;
Q:$D(OCXRULE("R71R1B"))
;
N OCXNMSG,OCXCMSG,OCXPORD,OCXFORD,OCXDATA,OCXNUM,OCXDUZ,OCXQUIT,OCXLOGS,OCXLOGD
I ($G(OCXOSRC)="CPRS ORDER PRESCAN") S OCXCMSG=(+OCXPSD)_"^33^^Duplicate opioid medications: "_$$GETDATA(DFN,"138^139",158) I 1
E S OCXCMSG="Duplicate opioid medications: "_$$GETDATA(DFN,"138^139",158)
S OCXNMSG=""
;
Q:$G(OCXOERR)
;
; Send Order Check Message
;
S OCXOCMSG($O(OCXOCMSG(999999),-1)+1)=OCXCMSG
Q
;
R72R1A ; Verify all Event/Elements of Rule #72 'ALLERGIES UNASSESSIBLE' Relation #1 'ALLERGIES UNASSESSIBLE AND (RADIOLOGY ORDER OR PHA...'
; Called from EL28+6^OCXOZ0I, and EL135+6^OCXOZ0I, and EL137+6^OCXOZ0I, and EL140+5^OCXOZ0I.
;
Q:$G(OCXOERR)
;
; Local Extrinsic Functions
; MCE135( ----------> Verify Event/Element: 'DIET ORDER'
; MCE137( ----------> Verify Event/Element: 'PHARMACY ORDER'
; MCE140( ----------> Verify Event/Element: 'ALLERGIES UNASSESSIBLE'
; MCE28( -----------> Verify Event/Element: 'RADIOLOGY ORDER'
;
Q:$G(^OCXS(860.2,72,"INACT"))
;
I $$MCE140 D
.I $$MCE28 D R72R1B^OCXOZ15
.I $$MCE137 D R72R1B^OCXOZ15
.I $$MCE135 D R72R1B^OCXOZ15
Q
;
GETDATA(DFN,OCXL,OCXDFI) ; This Local Extrinsic Function returns runtime data
;
N OCXE,VAL,PC S VAL=""
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)
Q VAL
;
MCE135() ; Verify Event/Element: DIET ORDER
;
; OCXDF(37) -> PATIENT IEN data field
;
N OCXRES
S OCXDF(37)=$G(DFN) I $L(OCXDF(37)) S OCXRES(135,37)=OCXDF(37)
Q:'(OCXDF(37)) 0 I $D(^TMP("OCXCHK",$J,OCXDF(37),135)) Q $G(^TMP("OCXCHK",$J,OCXDF(37),135))
Q 0
;
MCE137() ; Verify Event/Element: PHARMACY ORDER
;
; OCXDF(37) -> PATIENT IEN data field
;
N OCXRES
S OCXDF(37)=$G(DFN) I $L(OCXDF(37)) S OCXRES(137,37)=OCXDF(37)
Q:'(OCXDF(37)) 0 I $D(^TMP("OCXCHK",$J,OCXDF(37),137)) Q $G(^TMP("OCXCHK",$J,OCXDF(37),137))
Q 0
;
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
;
MCE140() ; Verify Event/Element: ALLERGIES UNASSESSIBLE
;
; OCXDF(37) -> PATIENT IEN data field
;
N OCXRES
S OCXDF(37)=$G(DFN) I $L(OCXDF(37)) S OCXRES(140,37)=OCXDF(37)
Q:'(OCXDF(37)) 0 I $D(^TMP("OCXCHK",$J,OCXDF(37),140)) Q $G(^TMP("OCXCHK",$J,OCXDF(37),140))
Q 0
;
MCE28() ; Verify Event/Element: RADIOLOGY ORDER
;
; OCXDF(37) -> PATIENT IEN data field
;
N OCXRES
S OCXDF(37)=$G(DFN) I $L(OCXDF(37)) S OCXRES(28,37)=OCXDF(37)
Q:'(OCXDF(37)) 0 I $D(^TMP("OCXCHK",$J,OCXDF(37),28)) Q $G(^TMP("OCXCHK",$J,OCXDF(37),28))
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)
;
OCXOZ14 ;SLC/RJS,CLA - Order Check Scan ;JAN 28,2014 at 03:37
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,221,243**;Dec 17,1997;Build 242
+2 ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
+3 ;
+4 ; ***************************************************************
+5 ; ** Warning: This routine is automatically generated by the **
+6 ; ** Rule Compiler (^OCXOCMP) and ANY changes to this routine **
+7 ; ** will be lost the next time the rule compiler executes. **
+8 ; ***************************************************************
+9 ;
+10 QUIT
+11 ;
R71R1A ; Verify all Event/Elements of Rule #71 'OPIOID MEDICATIONS' Relation #1 'OPIOID MED ORDER AND DUP OPIOID MEDS'
+1 ; Called from EL138+5^OCXOZ0I, and EL139+5^OCXOZ0I.
+2 ;
+3 IF $GET(OCXOERR)
QUIT
+4 ;
+5 ; Local Extrinsic Functions
+6 ; MCE138( ----------> Verify Event/Element: 'DUP OPIOID MEDS'
+7 ; MCE139( ----------> Verify Event/Element: 'OPIOID MED ORDER'
+8 ;
+9 IF $GET(^OCXS(860.2,71,"INACT"))
QUIT
+10 ;
+11 IF $$MCE139
Begin DoDot:1
+12 IF $$MCE138
DO R71R1B
End DoDot:1
+13 QUIT
+14 ;
R71R1B ; Send Order Check, Notication messages and/or Execute code for Rule #71 'OPIOID MEDICATIONS' Relation #1 'OPIOID MED ORDER AND DUP OPIOID MEDS'
+1 ; Called from R71R1A+12.
+2 ;
+3 IF $GET(OCXOERR)
QUIT
+4 ;
+5 ; Local Extrinsic Functions
+6 ; GETDATA( ---------> GET DATA FROM THE ACTIVE DATA FILE
+7 ;
+8 IF $DATA(OCXRULE("R71R1B"))
QUIT
+9 ;
+10 NEW OCXNMSG,OCXCMSG,OCXPORD,OCXFORD,OCXDATA,OCXNUM,OCXDUZ,OCXQUIT,OCXLOGS,OCXLOGD
+11 IF ($GET(OCXOSRC)="CPRS ORDER PRESCAN")
SET OCXCMSG=(+OCXPSD)_"^33^^Duplicate opioid medications: "_$$GETDATA(DFN,"138^139",158)
IF 1
+12 IF '$TEST
SET OCXCMSG="Duplicate opioid medications: "_$$GETDATA(DFN,"138^139",158)
+13 SET OCXNMSG=""
+14 ;
+15 IF $GET(OCXOERR)
QUIT
+16 ;
+17 ; Send Order Check Message
+18 ;
+19 SET OCXOCMSG($ORDER(OCXOCMSG(999999),-1)+1)=OCXCMSG
+20 QUIT
+21 ;
R72R1A ; Verify all Event/Elements of Rule #72 'ALLERGIES UNASSESSIBLE' Relation #1 'ALLERGIES UNASSESSIBLE AND (RADIOLOGY ORDER OR PHA...'
+1 ; Called from EL28+6^OCXOZ0I, and EL135+6^OCXOZ0I, and EL137+6^OCXOZ0I, and EL140+5^OCXOZ0I.
+2 ;
+3 IF $GET(OCXOERR)
QUIT
+4 ;
+5 ; Local Extrinsic Functions
+6 ; MCE135( ----------> Verify Event/Element: 'DIET ORDER'
+7 ; MCE137( ----------> Verify Event/Element: 'PHARMACY ORDER'
+8 ; MCE140( ----------> Verify Event/Element: 'ALLERGIES UNASSESSIBLE'
+9 ; MCE28( -----------> Verify Event/Element: 'RADIOLOGY ORDER'
+10 ;
+11 IF $GET(^OCXS(860.2,72,"INACT"))
QUIT
+12 ;
+13 IF $$MCE140
Begin DoDot:1
+14 IF $$MCE28
DO R72R1B^OCXOZ15
+15 IF $$MCE137
DO R72R1B^OCXOZ15
+16 IF $$MCE135
DO R72R1B^OCXOZ15
End DoDot:1
+17 QUIT
+18 ;
GETDATA(DFN,OCXL,OCXDFI) ; This Local Extrinsic Function returns runtime data
+1 ;
+2 NEW OCXE,VAL,PC
SET VAL=""
+3 FOR PC=1:1:$LENGTH(OCXL,U)
SET OCXE=$PIECE(OCXL,U,PC)
IF OCXE
SET VAL=$GET(^TMP("OCXCHK",$JOB,DFN,OCXE,OCXDFI))
IF $LENGTH(VAL)
QUIT
+4 QUIT VAL
+5 ;
MCE135() ; Verify Event/Element: DIET ORDER
+1 ;
+2 ; OCXDF(37) -> PATIENT IEN data field
+3 ;
+4 NEW OCXRES
+5 SET OCXDF(37)=$GET(DFN)
IF $LENGTH(OCXDF(37))
SET OCXRES(135,37)=OCXDF(37)
+6 IF '(OCXDF(37))
QUIT 0
IF $DATA(^TMP("OCXCHK",$JOB,OCXDF(37),135))
QUIT $GET(^TMP("OCXCHK",$JOB,OCXDF(37),135))
+7 QUIT 0
+8 ;
MCE137() ; Verify Event/Element: PHARMACY ORDER
+1 ;
+2 ; OCXDF(37) -> PATIENT IEN data field
+3 ;
+4 NEW OCXRES
+5 SET OCXDF(37)=$GET(DFN)
IF $LENGTH(OCXDF(37))
SET OCXRES(137,37)=OCXDF(37)
+6 IF '(OCXDF(37))
QUIT 0
IF $DATA(^TMP("OCXCHK",$JOB,OCXDF(37),137))
QUIT $GET(^TMP("OCXCHK",$JOB,OCXDF(37),137))
+7 QUIT 0
+8 ;
MCE138() ; Verify Event/Element: DUP OPIOID MEDS
+1 ;
+2 ; OCXDF(158) -> DUPLICATE OPIOID MEDICATIONS TEXT data field
+3 ; OCXDF(157) -> DUPLICATE OPIOID MEDICATIONS FLAG data field
+4 ; OCXDF(37) -> PATIENT IEN data field
+5 ;
+6 NEW OCXRES
+7 SET OCXDF(37)=$GET(DFN)
IF $LENGTH(OCXDF(37))
SET OCXRES(138,37)=OCXDF(37)
+8 IF '(OCXDF(37))
QUIT 0
IF $DATA(^TMP("OCXCHK",$JOB,OCXDF(37),138))
QUIT $GET(^TMP("OCXCHK",$JOB,OCXDF(37),138))
+9 SET OCXRES(138)=0
SET OCXDF(157)=$PIECE($$OPIOID(OCXDF(37)),"^",1)
IF $LENGTH(OCXDF(157))
SET OCXRES(138,157)=OCXDF(157)
IF (OCXDF(157))
+10 IF '$TEST
QUIT 0
+11 SET OCXDF(158)=$PIECE($$OPIOID(OCXDF(37)),"^",2)
SET OCXRES(138)=11
MERGE ^TMP("OCXCHK",$JOB,OCXDF(37),138)=OCXRES(138)
+12 QUIT +OCXRES(138)
+13 ;
MCE139() ; Verify Event/Element: OPIOID MED ORDER
+1 ;
+2 ; OCXDF(37) -> PATIENT IEN data field
+3 ;
+4 NEW OCXRES
+5 SET OCXDF(37)=$GET(DFN)
IF $LENGTH(OCXDF(37))
SET OCXRES(139,37)=OCXDF(37)
+6 IF '(OCXDF(37))
QUIT 0
IF $DATA(^TMP("OCXCHK",$JOB,OCXDF(37),139))
QUIT $GET(^TMP("OCXCHK",$JOB,OCXDF(37),139))
+7 QUIT 0
+8 ;
MCE140() ; Verify Event/Element: ALLERGIES UNASSESSIBLE
+1 ;
+2 ; OCXDF(37) -> PATIENT IEN data field
+3 ;
+4 NEW OCXRES
+5 SET OCXDF(37)=$GET(DFN)
IF $LENGTH(OCXDF(37))
SET OCXRES(140,37)=OCXDF(37)
+6 IF '(OCXDF(37))
QUIT 0
IF $DATA(^TMP("OCXCHK",$JOB,OCXDF(37),140))
QUIT $GET(^TMP("OCXCHK",$JOB,OCXDF(37),140))
+7 QUIT 0
+8 ;
MCE28() ; Verify Event/Element: RADIOLOGY ORDER
+1 ;
+2 ; OCXDF(37) -> PATIENT IEN data field
+3 ;
+4 NEW OCXRES
+5 SET OCXDF(37)=$GET(DFN)
IF $LENGTH(OCXDF(37))
SET OCXRES(28,37)=OCXDF(37)
+6 IF '(OCXDF(37))
QUIT 0
IF $DATA(^TMP("OCXCHK",$JOB,OCXDF(37),28))
QUIT $GET(^TMP("OCXCHK",$JOB,OCXDF(37),28))
+7 QUIT 0
+8 ;
OPIOID(ORPT) ;determine if pat is receiving opioid med
+1 ; rtn 1^opioid drug 1, opioid drug 2, opioid drug3, ...
+2 NEW ORDG,ORTN,ORNUM,ORDI,ORDCLAS,ORDERS,ORTEXT,DUP,DUPI,DUPJ,DUPLEN
+3 SET ORDG=0
SET ORTN=0
SET DUPI=0
SET DUPLEN=20
+4 KILL ^TMP("ORR",$JOB)
+5 SET ORDG=$ORDER(^ORD(100.98,"B","RX",ORDG))
+6 DO EN^ORQ1(ORPT_";DPT(",ORDG,2,"","","",0,0)
+7 NEW J,HOR,SEQ,X
SET J=1
SET HOR=0
SET SEQ=0
+8 SET HOR=$ORDER(^TMP("ORR",$JOB,HOR))
IF +HOR<1
QUIT ORTN
+9 FOR
SET SEQ=$ORDER(^TMP("ORR",$JOB,HOR,SEQ))
IF +SEQ<1
QUIT
Begin DoDot:1
+10 SET X=^TMP("ORR",$JOB,HOR,SEQ)
+11 SET ORNUM=+$PIECE(X,";")
+12 ;quit if dup med order # = current order #
IF ORNUM=+$GET(ORIFN)
QUIT
+13 SET ORDI=$$VALUE^ORCSAVE2(ORNUM,"DRUG")
+14 IF +$GET(ORDI)>0
Begin DoDot:2
+15 ;va drug class
SET ORDCLAS=$PIECE(^PSDRUG(ORDI,0),U,2)
+16 ;opioid classes
IF ($GET(ORDCLAS)="CN101")!($GET(ORDCLAS)="CN102")
Begin DoDot:3
+17 SET ORTEXT=$$FULLTEXT^ORQOR1(ORNUM)
+18 SET ORTEXT=$PIECE(ORTEXT,U)_" ["_$PIECE(ORTEXT,U,2)_"]"
+19 SET DUPI=DUPI+1
SET DUP(DUPI)=" ["_DUPI_"] "_ORTEXT
+20 SET ORTN=1
End DoDot:3
End DoDot:2
End DoDot:1
+21 IF DUPI>0
Begin DoDot:1
+22 SET DUPLEN=$PIECE(215/DUPI,".")
+23 FOR DUPJ=1:1:DUPI
Begin DoDot:2
+24 IF DUPJ=1
SET ORDERS=$EXTRACT(DUP(DUPJ),1,DUPLEN)
+25 IF '$TEST
SET ORDERS=ORDERS_", "_$EXTRACT(DUP(DUPJ),1,DUPLEN)
End DoDot:2
End DoDot:1
+26 KILL ^TMP("ORR",$JOB)
+27 QUIT ORTN_U_$GET(ORDERS)
+28 ;
