Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: OCXOZ14

OCXOZ14.m

Go to the documentation of this file. 
  1. 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
  1.  ;;  ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
  1.  ;
  1.  ; ***************************************************************
  1.  ; ** Warning: This routine is automatically generated by the   **
  1.  ; ** Rule Compiler (^OCXOCMP) and ANY changes to this routine  **
  1.  ; ** will be lost the next time the rule compiler executes.    **
  1.  ; ***************************************************************
  1.  ;
  1.  Q
  1.  ;
  1. 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.
  1.  ;
  1.  Q:$G(OCXOERR)
  1.  ;
  1.  ;      Local Extrinsic Functions
  1.  ; MCE138( ---------->  Verify Event/Element: 'DUP OPIOID MEDS'
  1.  ; MCE139( ---------->  Verify Event/Element: 'OPIOID MED ORDER'
  1.  ;
  1.  Q:$G(^OCXS(860.2,71,"INACT"))
  1.  ;
  1.  I $$MCE139 D 
  1.  .I $$MCE138 D R71R1B
  1.  Q
  1.  ;
  1. 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.
  1.  ;
  1.  Q:$G(OCXOERR)
  1.  ;
  1.  ;      Local Extrinsic Functions
  1.  ; GETDATA( ---------> GET DATA FROM THE ACTIVE DATA FILE
  1.  ;
  1.  Q:$D(OCXRULE("R71R1B"))
  1.  ;
  1.  N OCXNMSG,OCXCMSG,OCXPORD,OCXFORD,OCXDATA,OCXNUM,OCXDUZ,OCXQUIT,OCXLOGS,OCXLOGD
  1.  I ($G(OCXOSRC)="CPRS ORDER PRESCAN") S OCXCMSG=(+OCXPSD)_"^33^^Duplicate opioid medications: "_$$GETDATA(DFN,"138^139",158) I 1
  1.  E  S OCXCMSG="Duplicate opioid medications: "_$$GETDATA(DFN,"138^139",158)
  1.  S OCXNMSG=""
  1.  ;
  1.  Q:$G(OCXOERR)
  1.  ;
  1.  ; Send Order Check Message
  1.  ;
  1.  S OCXOCMSG($O(OCXOCMSG(999999),-1)+1)=OCXCMSG
  1.  Q
  1.  ;
  1. 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.
  1.  ;
  1.  Q:$G(OCXOERR)
  1.  ;
  1.  ;      Local Extrinsic Functions
  1.  ; MCE135( ---------->  Verify Event/Element: 'DIET ORDER'
  1.  ; MCE137( ---------->  Verify Event/Element: 'PHARMACY ORDER'
  1.  ; MCE140( ---------->  Verify Event/Element: 'ALLERGIES UNASSESSIBLE'
  1.  ; MCE28( ----------->  Verify Event/Element: 'RADIOLOGY ORDER'
  1.  ;
  1.  Q:$G(^OCXS(860.2,72,"INACT"))
  1.  ;
  1.  I $$MCE140 D 
  1.  .I $$MCE28 D R72R1B^OCXOZ15
  1.  .I $$MCE137 D R72R1B^OCXOZ15
  1.  .I $$MCE135 D R72R1B^OCXOZ15
  1.  Q
  1.  ;
  1. GETDATA(DFN,OCXL,OCXDFI) ;     This Local Extrinsic Function returns runtime data
  1.  ;
  1.  N OCXE,VAL,PC S VAL=""
  1.  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)
  1.  Q VAL
  1.  ;
  1. MCE135() ; Verify Event/Element: DIET ORDER
  1.  ;
  1.  ;  OCXDF(37) -> PATIENT IEN data field
  1.  ;
  1.  N OCXRES
  1.  S OCXDF(37)=$G(DFN) I $L(OCXDF(37)) S OCXRES(135,37)=OCXDF(37)
  1.  Q:'(OCXDF(37)) 0 I $D(^TMP("OCXCHK",$J,OCXDF(37),135)) Q $G(^TMP("OCXCHK",$J,OCXDF(37),135))
  1.  Q 0
  1.  ;
  1. MCE137() ; Verify Event/Element: PHARMACY ORDER
  1.  ;
  1.  ;  OCXDF(37) -> PATIENT IEN data field
  1.  ;
  1.  N OCXRES
  1.  S OCXDF(37)=$G(DFN) I $L(OCXDF(37)) S OCXRES(137,37)=OCXDF(37)
  1.  Q:'(OCXDF(37)) 0 I $D(^TMP("OCXCHK",$J,OCXDF(37),137)) Q $G(^TMP("OCXCHK",$J,OCXDF(37),137))
  1.  Q 0
  1.  ;
  1. MCE138() ; Verify Event/Element: DUP OPIOID MEDS
  1.  ;
  1.  ;  OCXDF(158) -> DUPLICATE OPIOID MEDICATIONS TEXT data field
  1.  ;  OCXDF(157) -> DUPLICATE OPIOID MEDICATIONS FLAG data field
  1.  ;  OCXDF(37) -> PATIENT IEN data field
  1.  ;
  1.  N OCXRES
  1.  S OCXDF(37)=$G(DFN) I $L(OCXDF(37)) S OCXRES(138,37)=OCXDF(37)
  1.  Q:'(OCXDF(37)) 0 I $D(^TMP("OCXCHK",$J,OCXDF(37),138)) Q $G(^TMP("OCXCHK",$J,OCXDF(37),138))
  1.  S OCXRES(138)=0,OCXDF(157)=$P($$OPIOID(OCXDF(37)),"^",1) I $L(OCXDF(157)) S OCXRES(138,157)=OCXDF(157) I (OCXDF(157))
  1.  E  Q 0
  1.  S OCXDF(158)=$P($$OPIOID(OCXDF(37)),"^",2),OCXRES(138)=11 M ^TMP("OCXCHK",$J,OCXDF(37),138)=OCXRES(138)
  1.  Q +OCXRES(138)
  1.  ;
  1. MCE139() ; Verify Event/Element: OPIOID MED ORDER
  1.  ;
  1.  ;  OCXDF(37) -> PATIENT IEN data field
  1.  ;
  1.  N OCXRES
  1.  S OCXDF(37)=$G(DFN) I $L(OCXDF(37)) S OCXRES(139,37)=OCXDF(37)
  1.  Q:'(OCXDF(37)) 0 I $D(^TMP("OCXCHK",$J,OCXDF(37),139)) Q $G(^TMP("OCXCHK",$J,OCXDF(37),139))
  1.  Q 0
  1.  ;
  1. MCE140() ; Verify Event/Element: ALLERGIES UNASSESSIBLE
  1.  ;
  1.  ;  OCXDF(37) -> PATIENT IEN data field
  1.  ;
  1.  N OCXRES
  1.  S OCXDF(37)=$G(DFN) I $L(OCXDF(37)) S OCXRES(140,37)=OCXDF(37)
  1.  Q:'(OCXDF(37)) 0 I $D(^TMP("OCXCHK",$J,OCXDF(37),140)) Q $G(^TMP("OCXCHK",$J,OCXDF(37),140))
  1.  Q 0
  1.  ;
  1. MCE28() ; Verify Event/Element: RADIOLOGY ORDER
  1.  ;
  1.  ;  OCXDF(37) -> PATIENT IEN data field
  1.  ;
  1.  N OCXRES
  1.  S OCXDF(37)=$G(DFN) I $L(OCXDF(37)) S OCXRES(28,37)=OCXDF(37)
  1.  Q:'(OCXDF(37)) 0 I $D(^TMP("OCXCHK",$J,OCXDF(37),28)) Q $G(^TMP("OCXCHK",$J,OCXDF(37),28))
  1.  Q 0
  1.  ;
  1. OPIOID(ORPT) ;determine if pat is receiving opioid med
  1.  ; rtn 1^opioid drug 1, opioid drug 2, opioid drug3, ...
  1.  N ORDG,ORTN,ORNUM,ORDI,ORDCLAS,ORDERS,ORTEXT,DUP,DUPI,DUPJ,DUPLEN
  1.  S ORDG=0,ORTN=0,DUPI=0,DUPLEN=20
  1.  K ^TMP("ORR",$J)
  1.  S ORDG=$O(^ORD(100.98,"B","RX",ORDG))
  1.  D EN^ORQ1(ORPT_";DPT(",ORDG,2,"","","",0,0)
  1.  N J,HOR,SEQ,X S J=1,HOR=0,SEQ=0
  1.  S HOR=$O(^TMP("ORR",$J,HOR)) Q:+HOR<1 ORTN
  1.  F  S SEQ=$O(^TMP("ORR",$J,HOR,SEQ)) Q:+SEQ<1  D
  1.  .S X=^TMP("ORR",$J,HOR,SEQ)
  1.  .S ORNUM=+$P(X,";")
  1.  .Q:ORNUM=+$G(ORIFN)  ;quit if dup med order # = current order #
  1.  .S ORDI=$$VALUE^ORCSAVE2(ORNUM,"DRUG")
  1.  .I +$G(ORDI)>0 D
  1.  ..S ORDCLAS=$P(^PSDRUG(ORDI,0),U,2)  ;va drug class
  1.  ..I ($G(ORDCLAS)="CN101")!($G(ORDCLAS)="CN102") D  ;opioid classes
  1.  ...S ORTEXT=$$FULLTEXT^ORQOR1(ORNUM)
  1.  ...S ORTEXT=$P(ORTEXT,U)_" ["_$P(ORTEXT,U,2)_"]"
  1.  ...S DUPI=DUPI+1,DUP(DUPI)=" ["_DUPI_"] "_ORTEXT
  1.  ...S ORTN=1
  1.  I DUPI>0 D
  1.  .S DUPLEN=$P(215/DUPI,".")
  1.  .F DUPJ=1:1:DUPI D
  1.  ..I DUPJ=1 S ORDERS=$E(DUP(DUPJ),1,DUPLEN)
  1.  ..E  S ORDERS=ORDERS_", "_$E(DUP(DUPJ),1,DUPLEN)
  1.  K ^TMP("ORR",$J)
  1.  Q ORTN_U_$G(ORDERS)
  1.  ;