- 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