PSSDSEXE ;BIR/CMF-Exceptions for Dose call Continuation ;02/24/09
;;1.0;PHARMACY DATA MANAGEMENT;**178,206,224**;9/30/97;Build 3
;
;Called from PSSDSEXD, this routine takes the results from the call to First DataBank and creates displayable TMP
;globals for the calling applications. Typically, PSSDBASA indicates a CPRS call, and PSSDBASB indicates a pharmacy call
;
;PSSDBCAR ARRAY pieces, set mostly in PSSDSAPD are described in PSSDSEXC:
;
;PSSDBCAX holds the errors to show
;
TWEAK2 ;; loop through exception then error globals, look for OR related tweaks
N PSSDWEX2,PSSDWE2,PSSDWLP,NODE
S PSSDWEX2=""
F S PSSDWEX2=$O(^TMP($J,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWEX2)) Q:PSSDWEX2="" D
.S PSSDWE2=""
.F S PSSDWE2=$O(^TMP($J,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,PSSDWE2)) Q:PSSDWE2="" D
..S NODE=$G(^TMP($J,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,PSSDWE2))
..Q:NODE=""
..Q:$$TWEAK20(PSSDWEX2)
..Q:$$TWEAK21(NODE)
..Q:$$TWEAK23(NODE)
..Q:$$TWEAK24(NODE)
..Q:$$TWEAK25(NODE)
..Q:$$TWEAK26(NODE)
..Q:$$TWEAK29A(PSSDWEX2)
D TWEAK22
S PSSDWLP=""
F S PSSDWLP=$O(^TMP($J,PSSDBASF,"OUT","DOSE","ERROR",PSSDWLP)) Q:PSSDWLP="" D
.Q:$$TWEAK28(PSSDWLP)
.Q:$$TWEAK29(PSSDWLP)
D TWEAK200^PSSDSEXF
Q
;;
TWEAK21(NODE) ;; test for OR inactive drug
N DRUGIEN,DRUGNAME,MESSAGE,REASON,FLAG
S FLAG=0
S DRUGIEN=$P(PSSDBCAR(PSSDWEX2),U,3)
D:$$ORTEST(DRUGIEN)=1
.S DRUGNAME=$P(PSSDBCAR(PSSDWEX2),U,2)
.S MESSAGE=$$CHECKMSG^PSSDSEXD(PSSDWEX2)_$$MSGEND(PSSDWEX2,DRUGNAME) ; could not be done for Drug: "_DRUGNAME_", please complete a manual check for appropriate Dosing."
.S REASON=""
.S $P(^TMP($J,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,PSSDWE2),U,7)=MESSAGE
.S $P(^(PSSDWE2),U,10)=REASON
.D:PSSDBASA
..S ^TMP($J,PSSDBASF,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,1)=MESSAGE
..S ^TMP($J,PSSDBASF,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,2)=REASON
.D:PSSDBASB
..S ^TMP($J,PSSDBASG,"OUT",PSSDWEX2,"EXCEPTIONS",1)=MESSAGE
..S ^TMP($J,PSSDBASG,"OUT",PSSDWEX2,"EXCEPTIONS",2)=REASON
.S $P(PSSDBCAR(PSSDWEX2),U,27)=1
.S FLAG=1
Q FLAG
;;
TWEAK22 ;; loop through initial entry array, look for drugs which may have not been excepted
N I,DRUGIEN,DRUGNAME,PSSDWEX2,MESSAGE,REASON
Q:'$D(PSSDBFDB)
S I=0
F S I=$O(PSSDBFDB(I)) Q:'I D
.S DRUGIEN=+$G(PSSDBFDB(I,"DRUG_IEN"))
.Q:DRUGIEN<1
.Q:$$ORTEST(DRUGIEN)=0
.S PSSDWEX2=$G(PSSDBFDB(I,"RX_NUM"))
.Q:PSSDWEX2=""
.Q:$D(^TMP($J,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWEX2)) ;; already handled by TWEAK21
.S DRUGNAME=$G(PSSDBFDB(I,"DRUG_NM"))
.Q:DRUGNAME=""
.S MESSAGE=$$CHECKMSG^PSSDSEXD(PSSDWEX2)_$$MSGEND(PSSDWEX2,DRUGNAME) ;" could not be done for Drug: "_DRUGNAME_", please complete a manual check for appropriate Dosing."
.S REASON=""
.S $P(^TMP($J,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,1),U,7)=MESSAGE
.S $P(^TMP($J,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,1),U,10)=REASON
.D:PSSDBASA
..S ^TMP($J,PSSDBASF,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,1)=MESSAGE
..S ^TMP($J,PSSDBASF,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,2)=REASON
.D:PSSDBASB
..S ^TMP($J,PSSDBASG,"OUT",PSSDWEX2,"EXCEPTIONS",1)=MESSAGE
..S ^TMP($J,PSSDBASG,"OUT",PSSDWEX2,"EXCEPTIONS",2)=REASON
.S $P(PSSDBCAR(PSSDWEX2),U,27)=1
Q
;;
TWEAK23(NODE) ;; change CPRS message on bad dose route, bad dose type
N DRUGIEN,DRUGNAME,ROUTE,MESSAGE,REASON,FLAG
S FLAG=0
D:$P(PSSDBCAR(PSSDWEX2),U,23)=1
.S DRUGNAME=$P(PSSDBCAR(PSSDWEX2),U,2)
.D:+$P(PSSDBCAR(PSSDWEX2),U,31)=0
..S $P(PSSDBCAR(PSSDWEX2),U,31)=1
..S ROUTE=$P(PSSDBCAR(PSSDWEX2),U,9)
..D:ROUTE=""
...F I=1:1 S ROUTE(I)=$G(PSSDBFDB(I,"RX_NUM")) Q:ROUTE(I)="" S ROUTE("RX_NUM",ROUTE(I))=I
...S ROUTE("I")=$G(ROUTE("RX_NUM",PSSDWEX2))
...S:+ROUTE("I") ROUTE("MR_IEN")=$G(PSSDBDS(ROUTE("I"),"MR_IEN"))
...S:+ROUTE("MR_IEN") ROUTE=$$GET1^DIQ(51.2,ROUTE("MR_IEN"),".01","E")
..S $P(PSSDBCAR(PSSDWEX2),U,32)=" for "_ROUTE_" route: "
.S MESSAGE=$$CHECKMSG^PSSDSEXD(PSSDWEX2)_$$MSGEND(PSSDWEX2,DRUGNAME) ;" could not be done for Drug: "_DRUGNAME_", please complete a manual check for appropriate Dosing."
.S REASON=""
.S $P(^TMP($J,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,PSSDWE2),U,7)=MESSAGE
.S $P(^(PSSDWE2),U,10)=REASON
.D:PSSDBASA
..S ^TMP($J,PSSDBASF,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,1)=MESSAGE
..S ^TMP($J,PSSDBASF,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,2)=REASON
.D:PSSDBASB
..S ^TMP($J,PSSDBASG,"OUT",PSSDWEX2,"EXCEPTIONS",1)=MESSAGE
..S ^TMP($J,PSSDBASG,"OUT",PSSDWEX2,"EXCEPTIONS",2)=REASON
.S $P(PSSDBCAR(PSSDWEX2),U,27)=1
.S FLAG=1
Q FLAG
;;
TWEAK24(NODE) ;; change CPRS message on bad frequency or bad frequency duration
N DRUGNAME,MESSAGE,REASON,FLAG
S FLAG=0
S REASON=$$UP^XLFSTR($P(^TMP($J,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,PSSDWE2),U,10))
D:(REASON="INVALID OR UNDEFINED FREQUENCY")!(REASON="FREQUENCY GREATER THAN ORDER DURATION")
.I $P(PSSDBCAR(PSSDWEX2),U,1)="S"&(+$P(PSSDBCAR(PSSDWEX2),U,8)=0) D Q ;;rtc#570308,#591734 ; ignore,remove frequency issues for 'single' type
..K ^TMP($J,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,PSSDWE2)
..S FLAG=1
..S $P(PSSDBCAR(PSSDWEX2),U,27)=1
.S DRUGNAME=$P(PSSDBCAR(PSSDWEX2),U,2)
.S MESSAGE="Max Daily Dose Check "_$$MSGEND(PSSDWEX2,DRUGNAME) ;could not be done for Drug: "_DRUGNAME_", please complete a manual check for appropriate Dosing."
.S REASON=""
.S $P(^(PSSDWE2),U,7)=MESSAGE
.S $P(^(PSSDWE2),U,10)=REASON
.D:PSSDBASA
..S ^TMP($J,PSSDBASF,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,1)=MESSAGE
..S ^TMP($J,PSSDBASF,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,2)=REASON
.D:PSSDBASB
..S ^TMP($J,PSSDBASG,"OUT",PSSDWEX2,"EXCEPTIONS",1)=MESSAGE
..S ^TMP($J,PSSDBASG,"OUT",PSSDWEX2,"EXCEPTIONS",2)=REASON
.S $P(PSSDBCAR(PSSDWEX2),U,27)=1
.S FLAG=1
Q FLAG
;;
TWEAK25(NODE) ;; change CPRS message on Free Text Dosage could not be evaluated
N DRUGNAME,MESSAGE,REASON,FLAG
S FLAG=0
S REASON=$$UP^XLFSTR($P(^TMP($J,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,PSSDWE2),U,10))
D:REASON="FREE TEXT DOSAGE COULD NOT BE EVALUATED"
.S DRUGNAME=$P(PSSDBCAR(PSSDWEX2),U,2)
.S MESSAGE=$$CHECKMSG^PSSDSEXD(PSSDWEX2)_$$MSGEND(PSSDWEX2,DRUGNAME) ;" could not be done for Drug: "_DRUGNAME_", please complete a manual check for appropriate Dosing."
.S REASON=""
.S $P(^(PSSDWE2),U,7)=MESSAGE
.S $P(^(PSSDWE2),U,10)=REASON
.D:PSSDBASA
..S ^TMP($J,PSSDBASF,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,1)=MESSAGE
..S ^TMP($J,PSSDBASF,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,2)=REASON
.D:PSSDBASB
..S ^TMP($J,PSSDBASG,"OUT",PSSDWEX2,"EXCEPTIONS",1)=MESSAGE
..S ^TMP($J,PSSDBASG,"OUT",PSSDWEX2,"EXCEPTIONS",2)=REASON
.S $P(PSSDBCAR(PSSDWEX2),U,27)=1
.S FLAG=1
.;;per RTC#534584;;D TWEAK25A()
Q FLAG
;;
;;TWEAK25A() ;;remove general messages when CPRS, free text error, multi-dispense drugs
;;N DRUGNAME,DRUGIEN,DRUGORI,FLAG
;;S FLAG=0
;;S DRUGNAME=$P(PSSDBCAR(PSSDWEX2),U,2)
;;S DRUGIEN=$P(PSSDBCAR(PSSDWEX2),U,3)
;;Q:(DRUGNAME="")!(DRUGIEN="")
;;S DRUGORI=$P($G(^PSDRUG(DRUGIEN,2)),U)
;;Q:DRUGORI=""
;;S DRUGORI("Top")=$O(^PSDRUG("ASP",DRUGORI,0))
;;S DRUGORI("Bottom")=$O(^PSDRUG("ASP",DRUGORI,9999999),-1)
;;D:DRUGORI("Top")'=DRUGORI("Bottom")
;;.S FLAG=1
;;.K ^TMP($J,PSSDBASE,"OUT","DOSE",PSSDWEX2,DRUGNAME,"GENERAL","MESSAGE",DRUGIEN)
;;.I PSSDBASA K ^TMP($J,PSSDBASF,"OUT","DOSE",PSSDWEX2,DRUGNAME,"3_GENERAL","MESSAGE",DRUGIEN,1)
;;.I PSSDBASB K ^TMP($J,PSSDBASG,"OUT",PSSDWEX2,"MESSAGE","3_GENERAL",DRUGIEN,1)
;;Q FLAG
;;
TWEAK26(NODE) ;; change CPRS message on Free Text Infusion Rate could not be evaluated
N DRUGNAME,MESSAGE,REASON,FLAG
S FLAG=0
S REASON=$$UP^XLFSTR($P(^TMP($J,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,PSSDWE2),U,10))
D:REASON="FREE TEXT INFUSION RATE COULD NOT BE EVALUATED"
.S DRUGNAME=$P(PSSDBCAR(PSSDWEX2),U,2)
.S MESSAGE=$$CHECKMSG^PSSDSEXD(PSSDWEX2)_$$MSGEND(PSSDWEX2,DRUGNAME) ;" could not be done for Drug: "_DRUGNAME_", please complete a manual check for appropriate Dosing."
.S REASON=""
.S $P(^(PSSDWE2),U,7)=MESSAGE
.S $P(^(PSSDWE2),U,10)=REASON
.D:PSSDBASA
..S ^TMP($J,PSSDBASF,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,1)=MESSAGE
..S ^TMP($J,PSSDBASF,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,2)=REASON
.D:PSSDBASB
..S ^TMP($J,PSSDBASG,"OUT",PSSDWEX2,"EXCEPTIONS",1)=MESSAGE
..S ^TMP($J,PSSDBASG,"OUT",PSSDWEX2,"EXCEPTIONS",2)=REASON
.S $P(PSSDBCAR(PSSDWEX2),U,27)=1
.S FLAG=1
Q FLAG
;;
TWEAK27(PSSDWLP,PSSDWL1) ;; if single type or complex, flag & scrub Max Daily warnings
N PSSDWMSG,FLAG
S FLAG=0
D:($P(PSSDBCAR(PSSDWLP),U,1)="S")!($P(PSSDBCAR(PSSDWLP),U,16)=1)
.S PSSDWMSG=$G(^TMP($J,PSSDBASE,"OUT","DOSE","ERROR",PSSDWLP,PSSDWL1,"MSG"))
.D:PSSDWMSG["Max Daily Dose Check"
..K ^TMP($J,PSSDBASE,"OUT","DOSE","ERROR",PSSDWLP,PSSDWL1)
..K:PSSDBASA ^TMP($J,PSSDBASF,"OUT","DOSE","ERROR",PSSDWLP,PSSDWL1)
..K:PSSDBASB ^TMP($J,PSSDBASG,"OUT",PSSDWLP,"ERROR",PSSDWL1)
..S $P(PSSDBCAR(PSSDWLP),U,27)=1
..S FLAG=1
Q FLAG
;;
TWEAK20(PSSDWEX2) ;; if single type CPRS call, flag & scrub Max Daily exceptions
N PSSDEMSG,FLAG
S FLAG=0
D:(PSSDSWHE=1)&($P(PSSDBCAR(PSSDWEX2),U,1)="S")&(+$P(PSSDBCAR(PSSDWEX2),U,8)=0)
.S PSSDEMSG=$G(^TMP($J,PSSDBASF,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,1))
.D:PSSDEMSG["Max Daily Dose Check"
..K ^TMP($J,PSSDBASF,"OUT","EXCEPTIONS","DOSE",PSSDWEX2)
..S $P(PSSDBCAR(PSSDWEX2),U,27)=1
..S FLAG=1
Q FLAG
;;
TWEAK28(PSSDWLP) ;; if CPRS call, alter 'Unable to convert' errors to generic
N PSSDWCNT,PSSDWMSG,PSSDWRSN,FLAG
S FLAG=0
S PSSDWCNT=0
F S PSSDWCNT=$O(^TMP($J,PSSDBASF,"OUT","DOSE","ERROR",PSSDWLP,PSSDWCNT)) Q:'PSSDWCNT D
.S PSSDWRSN=$G(^TMP($J,PSSDBASF,"OUT","DOSE","ERROR",PSSDWLP,PSSDWCNT,"TEXT"))
.D:PSSDWRSN["Unable to convert units"
..S PSSDWMSG=$$CHECKMSG^PSSDSEXD(PSSDWLP)_$$MSGEND(PSSDWLP,$P(PSSDBCAR(PSSDWLP),U,2))
..S PSSDWRSN=""
..S ^TMP($J,PSSDBASF,"OUT","DOSE","ERROR",PSSDWLP,PSSDWCNT,"MSG")=PSSDWMSG
..S ^TMP($J,PSSDBASF,"OUT","DOSE","ERROR",PSSDWLP,PSSDWCNT,"TEXT")=PSSDWRSN
..D:(PSSDWMSG["Dosing Checks")&(PSSDWCNT=1)
...F S PSSDWCNT=$O(^TMP($J,PSSDBASF,"OUT","DOSE","ERROR",PSSDWLP,PSSDWCNT)) Q:'PSSDWCNT D
....K ^TMP($J,PSSDBASF,"OUT","DOSE","ERROR",PSSDWLP,PSSDWCNT)
..S $P(PSSDBCAR(PSSDWLP),U,27)=1
..S FLAG=1
Q FLAG
;;
TWEAK29(PSSDWLP) ;; if CPRS call, alter 'No dosing information' errors to generic
N PSSDWCNT,PSSDWMSG,PSSDWRSN,FLAG
S FLAG=0
S PSSDWCNT=0
F S PSSDWCNT=$O(^TMP($J,PSSDBASF,"OUT","DOSE","ERROR",PSSDWLP,PSSDWCNT)) Q:'PSSDWCNT D
.S PSSDWRSN=$G(^TMP($J,PSSDBASF,"OUT","DOSE","ERROR",PSSDWLP,PSSDWCNT,"TEXT"))
.D:PSSDWRSN["No dosing information specific to"
..S PSSDWMSG=$$CHECKMSG^PSSDSEXD(PSSDWLP)_$$ROUTEMSG(PSSDWLP,$P(PSSDBCAR(PSSDWLP),U,2))
..S PSSDWRSN=""
..S ^TMP($J,PSSDBASF,"OUT","DOSE","ERROR",PSSDWLP,PSSDWCNT,"MSG")=PSSDWMSG
..S ^TMP($J,PSSDBASF,"OUT","DOSE","ERROR",PSSDWLP,PSSDWCNT,"TEXT")=PSSDWRSN
..D:(PSSDWMSG["Dosing Checks")&(PSSDWCNT=1)
...F S PSSDWCNT=$O(^TMP($J,PSSDBASF,"OUT","DOSE","ERROR",PSSDWLP,PSSDWCNT)) Q:'PSSDWCNT D
....K ^TMP($J,PSSDBASF,"OUT","DOSE","ERROR",PSSDWLP,PSSDWCNT)
..S $P(PSSDBCAR(PSSDWLP),U,27)=1
..S FLAG=1
Q FLAG
;;
TWEAK29A(PSSDWEX2) ;; ensure no age warnings for Max Single for excluded from daily
N PSSDWE2,PSSDEMSG,PSSREPL,FLAG
S FLAG=0
S PSSDWE2=0
F S PSSDWE2=$O(^TMP($J,PSSDBASF,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,PSSDWE2)) Q:'PSSDWE2 D
.D:($P(PSSDBCAR(PSSDWEX2),U,15)=1)&($P(PSSDBCAR(PSSDWEX2),U,19)=1)
..S PSSDEMSG=^TMP($J,PSSDBASF,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,PSSDWE2)
..D:PSSDEMSG["Dosing checks"
...S PSSREPL("Dosing checks")="Maximum Single Dose Check"
...S PSSDEMSG=$$REPLACE^XLFSTR(PSSDEMSG,.PSSREPL)
...S ^TMP($J,PSSDBASF,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,PSSDWE2)=PSSDEMSG
...S $P(PSSDBCAR(PSSDWEX2),U,27)=1
...S FLAG=1
Q FLAG
;;
ORTEST(DRUGIEN) ;; return 1 if Orderable Item is inactive
N ITEMIEN,ITEMINCT
S DRUGIEN=+$G(DRUGIEN)
Q:'$D(^PSDRUG(DRUGIEN)) 0
S ITEMIEN=$$GET1^DIQ(50,DRUGIEN,2.1,"I")
Q:ITEMIEN="" 0
S ITEMINCT=$$GET1^DIQ(50.7,ITEMIEN,.04,"I")
Q:ITEMINCT="" 0
Q $S(ITEMINCT>DT:0,1:1)
;;
MSGEND(PSSDWEX2,DRUGNAME) ;; build end of message, add dose to drugname if necessary, add route information if necessary
N RESULT
S:$$ISCMPLEX^PSSDSEXD(PSSDWEX2)=1 DRUGNAME=DRUGNAME_"(Dose="_$G(PSSDSDPL(PSSDWEX2))_")"
Q $$ROUTEMSG(PSSDWEX2,DRUGNAME)
;;
ROUTEMSG(PSSDWEX2,DRUGNAME) ;; build end of message, add route information if necessary
N RESULT
S:+$P(PSSDBCAR(PSSDWEX2),U,31)=1 DRUGNAME=DRUGNAME_$P($P(PSSDBCAR(PSSDWEX2),U,32),":")
S RESULT=" could not be done for Drug: "_DRUGNAME_", please complete a manual check for appropriate Dosing."
Q RESULT
;;
TWEAK4 ;; loop through error global, set piece 34 and 35 of PSSDBCAR array when piece 1="B"
N PSSDWE5,PSSDWDRG,PSSDWIEN
S PSSDWE5=""
F S PSSDWE5=$O(^TMP($J,PSSDBASE,"OUT","DOSE",PSSDWE5)) Q:PSSDWE5="" I $D(PSSDBCAR(PSSDWE5)),'$P(PSSDBCAR(PSSDWE5),"^",14),$P(PSSDBCAR(PSSDWE5),"^",1)="B" D ;2.1 piece 14 check added
.S PSSDWDRG=$P(PSSDBCAR(PSSDWE5),"^",2),PSSDWIEN=$P(PSSDBCAR(PSSDWE5),"^",3) Q:PSSDWDRG=""!('PSSDWIEN)
.I $G(^TMP($J,PSSDBASE,"OUT","DOSE",PSSDWE5,PSSDWDRG,"SINGLE","STATUSCODE",PSSDWIEN))=5 S $P(PSSDBCAR(PSSDWE5),"^",34)=1
.I $G(^TMP($J,PSSDBASE,"OUT","DOSE",PSSDWE5,PSSDWDRG,"DAILYMAX","STATUSCODE",PSSDWIEN))=5 S $P(PSSDBCAR(PSSDWE5),"^",35)=1
Q
;;
ISCMPLET(PSSLOOP) ;; is completed
N PSSP1
S PSSP1=$P(PSSDBCAR(PSSLOOP),U,1)
Q $S(PSSP1="S":"Maximum Single Dose Check",PSSP1="D":"Max Daily Dose Check",1:$$ISCMPLEB(PSSLOOP))
;;
ISCMPLEB(PSSLOOP) ;; is completed, both attempted, did both finish?
N PSSP15,PSSP33,PSSP34,PSSP35
S PSSP15=+$P(PSSDBCAR(PSSLOOP),U,15)
S PSSP33=+$P(PSSDBCAR(PSSLOOP),U,33)
S PSSP34=+$P(PSSDBCAR(PSSLOOP),U,34)
S PSSP35=+$P(PSSDBCAR(PSSLOOP),U,35)
Q:(PSSP15=1)!((PSSP34=1)&(PSSP35=0)&(PSSP33=0)) "Maximum Single Dose Check"
Q:(PSSP35=1)&(PSSP34=0)&(PSSP33=0) "Max Daily Dose Check"
Q "Dosing Checks"
;;
GETGNRL3(PSSDWEX2) ;; ensure General Dosing set if intermittent + bad frequency
N DRUGNAME,DRUGIEN,MESSAGE
S DRUGNAME=$P(PSSDBCAR(PSSDWEX2),U,2)
S DRUGIEN=$P(PSSDBCAR(PSSDWEX2),U,3)
Q:(DRUGNAME="")!(DRUGIEN="")
D:'$D(^TMP($J,PSSDBASE,"OUT","DOSE",PSSDWEX2,DRUGNAME,"GENERAL","MESSAGE",DRUGIEN))
.K ^TMP($J,"PSSDSEXD")
.M ^TMP($J,"PSSDSEXD","IN")=^TMP($J,PSSDBASE,"IN")
.S $P(^TMP($J,"PSSDSEXD","IN","DOSE",PSSDWEX2),U,10)=$P(^TMP($J,"PSSDSEXD","IN","DOSE",PSSDWEX2),U,8) ; duration rate = dose rate
.S $P(^TMP($J,"PSSDSEXD","IN","DOSE",PSSDWEX2),U,8)=1 ;; frequency
.S $P(^TMP($J,"PSSDSEXD","IN","DOSE",PSSDWEX2),U,9)=1 ;; duration
.D IN^PSSHRQ2("PSSDSEXD")
.Q:$D(^TMP($J,"PSSDSEXD","OUT","EXCEPTIONS"))
.S ^TMP($J,PSSDBASE,"OUT","DOSE",PSSDWEX2,DRUGNAME,"GENERAL","MESSAGE",DRUGIEN)=^TMP($J,"PSSDSEXD","OUT","DOSE",PSSDWEX2,DRUGNAME,"GENERAL","MESSAGE",DRUGIEN)
I $D(^TMP($J,"PSSDSEXD","OUT","EXCEPTIONS")) K ^TMP($J,"PSSDSEXD") Q
S MESSAGE=^TMP($J,PSSDBASE,"OUT","DOSE",PSSDWEX2,DRUGNAME,"GENERAL","MESSAGE",DRUGIEN)
I PSSDBASA S ^TMP($J,PSSDBASF,"OUT","DOSE",PSSDWEX2,DRUGNAME,"3_GENERAL","MESSAGE",DRUGIEN,1)=MESSAGE
I PSSDBASB S ^TMP($J,PSSDBASG,"OUT",PSSDWEX2,"MESSAGE","3_GENERAL",DRUGIEN,1)=MESSAGE
K ^TMP($J,"PSSDSEXD")
Q
;;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSDSEXE 15354 printed Oct 16, 2024@18:32:01 Page 2
PSSDSEXE ;BIR/CMF-Exceptions for Dose call Continuation ;02/24/09
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**178,206,224**;9/30/97;Build 3
+2 ;
+3 ;Called from PSSDSEXD, this routine takes the results from the call to First DataBank and creates displayable TMP
+4 ;globals for the calling applications. Typically, PSSDBASA indicates a CPRS call, and PSSDBASB indicates a pharmacy call
+5 ;
+6 ;PSSDBCAR ARRAY pieces, set mostly in PSSDSAPD are described in PSSDSEXC:
+7 ;
+8 ;PSSDBCAX holds the errors to show
+9 ;
TWEAK2 ;; loop through exception then error globals, look for OR related tweaks
+1 NEW PSSDWEX2,PSSDWE2,PSSDWLP,NODE
+2 SET PSSDWEX2=""
+3 FOR
SET PSSDWEX2=$ORDER(^TMP($JOB,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWEX2))
if PSSDWEX2=""
QUIT
Begin DoDot:1
+4 SET PSSDWE2=""
+5 FOR
SET PSSDWE2=$ORDER(^TMP($JOB,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,PSSDWE2))
if PSSDWE2=""
QUIT
Begin DoDot:2
+6 SET NODE=$GET(^TMP($JOB,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,PSSDWE2))
+7 if NODE=""
QUIT
+8 if $$TWEAK20(PSSDWEX2)
QUIT
+9 if $$TWEAK21(NODE)
QUIT
+10 if $$TWEAK23(NODE)
QUIT
+11 if $$TWEAK24(NODE)
QUIT
+12 if $$TWEAK25(NODE)
QUIT
+13 if $$TWEAK26(NODE)
QUIT
+14 if $$TWEAK29A(PSSDWEX2)
QUIT
End DoDot:2
End DoDot:1
+15 DO TWEAK22
+16 SET PSSDWLP=""
+17 FOR
SET PSSDWLP=$ORDER(^TMP($JOB,PSSDBASF,"OUT","DOSE","ERROR",PSSDWLP))
if PSSDWLP=""
QUIT
Begin DoDot:1
+18 if $$TWEAK28(PSSDWLP)
QUIT
+19 if $$TWEAK29(PSSDWLP)
QUIT
End DoDot:1
+20 DO TWEAK200^PSSDSEXF
+21 QUIT
+22 ;;
TWEAK21(NODE) ;; test for OR inactive drug
+1 NEW DRUGIEN,DRUGNAME,MESSAGE,REASON,FLAG
+2 SET FLAG=0
+3 SET DRUGIEN=$PIECE(PSSDBCAR(PSSDWEX2),U,3)
+4 if $$ORTEST(DRUGIEN)=1
Begin DoDot:1
+5 SET DRUGNAME=$PIECE(PSSDBCAR(PSSDWEX2),U,2)
+6 ; could not be done for Drug: "_DRUGNAME_", please complete a manual check for appropriate Dosing."
SET MESSAGE=$$CHECKMSG^PSSDSEXD(PSSDWEX2)_$$MSGEND(PSSDWEX2,DRUGNAME)
+7 SET REASON=""
+8 SET $PIECE(^TMP($JOB,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,PSSDWE2),U,7)=MESSAGE
+9 SET $PIECE(^(PSSDWE2),U,10)=REASON
+10 if PSSDBASA
Begin DoDot:2
+11 SET ^TMP($JOB,PSSDBASF,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,1)=MESSAGE
+12 SET ^TMP($JOB,PSSDBASF,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,2)=REASON
End DoDot:2
+13 if PSSDBASB
Begin DoDot:2
+14 SET ^TMP($JOB,PSSDBASG,"OUT",PSSDWEX2,"EXCEPTIONS",1)=MESSAGE
+15 SET ^TMP($JOB,PSSDBASG,"OUT",PSSDWEX2,"EXCEPTIONS",2)=REASON
End DoDot:2
+16 SET $PIECE(PSSDBCAR(PSSDWEX2),U,27)=1
+17 SET FLAG=1
End DoDot:1
+18 QUIT FLAG
+19 ;;
TWEAK22 ;; loop through initial entry array, look for drugs which may have not been excepted
+1 NEW I,DRUGIEN,DRUGNAME,PSSDWEX2,MESSAGE,REASON
+2 if '$DATA(PSSDBFDB)
QUIT
+3 SET I=0
+4 FOR
SET I=$ORDER(PSSDBFDB(I))
if 'I
QUIT
Begin DoDot:1
+5 SET DRUGIEN=+$GET(PSSDBFDB(I,"DRUG_IEN"))
+6 if DRUGIEN<1
QUIT
+7 if $$ORTEST(DRUGIEN)=0
QUIT
+8 SET PSSDWEX2=$GET(PSSDBFDB(I,"RX_NUM"))
+9 if PSSDWEX2=""
QUIT
+10 ;; already handled by TWEAK21
if $DATA(^TMP($JOB,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWEX2))
QUIT
+11 SET DRUGNAME=$GET(PSSDBFDB(I,"DRUG_NM"))
+12 if DRUGNAME=""
QUIT
+13 ;" could not be done for Drug: "_DRUGNAME_", please complete a manual check for appropriate Dosing."
SET MESSAGE=$$CHECKMSG^PSSDSEXD(PSSDWEX2)_$$MSGEND(PSSDWEX2,DRUGNAME)
+14 SET REASON=""
+15 SET $PIECE(^TMP($JOB,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,1),U,7)=MESSAGE
+16 SET $PIECE(^TMP($JOB,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,1),U,10)=REASON
+17 if PSSDBASA
Begin DoDot:2
+18 SET ^TMP($JOB,PSSDBASF,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,1)=MESSAGE
+19 SET ^TMP($JOB,PSSDBASF,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,2)=REASON
End DoDot:2
+20 if PSSDBASB
Begin DoDot:2
+21 SET ^TMP($JOB,PSSDBASG,"OUT",PSSDWEX2,"EXCEPTIONS",1)=MESSAGE
+22 SET ^TMP($JOB,PSSDBASG,"OUT",PSSDWEX2,"EXCEPTIONS",2)=REASON
End DoDot:2
+23 SET $PIECE(PSSDBCAR(PSSDWEX2),U,27)=1
End DoDot:1
+24 QUIT
+25 ;;
TWEAK23(NODE) ;; change CPRS message on bad dose route, bad dose type
+1 NEW DRUGIEN,DRUGNAME,ROUTE,MESSAGE,REASON,FLAG
+2 SET FLAG=0
+3 if $PIECE(PSSDBCAR(PSSDWEX2),U,23)=1
Begin DoDot:1
+4 SET DRUGNAME=$PIECE(PSSDBCAR(PSSDWEX2),U,2)
+5 if +$PIECE(PSSDBCAR(PSSDWEX2),U,31)=0
Begin DoDot:2
+6 SET $PIECE(PSSDBCAR(PSSDWEX2),U,31)=1
+7 SET ROUTE=$PIECE(PSSDBCAR(PSSDWEX2),U,9)
+8 if ROUTE=""
Begin DoDot:3
+9 FOR I=1:1
SET ROUTE(I)=$GET(PSSDBFDB(I,"RX_NUM"))
if ROUTE(I)=""
QUIT
SET ROUTE("RX_NUM",ROUTE(I))=I
+10 SET ROUTE("I")=$GET(ROUTE("RX_NUM",PSSDWEX2))
+11 if +ROUTE("I")
SET ROUTE("MR_IEN")=$GET(PSSDBDS(ROUTE("I"),"MR_IEN"))
+12 if +ROUTE("MR_IEN")
SET ROUTE=$$GET1^DIQ(51.2,ROUTE("MR_IEN"),".01","E")
End DoDot:3
+13 SET $PIECE(PSSDBCAR(PSSDWEX2),U,32)=" for "_ROUTE_" route: "
End DoDot:2
+14 ;" could not be done for Drug: "_DRUGNAME_", please complete a manual check for appropriate Dosing."
SET MESSAGE=$$CHECKMSG^PSSDSEXD(PSSDWEX2)_$$MSGEND(PSSDWEX2,DRUGNAME)
+15 SET REASON=""
+16 SET $PIECE(^TMP($JOB,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,PSSDWE2),U,7)=MESSAGE
+17 SET $PIECE(^(PSSDWE2),U,10)=REASON
+18 if PSSDBASA
Begin DoDot:2
+19 SET ^TMP($JOB,PSSDBASF,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,1)=MESSAGE
+20 SET ^TMP($JOB,PSSDBASF,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,2)=REASON
End DoDot:2
+21 if PSSDBASB
Begin DoDot:2
+22 SET ^TMP($JOB,PSSDBASG,"OUT",PSSDWEX2,"EXCEPTIONS",1)=MESSAGE
+23 SET ^TMP($JOB,PSSDBASG,"OUT",PSSDWEX2,"EXCEPTIONS",2)=REASON
End DoDot:2
+24 SET $PIECE(PSSDBCAR(PSSDWEX2),U,27)=1
+25 SET FLAG=1
End DoDot:1
+26 QUIT FLAG
+27 ;;
TWEAK24(NODE) ;; change CPRS message on bad frequency or bad frequency duration
+1 NEW DRUGNAME,MESSAGE,REASON,FLAG
+2 SET FLAG=0
+3 SET REASON=$$UP^XLFSTR($PIECE(^TMP($JOB,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,PSSDWE2),U,10))
+4 if (REASON="INVALID OR UNDEFINED FREQUENCY")!(REASON="FREQUENCY GREATER THAN ORDER DURATION")
Begin DoDot:1
+5 ;;rtc#570308,#591734 ; ignore,remove frequency issues for 'single' type
IF $PIECE(PSSDBCAR(PSSDWEX2),U,1)="S"&(+$PIECE(PSSDBCAR(PSSDWEX2),U,8)=0)
Begin DoDot:2
+6 KILL ^TMP($JOB,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,PSSDWE2)
+7 SET FLAG=1
+8 SET $PIECE(PSSDBCAR(PSSDWEX2),U,27)=1
End DoDot:2
QUIT
+9 SET DRUGNAME=$PIECE(PSSDBCAR(PSSDWEX2),U,2)
+10 ;could not be done for Drug: "_DRUGNAME_", please complete a manual check for appropriate Dosing."
SET MESSAGE="Max Daily Dose Check "_$$MSGEND(PSSDWEX2,DRUGNAME)
+11 SET REASON=""
+12 SET $PIECE(^(PSSDWE2),U,7)=MESSAGE
+13 SET $PIECE(^(PSSDWE2),U,10)=REASON
+14 if PSSDBASA
Begin DoDot:2
+15 SET ^TMP($JOB,PSSDBASF,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,1)=MESSAGE
+16 SET ^TMP($JOB,PSSDBASF,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,2)=REASON
End DoDot:2
+17 if PSSDBASB
Begin DoDot:2
+18 SET ^TMP($JOB,PSSDBASG,"OUT",PSSDWEX2,"EXCEPTIONS",1)=MESSAGE
+19 SET ^TMP($JOB,PSSDBASG,"OUT",PSSDWEX2,"EXCEPTIONS",2)=REASON
End DoDot:2
+20 SET $PIECE(PSSDBCAR(PSSDWEX2),U,27)=1
+21 SET FLAG=1
End DoDot:1
+22 QUIT FLAG
+23 ;;
TWEAK25(NODE) ;; change CPRS message on Free Text Dosage could not be evaluated
+1 NEW DRUGNAME,MESSAGE,REASON,FLAG
+2 SET FLAG=0
+3 SET REASON=$$UP^XLFSTR($PIECE(^TMP($JOB,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,PSSDWE2),U,10))
+4 if REASON="FREE TEXT DOSAGE COULD NOT BE EVALUATED"
Begin DoDot:1
+5 SET DRUGNAME=$PIECE(PSSDBCAR(PSSDWEX2),U,2)
+6 ;" could not be done for Drug: "_DRUGNAME_", please complete a manual check for appropriate Dosing."
SET MESSAGE=$$CHECKMSG^PSSDSEXD(PSSDWEX2)_$$MSGEND(PSSDWEX2,DRUGNAME)
+7 SET REASON=""
+8 SET $PIECE(^(PSSDWE2),U,7)=MESSAGE
+9 SET $PIECE(^(PSSDWE2),U,10)=REASON
+10 if PSSDBASA
Begin DoDot:2
+11 SET ^TMP($JOB,PSSDBASF,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,1)=MESSAGE
+12 SET ^TMP($JOB,PSSDBASF,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,2)=REASON
End DoDot:2
+13 if PSSDBASB
Begin DoDot:2
+14 SET ^TMP($JOB,PSSDBASG,"OUT",PSSDWEX2,"EXCEPTIONS",1)=MESSAGE
+15 SET ^TMP($JOB,PSSDBASG,"OUT",PSSDWEX2,"EXCEPTIONS",2)=REASON
End DoDot:2
+16 SET $PIECE(PSSDBCAR(PSSDWEX2),U,27)=1
+17 SET FLAG=1
+18 ;;per RTC#534584;;D TWEAK25A()
End DoDot:1
+19 QUIT FLAG
+20 ;;
+21 ;;TWEAK25A() ;;remove general messages when CPRS, free text error, multi-dispense drugs
+22 ;;N DRUGNAME,DRUGIEN,DRUGORI,FLAG
+23 ;;S FLAG=0
+24 ;;S DRUGNAME=$P(PSSDBCAR(PSSDWEX2),U,2)
+25 ;;S DRUGIEN=$P(PSSDBCAR(PSSDWEX2),U,3)
+26 ;;Q:(DRUGNAME="")!(DRUGIEN="")
+27 ;;S DRUGORI=$P($G(^PSDRUG(DRUGIEN,2)),U)
+28 ;;Q:DRUGORI=""
+29 ;;S DRUGORI("Top")=$O(^PSDRUG("ASP",DRUGORI,0))
+30 ;;S DRUGORI("Bottom")=$O(^PSDRUG("ASP",DRUGORI,9999999),-1)
+31 ;;D:DRUGORI("Top")'=DRUGORI("Bottom")
+32 ;;.S FLAG=1
+33 ;;.K ^TMP($J,PSSDBASE,"OUT","DOSE",PSSDWEX2,DRUGNAME,"GENERAL","MESSAGE",DRUGIEN)
+34 ;;.I PSSDBASA K ^TMP($J,PSSDBASF,"OUT","DOSE",PSSDWEX2,DRUGNAME,"3_GENERAL","MESSAGE",DRUGIEN,1)
+35 ;;.I PSSDBASB K ^TMP($J,PSSDBASG,"OUT",PSSDWEX2,"MESSAGE","3_GENERAL",DRUGIEN,1)
+36 ;;Q FLAG
+37 ;;
TWEAK26(NODE) ;; change CPRS message on Free Text Infusion Rate could not be evaluated
+1 NEW DRUGNAME,MESSAGE,REASON,FLAG
+2 SET FLAG=0
+3 SET REASON=$$UP^XLFSTR($PIECE(^TMP($JOB,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,PSSDWE2),U,10))
+4 if REASON="FREE TEXT INFUSION RATE COULD NOT BE EVALUATED"
Begin DoDot:1
+5 SET DRUGNAME=$PIECE(PSSDBCAR(PSSDWEX2),U,2)
+6 ;" could not be done for Drug: "_DRUGNAME_", please complete a manual check for appropriate Dosing."
SET MESSAGE=$$CHECKMSG^PSSDSEXD(PSSDWEX2)_$$MSGEND(PSSDWEX2,DRUGNAME)
+7 SET REASON=""
+8 SET $PIECE(^(PSSDWE2),U,7)=MESSAGE
+9 SET $PIECE(^(PSSDWE2),U,10)=REASON
+10 if PSSDBASA
Begin DoDot:2
+11 SET ^TMP($JOB,PSSDBASF,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,1)=MESSAGE
+12 SET ^TMP($JOB,PSSDBASF,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,2)=REASON
End DoDot:2
+13 if PSSDBASB
Begin DoDot:2
+14 SET ^TMP($JOB,PSSDBASG,"OUT",PSSDWEX2,"EXCEPTIONS",1)=MESSAGE
+15 SET ^TMP($JOB,PSSDBASG,"OUT",PSSDWEX2,"EXCEPTIONS",2)=REASON
End DoDot:2
+16 SET $PIECE(PSSDBCAR(PSSDWEX2),U,27)=1
+17 SET FLAG=1
End DoDot:1
+18 QUIT FLAG
+19 ;;
TWEAK27(PSSDWLP,PSSDWL1) ;; if single type or complex, flag & scrub Max Daily warnings
+1 NEW PSSDWMSG,FLAG
+2 SET FLAG=0
+3 if ($PIECE(PSSDBCAR(PSSDWLP),U,1)="S")!($PIECE(PSSDBCAR(PSSDWLP),U,16)=1)
Begin DoDot:1
+4 SET PSSDWMSG=$GET(^TMP($JOB,PSSDBASE,"OUT","DOSE","ERROR",PSSDWLP,PSSDWL1,"MSG"))
+5 if PSSDWMSG["Max Daily Dose Check"
Begin DoDot:2
+6 KILL ^TMP($JOB,PSSDBASE,"OUT","DOSE","ERROR",PSSDWLP,PSSDWL1)
+7 if PSSDBASA
KILL ^TMP($JOB,PSSDBASF,"OUT","DOSE","ERROR",PSSDWLP,PSSDWL1)
+8 if PSSDBASB
KILL ^TMP($JOB,PSSDBASG,"OUT",PSSDWLP,"ERROR",PSSDWL1)
+9 SET $PIECE(PSSDBCAR(PSSDWLP),U,27)=1
+10 SET FLAG=1
End DoDot:2
End DoDot:1
+11 QUIT FLAG
+12 ;;
TWEAK20(PSSDWEX2) ;; if single type CPRS call, flag & scrub Max Daily exceptions
+1 NEW PSSDEMSG,FLAG
+2 SET FLAG=0
+3 if (PSSDSWHE=1)&($PIECE(PSSDBCAR(PSSDWEX2),U,1)="S")&(+$PIECE(PSSDBCAR(PSSDWEX2),U,8)=0)
Begin DoDot:1
+4 SET PSSDEMSG=$GET(^TMP($JOB,PSSDBASF,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,1))
+5 if PSSDEMSG["Max Daily Dose Check"
Begin DoDot:2
+6 KILL ^TMP($JOB,PSSDBASF,"OUT","EXCEPTIONS","DOSE",PSSDWEX2)
+7 SET $PIECE(PSSDBCAR(PSSDWEX2),U,27)=1
+8 SET FLAG=1
End DoDot:2
End DoDot:1
+9 QUIT FLAG
+10 ;;
TWEAK28(PSSDWLP) ;; if CPRS call, alter 'Unable to convert' errors to generic
+1 NEW PSSDWCNT,PSSDWMSG,PSSDWRSN,FLAG
+2 SET FLAG=0
+3 SET PSSDWCNT=0
+4 FOR
SET PSSDWCNT=$ORDER(^TMP($JOB,PSSDBASF,"OUT","DOSE","ERROR",PSSDWLP,PSSDWCNT))
if 'PSSDWCNT
QUIT
Begin DoDot:1
+5 SET PSSDWRSN=$GET(^TMP($JOB,PSSDBASF,"OUT","DOSE","ERROR",PSSDWLP,PSSDWCNT,"TEXT"))
+6 if PSSDWRSN["Unable to convert units"
Begin DoDot:2
+7 SET PSSDWMSG=$$CHECKMSG^PSSDSEXD(PSSDWLP)_$$MSGEND(PSSDWLP,$PIECE(PSSDBCAR(PSSDWLP),U,2))
+8 SET PSSDWRSN=""
+9 SET ^TMP($JOB,PSSDBASF,"OUT","DOSE","ERROR",PSSDWLP,PSSDWCNT,"MSG")=PSSDWMSG
+10 SET ^TMP($JOB,PSSDBASF,"OUT","DOSE","ERROR",PSSDWLP,PSSDWCNT,"TEXT")=PSSDWRSN
+11 if (PSSDWMSG["Dosing Checks")&(PSSDWCNT=1)
Begin DoDot:3
+12 FOR
SET PSSDWCNT=$ORDER(^TMP($JOB,PSSDBASF,"OUT","DOSE","ERROR",PSSDWLP,PSSDWCNT))
if 'PSSDWCNT
QUIT
Begin DoDot:4
+13 KILL ^TMP($JOB,PSSDBASF,"OUT","DOSE","ERROR",PSSDWLP,PSSDWCNT)
End DoDot:4
End DoDot:3
+14 SET $PIECE(PSSDBCAR(PSSDWLP),U,27)=1
+15 SET FLAG=1
End DoDot:2
End DoDot:1
+16 QUIT FLAG
+17 ;;
TWEAK29(PSSDWLP) ;; if CPRS call, alter 'No dosing information' errors to generic
+1 NEW PSSDWCNT,PSSDWMSG,PSSDWRSN,FLAG
+2 SET FLAG=0
+3 SET PSSDWCNT=0
+4 FOR
SET PSSDWCNT=$ORDER(^TMP($JOB,PSSDBASF,"OUT","DOSE","ERROR",PSSDWLP,PSSDWCNT))
if 'PSSDWCNT
QUIT
Begin DoDot:1
+5 SET PSSDWRSN=$GET(^TMP($JOB,PSSDBASF,"OUT","DOSE","ERROR",PSSDWLP,PSSDWCNT,"TEXT"))
+6 if PSSDWRSN["No dosing information specific to"
Begin DoDot:2
+7 SET PSSDWMSG=$$CHECKMSG^PSSDSEXD(PSSDWLP)_$$ROUTEMSG(PSSDWLP,$PIECE(PSSDBCAR(PSSDWLP),U,2))
+8 SET PSSDWRSN=""
+9 SET ^TMP($JOB,PSSDBASF,"OUT","DOSE","ERROR",PSSDWLP,PSSDWCNT,"MSG")=PSSDWMSG
+10 SET ^TMP($JOB,PSSDBASF,"OUT","DOSE","ERROR",PSSDWLP,PSSDWCNT,"TEXT")=PSSDWRSN
+11 if (PSSDWMSG["Dosing Checks")&(PSSDWCNT=1)
Begin DoDot:3
+12 FOR
SET PSSDWCNT=$ORDER(^TMP($JOB,PSSDBASF,"OUT","DOSE","ERROR",PSSDWLP,PSSDWCNT))
if 'PSSDWCNT
QUIT
Begin DoDot:4
+13 KILL ^TMP($JOB,PSSDBASF,"OUT","DOSE","ERROR",PSSDWLP,PSSDWCNT)
End DoDot:4
End DoDot:3
+14 SET $PIECE(PSSDBCAR(PSSDWLP),U,27)=1
+15 SET FLAG=1
End DoDot:2
End DoDot:1
+16 QUIT FLAG
+17 ;;
TWEAK29A(PSSDWEX2) ;; ensure no age warnings for Max Single for excluded from daily
+1 NEW PSSDWE2,PSSDEMSG,PSSREPL,FLAG
+2 SET FLAG=0
+3 SET PSSDWE2=0
+4 FOR
SET PSSDWE2=$ORDER(^TMP($JOB,PSSDBASF,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,PSSDWE2))
if 'PSSDWE2
QUIT
Begin DoDot:1
+5 if ($PIECE(PSSDBCAR(PSSDWEX2),U,15)=1)&($PIECE(PSSDBCAR(PSSDWEX2),U,19)=1)
Begin DoDot:2
+6 SET PSSDEMSG=^TMP($JOB,PSSDBASF,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,PSSDWE2)
+7 if PSSDEMSG["Dosing checks"
Begin DoDot:3
+8 SET PSSREPL("Dosing checks")="Maximum Single Dose Check"
+9 SET PSSDEMSG=$$REPLACE^XLFSTR(PSSDEMSG,.PSSREPL)
+10 SET ^TMP($JOB,PSSDBASF,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,PSSDWE2)=PSSDEMSG
+11 SET $PIECE(PSSDBCAR(PSSDWEX2),U,27)=1
+12 SET FLAG=1
End DoDot:3
End DoDot:2
End DoDot:1
+13 QUIT FLAG
+14 ;;
ORTEST(DRUGIEN) ;; return 1 if Orderable Item is inactive
+1 NEW ITEMIEN,ITEMINCT
+2 SET DRUGIEN=+$GET(DRUGIEN)
+3 if '$DATA(^PSDRUG(DRUGIEN))
QUIT 0
+4 SET ITEMIEN=$$GET1^DIQ(50,DRUGIEN,2.1,"I")
+5 if ITEMIEN=""
QUIT 0
+6 SET ITEMINCT=$$GET1^DIQ(50.7,ITEMIEN,.04,"I")
+7 if ITEMINCT=""
QUIT 0
+8 QUIT $SELECT(ITEMINCT>DT:0,1:1)
+9 ;;
MSGEND(PSSDWEX2,DRUGNAME) ;; build end of message, add dose to drugname if necessary, add route information if necessary
+1 NEW RESULT
+2 if $$ISCMPLEX^PSSDSEXD(PSSDWEX2)=1
SET DRUGNAME=DRUGNAME_"(Dose="_$GET(PSSDSDPL(PSSDWEX2))_")"
+3 QUIT $$ROUTEMSG(PSSDWEX2,DRUGNAME)
+4 ;;
ROUTEMSG(PSSDWEX2,DRUGNAME) ;; build end of message, add route information if necessary
+1 NEW RESULT
+2 if +$PIECE(PSSDBCAR(PSSDWEX2),U,31)=1
SET DRUGNAME=DRUGNAME_$PIECE($PIECE(PSSDBCAR(PSSDWEX2),U,32),":")
+3 SET RESULT=" could not be done for Drug: "_DRUGNAME_", please complete a manual check for appropriate Dosing."
+4 QUIT RESULT
+5 ;;
TWEAK4 ;; loop through error global, set piece 34 and 35 of PSSDBCAR array when piece 1="B"
+1 NEW PSSDWE5,PSSDWDRG,PSSDWIEN
+2 SET PSSDWE5=""
+3 ;2.1 piece 14 check added
FOR
SET PSSDWE5=$ORDER(^TMP($JOB,PSSDBASE,"OUT","DOSE",PSSDWE5))
if PSSDWE5=""
QUIT
IF $DATA(PSSDBCAR(PSSDWE5))
IF '$PIECE(PSSDBCAR(PSSDWE5),"^",14)
IF $PIECE(PSSDBCAR(PSSDWE5),"^",1)="B"
Begin DoDot:1
+4 SET PSSDWDRG=$PIECE(PSSDBCAR(PSSDWE5),"^",2)
SET PSSDWIEN=$PIECE(PSSDBCAR(PSSDWE5),"^",3)
if PSSDWDRG=""!('PSSDWIEN)
QUIT
+5 IF $GET(^TMP($JOB,PSSDBASE,"OUT","DOSE",PSSDWE5,PSSDWDRG,"SINGLE","STATUSCODE",PSSDWIEN))=5
SET $PIECE(PSSDBCAR(PSSDWE5),"^",34)=1
+6 IF $GET(^TMP($JOB,PSSDBASE,"OUT","DOSE",PSSDWE5,PSSDWDRG,"DAILYMAX","STATUSCODE",PSSDWIEN))=5
SET $PIECE(PSSDBCAR(PSSDWE5),"^",35)=1
End DoDot:1
+7 QUIT
+8 ;;
ISCMPLET(PSSLOOP) ;; is completed
+1 NEW PSSP1
+2 SET PSSP1=$PIECE(PSSDBCAR(PSSLOOP),U,1)
+3 QUIT $SELECT(PSSP1="S":"Maximum Single Dose Check",PSSP1="D":"Max Daily Dose Check",1:$$ISCMPLEB(PSSLOOP))
+4 ;;
ISCMPLEB(PSSLOOP) ;; is completed, both attempted, did both finish?
+1 NEW PSSP15,PSSP33,PSSP34,PSSP35
+2 SET PSSP15=+$PIECE(PSSDBCAR(PSSLOOP),U,15)
+3 SET PSSP33=+$PIECE(PSSDBCAR(PSSLOOP),U,33)
+4 SET PSSP34=+$PIECE(PSSDBCAR(PSSLOOP),U,34)
+5 SET PSSP35=+$PIECE(PSSDBCAR(PSSLOOP),U,35)
+6 if (PSSP15=1)!((PSSP34=1)&(PSSP35=0)&(PSSP33=0))
QUIT "Maximum Single Dose Check"
+7 if (PSSP35=1)&(PSSP34=0)&(PSSP33=0)
QUIT "Max Daily Dose Check"
+8 QUIT "Dosing Checks"
+9 ;;
GETGNRL3(PSSDWEX2) ;; ensure General Dosing set if intermittent + bad frequency
+1 NEW DRUGNAME,DRUGIEN,MESSAGE
+2 SET DRUGNAME=$PIECE(PSSDBCAR(PSSDWEX2),U,2)
+3 SET DRUGIEN=$PIECE(PSSDBCAR(PSSDWEX2),U,3)
+4 if (DRUGNAME="")!(DRUGIEN="")
QUIT
+5 if '$DATA(^TMP($JOB,PSSDBASE,"OUT","DOSE",PSSDWEX2,DRUGNAME,"GENERAL","MESSAGE",DRUGIEN))
Begin DoDot:1
+6 KILL ^TMP($JOB,"PSSDSEXD")
+7 MERGE ^TMP($JOB,"PSSDSEXD","IN")=^TMP($JOB,PSSDBASE,"IN")
+8 ; duration rate = dose rate
SET $PIECE(^TMP($JOB,"PSSDSEXD","IN","DOSE",PSSDWEX2),U,10)=$PIECE(^TMP($JOB,"PSSDSEXD","IN","DOSE",PSSDWEX2),U,8)
+9 ;; frequency
SET $PIECE(^TMP($JOB,"PSSDSEXD","IN","DOSE",PSSDWEX2),U,8)=1
+10 ;; duration
SET $PIECE(^TMP($JOB,"PSSDSEXD","IN","DOSE",PSSDWEX2),U,9)=1
+11 DO IN^PSSHRQ2("PSSDSEXD")
+12 if $DATA(^TMP($JOB,"PSSDSEXD","OUT","EXCEPTIONS"))
QUIT
+13 SET ^TMP($JOB,PSSDBASE,"OUT","DOSE",PSSDWEX2,DRUGNAME,"GENERAL","MESSAGE",DRUGIEN)=^TMP($JOB,"PSSDSEXD","OUT","DOSE",PSSDWEX2,DRUGNAME,"GENERAL","MESSAGE",DRUGIEN)
End DoDot:1
+14 IF $DATA(^TMP($JOB,"PSSDSEXD","OUT","EXCEPTIONS"))
KILL ^TMP($JOB,"PSSDSEXD")
QUIT
+15 SET MESSAGE=^TMP($JOB,PSSDBASE,"OUT","DOSE",PSSDWEX2,DRUGNAME,"GENERAL","MESSAGE",DRUGIEN)
+16 IF PSSDBASA
SET ^TMP($JOB,PSSDBASF,"OUT","DOSE",PSSDWEX2,DRUGNAME,"3_GENERAL","MESSAGE",DRUGIEN,1)=MESSAGE
+17 IF PSSDBASB
SET ^TMP($JOB,PSSDBASG,"OUT",PSSDWEX2,"MESSAGE","3_GENERAL",DRUGIEN,1)=MESSAGE
+18 KILL ^TMP($JOB,"PSSDSEXD")
+19 QUIT
+20 ;;
