ORKCHK5 ; slc/CLA - Support routine called by ORKCHK to do ACCEPT mode order checks ;3/6/97 9:35
;;3.0;ORDER ENTRY/RESULTS REPORTING;**6,32,74,94,123,190**;Dec 17, 1997
Q
;
EN(ORKS,ORKDFN,ORKA,ORENT,ORKTMODE) ;perform order checking for orderable item acceptance
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 OCN,DNGR,ORKMSG,ORKPDATA,ORKOCNUM
;
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)
I ORKDG="GMRC",'$L(ODT) S ODT=$$NOW^XLFDT ;def consult order d/t is now
;
I $E(ORKDG,1,2)="PS" D PHARM
I $E(ORKDG,1,2)'="PS",($E(ORKDG,1,2)'="LR"),($L($G(OI))),($L($G(ODT))),(ORKTMODE'="ALL") D DUPOR
I $E(ORKDG,1,2)="LR",($L($G(OI))),($L($G(ODT))),(ORKTMODE'="ALL") D
.D DUPLAB
.D LABFREQ
I $E(ORKDG,1,2)'="PS" D MLM^ORKCHK2(.ORKS,ORKDFN,ORKA,ORENT,"ACCEPT")
Q
;
PHARM ;process pharmacy order checks:
N ORPSPKG,ORPSA,ORKDD
N ORALLRN,ORALLRF,ORALLRD
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,"ACCEPT")
;
;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,"ACCEPT")
Q
;
RXOCS ;drug-allergy interaction
Q:ORALLRF="D"
N ORKAL
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
;
DUPOR ;duplicate orders for non-pharmacy and non-lab:
S OCN=0,OCN=$O(^ORD(100.8,"B","DUPLICATE ORDER",OCN))
Q:+$G(OCN)<1
Q:$$GET^XPAR(ORENT,"ORK PROCESSING FLAG",OCN,"I")="D"
N ORKOR S ORKOR=0
D DUP^ORKOR(.ORKOR,ORKDFN,OI,ODT,ORKDG) I (ORKOR>0) D
.S ORKOCNUM=+$P(ORKOR,U)
.S DNGR=$$GET^XPAR("DIV^SYS^PKG","ORK CLINICAL DANGER LEVEL",OCN,"I")
.S ORKMSG="Duplicate order: "_$P(ORKOR,U,2)
.S ORKS("ORK",DNGR_","_$G(ORNUM)_","_ORKOCNUM_","_$E(ORKMSG,1,225))=ORNUM_U_OCN_U_DNGR_U_ORKMSG_U_ORKOCNUM
Q
;
DUPLAB ;duplicate laboratory orders:
N ORKLR,OCI
S ORKLR=0,OCI=""
S OCN=0,OCN=$O(^ORD(100.8,"B","DUPLICATE ORDER",OCN))
Q:+$G(OCN)<1
Q:$$GET^XPAR(ORENT,"ORK PROCESSING FLAG",OCN,"I")="D"
S DNGR=$$GET^XPAR("DIV^SYS^PKG","ORK CLINICAL DANGER LEVEL",OCN,"I")
D DUP^ORKLR(.ORKLR,OI,ORKDFN,ODT,ORKPDATA)
F S OCI=$O(ORKLR(OCI)) Q:OCI="" D
.S ORKOCNUM=+$P(ORKLR(OCI),U)
.S ORKMSG="Duplicate order: "_$P(ORKLR(OCI),U,2)
.S ORKS("ORK",DNGR_","_$G(ORNUM)_","_ORKOCNUM_","_$E(ORKMSG,1,225))=ORNUM_U_OCN_U_DNGR_U_ORKMSG_U_ORKOCNUM
Q
;
LABFREQ ;lab order frequency restrictions:
N ORKLR,OCI
S ORKLR=0,OCI=""
S OCN=0,OCN=$O(^ORD(100.8,"B","LAB ORDER FREQ RESTRICTIONS",OCN))
Q:+$G(OCN)<1
Q:$$GET^XPAR(ORENT,"ORK PROCESSING FLAG",OCN,"I")="D"
S DNGR=$$GET^XPAR("DIV^SYS^PKG","ORK CLINICAL DANGER LEVEL",OCN,"I")
D ORFREQ^ORKLR2(.ORKLR,OI,ORKDFN_";DPT(",ODT,ORKPDATA)
S OCI="" F S OCI=$O(ORKLR(OCI)) Q:OCI="" D
.S ORKMSG=$P(ORKLR(OCI),U,2)
.S ORKS("ORK",DNGR_","_$G(ORNUM)_","_$E(ORKMSG,1,225))=ORNUM_U_OCN_U_DNGR_U_ORKMSG
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
ORKCHK5 ; slc/CLA - Support routine called by ORKCHK to do ACCEPT mode order checks ;3/6/97 9:35
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**6,32,74,94,123,190**;Dec 17, 1997
+2 QUIT
+3 ;
EN(ORKS,ORKDFN,ORKA,ORENT,ORKTMODE) ;perform order checking for orderable item acceptance
+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 OCN,DNGR,ORKMSG,ORKPDATA,ORKOCNUM
+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 ;def consult order d/t is now
IF ORKDG="GMRC"
IF '$LENGTH(ODT)
SET ODT=$$NOW^XLFDT
+11 ;
+12 IF $EXTRACT(ORKDG,1,2)="PS"
DO PHARM
+13 IF $EXTRACT(ORKDG,1,2)'="PS"
IF ($EXTRACT(ORKDG,1,2)'="LR")
IF ($LENGTH($GET(OI)))
IF ($LENGTH($GET(ODT)))
IF (ORKTMODE'="ALL")
DO DUPOR
+14 IF $EXTRACT(ORKDG,1,2)="LR"
IF ($LENGTH($GET(OI)))
IF ($LENGTH($GET(ODT)))
IF (ORKTMODE'="ALL")
Begin DoDot:1
+15 DO DUPLAB
+16 DO LABFREQ
End DoDot:1
+17 IF $EXTRACT(ORKDG,1,2)'="PS"
DO MLM^ORKCHK2(.ORKS,ORKDFN,ORKA,ORENT,"ACCEPT")
+18 QUIT
+19 ;
PHARM ;process pharmacy order checks:
+1 NEW ORPSPKG,ORPSA,ORKDD
+2 NEW ORALLRN,ORALLRF,ORALLRD
+3 DO PARAMS("ALLERGY-DRUG INTERACTION",.ORALLRN,.ORALLRF,.ORALLRD)
+4 ;
+5 ;dispense drug selected:
+6 IF $LENGTH($GET(HL7LPTR))
IF ($GET(HL7LCOD)="99PSD")
Begin DoDot:1
+7 DO RXOCS
+8 DO MLM^ORKCHK2(.ORKS,ORKDFN,ORKA,ORENT,"ACCEPT")
End DoDot:1
+9 ;
+10 ;dispense drug NOT selected, split OI into dispense drugs:
+11 IF '$LENGTH($GET(HL7LPTR))
Begin DoDot:1
+12 SET ORPSPKG=$EXTRACT(ORKDG,3)
+13 ;change to "X" if "H"erbal/non-VA med
IF ORPSPKG="H"
SET ORPSPKG="X"
+14 IF "IOX"[ORPSPKG
DO OI2DD(.ORPSA,OI,ORPSPKG)
+15 SET ORKDD=0
FOR
SET ORKDD=$ORDER(ORPSA(ORKDD))
IF 'ORKDD
QUIT
Begin DoDot:2
+16 SET HL7LTXT=ORPSA(ORKDD)
+17 SET HL7NPTR=$PIECE(ORKDD,";",2)
+18 SET HL7LPTR=+ORKDD
+19 SET HL7LCOD="99PSD"
SET HL7NCOD="99NDF"
+20 SET $PIECE(HL7,U)=HL7NPTR
SET $PIECE(HL7,U,3)=HL7NCOD
+21 SET $PIECE(HL7,U,4)=HL7LPTR
SET $PIECE(HL7,U,5)=HL7LTXT
SET $PIECE(HL7,U,6)=HL7LCOD
+22 ;set these for MLM OCX call
SET $PIECE(ORKA,"|",3)=HL7
+23 DO RXOCS
+24 DO MLM^ORKCHK2(.ORKS,ORKDFN,ORKA,ORENT,"ACCEPT")
End DoDot:2
End DoDot:1
+25 QUIT
+26 ;
RXOCS ;drug-allergy interaction
+1 IF ORALLRF="D"
QUIT
+2 NEW ORKAL
+3 IF $LENGTH($GET(HL7NPTR))
IF ($GET(HL7NCOD)="99NDF")
Begin DoDot:1
+4 DO RXN^ORQQAL(.ORKAL,ORKDFN,"DR",HL7NPTR,$GET(HL7LPTR))
IF (ORKAL>0)
Begin DoDot:2
+5 IF $LENGTH($PIECE(ORKAL,U,2))<1
QUIT
+6 SET ORKMSG="Previous adverse reaction to: "_$PIECE(ORKAL,U,2)
+7 SET ORKS("ORK",ORALLRD_","_$GET(ORNUM)_","_$EXTRACT(ORKMSG,1,225))=ORNUM_U_ORALLRN_U_ORALLRD_U_ORKMSG
End DoDot:2
End DoDot:1
+8 QUIT
+9 ;
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 ;
DUPOR ;duplicate orders for non-pharmacy and non-lab:
+1 SET OCN=0
SET OCN=$ORDER(^ORD(100.8,"B","DUPLICATE ORDER",OCN))
+2 IF +$GET(OCN)<1
QUIT
+3 IF $$GET^XPAR(ORENT,"ORK PROCESSING FLAG",OCN,"I")="D"
QUIT
+4 NEW ORKOR
SET ORKOR=0
+5 DO DUP^ORKOR(.ORKOR,ORKDFN,OI,ODT,ORKDG)
IF (ORKOR>0)
Begin DoDot:1
+6 SET ORKOCNUM=+$PIECE(ORKOR,U)
+7 SET DNGR=$$GET^XPAR("DIV^SYS^PKG","ORK CLINICAL DANGER LEVEL",OCN,"I")
+8 SET ORKMSG="Duplicate order: "_$PIECE(ORKOR,U,2)
+9 SET ORKS("ORK",DNGR_","_$GET(ORNUM)_","_ORKOCNUM_","_$EXTRACT(ORKMSG,1,225))=ORNUM_U_OCN_U_DNGR_U_ORKMSG_U_ORKOCNUM
End DoDot:1
+10 QUIT
+11 ;
DUPLAB ;duplicate laboratory orders:
+1 NEW ORKLR,OCI
+2 SET ORKLR=0
SET OCI=""
+3 SET OCN=0
SET OCN=$ORDER(^ORD(100.8,"B","DUPLICATE ORDER",OCN))
+4 IF +$GET(OCN)<1
QUIT
+5 IF $$GET^XPAR(ORENT,"ORK PROCESSING FLAG",OCN,"I")="D"
QUIT
+6 SET DNGR=$$GET^XPAR("DIV^SYS^PKG","ORK CLINICAL DANGER LEVEL",OCN,"I")
+7 DO DUP^ORKLR(.ORKLR,OI,ORKDFN,ODT,ORKPDATA)
+8 FOR
SET OCI=$ORDER(ORKLR(OCI))
IF OCI=""
QUIT
Begin DoDot:1
+9 SET ORKOCNUM=+$PIECE(ORKLR(OCI),U)
+10 SET ORKMSG="Duplicate order: "_$PIECE(ORKLR(OCI),U,2)
+11 SET ORKS("ORK",DNGR_","_$GET(ORNUM)_","_ORKOCNUM_","_$EXTRACT(ORKMSG,1,225))=ORNUM_U_OCN_U_DNGR_U_ORKMSG_U_ORKOCNUM
End DoDot:1
+12 QUIT
+13 ;
LABFREQ ;lab order frequency restrictions:
+1 NEW ORKLR,OCI
+2 SET ORKLR=0
SET OCI=""
+3 SET OCN=0
SET OCN=$ORDER(^ORD(100.8,"B","LAB ORDER FREQ RESTRICTIONS",OCN))
+4 IF +$GET(OCN)<1
QUIT
+5 IF $$GET^XPAR(ORENT,"ORK PROCESSING FLAG",OCN,"I")="D"
QUIT
+6 SET DNGR=$$GET^XPAR("DIV^SYS^PKG","ORK CLINICAL DANGER LEVEL",OCN,"I")
+7 DO ORFREQ^ORKLR2(.ORKLR,OI,ORKDFN_";DPT(",ODT,ORKPDATA)
+8 SET OCI=""
FOR
SET OCI=$ORDER(ORKLR(OCI))
IF OCI=""
QUIT
Begin DoDot:1
+9 SET ORKMSG=$PIECE(ORKLR(OCI),U,2)
+10 SET ORKS("ORK",DNGR_","_$GET(ORNUM)_","_$EXTRACT(ORKMSG,1,225))=ORNUM_U_OCN_U_DNGR_U_ORKMSG
End DoDot:1
+11 QUIT
+12 ;
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
