PSSHRVL1 ;WOIFO/Alex Vasquez, Timothy Sabat, Steve Gordon - Continuation Data Validation routine for drug checks ;01/15/07
;;1.0;PHARMACY DATA MANAGEMENT;**136,169,160,173,178,224**;9/30/97;Build 3
;
; Reference to ^PSNDF(50.68 supported by IA #2079
; Reference to ^PSNDF(50.68 supported by IA #3735
;
NEXTEX(PSS,PSSHASH) ;
;@DESC Gets the next exception
;@PSS The temp hash
;@PSSHASH The internal hash
;
N PSNEXT
S PSNEXT=":"
S PSNEXT=$ORDER(^TMP($JOB,PSSHASH("Base"),"OUT","EXCEPTIONS",PSS("PharmOrderNo"),PSNEXT),-1)
Q PSNEXT+1
;;
NEXTEXD(PSS,PSSHASH) ;
;@DESC Gets the next dose exception
;@PSS The temp hash
;@PSSHASH The internal hash
N PSNEXT
S PSNEXT=":"
S PSNEXT=$ORDER(^TMP($JOB,PSSHASH("Base"),"OUT","EXCEPTIONS","DOSE",PSS("PharmOrderNo"),PSNEXT),-1)
Q PSNEXT+1
;;
WRITE(PSSHASH) ;
;@Writes a response, based on the list of exceptions stored in Hash
;@NOTE The internal hash looks like this:
;PSSHASH("Exception","PROSPECTIVE","DOSE",PharmacyOrderNum,Counter)=Gcn,Vuid,IEN,DrugName,CprsOrderNum,Package,Reason,ReasonCode,ResonSource,ReasonText,NoWrite
;PSSHASH("Exception","PROSPECTIVE",PharmacyOrderNum,Counter)=Gcn,Vuid,IEN,DrugName,CprsOrderNum,Package,Reason,ReasonCode,ResonSource,ReasonText,NoWrite
;PSSHASH("Exception","PROFILE",PharmacyOrderNum,Counter)=Gcn,Vuid,IEN,DrugName,CprsOrderNum,Package,Reason,ReasonCode,ResonSource,ReasonText,NoWrite
;PSSHASH("Exception","PatientIenMissing")=""
;PSSHASH("Reason")="Failed Validation"
;
;
NEW PSS
SET PSS("PharmOrderNo")=""
SET PSS("I")=""
FOR SET PSS("PharmOrderNo")=$ORDER(PSSHASH("Exception","PROFILE",PSS("PharmOrderNo"))) QUIT:PSS("PharmOrderNo")="" DO
. FOR SET PSS("I")=$ORDER(PSSHASH("Exception","PROFILE",PSS("PharmOrderNo"),PSS("I"))) QUIT:PSS("I")="" DO
. . DO WPROFILE(.PSSHASH,.PSS)
. . QUIT
. QUIT
;
SET PSS("PharmOrderNo")=""
SET PSS("I")=""
FOR SET PSS("PharmOrderNo")=$ORDER(PSSHASH("Exception","PROSPECTIVE","DOSE",PSS("PharmOrderNo"))) QUIT:PSS("PharmOrderNo")="" DO
. FOR SET PSS("I")=$ORDER(PSSHASH("Exception","PROSPECTIVE","DOSE",PSS("PharmOrderNo"),PSS("I"))) QUIT:PSS("I")="" DO
. . DO WDOSE(.PSSHASH,.PSS)
. . ;kill off node to prevent next loop from setting PSS("PharmOrderNo") to "DOSE"
. . K PSSHASH("Exception","PROSPECTIVE","DOSE",PSS("PharmOrderNo"),PSS("I"))
. QUIT
;
SET PSS("PharmOrderNo")=""
SET PSS("I")=""
FOR SET PSS("PharmOrderNo")=$ORDER(PSSHASH("Exception","PROSPECTIVE",PSS("PharmOrderNo"))) QUIT:PSS("PharmOrderNo")="" DO
. FOR SET PSS("I")=$ORDER(PSSHASH("Exception","PROSPECTIVE",PSS("PharmOrderNo"),PSS("I"))) QUIT:PSS("I")="" DO
. . DO WPROSPEC(.PSSHASH,.PSS)
. QUIT
;
QUIT
;;
WDOSE(PSSHASH,PSS) ;
;@DESC Writes the dose exceptions out.
;@PSSHASH The internal hash
;@PSS The temp hash
;@NOTE The exception hash looks like this.
;PSSHASH("Exception","PROSPECTIVE","DOSE",PharmacyOrderNum,Counter)=Gcn,Vuid,IEN,DrugName,CprsOrderNum,Package,Reason,ReasonCode,ResonSource,ReasonText
;
NEW TYPE,I
SET PSS("DoseValue")=$G(^TMP($JOB,PSSHASH("Base"),"IN","DOSE",PSS("PharmOrderNo")))
;Set the next exception
D:$P(PSSHASH("Exception","PROSPECTIVE","DOSE",PSS("PharmOrderNo"),PSS("I")),U,11)'=1
.S ^TMP($JOB,PSSHASH("Base"),"OUT","EXCEPTIONS","DOSE",PSS("PharmOrderNo"),$$NEXTEXD(.PSS,.PSSHASH))=PSSHASH("Exception","PROSPECTIVE","DOSE",PSS("PharmOrderNo"),PSS("I"))
QUIT
;;
WPROFILE(PSSHASH,PSS) ;
;@DESC Writes the profile drug exceptions out.
;@PSSHASH The internal hash
;@PSS The temp hash
;Kill the corresponding profile drug
;KILL ^TMP($JOB,PSSHASH("Base"),"IN","PROFILE",PSS("PharmOrderNo"))
;Set the exception in the global
S:$P(PSSHASH("Exception","PROFILE",PSS("PharmOrderNo"),PSS("I")),U,11)'=1 ^TMP($JOB,PSSHASH("Base"),"OUT","EXCEPTIONS",PSS("PharmOrderNo"),$$NEXTEX(.PSS,.PSSHASH))=PSSHASH("Exception","PROFILE",PSS("PharmOrderNo"),PSS("I"))
;If no profile drugs left and the proVpro flag exists, delete it.
DO:'$DATA(^TMP($JOB,PSSHASH("Base"),"IN","PROFILE"))
. ;KILL ^TMP($JOB,PSSHASH("Base"),"IN","PROFILEVPROFILE")
. D KILLCHEK(PSSHASH("Base"),"PROFILEVPROFILE")
. QUIT
QUIT
;;
WPROSPEC(PSSHASH,PSS) ;
;@DESC Writes the prospective drug exceptions out.
;@PSSHASH The internal hash
;@PSS The temp hash
;@NOTE Exception Hash Looks Like
;PSSHASH("Exception","PROSPECTIVE","DOSE",PharmacyOrderNum,Counter)=Gcn,Vuid,IEN,DrugName,CprsOrderNum,Package,Reason,ReasonCode,ResonSource,ReasonText
;PSSHASH("Exception","PROSPECTIVE",PharmacyOrderNum,Counter)=Gcn,Vuid,IEN,DrugName,CprsOrderNum,Package,Reason,ReasonCode,ResonSource,ReasonText
;
;Set the exception data
S:$P(PSSHASH("Exception","PROSPECTIVE",PSS("PharmOrderNo"),PSS("I")),U,11)'=1 ^TMP($JOB,PSSHASH("Base"),"OUT","EXCEPTIONS",PSS("PharmOrderNo"),$$NEXTEX(.PSS,.PSSHASH))=PSSHASH("Exception","PROSPECTIVE",PSS("PharmOrderNo"),PSS("I"))
QUIT
;
KILLALL(BASE) ;
;INPUTS BASE SUBCRIPT
;@DESC Kills the DrugDrug, Therapy, ProfileVProfile, and Dose check nodes.
DO KILLCHEK("DRUGDRUG",BASE)
DO KILLCHEK("THERAPY",BASE)
DO KILLCHEK("PROFILEVPROFILE",BASE)
DO KILLCHEK("DOSE",BASE)
QUIT
;;
KILLCHEK(PSSCHECK,BASE) ;
;@DESC Kills the check node specified in parameter
;@PSSCHEK The node to kill
;
KILL ^TMP($JOB,BASE,"IN",PSSCHECK)
QUIT
;
;
KILLNODE(BASE,TYPE,ORDER) ;
;
;@DESC KILLS A SINGLE NODE FOR A DRUG
;@BASE--the subscript after $JOB
;@TYPE-Can have 3 possible values: "PROSPECTIVE","PROFILE" or "DOSE"
;@ODRDER-Is the order information to make the node unique
KILL ^TMP($JOB,BASE,"IN",TYPE,ORDER)
Q
;
GCNREASN(DRUGIEN,DRUGNM,ORDRNUM,BADGCN) ;
;
;Returns a message and reason on why a drug does not have a GCNSEQNO
;inputs: DRUGIEN-IEN OF DRUG
;DRUGNM-NAME OF DRUG
;ORDRNUM-PHARMACY ORDER NUM
;BADGCN-(OPTIONAL)FLAG IS SET to 1 IF DRUG RETURNED AS NOT FOUND BY SWRI/FDB
; if set to -1 Missing or invalid GCNSEQNO from Input node
N VAPROD1,NDNODE,REASON,MESSAGE,VAIEN,PSSVQPAC,PSSVQDOS,PSSVQNOM,PSSVQREM,PSSVQTY1,PSSVQTY2,PSSREASN
S MESSAGE=$$NOCHKMSG(DRUGNM,ORDRNUM),PSSVQDOS=0,PSSVQPAC=$S($E(PSSHASH("Base"),1,2)="PS":1,1:0) I $T(DS^PSSDSAPI)]"",$$DS^PSSDSAPI S PSSVQDOS=1
S REASON="",PSSVQREM=$S($P(ORDRNUM,";")="R":1,1:0)
S PSSVQTY1=$P(ORDRNUM,";",3),PSSVQTY1=$$UP^XLFSTR(PSSVQTY1),PSSVQTY2=$S(PSSVQTY1["PROSPECTIVE":1,1:0)
;
S VAPROD1=""
D ;Case statement
.I $G(BADGCN)=1 S MESSAGE=$$NXCHKMSG(DRUGNM) S PSSVQNOM=$$GCMESS,REASON=$S(PSSVQNOM:"^1",1:""),PSSREASN=1 Q
.I '$G(DRUGIEN),'PSSVQREM S REASON="No dispense drug found for Orderable Item",PSSREASN=2 Q
.S NDNODE=$G(^PSDRUG(DRUGIEN,"ND"))
.;if no ndnode or 3rd piece not populated
.I 'PSSVQREM,'$L(NDNODE)!('$P(NDNODE,U,3)) D Q
..S REASON="Drug not matched to NDF",PSSREASN=3 D:PSSVQPAC&($D(^TMP($J,PSSHASH("Base"),"IN","DOSE"))) NZMSG I 'PSSVQPAC S MESSAGE=$$NXCHKMSG(DRUGNM),REASON=""
.S VAIEN=$S('PSSVQREM:+$P(NDNODE,U,3),1:0)
.S:VAIEN VAPROD1=$P($G(^PSNDF(50.68,VAIEN,1)),U,5) ; Get the GCNSEQNO
.I 'VAPROD1!($G(BADGCN)=-1) D
..S MESSAGE=$$NXCHKMSG(DRUGNM) S PSSVQNOM=$$GCMESS,REASON=$S(PSSVQNOM:"^1",1:""),PSSREASN=4
;
I PSSVQPAC=0,PSSVQTY2=1 D
.S ^TMP($J,PSSHASH("Base"),"OR-TRANSIENT",DRUGIEN,DRUGNM,ORDRNUM,BADGCN)=MESSAGE_U_PSSREASN
Q MESSAGE_U_REASON
;
NOCHKMSG(DRUGNM,ORDRNUM) ;
;Returns msg that no checks could be performed.
;INPUTS:
;DRUGNM-Name of drug
;ORDRNUM-PHARMACY ORDER NUMBER
N MESSAGE
S MESSAGE="Enhanced Order Checks cannot be performed for "_$$LOCORREM(ORDRNUM)_$$OUTPAT(ORDRNUM)_" Drug: "_DRUGNM
Q MESSAGE
;
OUTPAT(ORDRNUM) ;
; Returns " Outpatient" if it is one.
;INPUTS:
;ORDRNUM-PHARMACY ORDER NUMBER
;PSSBASE - globally defined
;
N OUTPAT
S OUTPAT=""
I $$LOCORREM(ORDRNUM)="Local" D
.I $E(ORDRNUM)'="I",$E(ORDRNUM)'="R",ORDRNUM["PROFILE",$G(^TMP($J,PSSBASE,"IN","SOURCE"))="I" S OUTPAT=" Outpatient"
Q OUTPAT
;
OIMSG(OINAME,PSSNOITN) ;
;INPUT: Orderable item name
; Order number
;RETURNS-ERROR MESSAGE
N MESSAGE,PSSNOITP,PSSNOITD,PSSNOIT1,PSSNOIT2
S PSSNOITP=$S($E(PSSHASH("Base"),1,2)="PS":0,1:1)
S PSSNOITD=0 I $T(DS^PSSDSAPI)]"",$$DS^PSSDSAPI S PSSNOITD=1
S PSSNOIT1=$P(PSSNOITN,";",3),PSSNOIT1=$$UP^XLFSTR(PSSNOIT1),PSSNOIT2=$S(PSSNOIT1["PROSPECTIVE":1,1:0)
I PSSNOITP D Q MESSAGE
.I $D(^TMP($J,PSSHASH("Base"),"IN","DOSE")) D Q
..S MESSAGE="Maximum Single Dose Check could not be done for Drug: "_OINAME_", please complete a manual check for appropriate Dosing."
.S MESSAGE="Order Checks could not be done for Drug: "_OINAME_", please complete a manual check for Drug Interactions"_$S(PSSNOITD&($G(PSSNOIT2)):", Duplicate Therapy and appropriate Dosing.",1:" and Duplicate Therapy.")
S MESSAGE="Enhanced Order Checks cannot be performed for Orderable Item: "_OINAME
Q MESSAGE
;
INRSON(ERRNUM,ORDERNUM) ;
;INPUT-REASON CODE (1,2 OR 3)
;ORDERNUM-(OPTIONAL)-ORDERNUMBER
;OUTPUT-REASON MESSAGE
;
N REASON,NONVAFLG
S NONVAFLG=0 ;DEFAULT
S ORDERNUM=$G(ORDERNUM)
I $E(ORDERNUM)="N" S NONVAFLG=1
D
.I ERRNUM=1 D Q
.. I 'NONVAFLG S REASON="No Dispense Drug found." Q ; No active Dispense Drug found for Pending order.
.. I NONVAFLG S REASON="No Dispense Drug found." ; No active Dispense Drug found for Non-VA med order.
.I ERRNUM=2 S REASON="Free Text Dosage could not be evaluated." Q
.I ERRNUM=3 S REASON="Free Text Infusion Rate could not be evaluated."
.I ERRNUM=4 S REASON="No active IV Additive/Solution marked for IV fluid order entry could be found."
Q REASON
;
DEMOCHK(AGE,BSA,WEIGHT,PSDRUG,WHERE) ;
;Checks age and returns message and error reason
;input: AGE--AGE
;BSA-BSA
;WEIGHT OF THE PATIENT
;WHERE value of PSSDSWHE (1 for OR, 0 for IP/OP) as determined by dosing API
;output: message and reason strings
;
N PSMESSAGE,PSREASON,PSRESULT,TEXT,X,FLAG
S PSRESULT="",PSREASON="",TEXT="",WHERE=$S(+$G(WHERE)=1:1,1:0),AGE=+$G(AGE),BSA=+$G(BSA),WEIGHT=+$G(WEIGHT)
I AGE=0 D Q PSRESULT
.S TEXT=" AGE"
.D:WHERE=0
..S PSMESSAGE=$$DOSEMSG(PSDRUG)
..S PSREASON="One or more required patient parameters unavailable:"_TEXT
.D:WHERE=1
..S PSMESSAGE="Dosing checks could not be done for Drug: "_PSDRUG_", please complete a manual check for appropriate dosing."
.S PSRESULT=PSMESSAGE_U_PSREASON
Q PSRESULT
;
MEDRTE(PSROUTE,PSDRUGNM) ;
;Checks route if null
;inputs: ROUTE-MEDICATION ROUTE
;DRUGNM-DRUG NAME
;RETURNS THE ERROR MESSAGE AND ERROR REASON
N PSMESSAGE,PSREASON,PSRESULT
S PSRESULT=""
I '$L(PSROUTE) D
.S PSMESSAGE=$$DOSEMSG(PSDRUGNM)
.;S PSREASON="Unmapped Local Medication Route"
.S PSREASON="Invalid or Undefined Dose Route"
.S PSRESULT=PSMESSAGE_U_PSREASON
Q PSRESULT
;
;
CHKDSTYP(DOSETYP,PSDRUGNM) ;
;inputs: DOSETYP-DOSE TYPE (MAINTENANCE,LOADING)
;PSDRUGNM-DRUG NAME
;RETURNS THE ERROR MESSAGE AND ERROR REASON
N PSREASON,PSRESULT,PSMSG,TEXT,OKFLAG
S PSRESULT="",OKFLAG=0
F TEXT="LOADING","MAINTENANCE","INITIAL DOSE","INTERMEDIATE DOSE","PROPHYLACTIC","SINGLE DOSE" D Q:OKFLAG
.I DOSETYP=TEXT S OKFLAG=1 Q
I '$L(DOSETYP)!'OKFLAG D
.S PSMSG=$$DOSEMSG(PSDRUGNM)
.;S PSREASON="Undefined Dose Type"
.S PSREASON="Invalid or Undefined Dose Type"
.S PSRESULT=PSMSG_U_PSREASON
Q PSRESULT
;
CHKDOSE(PSDOSE,PSDRUGNM) ;
;CHECKS THE DOSE OF DRUG DOSE REQUEST
;INPUTS: PSDOSE-ORDERED DOSE OF A DRUG
;PSDRUGNM=NAME OF DRUG
;RETURNS THE ERROR MESSAGE AND ERROR REASON
N PSREASON,PSRESULT,PSMSG
S PSRESULT=""
I PSDOSE'=+PSDOSE D
.S PSMSG=$$DOSEMSG(PSDRUGNM)
.S PSREASON="Invalid or Undefined Dose"
.S PSRESULT=PSMSG_U_PSREASON
Q PSRESULT
;
CHKUNIT(PSUNIT,PSDRUGNM) ;
;CHECKS THE UNITS OF A DOSE-RETURNS ERROR AND REASON
;INPUTS: PSUNIT-UNITS OF THE DRUG
;PSDRUGNM-NAME OF THE DRUG
N PSREASON,PSRESULT,PSMSG
S PSRESULT=""
I '$L(PSUNIT) D
.S PSMSG=$$DOSEMSG(PSDRUGNM)
.S PSREASON="Invalid or Undefined Dose Unit"
.S PSRESULT=PSMSG_U_PSREASON
Q PSRESULT
;
CHKFREQ(PSFREQ) ;
;INPUTS: PSFREQ-HOW OFTEN A DRUG IS ADMINISTRED
;RETURNS-ERROR MESSAGE AND ERROR REASON
N PSREASON,PSRESULT,PSMSG
S PSMSG="Daily Dosage Range Check could not be performed."
S PSRESULT=""
D
.I '$L(PSFREQ) Q ;Freq can be null
.I '$$VALFREQ^PSSHFREQ(PSFREQ) D
..S PSREASON="Invalid or Undefined Frequency"
..S PSRESULT=PSMSG_U_PSREASON
Q PSRESULT
;
CHKRATE(PSRATE,TYPE,DRUGNM,DURATION) ;
;INPUTS: PSRATE-Can be either dose or duration rate
;TYPE-DOSE OR DURATION
;DRUGNM-DRUG NAME
;DURATION-OPTIONAL DURATION NUMERIC
S DURATION=$G(DURATION)
;output: returns error message and reason
N OKFLAG,STDRATE,RESULT,REASON,PSMSG
S RESULT=""
S OKFLAG=0 ;ASSUME BAD
D
.I '$L(PSRATE),TYPE="DURATION",'$L(DURATION) Q ;can be null for duration if duration is null
.F STDRATE="H","HOUR","MINUTE","MIN","DAY" D Q:OKFLAG
..I PSRATE=STDRATE S OKFLAG=1
.I 'OKFLAG D
..S TYPE=$S(TYPE="DURATION":"Duration",TYPE="DOSE":"DOSE",1:"Duration or Dose")
..S REASON="Invalid or Undefined "_TYPE_" Rate"
..S PSMSG=$$DOSEMSG(DRUGNM)
..S RESULT=PSMSG_U_REASON
Q RESULT
;
CHKDRATN(DURATION,DRUGNM) ;
;INPUTS; DURATION-INTEGER-HOW LONG A DRUG IS TAKEN
;PSMSG-ERROR MESSAGE
N RESULT,REASON,PSMSG
S RESULT=""
;If not integer error
D
.I '$L(DURATION) Q ;can be null OK
.;must be an integer > 0
.;I (DURATION'=+DURATION)!(DURATION'=(DURATION\1))!(DURATION=0) D
.I (DURATION=0)!(DURATION'?1.N) D
..S REASON="Invalid or Undefined Duration"
..S PSMSG=$$DOSEMSG(DRUGNM)
..S RESULT=PSMSG_U_REASON
Q RESULT
;
DOSEMSG(DRUGNAME,TYPE,WARN) ;
;INPUTS:DRUGNMAME
;TYPE-either "R" for range or "S" for single or "D" for daily or "M" for max daily (optional)
;WARN-'W' for warning text, else exception text
;OUTPUT STANDARD DOSAGE ERROR MESSAGE
N RETURN,TEXT
S TYPE=$G(TYPE) ;OPTIONAL PARAMETER ONLY CALLED FROM PSSHRQ23
S WARN=$G(WARN) ;OPTIONAL PARAMETER ONLY CALLED FROM PSSDSEXD
S TEXT=$S(WARN="W":" Warning for ",1:" could not be performed for Drug: ")
D
.I TYPE="S" D Q
..SET RETURN="Maximum Single Dose Check"_TEXT_DRUGNAME
.I TYPE="M" D Q
..S RETURN="Max Daily Dose Check"_TEXT_DRUGNAME
.S RETURN=$S(WARN="W":"Dosing Order Check",1:"Dosing Checks")_TEXT_DRUGNAME
Q RETURN
;
GETUCI() ;
;RETURNS CURRENT UCI
N Y
X ^%ZOSF("UCI")
Q Y
;
ERRMSG(TYPE,DRUGNAME,ORDRNUM,WARNING) ;
;Returns standard messages for error nodes
;created from FDB alerts
;inputs:
;TYPE-DRUGDRUG,THERAPY,DOSE
;DRUGNAME-NAME OF DRUG
;WARNING (OPTIONAL) 1 OR 0 IF SET CAME BACKF FROM FDB AS SEVERITY OF WARINING)
;CALLED BY MSGWRITE^PSSHRQ21
;FDB Errors, Input Exceptions and Dose Screening prior to FDB call pass in Null Type
N MSG,LOCORREM
S WARNING=$G(WARNING)
S MSG=""
S LOCORREM=$$LOCORREM(ORDRNUM)
D
.I WARNING D Q
..I TYPE="DRUGDRUG" S MSG="Drug Interaction Order Check for "_LOCORREM_" Drug: "
..I TYPE="THERAPY" S MSG="Duplicate Therapy Order Check for "_LOCORREM_" Drug: "
..I TYPE="DOSE" S MSG="Dosing Order Check Warning for "_DRUGNAME_":" Q ; do not execute the next line - and 2.1 change from Maximum to Dosing Order..
..S MSG=MSG_DRUGNAME_" Warning"
.I TYPE="DRUGDRUG" S MSG="Drug Interaction Order Check could not be performed."
.I TYPE="THERAPY" S MSG="Duplicate Therapy Order Check could not be performed for "_LOCORREM_" Drug: "_DRUGNAME
.I TYPE="DOSE" S MSG=$$DOSEMSG(DRUGNAME)
Q MSG
;
ORDRTYP(ORDERNUM) ;
;RETURNS THE TYPE OF ORDER: OUTPATIENT PROSPECTIVE DRUG, OUTPATIENT, REMOTE OR INPATIENT
;INPUTS: ORDERNUM: TYPE;ORDER NUMBER;DRUG TYPE (PROFILE, PROSPECTIVE, REMOTE);COUNTER
N TYPE,C1
S TYPE=""
S C1=$E(ORDERNUM)
D
.I ORDERNUM["REMOTE" S TYPE="REMOTE" Q
.I C1="O" S TYPE="OUTPATIENT" Q
.I C1="Z" S TYPE="OUTPATIENT" Q
.I C1="I" S TYPE="INPATIENT" Q
.I C1="R" S TYPE="REMOTE" Q
Q TYPE
;
LOCORREM(ORDERNUM) ;
;INPUTS: ORDERNUM: TYPE;ORDER NUMBER;DRUG TYPE (PROFILE, PROSPECTIVE, REMOTE);COUNTER
;OUTPUTS:-String either "local" or "Remote"
N ORDRTYP,LOCORREM
S ORDRTYP=$$ORDRTYP(ORDERNUM)
D
.I ORDRTYP="REMOTE" S LOCORREM="Remote" Q
.S LOCORREM="Local"
Q LOCORREM
;
STATMSG() ;
;This returns the standard message when an FDB update is being performed.
;
N MSG
;S MSG="Enhanced Order checks are unavailable. A Vendor database update is in progress."
;S MSG="The connection to the vendor database has been disabled."
S MSG=$S(+$G(PSSDSWHE)=0:"The connection to the vendor database has been disabled.",1:"Vendor database updates are being processed.") ;2.1 message text split
Q MSG
;
;
GCMESS() ;Get Exclude field
N PSSVQND,PSSVQEXC,PSSVQPVP
S PSSVQPVP=$P(ORDRNUM,";",3)
I '$D(PSJDGCK) S PSSVQND=^TMP($J,PSSHASH("Base"),"IN",PSSVQPVP,ORDRNUM)
I $D(PSJDGCK) S PSSVQND=^TMP($J,PSSHASH("Base"),"IN","PROSPECTIVE",ORDRNUM)
S PSSVQEXC=""
D GCNMESX
Q PSSVQEXC
;
;
GCNMESX ;
N PSSVQDRG,PSSVQ1,PSSVQ3,PSSVQVUI,PSSVQAR,PSSVQ4,PSSVQARR
S PSSVQDRG=$P(PSSVQND,"^",3) I PSSVQDRG D Q
.S PSSVQ1=$P($G(^PSDRUG(PSSVQDRG,"ND")),"^"),PSSVQ3=$P($G(^PSDRUG(PSSVQDRG,"ND")),"^",3)
.I PSSVQ1,PSSVQ3 S PSSVQEXC=$$DDIEX^PSNAPIS(PSSVQ1,PSSVQ3)
S PSSVQVUI=$P(PSSVQND,"^",2) I 'PSSVQVUI Q
S PSSVQAR="PSSVQARR"
D GETIREF^XTID(50.68,.01,PSSVQVUI,PSSVQAR)
S PSSVQ4=$O(PSSVQARR(50.68,.01,""))
I PSSVQ4 S PSSVQEXC=$$DDIEX^PSNAPIS("",PSSVQ4)
Q
;
;
NXCHKMSG(DRUGNM) ;2.1 changes
N PSSZMESS
I $D(^TMP($J,PSSHASH("Base"),"IN","DOSE")) D Q PSSZMESS
.I 'PSSVQDOS!('PSSVQTY2)!(PSSVQREM)!($$EXMT(DRUGIEN)) S PSSZMESS=MESSAGE Q
.S PSSZMESS="Dosing Checks could not be performed for Drug: "_DRUGNM_", please complete a manual check for appropriate Dosing." ; 2.1 Schedule not known, so message must stay generic
S PSSZMESS="Order Checks could not be done for"
S PSSZMESS=PSSZMESS_$S(PSSVQREM:" Remote",2:"")_" Drug: "_DRUGNM_", please complete a manual check for Drug Interactions"_$S(PSSVQDOS&($G(PSSVQTY2))&('$$EXMT(DRUGIEN)):", Duplicate Therapy and appropriate Dosing.",1:" and Duplicate Therapy.")
Q PSSZMESS
;
;
NZMSG ;Reset Message for Pharmacy Not matched to NDF error for Dosing
S MESSAGE="Maximum Single Dose Check could not be performed for Drug: "_DRUGNM
Q
;;
EXMT(PSSHRDRG) ; given drug ien, is it exempt from dosing call? 2.1 change
I PSSHRDRG'>0 Q 0
Q $$EXMT^PSSDSAPI(PSSHRDRG)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSHRVL1 18392 printed Oct 16, 2024@18:32:44 Page 2
PSSHRVL1 ;WOIFO/Alex Vasquez, Timothy Sabat, Steve Gordon - Continuation Data Validation routine for drug checks ;01/15/07
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**136,169,160,173,178,224**;9/30/97;Build 3
+2 ;
+3 ; Reference to ^PSNDF(50.68 supported by IA #2079
+4 ; Reference to ^PSNDF(50.68 supported by IA #3735
+5 ;
NEXTEX(PSS,PSSHASH) ;
+1 ;@DESC Gets the next exception
+2 ;@PSS The temp hash
+3 ;@PSSHASH The internal hash
+4 ;
+5 NEW PSNEXT
+6 SET PSNEXT=":"
+7 SET PSNEXT=$ORDER(^TMP($JOB,PSSHASH("Base"),"OUT","EXCEPTIONS",PSS("PharmOrderNo"),PSNEXT),-1)
+8 QUIT PSNEXT+1
+9 ;;
NEXTEXD(PSS,PSSHASH) ;
+1 ;@DESC Gets the next dose exception
+2 ;@PSS The temp hash
+3 ;@PSSHASH The internal hash
+4 NEW PSNEXT
+5 SET PSNEXT=":"
+6 SET PSNEXT=$ORDER(^TMP($JOB,PSSHASH("Base"),"OUT","EXCEPTIONS","DOSE",PSS("PharmOrderNo"),PSNEXT),-1)
+7 QUIT PSNEXT+1
+8 ;;
WRITE(PSSHASH) ;
+1 ;@Writes a response, based on the list of exceptions stored in Hash
+2 ;@NOTE The internal hash looks like this:
+3 ;PSSHASH("Exception","PROSPECTIVE","DOSE",PharmacyOrderNum,Counter)=Gcn,Vuid,IEN,DrugName,CprsOrderNum,Package,Reason,ReasonCode,ResonSource,ReasonText,NoWrite
+4 ;PSSHASH("Exception","PROSPECTIVE",PharmacyOrderNum,Counter)=Gcn,Vuid,IEN,DrugName,CprsOrderNum,Package,Reason,ReasonCode,ResonSource,ReasonText,NoWrite
+5 ;PSSHASH("Exception","PROFILE",PharmacyOrderNum,Counter)=Gcn,Vuid,IEN,DrugName,CprsOrderNum,Package,Reason,ReasonCode,ResonSource,ReasonText,NoWrite
+6 ;PSSHASH("Exception","PatientIenMissing")=""
+7 ;PSSHASH("Reason")="Failed Validation"
+8 ;
+9 ;
+10 NEW PSS
+11 SET PSS("PharmOrderNo")=""
+12 SET PSS("I")=""
+13 FOR
SET PSS("PharmOrderNo")=$ORDER(PSSHASH("Exception","PROFILE",PSS("PharmOrderNo")))
if PSS("PharmOrderNo")=""
QUIT
Begin DoDot:1
+14 FOR
SET PSS("I")=$ORDER(PSSHASH("Exception","PROFILE",PSS("PharmOrderNo"),PSS("I")))
if PSS("I")=""
QUIT
Begin DoDot:2
+15 DO WPROFILE(.PSSHASH,.PSS)
+16 QUIT
End DoDot:2
+17 QUIT
End DoDot:1
+18 ;
+19 SET PSS("PharmOrderNo")=""
+20 SET PSS("I")=""
+21 FOR
SET PSS("PharmOrderNo")=$ORDER(PSSHASH("Exception","PROSPECTIVE","DOSE",PSS("PharmOrderNo")))
if PSS("PharmOrderNo")=""
QUIT
Begin DoDot:1
+22 FOR
SET PSS("I")=$ORDER(PSSHASH("Exception","PROSPECTIVE","DOSE",PSS("PharmOrderNo"),PSS("I")))
if PSS("I")=""
QUIT
Begin DoDot:2
+23 DO WDOSE(.PSSHASH,.PSS)
+24 ;kill off node to prevent next loop from setting PSS("PharmOrderNo") to "DOSE"
+25 KILL PSSHASH("Exception","PROSPECTIVE","DOSE",PSS("PharmOrderNo"),PSS("I"))
End DoDot:2
+26 QUIT
End DoDot:1
+27 ;
+28 SET PSS("PharmOrderNo")=""
+29 SET PSS("I")=""
+30 FOR
SET PSS("PharmOrderNo")=$ORDER(PSSHASH("Exception","PROSPECTIVE",PSS("PharmOrderNo")))
if PSS("PharmOrderNo")=""
QUIT
Begin DoDot:1
+31 FOR
SET PSS("I")=$ORDER(PSSHASH("Exception","PROSPECTIVE",PSS("PharmOrderNo"),PSS("I")))
if PSS("I")=""
QUIT
Begin DoDot:2
+32 DO WPROSPEC(.PSSHASH,.PSS)
End DoDot:2
+33 QUIT
End DoDot:1
+34 ;
+35 QUIT
+36 ;;
WDOSE(PSSHASH,PSS) ;
+1 ;@DESC Writes the dose exceptions out.
+2 ;@PSSHASH The internal hash
+3 ;@PSS The temp hash
+4 ;@NOTE The exception hash looks like this.
+5 ;PSSHASH("Exception","PROSPECTIVE","DOSE",PharmacyOrderNum,Counter)=Gcn,Vuid,IEN,DrugName,CprsOrderNum,Package,Reason,ReasonCode,ResonSource,ReasonText
+6 ;
+7 NEW TYPE,I
+8 SET PSS("DoseValue")=$GET(^TMP($JOB,PSSHASH("Base"),"IN","DOSE",PSS("PharmOrderNo")))
+9 ;Set the next exception
+10 if $PIECE(PSSHASH("Exception","PROSPECTIVE","DOSE",PSS("PharmOrderNo"),PSS("I")),U,11)'=1
Begin DoDot:1
+11 SET ^TMP($JOB,PSSHASH("Base"),"OUT","EXCEPTIONS","DOSE",PSS("PharmOrderNo"),$$NEXTEXD(.PSS,.PSSHASH))=PSSHASH("Exception","PROSPECTIVE","DOSE",PSS("PharmOrderNo"),PSS("I"))
End DoDot:1
+12 QUIT
+13 ;;
WPROFILE(PSSHASH,PSS) ;
+1 ;@DESC Writes the profile drug exceptions out.
+2 ;@PSSHASH The internal hash
+3 ;@PSS The temp hash
+4 ;Kill the corresponding profile drug
+5 ;KILL ^TMP($JOB,PSSHASH("Base"),"IN","PROFILE",PSS("PharmOrderNo"))
+6 ;Set the exception in the global
+7 if $PIECE(PSSHASH("Exception","PROFILE",PSS("PharmOrderNo"),PSS("I")),U,11)'=1
SET ^TMP($JOB,PSSHASH("Base"),"OUT","EXCEPTIONS",PSS("PharmOrderNo"),$$NEXTEX(.PSS,.PSSHASH))=PSSHASH("Exception","PROFILE",PSS("PharmOrderNo"),PSS("I"))
+8 ;If no profile drugs left and the proVpro flag exists, delete it.
+9 if '$DATA(^TMP($JOB,PSSHASH("Base"),"IN","PROFILE"))
Begin DoDot:1
+10 ;KILL ^TMP($JOB,PSSHASH("Base"),"IN","PROFILEVPROFILE")
+11 DO KILLCHEK(PSSHASH("Base"),"PROFILEVPROFILE")
+12 QUIT
End DoDot:1
+13 QUIT
+14 ;;
WPROSPEC(PSSHASH,PSS) ;
+1 ;@DESC Writes the prospective drug exceptions out.
+2 ;@PSSHASH The internal hash
+3 ;@PSS The temp hash
+4 ;@NOTE Exception Hash Looks Like
+5 ;PSSHASH("Exception","PROSPECTIVE","DOSE",PharmacyOrderNum,Counter)=Gcn,Vuid,IEN,DrugName,CprsOrderNum,Package,Reason,ReasonCode,ResonSource,ReasonText
+6 ;PSSHASH("Exception","PROSPECTIVE",PharmacyOrderNum,Counter)=Gcn,Vuid,IEN,DrugName,CprsOrderNum,Package,Reason,ReasonCode,ResonSource,ReasonText
+7 ;
+8 ;Set the exception data
+9 if $PIECE(PSSHASH("Exception","PROSPECTIVE",PSS("PharmOrderNo"),PSS("I")),U,11)'=1
SET ^TMP($JOB,PSSHASH("Base"),"OUT","EXCEPTIONS",PSS("PharmOrderNo"),$$NEXTEX(.PSS,.PSSHASH))=PSSHASH("Exception","PROSPECTIVE",PSS("PharmOrderNo"),PSS("I"))
+10 QUIT
+11 ;
KILLALL(BASE) ;
+1 ;INPUTS BASE SUBCRIPT
+2 ;@DESC Kills the DrugDrug, Therapy, ProfileVProfile, and Dose check nodes.
+3 DO KILLCHEK("DRUGDRUG",BASE)
+4 DO KILLCHEK("THERAPY",BASE)
+5 DO KILLCHEK("PROFILEVPROFILE",BASE)
+6 DO KILLCHEK("DOSE",BASE)
+7 QUIT
+8 ;;
KILLCHEK(PSSCHECK,BASE) ;
+1 ;@DESC Kills the check node specified in parameter
+2 ;@PSSCHEK The node to kill
+3 ;
+4 KILL ^TMP($JOB,BASE,"IN",PSSCHECK)
+5 QUIT
+6 ;
+7 ;
KILLNODE(BASE,TYPE,ORDER) ;
+1 ;
+2 ;@DESC KILLS A SINGLE NODE FOR A DRUG
+3 ;@BASE--the subscript after $JOB
+4 ;@TYPE-Can have 3 possible values: "PROSPECTIVE","PROFILE" or "DOSE"
+5 ;@ODRDER-Is the order information to make the node unique
+6 KILL ^TMP($JOB,BASE,"IN",TYPE,ORDER)
+7 QUIT
+8 ;
GCNREASN(DRUGIEN,DRUGNM,ORDRNUM,BADGCN) ;
+1 ;
+2 ;Returns a message and reason on why a drug does not have a GCNSEQNO
+3 ;inputs: DRUGIEN-IEN OF DRUG
+4 ;DRUGNM-NAME OF DRUG
+5 ;ORDRNUM-PHARMACY ORDER NUM
+6 ;BADGCN-(OPTIONAL)FLAG IS SET to 1 IF DRUG RETURNED AS NOT FOUND BY SWRI/FDB
+7 ; if set to -1 Missing or invalid GCNSEQNO from Input node
+8 NEW VAPROD1,NDNODE,REASON,MESSAGE,VAIEN,PSSVQPAC,PSSVQDOS,PSSVQNOM,PSSVQREM,PSSVQTY1,PSSVQTY2,PSSREASN
+9 SET MESSAGE=$$NOCHKMSG(DRUGNM,ORDRNUM)
SET PSSVQDOS=0
SET PSSVQPAC=$SELECT($EXTRACT(PSSHASH("Base"),1,2)="PS":1,1:0)
IF $TEXT(DS^PSSDSAPI)]""
IF $$DS^PSSDSAPI
SET PSSVQDOS=1
+10 SET REASON=""
SET PSSVQREM=$SELECT($PIECE(ORDRNUM,";")="R":1,1:0)
+11 SET PSSVQTY1=$PIECE(ORDRNUM,";",3)
SET PSSVQTY1=$$UP^XLFSTR(PSSVQTY1)
SET PSSVQTY2=$SELECT(PSSVQTY1["PROSPECTIVE":1,1:0)
+12 ;
+13 SET VAPROD1=""
+14 ;Case statement
Begin DoDot:1
+15 IF $GET(BADGCN)=1
SET MESSAGE=$$NXCHKMSG(DRUGNM)
SET PSSVQNOM=$$GCMESS
SET REASON=$SELECT(PSSVQNOM:"^1",1:"")
SET PSSREASN=1
QUIT
+16 IF '$GET(DRUGIEN)
IF 'PSSVQREM
SET REASON="No dispense drug found for Orderable Item"
SET PSSREASN=2
QUIT
+17 SET NDNODE=$GET(^PSDRUG(DRUGIEN,"ND"))
+18 ;if no ndnode or 3rd piece not populated
+19 IF 'PSSVQREM
IF '$LENGTH(NDNODE)!('$PIECE(NDNODE,U,3))
Begin DoDot:2
+20 SET REASON="Drug not matched to NDF"
SET PSSREASN=3
if PSSVQPAC&($DATA(^TMP($JOB,PSSHASH("Base"),"IN","DOSE")))
DO NZMSG
IF 'PSSVQPAC
SET MESSAGE=$$NXCHKMSG(DRUGNM)
SET REASON=""
End DoDot:2
QUIT
+21 SET VAIEN=$SELECT('PSSVQREM:+$PIECE(NDNODE,U,3),1:0)
+22 ; Get the GCNSEQNO
if VAIEN
SET VAPROD1=$PIECE($GET(^PSNDF(50.68,VAIEN,1)),U,5)
+23 IF 'VAPROD1!($GET(BADGCN)=-1)
Begin DoDot:2
+24 SET MESSAGE=$$NXCHKMSG(DRUGNM)
SET PSSVQNOM=$$GCMESS
SET REASON=$SELECT(PSSVQNOM:"^1",1:"")
SET PSSREASN=4
End DoDot:2
End DoDot:1
+25 ;
+26 IF PSSVQPAC=0
IF PSSVQTY2=1
Begin DoDot:1
+27 SET ^TMP($JOB,PSSHASH("Base"),"OR-TRANSIENT",DRUGIEN,DRUGNM,ORDRNUM,BADGCN)=MESSAGE_U_PSSREASN
End DoDot:1
+28 QUIT MESSAGE_U_REASON
+29 ;
NOCHKMSG(DRUGNM,ORDRNUM) ;
+1 ;Returns msg that no checks could be performed.
+2 ;INPUTS:
+3 ;DRUGNM-Name of drug
+4 ;ORDRNUM-PHARMACY ORDER NUMBER
+5 NEW MESSAGE
+6 SET MESSAGE="Enhanced Order Checks cannot be performed for "_$$LOCORREM(ORDRNUM)_$$OUTPAT(ORDRNUM)_" Drug: "_DRUGNM
+7 QUIT MESSAGE
+8 ;
OUTPAT(ORDRNUM) ;
+1 ; Returns " Outpatient" if it is one.
+2 ;INPUTS:
+3 ;ORDRNUM-PHARMACY ORDER NUMBER
+4 ;PSSBASE - globally defined
+5 ;
+6 NEW OUTPAT
+7 SET OUTPAT=""
+8 IF $$LOCORREM(ORDRNUM)="Local"
Begin DoDot:1
+9 IF $EXTRACT(ORDRNUM)'="I"
IF $EXTRACT(ORDRNUM)'="R"
IF ORDRNUM["PROFILE"
IF $GET(^TMP($JOB,PSSBASE,"IN","SOURCE"))="I"
SET OUTPAT=" Outpatient"
End DoDot:1
+10 QUIT OUTPAT
+11 ;
OIMSG(OINAME,PSSNOITN) ;
+1 ;INPUT: Orderable item name
+2 ; Order number
+3 ;RETURNS-ERROR MESSAGE
+4 NEW MESSAGE,PSSNOITP,PSSNOITD,PSSNOIT1,PSSNOIT2
+5 SET PSSNOITP=$SELECT($EXTRACT(PSSHASH("Base"),1,2)="PS":0,1:1)
+6 SET PSSNOITD=0
IF $TEXT(DS^PSSDSAPI)]""
IF $$DS^PSSDSAPI
SET PSSNOITD=1
+7 SET PSSNOIT1=$PIECE(PSSNOITN,";",3)
SET PSSNOIT1=$$UP^XLFSTR(PSSNOIT1)
SET PSSNOIT2=$SELECT(PSSNOIT1["PROSPECTIVE":1,1:0)
+8 IF PSSNOITP
Begin DoDot:1
+9 IF $DATA(^TMP($JOB,PSSHASH("Base"),"IN","DOSE"))
Begin DoDot:2
+10 SET MESSAGE="Maximum Single Dose Check could not be done for Drug: "_OINAME_", please complete a manual check for appropriate Dosing."
End DoDot:2
QUIT
+11 SET MESSAGE="Order Checks could not be done for Drug: "_OINAME_", please complete a manual check for Drug Interactions"_$SELECT(PSSNOITD&($GET(PSSNOIT2)):", Duplicate Therapy and appropriate Dosing.",1:" and Duplicate Therapy.")
End DoDot:1
QUIT MESSAGE
+12 SET MESSAGE="Enhanced Order Checks cannot be performed for Orderable Item: "_OINAME
+13 QUIT MESSAGE
+14 ;
INRSON(ERRNUM,ORDERNUM) ;
+1 ;INPUT-REASON CODE (1,2 OR 3)
+2 ;ORDERNUM-(OPTIONAL)-ORDERNUMBER
+3 ;OUTPUT-REASON MESSAGE
+4 ;
+5 NEW REASON,NONVAFLG
+6 ;DEFAULT
SET NONVAFLG=0
+7 SET ORDERNUM=$GET(ORDERNUM)
+8 IF $EXTRACT(ORDERNUM)="N"
SET NONVAFLG=1
+9 Begin DoDot:1
+10 IF ERRNUM=1
Begin DoDot:2
+11 ; No active Dispense Drug found for Pending order.
IF 'NONVAFLG
SET REASON="No Dispense Drug found."
QUIT
+12 ; No active Dispense Drug found for Non-VA med order.
IF NONVAFLG
SET REASON="No Dispense Drug found."
End DoDot:2
QUIT
+13 IF ERRNUM=2
SET REASON="Free Text Dosage could not be evaluated."
QUIT
+14 IF ERRNUM=3
SET REASON="Free Text Infusion Rate could not be evaluated."
+15 IF ERRNUM=4
SET REASON="No active IV Additive/Solution marked for IV fluid order entry could be found."
End DoDot:1
+16 QUIT REASON
+17 ;
DEMOCHK(AGE,BSA,WEIGHT,PSDRUG,WHERE) ;
+1 ;Checks age and returns message and error reason
+2 ;input: AGE--AGE
+3 ;BSA-BSA
+4 ;WEIGHT OF THE PATIENT
+5 ;WHERE value of PSSDSWHE (1 for OR, 0 for IP/OP) as determined by dosing API
+6 ;output: message and reason strings
+7 ;
+8 NEW PSMESSAGE,PSREASON,PSRESULT,TEXT,X,FLAG
+9 SET PSRESULT=""
SET PSREASON=""
SET TEXT=""
SET WHERE=$SELECT(+$GET(WHERE)=1:1,1:0)
SET AGE=+$GET(AGE)
SET BSA=+$GET(BSA)
SET WEIGHT=+$GET(WEIGHT)
+10 IF AGE=0
Begin DoDot:1
+11 SET TEXT=" AGE"
+12 if WHERE=0
Begin DoDot:2
+13 SET PSMESSAGE=$$DOSEMSG(PSDRUG)
+14 SET PSREASON="One or more required patient parameters unavailable:"_TEXT
End DoDot:2
+15 if WHERE=1
Begin DoDot:2
+16 SET PSMESSAGE="Dosing checks could not be done for Drug: "_PSDRUG_", please complete a manual check for appropriate dosing."
End DoDot:2
+17 SET PSRESULT=PSMESSAGE_U_PSREASON
End DoDot:1
QUIT PSRESULT
+18 QUIT PSRESULT
+19 ;
MEDRTE(PSROUTE,PSDRUGNM) ;
+1 ;Checks route if null
+2 ;inputs: ROUTE-MEDICATION ROUTE
+3 ;DRUGNM-DRUG NAME
+4 ;RETURNS THE ERROR MESSAGE AND ERROR REASON
+5 NEW PSMESSAGE,PSREASON,PSRESULT
+6 SET PSRESULT=""
+7 IF '$LENGTH(PSROUTE)
Begin DoDot:1
+8 SET PSMESSAGE=$$DOSEMSG(PSDRUGNM)
+9 ;S PSREASON="Unmapped Local Medication Route"
+10 SET PSREASON="Invalid or Undefined Dose Route"
+11 SET PSRESULT=PSMESSAGE_U_PSREASON
End DoDot:1
+12 QUIT PSRESULT
+13 ;
+14 ;
CHKDSTYP(DOSETYP,PSDRUGNM) ;
+1 ;inputs: DOSETYP-DOSE TYPE (MAINTENANCE,LOADING)
+2 ;PSDRUGNM-DRUG NAME
+3 ;RETURNS THE ERROR MESSAGE AND ERROR REASON
+4 NEW PSREASON,PSRESULT,PSMSG,TEXT,OKFLAG
+5 SET PSRESULT=""
SET OKFLAG=0
+6 FOR TEXT="LOADING","MAINTENANCE","INITIAL DOSE","INTERMEDIATE DOSE","PROPHYLACTIC","SINGLE DOSE"
Begin DoDot:1
+7 IF DOSETYP=TEXT
SET OKFLAG=1
QUIT
End DoDot:1
if OKFLAG
QUIT
+8 IF '$LENGTH(DOSETYP)!'OKFLAG
Begin DoDot:1
+9 SET PSMSG=$$DOSEMSG(PSDRUGNM)
+10 ;S PSREASON="Undefined Dose Type"
+11 SET PSREASON="Invalid or Undefined Dose Type"
+12 SET PSRESULT=PSMSG_U_PSREASON
End DoDot:1
+13 QUIT PSRESULT
+14 ;
CHKDOSE(PSDOSE,PSDRUGNM) ;
+1 ;CHECKS THE DOSE OF DRUG DOSE REQUEST
+2 ;INPUTS: PSDOSE-ORDERED DOSE OF A DRUG
+3 ;PSDRUGNM=NAME OF DRUG
+4 ;RETURNS THE ERROR MESSAGE AND ERROR REASON
+5 NEW PSREASON,PSRESULT,PSMSG
+6 SET PSRESULT=""
+7 IF PSDOSE'=+PSDOSE
Begin DoDot:1
+8 SET PSMSG=$$DOSEMSG(PSDRUGNM)
+9 SET PSREASON="Invalid or Undefined Dose"
+10 SET PSRESULT=PSMSG_U_PSREASON
End DoDot:1
+11 QUIT PSRESULT
+12 ;
CHKUNIT(PSUNIT,PSDRUGNM) ;
+1 ;CHECKS THE UNITS OF A DOSE-RETURNS ERROR AND REASON
+2 ;INPUTS: PSUNIT-UNITS OF THE DRUG
+3 ;PSDRUGNM-NAME OF THE DRUG
+4 NEW PSREASON,PSRESULT,PSMSG
+5 SET PSRESULT=""
+6 IF '$LENGTH(PSUNIT)
Begin DoDot:1
+7 SET PSMSG=$$DOSEMSG(PSDRUGNM)
+8 SET PSREASON="Invalid or Undefined Dose Unit"
+9 SET PSRESULT=PSMSG_U_PSREASON
End DoDot:1
+10 QUIT PSRESULT
+11 ;
CHKFREQ(PSFREQ) ;
+1 ;INPUTS: PSFREQ-HOW OFTEN A DRUG IS ADMINISTRED
+2 ;RETURNS-ERROR MESSAGE AND ERROR REASON
+3 NEW PSREASON,PSRESULT,PSMSG
+4 SET PSMSG="Daily Dosage Range Check could not be performed."
+5 SET PSRESULT=""
+6 Begin DoDot:1
+7 ;Freq can be null
IF '$LENGTH(PSFREQ)
QUIT
+8 IF '$$VALFREQ^PSSHFREQ(PSFREQ)
Begin DoDot:2
+9 SET PSREASON="Invalid or Undefined Frequency"
+10 SET PSRESULT=PSMSG_U_PSREASON
End DoDot:2
End DoDot:1
+11 QUIT PSRESULT
+12 ;
CHKRATE(PSRATE,TYPE,DRUGNM,DURATION) ;
+1 ;INPUTS: PSRATE-Can be either dose or duration rate
+2 ;TYPE-DOSE OR DURATION
+3 ;DRUGNM-DRUG NAME
+4 ;DURATION-OPTIONAL DURATION NUMERIC
+5 SET DURATION=$GET(DURATION)
+6 ;output: returns error message and reason
+7 NEW OKFLAG,STDRATE,RESULT,REASON,PSMSG
+8 SET RESULT=""
+9 ;ASSUME BAD
SET OKFLAG=0
+10 Begin DoDot:1
+11 ;can be null for duration if duration is null
IF '$LENGTH(PSRATE)
IF TYPE="DURATION"
IF '$LENGTH(DURATION)
QUIT
+12 FOR STDRATE="H","HOUR","MINUTE","MIN","DAY"
Begin DoDot:2
+13 IF PSRATE=STDRATE
SET OKFLAG=1
End DoDot:2
if OKFLAG
QUIT
+14 IF 'OKFLAG
Begin DoDot:2
+15 SET TYPE=$SELECT(TYPE="DURATION":"Duration",TYPE="DOSE":"DOSE",1:"Duration or Dose")
+16 SET REASON="Invalid or Undefined "_TYPE_" Rate"
+17 SET PSMSG=$$DOSEMSG(DRUGNM)
+18 SET RESULT=PSMSG_U_REASON
End DoDot:2
End DoDot:1
+19 QUIT RESULT
+20 ;
CHKDRATN(DURATION,DRUGNM) ;
+1 ;INPUTS; DURATION-INTEGER-HOW LONG A DRUG IS TAKEN
+2 ;PSMSG-ERROR MESSAGE
+3 NEW RESULT,REASON,PSMSG
+4 SET RESULT=""
+5 ;If not integer error
+6 Begin DoDot:1
+7 ;can be null OK
IF '$LENGTH(DURATION)
QUIT
+8 ;must be an integer > 0
+9 ;I (DURATION'=+DURATION)!(DURATION'=(DURATION\1))!(DURATION=0) D
+10 IF (DURATION=0)!(DURATION'?1.N)
Begin DoDot:2
+11 SET REASON="Invalid or Undefined Duration"
+12 SET PSMSG=$$DOSEMSG(DRUGNM)
+13 SET RESULT=PSMSG_U_REASON
End DoDot:2
End DoDot:1
+14 QUIT RESULT
+15 ;
DOSEMSG(DRUGNAME,TYPE,WARN) ;
+1 ;INPUTS:DRUGNMAME
+2 ;TYPE-either "R" for range or "S" for single or "D" for daily or "M" for max daily (optional)
+3 ;WARN-'W' for warning text, else exception text
+4 ;OUTPUT STANDARD DOSAGE ERROR MESSAGE
+5 NEW RETURN,TEXT
+6 ;OPTIONAL PARAMETER ONLY CALLED FROM PSSHRQ23
SET TYPE=$GET(TYPE)
+7 ;OPTIONAL PARAMETER ONLY CALLED FROM PSSDSEXD
SET WARN=$GET(WARN)
+8 SET TEXT=$SELECT(WARN="W":" Warning for ",1:" could not be performed for Drug: ")
+9 Begin DoDot:1
+10 IF TYPE="S"
Begin DoDot:2
+11 SET RETURN="Maximum Single Dose Check"_TEXT_DRUGNAME
End DoDot:2
QUIT
+12 IF TYPE="M"
Begin DoDot:2
+13 SET RETURN="Max Daily Dose Check"_TEXT_DRUGNAME
End DoDot:2
QUIT
+14 SET RETURN=$SELECT(WARN="W":"Dosing Order Check",1:"Dosing Checks")_TEXT_DRUGNAME
End DoDot:1
+15 QUIT RETURN
+16 ;
GETUCI() ;
+1 ;RETURNS CURRENT UCI
+2 NEW Y
+3 XECUTE ^%ZOSF("UCI")
+4 QUIT Y
+5 ;
ERRMSG(TYPE,DRUGNAME,ORDRNUM,WARNING) ;
+1 ;Returns standard messages for error nodes
+2 ;created from FDB alerts
+3 ;inputs:
+4 ;TYPE-DRUGDRUG,THERAPY,DOSE
+5 ;DRUGNAME-NAME OF DRUG
+6 ;WARNING (OPTIONAL) 1 OR 0 IF SET CAME BACKF FROM FDB AS SEVERITY OF WARINING)
+7 ;CALLED BY MSGWRITE^PSSHRQ21
+8 ;FDB Errors, Input Exceptions and Dose Screening prior to FDB call pass in Null Type
+9 NEW MSG,LOCORREM
+10 SET WARNING=$GET(WARNING)
+11 SET MSG=""
+12 SET LOCORREM=$$LOCORREM(ORDRNUM)
+13 Begin DoDot:1
+14 IF WARNING
Begin DoDot:2
+15 IF TYPE="DRUGDRUG"
SET MSG="Drug Interaction Order Check for "_LOCORREM_" Drug: "
+16 IF TYPE="THERAPY"
SET MSG="Duplicate Therapy Order Check for "_LOCORREM_" Drug: "
+17 ; do not execute the next line - and 2.1 change from Maximum to Dosing Order..
IF TYPE="DOSE"
SET MSG="Dosing Order Check Warning for "_DRUGNAME_":"
QUIT
+18 SET MSG=MSG_DRUGNAME_" Warning"
End DoDot:2
QUIT
+19 IF TYPE="DRUGDRUG"
SET MSG="Drug Interaction Order Check could not be performed."
+20 IF TYPE="THERAPY"
SET MSG="Duplicate Therapy Order Check could not be performed for "_LOCORREM_" Drug: "_DRUGNAME
+21 IF TYPE="DOSE"
SET MSG=$$DOSEMSG(DRUGNAME)
End DoDot:1
+22 QUIT MSG
+23 ;
ORDRTYP(ORDERNUM) ;
+1 ;RETURNS THE TYPE OF ORDER: OUTPATIENT PROSPECTIVE DRUG, OUTPATIENT, REMOTE OR INPATIENT
+2 ;INPUTS: ORDERNUM: TYPE;ORDER NUMBER;DRUG TYPE (PROFILE, PROSPECTIVE, REMOTE);COUNTER
+3 NEW TYPE,C1
+4 SET TYPE=""
+5 SET C1=$EXTRACT(ORDERNUM)
+6 Begin DoDot:1
+7 IF ORDERNUM["REMOTE"
SET TYPE="REMOTE"
QUIT
+8 IF C1="O"
SET TYPE="OUTPATIENT"
QUIT
+9 IF C1="Z"
SET TYPE="OUTPATIENT"
QUIT
+10 IF C1="I"
SET TYPE="INPATIENT"
QUIT
+11 IF C1="R"
SET TYPE="REMOTE"
QUIT
End DoDot:1
+12 QUIT TYPE
+13 ;
LOCORREM(ORDERNUM) ;
+1 ;INPUTS: ORDERNUM: TYPE;ORDER NUMBER;DRUG TYPE (PROFILE, PROSPECTIVE, REMOTE);COUNTER
+2 ;OUTPUTS:-String either "local" or "Remote"
+3 NEW ORDRTYP,LOCORREM
+4 SET ORDRTYP=$$ORDRTYP(ORDERNUM)
+5 Begin DoDot:1
+6 IF ORDRTYP="REMOTE"
SET LOCORREM="Remote"
QUIT
+7 SET LOCORREM="Local"
End DoDot:1
+8 QUIT LOCORREM
+9 ;
STATMSG() ;
+1 ;This returns the standard message when an FDB update is being performed.
+2 ;
+3 NEW MSG
+4 ;S MSG="Enhanced Order checks are unavailable. A Vendor database update is in progress."
+5 ;S MSG="The connection to the vendor database has been disabled."
+6 ;2.1 message text split
SET MSG=$SELECT(+$GET(PSSDSWHE)=0:"The connection to the vendor database has been disabled.",1:"Vendor database updates are being processed.")
+7 QUIT MSG
+8 ;
+9 ;
GCMESS() ;Get Exclude field
+1 NEW PSSVQND,PSSVQEXC,PSSVQPVP
+2 SET PSSVQPVP=$PIECE(ORDRNUM,";",3)
+3 IF '$DATA(PSJDGCK)
SET PSSVQND=^TMP($JOB,PSSHASH("Base"),"IN",PSSVQPVP,ORDRNUM)
+4 IF $DATA(PSJDGCK)
SET PSSVQND=^TMP($JOB,PSSHASH("Base"),"IN","PROSPECTIVE",ORDRNUM)
+5 SET PSSVQEXC=""
+6 DO GCNMESX
+7 QUIT PSSVQEXC
+8 ;
+9 ;
GCNMESX ;
+1 NEW PSSVQDRG,PSSVQ1,PSSVQ3,PSSVQVUI,PSSVQAR,PSSVQ4,PSSVQARR
+2 SET PSSVQDRG=$PIECE(PSSVQND,"^",3)
IF PSSVQDRG
Begin DoDot:1
+3 SET PSSVQ1=$PIECE($GET(^PSDRUG(PSSVQDRG,"ND")),"^")
SET PSSVQ3=$PIECE($GET(^PSDRUG(PSSVQDRG,"ND")),"^",3)
+4 IF PSSVQ1
IF PSSVQ3
SET PSSVQEXC=$$DDIEX^PSNAPIS(PSSVQ1,PSSVQ3)
End DoDot:1
QUIT
+5 SET PSSVQVUI=$PIECE(PSSVQND,"^",2)
IF 'PSSVQVUI
QUIT
+6 SET PSSVQAR="PSSVQARR"
+7 DO GETIREF^XTID(50.68,.01,PSSVQVUI,PSSVQAR)
+8 SET PSSVQ4=$ORDER(PSSVQARR(50.68,.01,""))
+9 IF PSSVQ4
SET PSSVQEXC=$$DDIEX^PSNAPIS("",PSSVQ4)
+10 QUIT
+11 ;
+12 ;
NXCHKMSG(DRUGNM) ;2.1 changes
+1 NEW PSSZMESS
+2 IF $DATA(^TMP($JOB,PSSHASH("Base"),"IN","DOSE"))
Begin DoDot:1
+3 IF 'PSSVQDOS!('PSSVQTY2)!(PSSVQREM)!($$EXMT(DRUGIEN))
SET PSSZMESS=MESSAGE
QUIT
+4 ; 2.1 Schedule not known, so message must stay generic
SET PSSZMESS="Dosing Checks could not be performed for Drug: "_DRUGNM_", please complete a manual check for appropriate Dosing."
End DoDot:1
QUIT PSSZMESS
+5 SET PSSZMESS="Order Checks could not be done for"
+6 SET PSSZMESS=PSSZMESS_$SELECT(PSSVQREM:" Remote",2:"")_" Drug: "_DRUGNM_", please complete a manual check for Drug Interactions"_$SELECT(PSSVQDOS&(...
... $GET(PSSVQTY2))&('$$EXMT(DRUGIEN)):", Duplicate Therapy and appropriate Dosing.",1:" and Duplicate Therapy.")
+7 QUIT PSSZMESS
+8 ;
+9 ;
NZMSG ;Reset Message for Pharmacy Not matched to NDF error for Dosing
+1 SET MESSAGE="Maximum Single Dose Check could not be performed for Drug: "_DRUGNM
+2 QUIT
+3 ;;
EXMT(PSSHRDRG) ; given drug ien, is it exempt from dosing call? 2.1 change
+1 IF PSSHRDRG'>0
QUIT 0
+2 QUIT $$EXMT^PSSDSAPI(PSSHRDRG)
