- ORKCHK6 ; slc/CLA - Support routine called by ORKCHK to do SESSION mode order checks ;15-Jun-2010 21:19;PLS
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**6,32,74,87,94,123,162,190,1005,249,1010**;Dec 17, 1997;Build 47
- ; Modified - IHS/MSC/PLS - 12/07/09 - Added Allergy-Drug Interaction order check during SESSION type
- 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,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 ;Patch 1005
- ;
- 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) ;Patch 1005
- ;
- ;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-drug interaction, duplicate drug order, duplicate drug class
- ; The following line has been modified to add the Allery-Drug Interaction
- Q:ORALLRF_ORCRITF_ORSIGF_ORDUPF_ORDUPCF'["E" ;quit if none are "E"nabled
- N ORKRX,ORPSNUM
- N ORKAL ;Patch 1005
- 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 drug order: "_ORKTXT
- ...S ORKS("ORK",ORDUPD_","_$G(ORNUM)_","_ORPSNUM_",Duplicate drug 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)
- ;drug-allergy interaction ;Patch 1005
- I $L($G(HL7NPTR)),($G(HL7NCOD)="99NDF") D
- .D RXN^ORQQAL(.ORKAL,ORKDFN,"DR",HL7NPTR,$G(HL7LPTR)) I (ORKAL>0) D
- ..Q:$L($P(ORKAL,U,2))<1
- ..S ORKMSG="Previous adverse reaction to: "_$P(ORKAL,U,2)
- ..S ORKS("ORK",ORALLRD_","_$G(ORNUM)_","_$E(ORKMSG,1,225))=ORNUM_U_ORALLRN_U_ORALLRD_U_ORKMSG
- 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
- ORKCHK6 ; slc/CLA - Support routine called by ORKCHK to do SESSION mode order checks ;15-Jun-2010 21:19;PLS
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**6,32,74,87,94,123,162,190,1005,249,1010**;Dec 17, 1997;Build 47
- +2 ; Modified - IHS/MSC/PLS - 12/07/09 - Added Allergy-Drug Interaction order check during SESSION type
- +3 QUIT
- +4 ;
- 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,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 ;Patch 1005
- 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 ;Patch 1005
- 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-drug interaction, duplicate drug order, duplicate drug class
- +1 ; The following line has been modified to add the Allery-Drug Interaction
- +2 ;quit if none are "E"nabled
- IF ORALLRF_ORCRITF_ORSIGF_ORDUPF_ORDUPCF'["E"
- QUIT
- +3 NEW ORKRX,ORPSNUM
- +4 ;Patch 1005
- NEW ORKAL
- +5 IF $LENGTH($GET(HL7LPTR))
- IF ($GET(HL7LCOD)="99PSD")
- Begin DoDot:1
- +6 DO CHKSESS^ORKPS(.ORKRX,ORKDFN,HL7LPTR,OI,ORKPDATA,ORKDG)
- +7 NEW CHK,XX
- SET CHK=0
- SET XX=""
- +8 FOR
- SET CHK=$ORDER(ORKRX(CHK))
- IF 'CHK
- QUIT
- Begin DoDot:2
- +9 SET XX=ORKRX(CHK)
- +10 ;
- +11 ;critical drug interaction:
- +12 IF $PIECE(XX,U)="DI"
- IF $PIECE(XX,U,5)="CRITICAL"
- Begin DoDot:3
- +13 IF ORCRITF="D"
- QUIT
- +14 ;get the associated order number
- SET ORPSNUM=$PIECE(XX,U,8)
- +15 IF $LENGTH(ORPSNUM)
- IF $GET(^OR(100,+ORPSNUM,0))
- SET ORKT=$$FULLTEXT^ORQOR1(+ORPSNUM)
- SET ORKTXT=$PIECE(ORKT,U)_" ["_$PIECE(ORKT,U,2)_"]"
- +16 IF '$TEST
- SET ORKTXT=$PIECE(XX,U,3)
- +17 SET ORKMSG=$PIECE(XX,U,5)_" drug-drug interaction: "_$PIECE(XX,U,6)_" & "_$PIECE(XX,U,7)
- +18 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
- +19 ;
- +20 ;significant drug interaction:
- +21 IF $PIECE(XX,U)="DI"
- IF $PIECE(XX,U,5)="SIGNIFICANT"
- Begin DoDot:3
- +22 IF ORSIGF="D"
- QUIT
- +23 ;get the associated order number
- SET ORPSNUM=$PIECE(XX,U,8)
- +24 IF $LENGTH(ORPSNUM)
- IF $GET(^OR(100,+ORPSNUM,0))
- SET ORKT=$$FULLTEXT^ORQOR1(+ORPSNUM)
- SET ORKTXT=$PIECE(ORKT,U)_" ["_$PIECE(ORKT,U,2)_"]"
- +25 IF '$TEST
- SET ORKTXT=$PIECE(XX,U,3)
- +26 SET ORKMSG=$PIECE(XX,U,5)_" drug-drug interaction: "_$PIECE(XX,U,6)_" & "_$PIECE(XX,U,7)
- +27 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
- +28 ;
- +29 ;duplicate drug:
- +30 IF $PIECE(XX,U)="DD"
- Begin DoDot:3
- +31 IF ORDUPF="D"
- QUIT
- +32 ;get the associated order number
- SET ORPSNUM=$PIECE(XX,U,4)
- +33 IF $LENGTH(ORPSNUM)
- IF $GET(^OR(100,+ORPSNUM,0))
- SET ORKT=$$FULLTEXT^ORQOR1(+ORPSNUM)
- SET ORKTXT=$PIECE(ORKT,U)_" ["_$PIECE(ORKT,U,2)_"]"
- +34 IF '$TEST
- SET ORKTXT=$PIECE(XX,U,3)
- +35 SET ORKMSG="Duplicate drug order: "_ORKTXT
- +36 SET ORKS("ORK",ORDUPD_","_$GET(ORNUM)_","_ORPSNUM_",Duplicate drug order: "_$PIECE(XX,U,3))=ORNUM_U_ORDUPN_U_ORDUPD_U_ORKMSG_U_$GET(ORPSNUM)
- End DoDot:3
- +37 ;
- +38 ;duplicate class:
- +39 IF $PIECE(XX,U)="DC"
- Begin DoDot:3
- +40 IF ORDUPCF="D"
- QUIT
- +41 ;get the associated order number
- SET ORPSNUM=$PIECE(XX,U,6)
- +42 IF $LENGTH(ORPSNUM)
- IF $GET(^OR(100,+ORPSNUM,0))
- SET ORKT=$$FULLTEXT^ORQOR1(+ORPSNUM)
- SET ORKTXT=$PIECE(ORKT,U)_" ["_$PIECE(ORKT,U,2)_"]"
- +43 IF '$TEST
- SET ORKTXT=$PIECE(XX,U,5)
- +44 SET ORKMSG="Duplicate drug class order: "_$PIECE(XX,U,3)
- +45 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
- +46 ;drug-allergy interaction ;Patch 1005
- +47 IF $LENGTH($GET(HL7NPTR))
- IF ($GET(HL7NCOD)="99NDF")
- Begin DoDot:1
- +48 DO RXN^ORQQAL(.ORKAL,ORKDFN,"DR",HL7NPTR,$GET(HL7LPTR))
- IF (ORKAL>0)
- Begin DoDot:2
- +49 IF $LENGTH($PIECE(ORKAL,U,2))<1
- QUIT
- +50 SET ORKMSG="Previous adverse reaction to: "_$PIECE(ORKAL,U,2)
- +51 SET ORKS("ORK",ORALLRD_","_$GET(ORNUM)_","_$EXTRACT(ORKMSG,1,225))=ORNUM_U_ORALLRN_U_ORALLRD_U_ORKMSG
- End DoDot:2
- End DoDot:1
- +52 QUIT
- +53 ;
- 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
