ORKCHKM ; IHS/MSC/DKM - Support routine called by ORKCHK to do MANUAL mode order checks ;23-Nov-2011 11:46;PLS
;;3.0;ORDER ENTRY/RESULTS REPORTING;**1005,1010**;Nov 29, 2007;Build 47
; Modified - IHS/MSC/DKM - 11/29/07 -
Q
;
EN(ORKS,ORKDFN,ORKA,ORENT,ORKTMODE) ;perform manual order checking
Q:$$GET^XPAR("DIV^SYS^PKG","ORK SYSTEM ENABLE/DISABLE",1,"I")="D"
;
N OI,ORKDG,HL7,ODT,ORNUM,HL7NPTR,HL7NTXT,HL7NCOD,HL7LPTR,HL7LTXT,HL7LCOD
N ORKMSG,ORKDGI,ORKT,ORKTXT,ORKPDATA
;
S OI=$P(ORKA,"|"),ORKDG=$P(ORKA,"|",2),HL7=$P(ORKA,"|",3)
S ODT=$P(ORKA,"|",4),ORNUM=$P(ORKA,"|",5),ORKPDATA=$P(ORKA,"|",6)
S HL7NPTR=$P(HL7,U),HL7NTXT=$P(HL7,U,2),HL7NCOD=$P(HL7,U,3)
S HL7LPTR=$P(HL7,U,4),HL7LTXT=$P(HL7,U,5),HL7LCOD=$P(HL7,U,6)
;
S:ORKDG="PSJ" ORKDG="PSI"
I $E(ORKDG,1,2)="PS" D PHARM
I $E(ORKDG,1,2)'="PS" D MLM^ORKCHK2(.ORKS,ORKDFN,ORKA,ORENT,"SESSION")
Q
;
PHARM ;process pharmacy order checks:
N ORPSPKG,ORPSA,ORKDD
N ORCRITN,ORCRITF,ORCRITD,ORSIGN,ORSIGF,ORSIGD,ORDUPN,ORDUPF,ORDUPD,ORDUPC,ORDUPCF,ORDUPCD
N ORALLRN,ORALLRF,ORALLRD
;
D PARAMS("CRITICAL DRUG INTERACTION",.ORCRITN,.ORCRITF,.ORCRITD)
D PARAMS("SIGNIFICANT DRUG INTERACTION",.ORSIGN,.ORSIGF,.ORSIGD)
D PARAMS("DUPLICATE DRUG ORDER",.ORDUPN,.ORDUPF,.ORDUPD)
D PARAMS("DUPLICATE DRUG CLASS ORDER",.ORDUPCN,.ORDUPCF,.ORDUPCD)
D PARAMS("ALLERGY-DRUG INTERACTION",.ORALLRN,.ORALLRF,.ORALLRD)
;
;dispense drug selected:
I $L($G(HL7LPTR)),($G(HL7LCOD)="99PSD") D
.D RXOCS
.D MLM^ORKCHK2(.ORKS,ORKDFN,ORKA,ORENT,"SESSION")
;
;dispense drug NOT selected, split OI into dispense drugs:
I '$L($G(HL7LPTR)) D
.S ORPSPKG=$E(ORKDG,3)
.I ORPSPKG="H" S ORPSPKG="X" ;change to "X" if "H"erbal/non-VA med
.I "IOX"[ORPSPKG D OI2DD(.ORPSA,OI,ORPSPKG)
.S ORKDD=0 F S ORKDD=$O(ORPSA(ORKDD)) Q:'ORKDD D
..S HL7LTXT=ORPSA(ORKDD)
..S HL7NPTR=$P(ORKDD,";",2)
..S HL7LPTR=+ORKDD
..S HL7LCOD="99PSD",HL7NCOD="99NDF"
..S $P(HL7,U)=HL7NPTR,$P(HL7,U,3)=HL7NCOD
..S $P(HL7,U,4)=HL7LPTR,$P(HL7,U,5)=HL7LTXT,$P(HL7,U,6)=HL7LCOD
..S $P(ORKA,"|",3)=HL7 ;set these for MLM OCX call
..D RXOCS
..D MLM^ORKCHK2(.ORKS,ORKDFN,ORKA,ORENT,"SESSION")
Q
;
RXOCS ;drug-allergy, drug-drug interaction, duplicate drug order, duplicate drug class
Q:ORCRITF_ORSIGF_ORDUPF_ORDUPCF_ORALLRF'["E" ;quit if none are "E"nabled
N ORKRX,ORPSNUM
;drug-allergy interaction:
I ORALLRF'="D",$L($G(HL7NPTR)),($G(HL7NCOD)="99NDF") D
.N ORKAL
.D RXN^ORQQAL(.ORKAL,ORKDFN,"DR",HL7NPTR,$G(HL7LPTR))
.I ORKAL>0 D
..Q:'$L($P(ORKAL,U,2))
..S ORKT=$$FULLTEXT^ORQOR1(ORNUM),ORKTXT=$P(ORKT,U)_" ["_$P(ORKT,U,2)_"]"
..S ORKMSG="Previous adverse reaction to: "_$P(ORKAL,U,2)_" ("_ORKTXT_")"
..S ORKS("ORK",ORALLRD_","_$G(ORNUM)_","_$E(ORKMSG,1,225))=ORNUM_U_ORALLRN_U_ORALLRD_U_ORKMSG
I $L($G(HL7LPTR)),($G(HL7LCOD)="99PSD") D
.D CHKSESS^ORKPS(.ORKRX,ORKDFN,HL7LPTR,OI,ORKPDATA,ORKDG)
.N CHK,XX S CHK=0,XX=""
.F S CHK=$O(ORKRX(CHK)) Q:'CHK D
..S XX=ORKRX(CHK)
..;
..;critical drug interaction:
..I $P(XX,U)="DI",$P(XX,U,5)="CRITICAL" D
...Q:ORCRITF="D"
...S ORPSNUM=$P(XX,U,8) ;get the associated order number
...I $L(ORPSNUM),$G(^OR(100,+ORPSNUM,0)) S ORKT=$$FULLTEXT^ORQOR1(+ORPSNUM),ORKTXT=$P(ORKT,U)_" ["_$P(ORKT,U,2)_"]"
...E S ORKTXT=$P(XX,U,3)
...S ORKMSG=$P(XX,U,5)_" drug-drug interaction: "_$P(XX,U,6)_" & "_$P(XX,U,7)
...S ORKS("ORK",ORCRITD_","_$G(ORNUM)_","_ORPSNUM_","_$E(ORKMSG,1,225))=ORNUM_U_ORCRITN_U_ORCRITD_U_ORKMSG_" ("_ORKTXT_")"_U_$G(ORPSNUM)
..;
..;significant drug interaction:
..I $P(XX,U)="DI",$P(XX,U,5)="SIGNIFICANT" D
...Q:ORSIGF="D"
...S ORPSNUM=$P(XX,U,8) ;get the associated order number
...I $L(ORPSNUM),$G(^OR(100,+ORPSNUM,0)) S ORKT=$$FULLTEXT^ORQOR1(+ORPSNUM),ORKTXT=$P(ORKT,U)_" ["_$P(ORKT,U,2)_"]"
...E S ORKTXT=$P(XX,U,3)
...S ORKMSG=$P(XX,U,5)_" drug-drug interaction: "_$P(XX,U,6)_" & "_$P(XX,U,7)
...S ORKS("ORK",ORSIGD_","_$G(ORNUM)_","_ORPSNUM_","_$E(ORKMSG,1,225))=ORNUM_U_ORSIGN_U_ORSIGD_U_ORKMSG_" ("_ORKTXT_")"_U_$G(ORPSNUM)
..;
..;duplicate drug:
..I $P(XX,U)="DD" D
...Q:ORDUPF="D"
...S ORPSNUM=$P(XX,U,4) ;get the associated order number
...I $L(ORPSNUM),$G(^OR(100,+ORPSNUM,0)) S ORKT=$$FULLTEXT^ORQOR1(+ORPSNUM),ORKTXT=$P(ORKT,U)_" ["_$P(ORKT,U,2)_"]"
...E S ORKTXT=$P(XX,U,3)
...S ORKMSG="Duplicate order: "_ORKTXT
...S ORKS("ORK",ORDUPD_","_$G(ORNUM)_","_ORPSNUM_",Duplicate order: "_$P(XX,U,3))=ORNUM_U_ORDUPN_U_ORDUPD_U_ORKMSG_U_$G(ORPSNUM)
..;
..;duplicate class:
..I $P(XX,U)="DC" D
...Q:ORDUPCF="D"
...S ORPSNUM=$P(XX,U,6) ;get the associated order number
...I $L(ORPSNUM),$G(^OR(100,+ORPSNUM,0)) S ORKT=$$FULLTEXT^ORQOR1(+ORPSNUM),ORKTXT=$P(ORKT,U)_" ["_$P(ORKT,U,2)_"]"
...E S ORKTXT=$P(XX,U,5)
...S ORKMSG="Duplicate drug class order: "_$P(XX,U,3)
...S ORKS("ORK",ORDUPCD_","_$G(ORNUM)_","_ORPSNUM_","_$E(ORKMSG,1,225))=ORNUM_U_ORDUPCN_U_ORDUPCD_U_ORKMSG_" ("_ORKTXT_")"_U_$G(ORPSNUM)
Q
;
OI2DD(ORPSA,OROI,ORPSPKG) ;rtn dispense drugs for a PS OI
N PSOI
Q:'$D(^ORD(101.43,OROI,0))
S PSOI=$P($P(^ORD(101.43,OROI,0),U,2),";")
Q:+$G(PSOI)<1
D DRG^PSSUTIL1(.ORPSA,PSOI,ORPSPKG)
Q
;
PARAMS(ORKNAME,ORKNUM,ORKFLAG,ORKDNGR) ; get parameter values for an order chk
S ORKNUM=0,ORKNUM=$O(^ORD(100.8,"B",ORKNAME,ORKNUM))
S ORKFLAG=$$GET^XPAR(ORENT,"ORK PROCESSING FLAG",ORKNUM,"I")
S ORKDNGR=$$GET^XPAR("DIV^SYS^PKG","ORK CLINICAL DANGER LEVEL",ORKNUM,"I")
Q
ORKCHKM ; IHS/MSC/DKM - Support routine called by ORKCHK to do MANUAL mode order checks ;23-Nov-2011 11:46;PLS
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**1005,1010**;Nov 29, 2007;Build 47
+2 ; Modified - IHS/MSC/DKM - 11/29/07 -
+3 QUIT
+4 ;
EN(ORKS,ORKDFN,ORKA,ORENT,ORKTMODE) ;perform manual order checking
+1 IF $$GET^XPAR("DIV^SYS^PKG","ORK SYSTEM ENABLE/DISABLE",1,"I")="D"
QUIT
+2 ;
+3 NEW OI,ORKDG,HL7,ODT,ORNUM,HL7NPTR,HL7NTXT,HL7NCOD,HL7LPTR,HL7LTXT,HL7LCOD
+4 NEW ORKMSG,ORKDGI,ORKT,ORKTXT,ORKPDATA
+5 ;
+6 SET OI=$PIECE(ORKA,"|")
SET ORKDG=$PIECE(ORKA,"|",2)
SET HL7=$PIECE(ORKA,"|",3)
+7 SET ODT=$PIECE(ORKA,"|",4)
SET ORNUM=$PIECE(ORKA,"|",5)
SET ORKPDATA=$PIECE(ORKA,"|",6)
+8 SET HL7NPTR=$PIECE(HL7,U)
SET HL7NTXT=$PIECE(HL7,U,2)
SET HL7NCOD=$PIECE(HL7,U,3)
+9 SET HL7LPTR=$PIECE(HL7,U,4)
SET HL7LTXT=$PIECE(HL7,U,5)
SET HL7LCOD=$PIECE(HL7,U,6)
+10 ;
+11 IF ORKDG="PSJ"
SET ORKDG="PSI"
+12 IF $EXTRACT(ORKDG,1,2)="PS"
DO PHARM
+13 IF $EXTRACT(ORKDG,1,2)'="PS"
DO MLM^ORKCHK2(.ORKS,ORKDFN,ORKA,ORENT,"SESSION")
+14 QUIT
+15 ;
PHARM ;process pharmacy order checks:
+1 NEW ORPSPKG,ORPSA,ORKDD
+2 NEW ORCRITN,ORCRITF,ORCRITD,ORSIGN,ORSIGF,ORSIGD,ORDUPN,ORDUPF,ORDUPD,ORDUPC,ORDUPCF,ORDUPCD
+3 NEW ORALLRN,ORALLRF,ORALLRD
+4 ;
+5 DO PARAMS("CRITICAL DRUG INTERACTION",.ORCRITN,.ORCRITF,.ORCRITD)
+6 DO PARAMS("SIGNIFICANT DRUG INTERACTION",.ORSIGN,.ORSIGF,.ORSIGD)
+7 DO PARAMS("DUPLICATE DRUG ORDER",.ORDUPN,.ORDUPF,.ORDUPD)
+8 DO PARAMS("DUPLICATE DRUG CLASS ORDER",.ORDUPCN,.ORDUPCF,.ORDUPCD)
+9 DO PARAMS("ALLERGY-DRUG INTERACTION",.ORALLRN,.ORALLRF,.ORALLRD)
+10 ;
+11 ;dispense drug selected:
+12 IF $LENGTH($GET(HL7LPTR))
IF ($GET(HL7LCOD)="99PSD")
Begin DoDot:1
+13 DO RXOCS
+14 DO MLM^ORKCHK2(.ORKS,ORKDFN,ORKA,ORENT,"SESSION")
End DoDot:1
+15 ;
+16 ;dispense drug NOT selected, split OI into dispense drugs:
+17 IF '$LENGTH($GET(HL7LPTR))
Begin DoDot:1
+18 SET ORPSPKG=$EXTRACT(ORKDG,3)
+19 ;change to "X" if "H"erbal/non-VA med
IF ORPSPKG="H"
SET ORPSPKG="X"
+20 IF "IOX"[ORPSPKG
DO OI2DD(.ORPSA,OI,ORPSPKG)
+21 SET ORKDD=0
FOR
SET ORKDD=$ORDER(ORPSA(ORKDD))
IF 'ORKDD
QUIT
Begin DoDot:2
+22 SET HL7LTXT=ORPSA(ORKDD)
+23 SET HL7NPTR=$PIECE(ORKDD,";",2)
+24 SET HL7LPTR=+ORKDD
+25 SET HL7LCOD="99PSD"
SET HL7NCOD="99NDF"
+26 SET $PIECE(HL7,U)=HL7NPTR
SET $PIECE(HL7,U,3)=HL7NCOD
+27 SET $PIECE(HL7,U,4)=HL7LPTR
SET $PIECE(HL7,U,5)=HL7LTXT
SET $PIECE(HL7,U,6)=HL7LCOD
+28 ;set these for MLM OCX call
SET $PIECE(ORKA,"|",3)=HL7
+29 DO RXOCS
+30 DO MLM^ORKCHK2(.ORKS,ORKDFN,ORKA,ORENT,"SESSION")
End DoDot:2
End DoDot:1
+31 QUIT
+32 ;
RXOCS ;drug-allergy, drug-drug interaction, duplicate drug order, duplicate drug class
+1 ;quit if none are "E"nabled
IF ORCRITF_ORSIGF_ORDUPF_ORDUPCF_ORALLRF'["E"
QUIT
+2 NEW ORKRX,ORPSNUM
+3 ;drug-allergy interaction:
+4 IF ORALLRF'="D"
IF $LENGTH($GET(HL7NPTR))
IF ($GET(HL7NCOD)="99NDF")
Begin DoDot:1
+5 NEW ORKAL
+6 DO RXN^ORQQAL(.ORKAL,ORKDFN,"DR",HL7NPTR,$GET(HL7LPTR))
+7 IF ORKAL>0
Begin DoDot:2
+8 IF '$LENGTH($PIECE(ORKAL,U,2))
QUIT
+9 SET ORKT=$$FULLTEXT^ORQOR1(ORNUM)
SET ORKTXT=$PIECE(ORKT,U)_" ["_$PIECE(ORKT,U,2)_"]"
+10 SET ORKMSG="Previous adverse reaction to: "_$PIECE(ORKAL,U,2)_" ("_ORKTXT_")"
+11 SET ORKS("ORK",ORALLRD_","_$GET(ORNUM)_","_$EXTRACT(ORKMSG,1,225))=ORNUM_U_ORALLRN_U_ORALLRD_U_ORKMSG
End DoDot:2
End DoDot:1
+12 IF $LENGTH($GET(HL7LPTR))
IF ($GET(HL7LCOD)="99PSD")
Begin DoDot:1
+13 DO CHKSESS^ORKPS(.ORKRX,ORKDFN,HL7LPTR,OI,ORKPDATA,ORKDG)
+14 NEW CHK,XX
SET CHK=0
SET XX=""
+15 FOR
SET CHK=$ORDER(ORKRX(CHK))
IF 'CHK
QUIT
Begin DoDot:2
+16 SET XX=ORKRX(CHK)
+17 ;
+18 ;critical drug interaction:
+19 IF $PIECE(XX,U)="DI"
IF $PIECE(XX,U,5)="CRITICAL"
Begin DoDot:3
+20 IF ORCRITF="D"
QUIT
+21 ;get the associated order number
SET ORPSNUM=$PIECE(XX,U,8)
+22 IF $LENGTH(ORPSNUM)
IF $GET(^OR(100,+ORPSNUM,0))
SET ORKT=$$FULLTEXT^ORQOR1(+ORPSNUM)
SET ORKTXT=$PIECE(ORKT,U)_" ["_$PIECE(ORKT,U,2)_"]"
+23 IF '$TEST
SET ORKTXT=$PIECE(XX,U,3)
+24 SET ORKMSG=$PIECE(XX,U,5)_" drug-drug interaction: "_$PIECE(XX,U,6)_" & "_$PIECE(XX,U,7)
+25 SET ORKS("ORK",ORCRITD_","_$GET(ORNUM)_","_ORPSNUM_","_$EXTRACT(ORKMSG,1,225))=ORNUM_U_ORCRITN_U_ORCRITD_U_ORKMSG_" ("_ORKTXT_")"_U_$GET(ORPSNUM)
End DoDot:3
+26 ;
+27 ;significant drug interaction:
+28 IF $PIECE(XX,U)="DI"
IF $PIECE(XX,U,5)="SIGNIFICANT"
Begin DoDot:3
+29 IF ORSIGF="D"
QUIT
+30 ;get the associated order number
SET ORPSNUM=$PIECE(XX,U,8)
+31 IF $LENGTH(ORPSNUM)
IF $GET(^OR(100,+ORPSNUM,0))
SET ORKT=$$FULLTEXT^ORQOR1(+ORPSNUM)
SET ORKTXT=$PIECE(ORKT,U)_" ["_$PIECE(ORKT,U,2)_"]"
+32 IF '$TEST
SET ORKTXT=$PIECE(XX,U,3)
+33 SET ORKMSG=$PIECE(XX,U,5)_" drug-drug interaction: "_$PIECE(XX,U,6)_" & "_$PIECE(XX,U,7)
+34 SET ORKS("ORK",ORSIGD_","_$GET(ORNUM)_","_ORPSNUM_","_$EXTRACT(ORKMSG,1,225))=ORNUM_U_ORSIGN_U_ORSIGD_U_ORKMSG_" ("_ORKTXT_")"_U_$GET(ORPSNUM)
End DoDot:3
+35 ;
+36 ;duplicate drug:
+37 IF $PIECE(XX,U)="DD"
Begin DoDot:3
+38 IF ORDUPF="D"
QUIT
+39 ;get the associated order number
SET ORPSNUM=$PIECE(XX,U,4)
+40 IF $LENGTH(ORPSNUM)
IF $GET(^OR(100,+ORPSNUM,0))
SET ORKT=$$FULLTEXT^ORQOR1(+ORPSNUM)
SET ORKTXT=$PIECE(ORKT,U)_" ["_$PIECE(ORKT,U,2)_"]"
+41 IF '$TEST
SET ORKTXT=$PIECE(XX,U,3)
+42 SET ORKMSG="Duplicate order: "_ORKTXT
+43 SET ORKS("ORK",ORDUPD_","_$GET(ORNUM)_","_ORPSNUM_",Duplicate order: "_$PIECE(XX,U,3))=ORNUM_U_ORDUPN_U_ORDUPD_U_ORKMSG_U_$GET(ORPSNUM)
End DoDot:3
+44 ;
+45 ;duplicate class:
+46 IF $PIECE(XX,U)="DC"
Begin DoDot:3
+47 IF ORDUPCF="D"
QUIT
+48 ;get the associated order number
SET ORPSNUM=$PIECE(XX,U,6)
+49 IF $LENGTH(ORPSNUM)
IF $GET(^OR(100,+ORPSNUM,0))
SET ORKT=$$FULLTEXT^ORQOR1(+ORPSNUM)
SET ORKTXT=$PIECE(ORKT,U)_" ["_$PIECE(ORKT,U,2)_"]"
+50 IF '$TEST
SET ORKTXT=$PIECE(XX,U,5)
+51 SET ORKMSG="Duplicate drug class order: "_$PIECE(XX,U,3)
+52 SET ORKS("ORK",ORDUPCD_","_$GET(ORNUM)_","_ORPSNUM_","_$EXTRACT(ORKMSG,1,225))=ORNUM_U_ORDUPCN_U_ORDUPCD_U_ORKMSG_" ("_ORKTXT_")"_U_$GET(ORPSNUM)
End DoDot:3
End DoDot:2
End DoDot:1
+53 QUIT
+54 ;
OI2DD(ORPSA,OROI,ORPSPKG) ;rtn dispense drugs for a PS OI
+1 NEW PSOI
+2 IF '$DATA(^ORD(101.43,OROI,0))
QUIT
+3 SET PSOI=$PIECE($PIECE(^ORD(101.43,OROI,0),U,2),";")
+4 IF +$GET(PSOI)<1
QUIT
+5 DO DRG^PSSUTIL1(.ORPSA,PSOI,ORPSPKG)
+6 QUIT
+7 ;
PARAMS(ORKNAME,ORKNUM,ORKFLAG,ORKDNGR) ; get parameter values for an order chk
+1 SET ORKNUM=0
SET ORKNUM=$ORDER(^ORD(100.8,"B",ORKNAME,ORKNUM))
+2 SET ORKFLAG=$$GET^XPAR(ORENT,"ORK PROCESSING FLAG",ORKNUM,"I")
+3 SET ORKDNGR=$$GET^XPAR("DIV^SYS^PKG","ORK CLINICAL DANGER LEVEL",ORKNUM,"I")
+4 QUIT
