- 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 Feb 18, 2025@23:58:04 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)