ORKCHK6 ; SLC/CLA - Support routine called by ORKCHK to do SESSION mode order checks ;03/21/18 06:21
;;3.0;ORDER ENTRY/RESULTS REPORTING;**6,32,74,87,94,123,162,190,249,280,272,346,345,269,469,481**;Dec 17, 1997;Build 3
Q
;
EN(ORKS,ORKDFN,ORKA,ORENT,ORKTMODE) ;perform order checking for entire ordering session
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,ORKTXT,ORKPDATA,ORIFN
;
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 ORIFN=ORNUM
;
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,ORRXDONE
N ORCRITN,ORCRITF,ORCRITD,ORSIGN,ORSIGF,ORSIGD,ORDUPN,ORDUPF,ORDUPD,ORDUPC,ORDUPCF,ORDUPCD,ORALLRN,ORALLRF,ORALLRD,ORDUPCN
;
D PARAMS("ALLERGY-DRUG INTERACTION",.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 THERAPY",.ORDUPCN,.ORDUPCF,.ORDUPCD)
;
S ORRXDONE=0 ;flag to set if RXOCS gets called
;dispense drug selected:
I $L($G(HL7LPTR)),($G(HL7LCOD)="99PSD") D
.D RXOCS
.S:$P(ORKA,"|",7)'="" $P(ORKA,"|",7)=""
.S ORRXDONE=1
.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 "IOH"[ORPSPKG D
..S ORPSA=$$OI2DD^ORKPS(OI,ORPSPKG,1)
..I +ORPSA D
...S HL7LTXT=$P($G(^ORD(101.43,OI,0)),U)
...S HL7NPTR=$P(ORPSA,";",2)
...S HL7LPTR=+ORPSA
...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
..S:$P(ORKA,"|",7)'="" $P(ORKA,"|",7)=""
..S ORRXDONE=1
..Q:HL7LTXT=""
..D MLM^ORKCHK2(.ORKS,ORKDFN,ORKA,ORENT,"SESSION")
I ORRXDONE=0 D
.N ORKSMSG,OROITXT
.S OROITXT=$P($G(^ORD(101.43,OI,0)),U)
.I $L(OROITXT)>0 S OROITXT=" for "_$$TRIM^XLFSTR(OROITXT)
.S ORKMSG="Enhanced order checks cannot be done"_OROITXT_". Please perform a manual check for Drug-Interactions, Duplicate Therapy"
.I $$DS^PSSDSAPI S ORKMSG=ORKMSG_" and Dosing"
.S ORKS("ORK",2_$E(ORKMSG,1,225))=ORNUM_U_25_U_3_U_ORKMSG
Q
;
RXOCS ;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,ORY,CHK,XX
;I $L($G(HL7LPTR)),($G(HL7LCOD)="99PSD") D
I 1 D
.D CHKSESS^ORKPS(.ORKRX,ORKDFN,HL7LPTR_U_HL7LTXT,OI,ORKPDATA,ORKDG,+$P($G(ORPSA),";",4),$P(ORKA,"|",7))
.S CHK=0,XX="" F S CHK=$O(ORKRX(CHK)) Q:'CHK D
..S XX=ORKRX(CHK)
..;
..;get errors/exceptions/checks not done
..I $P(XX,U)="ERR" S ORKS("ORK",2_$E($P(XX,U,2),1,225)_","_$G(ORNUM))=ORNUM_U_25_U_3_U_$P(XX,U,2)
..;
..;critical drug interaction:
..I $P(XX,U)="DI",$P(XX,U,2)="CRITICAL" D
...Q:ORCRITF="D"
...S ORPSNUM=$P(XX,U,3)
...S ORKTXT=$P(XX,U,2)_" drug-drug interaction: "_$P(XX,U,5)
...S ORKS("ORK",ORCRITD_","_$G(ORNUM)_","_ORPSNUM_","_$E(ORKTXT,1,225))=ORNUM_U_ORCRITN_U_ORCRITD_U_ORKTXT
..;
..;significant drug interaction:
..I $P(XX,U)="DI",$P(XX,U,2)="SIGNIFICANT" D
...Q:ORSIGF="D"
...S ORPSNUM=$P(XX,U,3)
...S ORKTXT=$P(XX,U,2)_" drug-drug interaction: "_$P(XX,U,5)
...S ORKS("ORK",ORSIGD_","_$G(ORNUM)_","_ORPSNUM_","_$E(ORKTXT,1,225))=ORNUM_U_ORSIGN_U_ORSIGD_U_ORKTXT
..;
..;duplicate drug:
..I $P(XX,U)="DD" D
...Q:ORDUPF="D"
...S ORPSNUM=$P(XX,U,4) ;get the associated order number
...S ORKTXT=$P(XX,U,3)
...I $L(ORPSNUM),$G(^OR(100,+ORPSNUM,0)) D
....D TEXT^ORQ12(.ORY,ORPSNUM,"")
....S ORKTXT=ORKTXT_$S($D(ORY(2))=1:" "_$$TRIM^XLFSTR(ORY(2)),1:"")_" ["_$P($G(^ORD(100.01,+$P(^OR(100,+ORPSNUM,3),U,3),0)),U,1)_"]"
...S ORKMSG="Duplicate drug order: "_ORKTXT
...S ORKS("ORK",ORDUPD_","_$G(ORNUM)_","_ORPSNUM_",Duplicate drug order: "_$E($P(XX,U,3),1,200))=ORNUM_U_ORDUPN_U_ORDUPD_U_ORKMSG_U_$G(ORPSNUM)
..;
..;duplicate class: NOW DRUG THERAPY
..I $P(XX,U)="DC" D
...Q:ORDUPCF="D"
...S ORPSNUM=$P(XX,U,2) ;get the associated order number
...S ORKMSG=$P(XX,U,4)
...N ORKCNT S ORKCNT=1 F Q:'$D(ORKS("ORK",ORDUPCD_","_$G(ORNUM)_","_ORPSNUM_","_ORKCNT)) S ORKCNT=ORKCNT+1
...S ORKS("ORK",ORDUPCD_","_$G(ORNUM)_","_ORPSNUM_","_ORKCNT)=ORNUM_U_ORDUPCN_U_ORDUPCD_U_ORKMSG
D RXOCS^ORKCHK5
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORKCHK6 5116 printed Nov 22, 2024@17:41:02 Page 2
ORKCHK6 ; SLC/CLA - Support routine called by ORKCHK to do SESSION mode order checks ;03/21/18 06:21
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**6,32,74,87,94,123,162,190,249,280,272,346,345,269,469,481**;Dec 17, 1997;Build 3
+2 QUIT
+3 ;
EN(ORKS,ORKDFN,ORKA,ORENT,ORKTMODE) ;perform order checking for entire ordering session
+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,ORKTXT,ORKPDATA,ORIFN
+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 SET ORIFN=ORNUM
+11 ;
+12 if ORKDG="PSJ"
SET ORKDG="PSI"
+13 IF $EXTRACT(ORKDG,1,2)="PS"
DO PHARM
+14 IF $EXTRACT(ORKDG,1,2)'="PS"
DO MLM^ORKCHK2(.ORKS,ORKDFN,ORKA,ORENT,"SESSION")
+15 QUIT
+16 ;
PHARM ;process pharmacy order checks:
+1 NEW ORPSPKG,ORPSA,ORRXDONE
+2 NEW ORCRITN,ORCRITF,ORCRITD,ORSIGN,ORSIGF,ORSIGD,ORDUPN,ORDUPF,ORDUPD,ORDUPC,ORDUPCF,ORDUPCD,ORALLRN,ORALLRF,ORALLRD,ORDUPCN
+3 ;
+4 DO PARAMS("ALLERGY-DRUG INTERACTION",.ORALLRN,.ORALLRF,.ORALLRD)
+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 THERAPY",.ORDUPCN,.ORDUPCF,.ORDUPCD)
+9 ;
+10 ;flag to set if RXOCS gets called
SET ORRXDONE=0
+11 ;dispense drug selected:
+12 IF $LENGTH($GET(HL7LPTR))
IF ($GET(HL7LCOD)="99PSD")
Begin DoDot:1
+13 DO RXOCS
+14 if $PIECE(ORKA,"|",7)'=""
SET $PIECE(ORKA,"|",7)=""
+15 SET ORRXDONE=1
+16 DO MLM^ORKCHK2(.ORKS,ORKDFN,ORKA,ORENT,"SESSION")
End DoDot:1
+17 ;
+18 ;dispense drug NOT selected, split OI into dispense drugs:
+19 IF '$LENGTH($GET(HL7LPTR))
Begin DoDot:1
+20 SET ORPSPKG=$EXTRACT(ORKDG,3)
+21 IF "IOH"[ORPSPKG
Begin DoDot:2
+22 SET ORPSA=$$OI2DD^ORKPS(OI,ORPSPKG,1)
+23 IF +ORPSA
Begin DoDot:3
+24 SET HL7LTXT=$PIECE($GET(^ORD(101.43,OI,0)),U)
+25 SET HL7NPTR=$PIECE(ORPSA,";",2)
+26 SET HL7LPTR=+ORPSA
+27 SET HL7LCOD="99PSD"
SET HL7NCOD="99NDF"
+28 SET $PIECE(HL7,U)=HL7NPTR
SET $PIECE(HL7,U,3)=HL7NCOD
+29 SET $PIECE(HL7,U,4)=HL7LPTR
SET $PIECE(HL7,U,5)=HL7LTXT
SET $PIECE(HL7,U,6)=HL7LCOD
+30 ;set these for MLM OCX call
SET $PIECE(ORKA,"|",3)=HL7
End DoDot:3
+31 DO RXOCS
+32 if $PIECE(ORKA,"|",7)'=""
SET $PIECE(ORKA,"|",7)=""
+33 SET ORRXDONE=1
+34 if HL7LTXT=""
QUIT
+35 DO MLM^ORKCHK2(.ORKS,ORKDFN,ORKA,ORENT,"SESSION")
End DoDot:2
End DoDot:1
+36 IF ORRXDONE=0
Begin DoDot:1
+37 NEW ORKSMSG,OROITXT
+38 SET OROITXT=$PIECE($GET(^ORD(101.43,OI,0)),U)
+39 IF $LENGTH(OROITXT)>0
SET OROITXT=" for "_$$TRIM^XLFSTR(OROITXT)
+40 SET ORKMSG="Enhanced order checks cannot be done"_OROITXT_". Please perform a manual check for Drug-Interactions, Duplicate Therapy"
+41 IF $$DS^PSSDSAPI
SET ORKMSG=ORKMSG_" and Dosing"
+42 SET ORKS("ORK",2_$EXTRACT(ORKMSG,1,225))=ORNUM_U_25_U_3_U_ORKMSG
End DoDot:1
+43 QUIT
+44 ;
RXOCS ;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,ORY,CHK,XX
+3 ;I $L($G(HL7LPTR)),($G(HL7LCOD)="99PSD") D
+4 IF 1
Begin DoDot:1
+5 DO CHKSESS^ORKPS(.ORKRX,ORKDFN,HL7LPTR_U_HL7LTXT,OI,ORKPDATA,ORKDG,+$PIECE($GET(ORPSA),";",4),$PIECE(ORKA,"|",7))
+6 SET CHK=0
SET XX=""
FOR
SET CHK=$ORDER(ORKRX(CHK))
if 'CHK
QUIT
Begin DoDot:2
+7 SET XX=ORKRX(CHK)
+8 ;
+9 ;get errors/exceptions/checks not done
+10 IF $PIECE(XX,U)="ERR"
SET ORKS("ORK",2_$EXTRACT($PIECE(XX,U,2),1,225)_","_$GET(ORNUM))=ORNUM_U_25_U_3_U_$PIECE(XX,U,2)
+11 ;
+12 ;critical drug interaction:
+13 IF $PIECE(XX,U)="DI"
IF $PIECE(XX,U,2)="CRITICAL"
Begin DoDot:3
+14 if ORCRITF="D"
QUIT
+15 SET ORPSNUM=$PIECE(XX,U,3)
+16 SET ORKTXT=$PIECE(XX,U,2)_" drug-drug interaction: "_$PIECE(XX,U,5)
+17 SET ORKS("ORK",ORCRITD_","_$GET(ORNUM)_","_ORPSNUM_","_$EXTRACT(ORKTXT,1,225))=ORNUM_U_ORCRITN_U_ORCRITD_U_ORKTXT
End DoDot:3
+18 ;
+19 ;significant drug interaction:
+20 IF $PIECE(XX,U)="DI"
IF $PIECE(XX,U,2)="SIGNIFICANT"
Begin DoDot:3
+21 if ORSIGF="D"
QUIT
+22 SET ORPSNUM=$PIECE(XX,U,3)
+23 SET ORKTXT=$PIECE(XX,U,2)_" drug-drug interaction: "_$PIECE(XX,U,5)
+24 SET ORKS("ORK",ORSIGD_","_$GET(ORNUM)_","_ORPSNUM_","_$EXTRACT(ORKTXT,1,225))=ORNUM_U_ORSIGN_U_ORSIGD_U_ORKTXT
End DoDot:3
+25 ;
+26 ;duplicate drug:
+27 IF $PIECE(XX,U)="DD"
Begin DoDot:3
+28 if ORDUPF="D"
QUIT
+29 ;get the associated order number
SET ORPSNUM=$PIECE(XX,U,4)
+30 SET ORKTXT=$PIECE(XX,U,3)
+31 IF $LENGTH(ORPSNUM)
IF $GET(^OR(100,+ORPSNUM,0))
Begin DoDot:4
+32 DO TEXT^ORQ12(.ORY,ORPSNUM,"")
+33 SET ORKTXT=ORKTXT_$SELECT($DATA(ORY(2))=1:" "_$$TRIM^XLFSTR(ORY(2)),1:"")_" ["_$PIECE($GET(^ORD(100.01,+$PIECE(^OR(100,+ORPSNUM,3),U,3),0)),U,1)_"]"
End DoDot:4
+34 SET ORKMSG="Duplicate drug order: "_ORKTXT
+35 SET ORKS("ORK",ORDUPD_","_$GET(ORNUM)_","_ORPSNUM_",Duplicate drug order: "_$EXTRACT($PIECE(XX,U,3),1,200))=ORNUM_U_ORDUPN_U_ORDUPD_U_ORKMSG_U_$GET(ORPSNUM)
End DoDot:3
+36 ;
+37 ;duplicate class: NOW DRUG THERAPY
+38 IF $PIECE(XX,U)="DC"
Begin DoDot:3
+39 if ORDUPCF="D"
QUIT
+40 ;get the associated order number
SET ORPSNUM=$PIECE(XX,U,2)
+41 SET ORKMSG=$PIECE(XX,U,4)
+42 NEW ORKCNT
SET ORKCNT=1
FOR
if '$DATA(ORKS("ORK",ORDUPCD_","_$GET(ORNUM)_","_ORPSNUM_","_ORKCNT))
QUIT
SET ORKCNT=ORKCNT+1
+43 SET ORKS("ORK",ORDUPCD_","_$GET(ORNUM)_","_ORPSNUM_","_ORKCNT)=ORNUM_U_ORDUPCN_U_ORDUPCD_U_ORKMSG
End DoDot:3
End DoDot:2
End DoDot:1
+44 DO RXOCS^ORKCHK5
+45 QUIT
+46 ;
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
