PSSDSEXD ;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 PSSDSEXC, 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
;
CONTINUE ;;
S:$G(PSSDBDS("CONTEXT"))="" PSSDBDS("CONTEXT")=$S(+PSSDSWHE=1:"CPRS-UD",1:"OP-UD")
D TWEAK4^PSSDSEXE
D TWEAK0
D:($P($G(PSSDBDS("CONTEXT")),"-",1,2)="IP-IV")!($P($G(PSSDBDS("CONTEXT")),"-",1,2)="IP-UD") TWEAK1
D:($P($G(PSSDBDS("CONTEXT")),"-",1,2)="CPRS-IV")!($P($G(PSSDBDS("CONTEXT")),"-",1,2)="CPRS-UD") TWEAK2
D:$P($G(PSSDBDS("CONTEXT")),"-",2,3)="IV-I" TWEAK3
Q
;;
TWEAK0 ;; loop through ERROR global remove/convert certain duplicates
N PSSDWLP,PSSDWL1
S PSSDWLP=""
F S PSSDWLP=$O(^TMP($J,PSSDBASE,"OUT","DOSE","ERROR",PSSDWLP)) Q:PSSDWLP="" D
.S PSSDWL1=""
.F S PSSDWL1=$O(^TMP($J,PSSDBASE,"OUT","DOSE","ERROR",PSSDWLP,PSSDWL1)) Q:PSSDWL1="" D
..Q:$$TWEAK001(PSSDWLP,PSSDWL1)
..Q:$$TWEAK01(PSSDWLP,PSSDWL1)
..Q:$$TWEAK02(PSSDWLP,PSSDWL1)
..Q:$$TWEAK03(PSSDWLP,PSSDWL1)
..Q:$$TWEAK04(PSSDWLP,PSSDWL1)
Q
;;
TWEAK001(PSSDWLP,PSSDWL1) ;;
Q $$TWEAK27^PSSDSEXE(PSSDWLP,PSSDWL1)
;;
TWEAK01(PSSDWLP,PSSDWL1) ;; remove dummy and duplicate weight required errors
N REASON,MESSAGE,FLAG,PSSDWLX,PSSDWE2,PSSREPL
S REASON=$P($G(^TMP($J,PSSDBASE,"OUT","DOSE","ERROR",PSSDWLP,PSSDWL1,"TEXT")),".",1)
S (FLAG,FLAG(1))=0
D:REASON="Weight required"
.;; first, wipe out if obtained from dummy data
.I $P(PSSDBCAR(PSSDWLP),U,6)=1 K ^TMP($J,PSSDBASE,"OUT","DOSE","ERROR",PSSDWLP,PSSDWL1) S FLAG=1 Q
.;; then, look for & scrub duplicates
.S MESSAGE=$G(^TMP($J,PSSDBASE,"OUT","DOSE","ERROR",PSSDWLP,PSSDWL1,"MSG"))
.S PSSDWLX=PSSDWL1
.F S PSSDWLX=$O(^TMP($J,PSSDBASE,"OUT","DOSE","ERROR",PSSDWLP,PSSDWLX)) Q:'PSSDWLX D
..S REASON(1)=$P($G(^TMP($J,PSSDBASE,"OUT","DOSE","ERROR",PSSDWLP,PSSDWLX,"TEXT")),".",1)
..Q:REASON'=REASON(1)
..S MESSAGE(1)=$G(^TMP($J,PSSDBASE,"OUT","DOSE","ERROR",PSSDWLP,PSSDWLX,"MSG"))
..S:MESSAGE'=MESSAGE(1) FLAG(1)=1 ;; if different message, set Dosing Checks message
..K ^TMP($J,PSSDBASE,"OUT","DOSE","ERROR",PSSDWLP,PSSDWLX)
..K:PSSDBASA ^TMP($J,PSSDBASF,"OUT","DOSE","ERROR",PSSDWLP,PSSDWLX)
..K:PSSDBASB ^TMP($J,PSSDBASG,"OUT",PSSDWLP,"ERROR",PSSDWLX)
..S FLAG=1
.;; finally, alter reason for calls from CPRS
.D:+$G(PSSDSWHE)=1!(FLAG(1)=1)
..S:FLAG(1)=1 MESSAGE=$$CHECKMSG(PSSDWLP)_" could not be "_$S(PSSDSWHE=1:"done",1:"performed")_" for Drug: "_$P(PSSDBCAR(PSSDWLP),U,2)
..D:PSSDSWHE=1
...S PSSREPL("performed")="done"
...S MESSAGE=$$REPLACE^XLFSTR(MESSAGE,.PSSREPL)_"."
...S PSSREPL(":.")="."
...S MESSAGE=$$REPLACE^XLFSTR(MESSAGE,.PSSREPL)
..S REASON=$S(+$G(PSSDSWHE)=0:"Weight required.",1:"No weight documented for patient.")
..S ^TMP($J,PSSDBASE,"OUT","DOSE","ERROR",PSSDWLP,PSSDWL1,"MSG")=MESSAGE
..S ^TMP($J,PSSDBASE,"OUT","DOSE","ERROR",PSSDWLP,PSSDWL1,"TEXT")=REASON
..D:PSSDBASA
...S ^TMP($J,PSSDBASF,"OUT","DOSE","ERROR",PSSDWLP,PSSDWL1,"MSG")=MESSAGE
...S ^TMP($J,PSSDBASF,"OUT","DOSE","ERROR",PSSDWLP,PSSDWL1,"TEXT")="Reason(s): "_REASON
..D:PSSDBASB
...S ^TMP($J,PSSDBASG,"OUT",PSSDWLP,"ERROR",PSSDWL1,"MSG")=MESSAGE
...S ^TMP($J,PSSDBASG,"OUT",PSSDWLP,"ERROR",PSSDWL1,"TEXT")="Reason(s): "_REASON
..Q
.D:$$SHOGEN(PSSDWLP) GETGNRL(PSSDWLP)
.S $P(PSSDBCAR(PSSDWLP),U,25)=1
.S $P(PSSDBCAR(PSSDWLP),U,27)=1
.Q
Q FLAG
;;
TWEAK02(PSSDWLP,PSSDWL1) ;; massage BSA required errors
N REASON,MESSAGE,FLAG,PSSDWLX,PSSDWE2
S REASON=$P($G(^TMP($J,PSSDBASE,"OUT","DOSE","ERROR",PSSDWLP,PSSDWL1,"TEXT")),".",1)
S (FLAG,FLAG(1))=0
D:REASON="Body surface area required"
.;; first, wipe out if obtained from dummy data
.I $P(PSSDBCAR(PSSDWLP),U,6)=1 K ^TMP($J,PSSDBASE,"OUT","DOSE","ERROR",PSSDWLP,PSSDWL1) S FLAG=1 Q
.;; then, look for & scrub duplicates
.S MESSAGE=$G(^TMP($J,PSSDBASE,"OUT","DOSE","ERROR",PSSDWLP,PSSDWL1,"MSG"))
.S PSSDWLX=PSSDWL1
.F S PSSDWLX=$O(^TMP($J,PSSDBASE,"OUT","DOSE","ERROR",PSSDWLP,PSSDWLX)) Q:'PSSDWLX D
..S REASON(1)=$P($G(^TMP($J,PSSDBASE,"OUT","DOSE","ERROR",PSSDWLP,PSSDWLX,"TEXT")),".",1)
..Q:REASON'=REASON(1)
..S MESSAGE(1)=$G(^TMP($J,PSSDBASE,"OUT","DOSE","ERROR",PSSDWLP,PSSDWLX,"MSG"))
..S:MESSAGE'=MESSAGE(1) FLAG(1)=1 ;; if different message, set Dosing Checks message
..K ^TMP($J,PSSDBASE,"OUT","DOSE","ERROR",PSSDWLP,PSSDWLX)
..K:PSSDBASA ^TMP($J,PSSDBASF,"OUT","DOSE","ERROR",PSSDWLP,PSSDWLX)
..K:PSSDBASB ^TMP($J,PSSDBASG,"OUT",PSSDWLP,"ERROR",PSSDWLX)
..S FLAG=1
.;; finally, alter reason for calls from CPRS
.D:+$G(PSSDSWHE)=1!(FLAG(1)=1)
..S:FLAG(1)=1 MESSAGE=$$CHECKMSG(PSSDWLP)_" could not be "_$S(PSSDSWHE=1:"done",1:"performed")_" for Drug: "_$P(PSSDBCAR(PSSDWLP),U,2)
..D:PSSDSWHE=1
...S PSSREPL("performed")="done"
...S MESSAGE=$$REPLACE^XLFSTR(MESSAGE,.PSSREPL)_"."
...S PSSREPL(":.")="."
...S MESSAGE=$$REPLACE^XLFSTR(MESSAGE,.PSSREPL)
..S REASON=$S(+$G(PSSDSWHE)=0:"Body surface area required.",1:"No weight and/or height documented for patient.")
..S ^TMP($J,PSSDBASE,"OUT","DOSE","ERROR",PSSDWLP,PSSDWL1,"MSG")=MESSAGE
..S ^TMP($J,PSSDBASE,"OUT","DOSE","ERROR",PSSDWLP,PSSDWL1,"TEXT")=REASON
..D:PSSDBASA
...S ^TMP($J,PSSDBASF,"OUT","DOSE","ERROR",PSSDWLP,PSSDWL1,"MSG")=MESSAGE
...S ^TMP($J,PSSDBASF,"OUT","DOSE","ERROR",PSSDWLP,PSSDWL1,"TEXT")="Reason(s): "_REASON
..D:PSSDBASB
...S ^TMP($J,PSSDBASG,"OUT",PSSDWLP,"ERROR",PSSDWL1,"MSG")=MESSAGE
...S ^TMP($J,PSSDBASG,"OUT",PSSDWLP,"ERROR",PSSDWL1,"TEXT")="Reason(s): "_REASON
..Q
.D:$$SHOGEN(PSSDWLP) GETGNRL(PSSDWLP)
.S $P(PSSDBCAR(PSSDWLP),U,26)=1
.S $P(PSSDBCAR(PSSDWLP),U,27)=1
.Q
Q FLAG
;;
TWEAK03(PSSDWLP,PSSDWL1) ;; convert 'Not screened' fdb messages, remove all exceptions
N SEVERITY,ROUTE,REASON,MESSAGE,FLAG
S SEVERITY=$P($G(^TMP($J,PSSDBASE,"OUT","DOSE","ERROR",PSSDWLP,PSSDWL1,"SEV")),".",1)
S FLAG=0
D:SEVERITY="NotScreened"
.S $P(PSSDBCAR(PSSDWLP),U,30)=1
.S MESSAGE=$$CHECKMSG(PSSDWLP)_" could not be "_$S(+$G(PSSDSWHE)=1:"done",1:"performed")_" for Drug: "_$P(PSSDBCAR(PSSDWLP),U,2)_$S(+$G(PSSDSWHE)=1:"",1:":")
.D:+$G(PSSDSWHE)=0
..;S MESSAGE=$$CHECKMSG(PSSDWLP)_" could not be performed for Drug: "_$P(PSSDBCAR(PSSDWLP),U,2)
..S REASON=$G(^TMP($J,PSSDBASE,"OUT","DOSE","ERROR",PSSDWLP,PSSDWL1,"TEXT"))
.D:+$G(PSSDSWHE)=1
..S MESSAGE=MESSAGE_", please complete a manual check for appropriate Dosing."
..;S MESSAGE=$$CHECKMSG(PSSDWLP)_" could not be done for Drug: "_$P(PSSDBCAR(PSSDWLP),U,2)_", please complete a manual check for appropriate Dosing."
..S REASON=""
.K ^TMP($J,PSSDBASE,"OUT","EXCEPTIONS",PSSDWLP)
.K ^TMP($J,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWLP)
.D:PSSDBASA
..S ^TMP($J,PSSDBASF,"OUT","DOSE","ERROR",PSSDWLP,PSSDWL1,"MSG")=MESSAGE
..S ^TMP($J,PSSDBASF,"OUT","DOSE","ERROR",PSSDWLP,PSSDWL1,"TEXT")=REASON
..K ^TMP($J,PSSDBASF,"OUT","EXCEPTIONS","DOSE",PSSDWLP)
.D:PSSDBASB
..S ^TMP($J,PSSDBASG,"OUT",PSSDWLP,"ERROR",PSSDWL1,"MSG")=MESSAGE
..S ^TMP($J,PSSDBASG,"OUT",PSSDWLP,"ERROR",PSSDWL1,"TEXT")="Reason(s): "_REASON
..K ^TMP($J,PSSDBASG,"OUT",PSSDWLP,"EXCEPTIONS")
.S FLAG=1
.S $P(PSSDBCAR(PSSDWLP),U,27)=1
.Q
Q FLAG
;;
TWEAK04(PSSDWLP,PSSDWL1) ;; convert/set warning fdb messages
N SEVERITY,REASON,MESSAGE,FLAG
S SEVERITY=$P($G(^TMP($J,PSSDBASE,"OUT","DOSE","ERROR",PSSDWLP,PSSDWL1,"SEV")),".",1)
S FLAG=0
D:SEVERITY="Warning"
.S MESSAGE=$$DOSEMSG^PSSHRVL1($P(PSSDBCAR(PSSDWLP),U,2),$S(($P(PSSDBCAR(PSSDWLP),U,1)="S")&(+$P(PSSDBCAR(PSSDWLP),U,8)=0):"S",$P(PSSDBCAR(PSSDWLP),U,15)=1:"S",1:""),"W")
.S ^TMP($J,PSSDBASE,"OUT","DOSE","ERROR",PSSDWLP,PSSDWL1,"MSG")=MESSAGE
.S REASON=^TMP($J,PSSDBASE,"OUT","DOSE","ERROR",PSSDWLP,PSSDWL1,"TEXT")
.; IP/OP/CPRS messages are the same
.D:PSSDBASA
..S ^TMP($J,PSSDBASF,"OUT","DOSE","ERROR",PSSDWLP,PSSDWL1,"MSG")=MESSAGE
..S ^TMP($J,PSSDBASF,"OUT","DOSE","ERROR",PSSDWLP,PSSDWL1,"TEXT")=REASON
.D:PSSDBASB
..S ^TMP($J,PSSDBASG,"OUT",PSSDWLP,"ERROR",PSSDWL1,"MSG")=MESSAGE
..S ^TMP($J,PSSDBASG,"OUT",PSSDWLP,"ERROR",PSSDWL1,"TEXT")=REASON
.S FLAG=1
.S $P(PSSDBCAR(PSSDWLP),U,27)=1
.Q
Q FLAG
;;
SHOGEN(PSSDWE5) ;;
N PSSDWGFB
S PSSDWGFB=0
Q $$SHOGEN^PSSDSEXC()
;;
GETGNRL(PSSDWLP) ;; set General Dosing info for missing weight/BSA
N DRUGNAME,DRUGIEN,MESSAGE
S DRUGNAME=$P(PSSDBCAR(PSSDWLP),U,2)
S DRUGIEN=$P(PSSDBCAR(PSSDWLP),U,3)
Q:(DRUGNAME="")!(DRUGIEN="")
D:'$D(^TMP($J,PSSDBASE,"OUT","DOSE",PSSDWLP,DRUGNAME,"GENERAL","MESSAGE",DRUGIEN))
.K ^TMP($J,"PSSDSEXD")
.M ^TMP($J,"PSSDSEXD","IN")=^TMP($J,PSSDBASE,"IN")
.S:+^TMP($J,"PSSDSEXD","IN","DOSE","BSA")'>0 ^("BSA")=1
.S:+^TMP($J,"PSSDSEXD","IN","DOSE","WT")'>0 ^("WT")=1
.D IN^PSSHRQ2("PSSDSEXD")
.Q:$D(^TMP($J,"PSSDSEXD","OUT","EXCEPTIONS"))
.S ^TMP($J,PSSDBASE,"OUT","DOSE",PSSDWLP,DRUGNAME,"GENERAL","MESSAGE",DRUGIEN)=^TMP($J,"PSSDSEXD","OUT","DOSE",PSSDWLP,DRUGNAME,"GENERAL","MESSAGE",DRUGIEN)
I $D(^TMP($J,"PSSDSEXD","OUT","EXCEPTIONS")) K ^TMP($J,"PSSDSEXD") Q
S MESSAGE=^TMP($J,PSSDBASE,"OUT","DOSE",PSSDWLP,DRUGNAME,"GENERAL","MESSAGE",DRUGIEN)
I PSSDBASA S ^TMP($J,PSSDBASF,"OUT","DOSE",PSSDWLP,DRUGNAME,"3_GENERAL","MESSAGE",DRUGIEN,1)=MESSAGE
I PSSDBASB S ^TMP($J,PSSDBASG,"OUT",PSSDWLP,"MESSAGE","3_GENERAL",DRUGIEN,1)=MESSAGE
K ^TMP($J,"PSSDSEXD")
Q
;;
TWEAK1 ;; loop through EXCEPTION global, test for five IV related tweaks
N PSSDWEX2,PSSDWE2,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:$$TWEAK11(NODE)
..Q:$$TWEAK12(NODE)
..Q:$$TWEAK13(NODE)
..Q:$$TWEAK14(NODE)
..Q:$$TWEAK15(NODE)
Q
;;
TWEAK11(NODE) ;;
N REASON,MESSAGE
S REASON=$$UP^XLFSTR($P(NODE,U,10))
Q:REASON'="DRUG NOT MATCHED TO NDF" 0
S MESSAGE=$$CHECKMSG(PSSDWEX2)_" could not be performed for Drug: "_$P(PSSDBCAR(PSSDWEX2),U,2)
S $P(^TMP($J,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,PSSDWE2),U,7)=MESSAGE
S:PSSDBASA ^TMP($J,PSSDBASF,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,1)=MESSAGE
S:PSSDBASB ^TMP($J,PSSDBASG,"OUT",PSSDWEX2,"EXCEPTIONS",1)=MESSAGE
S $P(PSSDBCAR(PSSDWEX2),U,27)=1
Q 1
;;
TWEAK12(NODE) ;;
N REASON
S REASON=$$UP^XLFSTR($P(NODE,U,10))
Q:REASON'="NO GCNSEQNO EXISTS FOR VA PRODUCT" 0
Q:$$EXMT^PSSDSAPI($P(PSSDBCAR(PSSDWEX2),U,3))=0 0
K ^TMP($J,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,PSSDWE2)
K:PSSDBASA ^TMP($J,PSSDBASF,"OUT","EXCEPTIONS","DOSE",PSSDWEX2)
K:PSSDBASB ^TMP($J,PSSDBASG,"OUT",PSSDWEX2,"EXCEPTIONS")
S $P(PSSDBCAR(PSSDWEX2),U,27)=1
Q 1
;;
TWEAK13(NODE) ;;
N REASON,MESSAGE
S REASON=$$UP^XLFSTR($P(NODE,U,10))
Q:REASON'="NO GCNSEQNO EXISTS FOR VA PRODUCT" 0
Q:$$EXMT^PSSDSAPI($P(PSSDBCAR(PSSDWEX2),U,3))=1 0
S MESSAGE=$$CHECKMSG(PSSDWEX2)_" could not be performed for Drug: "_$P(PSSDBCAR(PSSDWEX2),U,2)_", please complete a manual check for appropriate Dosing."
S $P(^TMP($J,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,PSSDWE2),U,7)=MESSAGE
S $P(^TMP($J,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,PSSDWE2),U,10)=""
D:PSSDBASA
.S ^TMP($J,PSSDBASF,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,1)=MESSAGE
.S ^TMP($J,PSSDBASF,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,2)=""
D:PSSDBASB
.S ^TMP($J,PSSDBASG,"OUT",PSSDWEX2,"EXCEPTIONS",1)=MESSAGE
.S ^TMP($J,PSSDBASG,"OUT",PSSDWEX2,"EXCEPTIONS",2)=""
S $P(PSSDBCAR(PSSDWEX2),U,27)=1
Q 1
;;
TWEAK14(NODE) ;;
N REASON
S REASON=$$UP^XLFSTR($P(NODE,U,10))
Q:REASON'="BAD GCNSEQNO ASSIGNED TO VA PRODUCT" 0
Q:$$EXMT^PSSDSAPI($P(PSSDBCAR(PSSDWEX2),U,3))=0 0
K ^TMP($J,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,PSSDWE2)
K:PSSDBASA ^TMP($J,PSSDBASF,"OUT","EXCEPTIONS","DOSE",PSSDWEX2)
K:PSSDBASB ^TMP($J,PSSDBASG,"OUT",PSSDWEX2,"EXCEPTIONS")
S $P(PSSDBCAR(PSSDWEX2),U,27)=1
Q 1
;;
TWEAK15(NODE) ;;
N REASON,MESSAGE
S REASON=$$UP^XLFSTR($P(NODE,U,10))
Q:REASON'="BAD GCNSEQNO ASSIGNED TO VA PRODUCT" 0
Q:$$EXMT^PSSDSAPI($P(PSSDBCAR(PSSDWEX2),U,3))=1 0
S MESSAGE=$$CHECKMSG(PSSDWEX2)_" could not be performed for Drug: "_$P(PSSDBCAR(PSSDWEX2),U,2)_", please complete a manual check for appropriate Dosing."
S $P(^TMP($J,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,PSSDWE2),U,7)=MESSAGE
S $P(^TMP($J,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,PSSDWE2),U,10)=""
D:PSSDBASA
.S ^TMP($J,PSSDBASF,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,1)=MESSAGE
.S ^TMP($J,PSSDBASF,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,2)=""
D:PSSDBASB
.S ^TMP($J,PSSDBASG,"OUT",PSSDWEX2,"EXCEPTIONS",1)=MESSAGE
.S ^TMP($J,PSSDBASG,"OUT",PSSDWEX2,"EXCEPTIONS",2)=""
S $P(PSSDBCAR(PSSDWEX2),U,27)=1
Q 1
;;
TWEAK2 ;; loop through exception global, look for OR related tweaks
D TWEAK2^PSSDSEXE
Q
;;
TWEAK3 ;; ensure itermittent with certain exceptions have general dosing info
N PSSDWEX2,PSSDWE2,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:$$TWEAK31(NODE)
Q
;;
TWEAK31(NODE) ;; itermittent with bad frequency
N REASON,MESSAGE
S REASON=$$UP^XLFSTR($P(NODE,U,10))
Q:REASON'="INVALID OR UNDEFINED FREQUENCY" 0
; -- RTC 165417
D:PSSDBASA
. S MESSAGE="Max Daily Dose Check could not be done for Drug: "_$P(PSSDBCAR(PSSDWEX2),U,2)_", please complete a manual check for appropriate Dosing."
. S $P(^TMP($J,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,PSSDWE2),U,7)=MESSAGE
. S $P(^TMP($J,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,PSSDWE2),U,10)=""
. S ^TMP($J,PSSDBASF,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,1)=MESSAGE
. S ^TMP($J,PSSDBASF,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,2)=""
D:$$SHOGEN(PSSDWEX2) GETGNRL3^PSSDSEXE(PSSDWEX2)
S $P(PSSDBCAR(PSSDWEX2),U,27)=1
Q 1
;;
CHECKMSG(PSSLOOP) ;; max single if single dose, excluded or complex, else dosing
Q $S(($P(PSSDBCAR(PSSLOOP),U,5)=0)!($P(PSSDBCAR(PSSLOOP),U,15)=1)!($$ISCMPLEX(PSSLOOP)):"Maximum Single Dose Check",$P(PSSDBCAR(PSSLOOP),U,30)=1:"Dosing Order Checks",1:$$ISCMPLET^PSSDSEXE(PSSLOOP)) ;;,1)"Dosing Checks")
;;
ISCMPLEX(PSSLOOP) ;; is complex order
Q $S($P(PSSDBCAR(PSSLOOP),U,16)=1:1,$P(PSSLOOP,";",5):1,1:0)
;;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSDSEXD 14769 printed Oct 16, 2024@18:32 Page 2
PSSDSEXD ;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 PSSDSEXC, 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 ;
CONTINUE ;;
+1 if $GET(PSSDBDS("CONTEXT"))=""
SET PSSDBDS("CONTEXT")=$SELECT(+PSSDSWHE=1:"CPRS-UD",1:"OP-UD")
+2 DO TWEAK4^PSSDSEXE
+3 DO TWEAK0
+4 if ($PIECE($GET(PSSDBDS("CONTEXT")),"-",1,2)="IP-IV")!($PIECE($GET(PSSDBDS("CONTEXT")),"-",1,2)="IP-UD")
DO TWEAK1
+5 if ($PIECE($GET(PSSDBDS("CONTEXT")),"-",1,2)="CPRS-IV")!($PIECE($GET(PSSDBDS("CONTEXT")),"-",1,2)="CPRS-UD")
DO TWEAK2
+6 if $PIECE($GET(PSSDBDS("CONTEXT")),"-",2,3)="IV-I"
DO TWEAK3
+7 QUIT
+8 ;;
TWEAK0 ;; loop through ERROR global remove/convert certain duplicates
+1 NEW PSSDWLP,PSSDWL1
+2 SET PSSDWLP=""
+3 FOR
SET PSSDWLP=$ORDER(^TMP($JOB,PSSDBASE,"OUT","DOSE","ERROR",PSSDWLP))
if PSSDWLP=""
QUIT
Begin DoDot:1
+4 SET PSSDWL1=""
+5 FOR
SET PSSDWL1=$ORDER(^TMP($JOB,PSSDBASE,"OUT","DOSE","ERROR",PSSDWLP,PSSDWL1))
if PSSDWL1=""
QUIT
Begin DoDot:2
+6 if $$TWEAK001(PSSDWLP,PSSDWL1)
QUIT
+7 if $$TWEAK01(PSSDWLP,PSSDWL1)
QUIT
+8 if $$TWEAK02(PSSDWLP,PSSDWL1)
QUIT
+9 if $$TWEAK03(PSSDWLP,PSSDWL1)
QUIT
+10 if $$TWEAK04(PSSDWLP,PSSDWL1)
QUIT
End DoDot:2
End DoDot:1
+11 QUIT
+12 ;;
TWEAK001(PSSDWLP,PSSDWL1) ;;
+1 QUIT $$TWEAK27^PSSDSEXE(PSSDWLP,PSSDWL1)
+2 ;;
TWEAK01(PSSDWLP,PSSDWL1) ;; remove dummy and duplicate weight required errors
+1 NEW REASON,MESSAGE,FLAG,PSSDWLX,PSSDWE2,PSSREPL
+2 SET REASON=$PIECE($GET(^TMP($JOB,PSSDBASE,"OUT","DOSE","ERROR",PSSDWLP,PSSDWL1,"TEXT")),".",1)
+3 SET (FLAG,FLAG(1))=0
+4 if REASON="Weight required"
Begin DoDot:1
+5 ;; first, wipe out if obtained from dummy data
+6 IF $PIECE(PSSDBCAR(PSSDWLP),U,6)=1
KILL ^TMP($JOB,PSSDBASE,"OUT","DOSE","ERROR",PSSDWLP,PSSDWL1)
SET FLAG=1
QUIT
+7 ;; then, look for & scrub duplicates
+8 SET MESSAGE=$GET(^TMP($JOB,PSSDBASE,"OUT","DOSE","ERROR",PSSDWLP,PSSDWL1,"MSG"))
+9 SET PSSDWLX=PSSDWL1
+10 FOR
SET PSSDWLX=$ORDER(^TMP($JOB,PSSDBASE,"OUT","DOSE","ERROR",PSSDWLP,PSSDWLX))
if 'PSSDWLX
QUIT
Begin DoDot:2
+11 SET REASON(1)=$PIECE($GET(^TMP($JOB,PSSDBASE,"OUT","DOSE","ERROR",PSSDWLP,PSSDWLX,"TEXT")),".",1)
+12 if REASON'=REASON(1)
QUIT
+13 SET MESSAGE(1)=$GET(^TMP($JOB,PSSDBASE,"OUT","DOSE","ERROR",PSSDWLP,PSSDWLX,"MSG"))
+14 ;; if different message, set Dosing Checks message
if MESSAGE'=MESSAGE(1)
SET FLAG(1)=1
+15 KILL ^TMP($JOB,PSSDBASE,"OUT","DOSE","ERROR",PSSDWLP,PSSDWLX)
+16 if PSSDBASA
KILL ^TMP($JOB,PSSDBASF,"OUT","DOSE","ERROR",PSSDWLP,PSSDWLX)
+17 if PSSDBASB
KILL ^TMP($JOB,PSSDBASG,"OUT",PSSDWLP,"ERROR",PSSDWLX)
+18 SET FLAG=1
End DoDot:2
+19 ;; finally, alter reason for calls from CPRS
+20 if +$GET(PSSDSWHE)=1!(FLAG(1)=1)
Begin DoDot:2
+21 if FLAG(1)=1
SET MESSAGE=$$CHECKMSG(PSSDWLP)_" could not be "_$SELECT(PSSDSWHE=1:"done",1:"performed")_" for Drug: "_$PIECE(PSSDBCAR(PSSDWLP),U,2)
+22 if PSSDSWHE=1
Begin DoDot:3
+23 SET PSSREPL("performed")="done"
+24 SET MESSAGE=$$REPLACE^XLFSTR(MESSAGE,.PSSREPL)_"."
+25 SET PSSREPL(":.")="."
+26 SET MESSAGE=$$REPLACE^XLFSTR(MESSAGE,.PSSREPL)
End DoDot:3
+27 SET REASON=$SELECT(+$GET(PSSDSWHE)=0:"Weight required.",1:"No weight documented for patient.")
+28 SET ^TMP($JOB,PSSDBASE,"OUT","DOSE","ERROR",PSSDWLP,PSSDWL1,"MSG")=MESSAGE
+29 SET ^TMP($JOB,PSSDBASE,"OUT","DOSE","ERROR",PSSDWLP,PSSDWL1,"TEXT")=REASON
+30 if PSSDBASA
Begin DoDot:3
+31 SET ^TMP($JOB,PSSDBASF,"OUT","DOSE","ERROR",PSSDWLP,PSSDWL1,"MSG")=MESSAGE
+32 SET ^TMP($JOB,PSSDBASF,"OUT","DOSE","ERROR",PSSDWLP,PSSDWL1,"TEXT")="Reason(s): "_REASON
End DoDot:3
+33 if PSSDBASB
Begin DoDot:3
+34 SET ^TMP($JOB,PSSDBASG,"OUT",PSSDWLP,"ERROR",PSSDWL1,"MSG")=MESSAGE
+35 SET ^TMP($JOB,PSSDBASG,"OUT",PSSDWLP,"ERROR",PSSDWL1,"TEXT")="Reason(s): "_REASON
End DoDot:3
+36 QUIT
End DoDot:2
+37 if $$SHOGEN(PSSDWLP)
DO GETGNRL(PSSDWLP)
+38 SET $PIECE(PSSDBCAR(PSSDWLP),U,25)=1
+39 SET $PIECE(PSSDBCAR(PSSDWLP),U,27)=1
+40 QUIT
End DoDot:1
+41 QUIT FLAG
+42 ;;
TWEAK02(PSSDWLP,PSSDWL1) ;; massage BSA required errors
+1 NEW REASON,MESSAGE,FLAG,PSSDWLX,PSSDWE2
+2 SET REASON=$PIECE($GET(^TMP($JOB,PSSDBASE,"OUT","DOSE","ERROR",PSSDWLP,PSSDWL1,"TEXT")),".",1)
+3 SET (FLAG,FLAG(1))=0
+4 if REASON="Body surface area required"
Begin DoDot:1
+5 ;; first, wipe out if obtained from dummy data
+6 IF $PIECE(PSSDBCAR(PSSDWLP),U,6)=1
KILL ^TMP($JOB,PSSDBASE,"OUT","DOSE","ERROR",PSSDWLP,PSSDWL1)
SET FLAG=1
QUIT
+7 ;; then, look for & scrub duplicates
+8 SET MESSAGE=$GET(^TMP($JOB,PSSDBASE,"OUT","DOSE","ERROR",PSSDWLP,PSSDWL1,"MSG"))
+9 SET PSSDWLX=PSSDWL1
+10 FOR
SET PSSDWLX=$ORDER(^TMP($JOB,PSSDBASE,"OUT","DOSE","ERROR",PSSDWLP,PSSDWLX))
if 'PSSDWLX
QUIT
Begin DoDot:2
+11 SET REASON(1)=$PIECE($GET(^TMP($JOB,PSSDBASE,"OUT","DOSE","ERROR",PSSDWLP,PSSDWLX,"TEXT")),".",1)
+12 if REASON'=REASON(1)
QUIT
+13 SET MESSAGE(1)=$GET(^TMP($JOB,PSSDBASE,"OUT","DOSE","ERROR",PSSDWLP,PSSDWLX,"MSG"))
+14 ;; if different message, set Dosing Checks message
if MESSAGE'=MESSAGE(1)
SET FLAG(1)=1
+15 KILL ^TMP($JOB,PSSDBASE,"OUT","DOSE","ERROR",PSSDWLP,PSSDWLX)
+16 if PSSDBASA
KILL ^TMP($JOB,PSSDBASF,"OUT","DOSE","ERROR",PSSDWLP,PSSDWLX)
+17 if PSSDBASB
KILL ^TMP($JOB,PSSDBASG,"OUT",PSSDWLP,"ERROR",PSSDWLX)
+18 SET FLAG=1
End DoDot:2
+19 ;; finally, alter reason for calls from CPRS
+20 if +$GET(PSSDSWHE)=1!(FLAG(1)=1)
Begin DoDot:2
+21 if FLAG(1)=1
SET MESSAGE=$$CHECKMSG(PSSDWLP)_" could not be "_$SELECT(PSSDSWHE=1:"done",1:"performed")_" for Drug: "_$PIECE(PSSDBCAR(PSSDWLP),U,2)
+22 if PSSDSWHE=1
Begin DoDot:3
+23 SET PSSREPL("performed")="done"
+24 SET MESSAGE=$$REPLACE^XLFSTR(MESSAGE,.PSSREPL)_"."
+25 SET PSSREPL(":.")="."
+26 SET MESSAGE=$$REPLACE^XLFSTR(MESSAGE,.PSSREPL)
End DoDot:3
+27 SET REASON=$SELECT(+$GET(PSSDSWHE)=0:"Body surface area required.",1:"No weight and/or height documented for patient.")
+28 SET ^TMP($JOB,PSSDBASE,"OUT","DOSE","ERROR",PSSDWLP,PSSDWL1,"MSG")=MESSAGE
+29 SET ^TMP($JOB,PSSDBASE,"OUT","DOSE","ERROR",PSSDWLP,PSSDWL1,"TEXT")=REASON
+30 if PSSDBASA
Begin DoDot:3
+31 SET ^TMP($JOB,PSSDBASF,"OUT","DOSE","ERROR",PSSDWLP,PSSDWL1,"MSG")=MESSAGE
+32 SET ^TMP($JOB,PSSDBASF,"OUT","DOSE","ERROR",PSSDWLP,PSSDWL1,"TEXT")="Reason(s): "_REASON
End DoDot:3
+33 if PSSDBASB
Begin DoDot:3
+34 SET ^TMP($JOB,PSSDBASG,"OUT",PSSDWLP,"ERROR",PSSDWL1,"MSG")=MESSAGE
+35 SET ^TMP($JOB,PSSDBASG,"OUT",PSSDWLP,"ERROR",PSSDWL1,"TEXT")="Reason(s): "_REASON
End DoDot:3
+36 QUIT
End DoDot:2
+37 if $$SHOGEN(PSSDWLP)
DO GETGNRL(PSSDWLP)
+38 SET $PIECE(PSSDBCAR(PSSDWLP),U,26)=1
+39 SET $PIECE(PSSDBCAR(PSSDWLP),U,27)=1
+40 QUIT
End DoDot:1
+41 QUIT FLAG
+42 ;;
TWEAK03(PSSDWLP,PSSDWL1) ;; convert 'Not screened' fdb messages, remove all exceptions
+1 NEW SEVERITY,ROUTE,REASON,MESSAGE,FLAG
+2 SET SEVERITY=$PIECE($GET(^TMP($JOB,PSSDBASE,"OUT","DOSE","ERROR",PSSDWLP,PSSDWL1,"SEV")),".",1)
+3 SET FLAG=0
+4 if SEVERITY="NotScreened"
Begin DoDot:1
+5 SET $PIECE(PSSDBCAR(PSSDWLP),U,30)=1
+6 SET MESSAGE=$$CHECKMSG(PSSDWLP)_" could not be "_$SELECT(+$GET(PSSDSWHE)=1:"done",1:"performed")_" for Drug: "_$PIECE(PSSDBCAR(PSSDWLP),U,2)_$SELECT(+$GET(PSSDSWHE)=1:"",1:":")
+7 if +$GET(PSSDSWHE)=0
Begin DoDot:2
+8 ;S MESSAGE=$$CHECKMSG(PSSDWLP)_" could not be performed for Drug: "_$P(PSSDBCAR(PSSDWLP),U,2)
+9 SET REASON=$GET(^TMP($JOB,PSSDBASE,"OUT","DOSE","ERROR",PSSDWLP,PSSDWL1,"TEXT"))
End DoDot:2
+10 if +$GET(PSSDSWHE)=1
Begin DoDot:2
+11 SET MESSAGE=MESSAGE_", please complete a manual check for appropriate Dosing."
+12 ;S MESSAGE=$$CHECKMSG(PSSDWLP)_" could not be done for Drug: "_$P(PSSDBCAR(PSSDWLP),U,2)_", please complete a manual check for appropriate Dosing."
+13 SET REASON=""
End DoDot:2
+14 KILL ^TMP($JOB,PSSDBASE,"OUT","EXCEPTIONS",PSSDWLP)
+15 KILL ^TMP($JOB,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWLP)
+16 if PSSDBASA
Begin DoDot:2
+17 SET ^TMP($JOB,PSSDBASF,"OUT","DOSE","ERROR",PSSDWLP,PSSDWL1,"MSG")=MESSAGE
+18 SET ^TMP($JOB,PSSDBASF,"OUT","DOSE","ERROR",PSSDWLP,PSSDWL1,"TEXT")=REASON
+19 KILL ^TMP($JOB,PSSDBASF,"OUT","EXCEPTIONS","DOSE",PSSDWLP)
End DoDot:2
+20 if PSSDBASB
Begin DoDot:2
+21 SET ^TMP($JOB,PSSDBASG,"OUT",PSSDWLP,"ERROR",PSSDWL1,"MSG")=MESSAGE
+22 SET ^TMP($JOB,PSSDBASG,"OUT",PSSDWLP,"ERROR",PSSDWL1,"TEXT")="Reason(s): "_REASON
+23 KILL ^TMP($JOB,PSSDBASG,"OUT",PSSDWLP,"EXCEPTIONS")
End DoDot:2
+24 SET FLAG=1
+25 SET $PIECE(PSSDBCAR(PSSDWLP),U,27)=1
+26 QUIT
End DoDot:1
+27 QUIT FLAG
+28 ;;
TWEAK04(PSSDWLP,PSSDWL1) ;; convert/set warning fdb messages
+1 NEW SEVERITY,REASON,MESSAGE,FLAG
+2 SET SEVERITY=$PIECE($GET(^TMP($JOB,PSSDBASE,"OUT","DOSE","ERROR",PSSDWLP,PSSDWL1,"SEV")),".",1)
+3 SET FLAG=0
+4 if SEVERITY="Warning"
Begin DoDot:1
+5 SET MESSAGE=$$DOSEMSG^PSSHRVL1($PIECE(PSSDBCAR(PSSDWLP),U,2),$SELECT(($PIECE(PSSDBCAR(PSSDWLP),U,1)="S")&(+$PIECE(PSSDBCAR(PSSDWLP),U,8)=0):"S",$PIECE(PSSDBCAR(PSSDWLP),U,15)=1:"S",1:""),"W")
+6 SET ^TMP($JOB,PSSDBASE,"OUT","DOSE","ERROR",PSSDWLP,PSSDWL1,"MSG")=MESSAGE
+7 SET REASON=^TMP($JOB,PSSDBASE,"OUT","DOSE","ERROR",PSSDWLP,PSSDWL1,"TEXT")
+8 ; IP/OP/CPRS messages are the same
+9 if PSSDBASA
Begin DoDot:2
+10 SET ^TMP($JOB,PSSDBASF,"OUT","DOSE","ERROR",PSSDWLP,PSSDWL1,"MSG")=MESSAGE
+11 SET ^TMP($JOB,PSSDBASF,"OUT","DOSE","ERROR",PSSDWLP,PSSDWL1,"TEXT")=REASON
End DoDot:2
+12 if PSSDBASB
Begin DoDot:2
+13 SET ^TMP($JOB,PSSDBASG,"OUT",PSSDWLP,"ERROR",PSSDWL1,"MSG")=MESSAGE
+14 SET ^TMP($JOB,PSSDBASG,"OUT",PSSDWLP,"ERROR",PSSDWL1,"TEXT")=REASON
End DoDot:2
+15 SET FLAG=1
+16 SET $PIECE(PSSDBCAR(PSSDWLP),U,27)=1
+17 QUIT
End DoDot:1
+18 QUIT FLAG
+19 ;;
SHOGEN(PSSDWE5) ;;
+1 NEW PSSDWGFB
+2 SET PSSDWGFB=0
+3 QUIT $$SHOGEN^PSSDSEXC()
+4 ;;
GETGNRL(PSSDWLP) ;; set General Dosing info for missing weight/BSA
+1 NEW DRUGNAME,DRUGIEN,MESSAGE
+2 SET DRUGNAME=$PIECE(PSSDBCAR(PSSDWLP),U,2)
+3 SET DRUGIEN=$PIECE(PSSDBCAR(PSSDWLP),U,3)
+4 if (DRUGNAME="")!(DRUGIEN="")
QUIT
+5 if '$DATA(^TMP($JOB,PSSDBASE,"OUT","DOSE",PSSDWLP,DRUGNAME,"GENERAL","MESSAGE",DRUGIEN))
Begin DoDot:1
+6 KILL ^TMP($JOB,"PSSDSEXD")
+7 MERGE ^TMP($JOB,"PSSDSEXD","IN")=^TMP($JOB,PSSDBASE,"IN")
+8 if +^TMP($JOB,"PSSDSEXD","IN","DOSE","BSA")'>0
SET ^("BSA")=1
+9 if +^TMP($JOB,"PSSDSEXD","IN","DOSE","WT")'>0
SET ^("WT")=1
+10 DO IN^PSSHRQ2("PSSDSEXD")
+11 if $DATA(^TMP($JOB,"PSSDSEXD","OUT","EXCEPTIONS"))
QUIT
+12 SET ^TMP($JOB,PSSDBASE,"OUT","DOSE",PSSDWLP,DRUGNAME,"GENERAL","MESSAGE",DRUGIEN)=^TMP($JOB,"PSSDSEXD","OUT","DOSE",PSSDWLP,DRUGNAME,"GENERAL","MESSAGE",DRUGIEN)
End DoDot:1
+13 IF $DATA(^TMP($JOB,"PSSDSEXD","OUT","EXCEPTIONS"))
KILL ^TMP($JOB,"PSSDSEXD")
QUIT
+14 SET MESSAGE=^TMP($JOB,PSSDBASE,"OUT","DOSE",PSSDWLP,DRUGNAME,"GENERAL","MESSAGE",DRUGIEN)
+15 IF PSSDBASA
SET ^TMP($JOB,PSSDBASF,"OUT","DOSE",PSSDWLP,DRUGNAME,"3_GENERAL","MESSAGE",DRUGIEN,1)=MESSAGE
+16 IF PSSDBASB
SET ^TMP($JOB,PSSDBASG,"OUT",PSSDWLP,"MESSAGE","3_GENERAL",DRUGIEN,1)=MESSAGE
+17 KILL ^TMP($JOB,"PSSDSEXD")
+18 QUIT
+19 ;;
TWEAK1 ;; loop through EXCEPTION global, test for five IV related tweaks
+1 NEW PSSDWEX2,PSSDWE2,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 $$TWEAK11(NODE)
QUIT
+9 if $$TWEAK12(NODE)
QUIT
+10 if $$TWEAK13(NODE)
QUIT
+11 if $$TWEAK14(NODE)
QUIT
+12 if $$TWEAK15(NODE)
QUIT
End DoDot:2
End DoDot:1
+13 QUIT
+14 ;;
TWEAK11(NODE) ;;
+1 NEW REASON,MESSAGE
+2 SET REASON=$$UP^XLFSTR($PIECE(NODE,U,10))
+3 if REASON'="DRUG NOT MATCHED TO NDF"
QUIT 0
+4 SET MESSAGE=$$CHECKMSG(PSSDWEX2)_" could not be performed for Drug: "_$PIECE(PSSDBCAR(PSSDWEX2),U,2)
+5 SET $PIECE(^TMP($JOB,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,PSSDWE2),U,7)=MESSAGE
+6 if PSSDBASA
SET ^TMP($JOB,PSSDBASF,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,1)=MESSAGE
+7 if PSSDBASB
SET ^TMP($JOB,PSSDBASG,"OUT",PSSDWEX2,"EXCEPTIONS",1)=MESSAGE
+8 SET $PIECE(PSSDBCAR(PSSDWEX2),U,27)=1
+9 QUIT 1
+10 ;;
TWEAK12(NODE) ;;
+1 NEW REASON
+2 SET REASON=$$UP^XLFSTR($PIECE(NODE,U,10))
+3 if REASON'="NO GCNSEQNO EXISTS FOR VA PRODUCT"
QUIT 0
+4 if $$EXMT^PSSDSAPI($PIECE(PSSDBCAR(PSSDWEX2),U,3))=0
QUIT 0
+5 KILL ^TMP($JOB,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,PSSDWE2)
+6 if PSSDBASA
KILL ^TMP($JOB,PSSDBASF,"OUT","EXCEPTIONS","DOSE",PSSDWEX2)
+7 if PSSDBASB
KILL ^TMP($JOB,PSSDBASG,"OUT",PSSDWEX2,"EXCEPTIONS")
+8 SET $PIECE(PSSDBCAR(PSSDWEX2),U,27)=1
+9 QUIT 1
+10 ;;
TWEAK13(NODE) ;;
+1 NEW REASON,MESSAGE
+2 SET REASON=$$UP^XLFSTR($PIECE(NODE,U,10))
+3 if REASON'="NO GCNSEQNO EXISTS FOR VA PRODUCT"
QUIT 0
+4 if $$EXMT^PSSDSAPI($PIECE(PSSDBCAR(PSSDWEX2),U,3))=1
QUIT 0
+5 SET MESSAGE=$$CHECKMSG(PSSDWEX2)_" could not be performed for Drug: "_$PIECE(PSSDBCAR(PSSDWEX2),U,2)_", please complete a manual check for appropriate Dosing."
+6 SET $PIECE(^TMP($JOB,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,PSSDWE2),U,7)=MESSAGE
+7 SET $PIECE(^TMP($JOB,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,PSSDWE2),U,10)=""
+8 if PSSDBASA
Begin DoDot:1
+9 SET ^TMP($JOB,PSSDBASF,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,1)=MESSAGE
+10 SET ^TMP($JOB,PSSDBASF,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,2)=""
End DoDot:1
+11 if PSSDBASB
Begin DoDot:1
+12 SET ^TMP($JOB,PSSDBASG,"OUT",PSSDWEX2,"EXCEPTIONS",1)=MESSAGE
+13 SET ^TMP($JOB,PSSDBASG,"OUT",PSSDWEX2,"EXCEPTIONS",2)=""
End DoDot:1
+14 SET $PIECE(PSSDBCAR(PSSDWEX2),U,27)=1
+15 QUIT 1
+16 ;;
TWEAK14(NODE) ;;
+1 NEW REASON
+2 SET REASON=$$UP^XLFSTR($PIECE(NODE,U,10))
+3 if REASON'="BAD GCNSEQNO ASSIGNED TO VA PRODUCT"
QUIT 0
+4 if $$EXMT^PSSDSAPI($PIECE(PSSDBCAR(PSSDWEX2),U,3))=0
QUIT 0
+5 KILL ^TMP($JOB,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,PSSDWE2)
+6 if PSSDBASA
KILL ^TMP($JOB,PSSDBASF,"OUT","EXCEPTIONS","DOSE",PSSDWEX2)
+7 if PSSDBASB
KILL ^TMP($JOB,PSSDBASG,"OUT",PSSDWEX2,"EXCEPTIONS")
+8 SET $PIECE(PSSDBCAR(PSSDWEX2),U,27)=1
+9 QUIT 1
+10 ;;
TWEAK15(NODE) ;;
+1 NEW REASON,MESSAGE
+2 SET REASON=$$UP^XLFSTR($PIECE(NODE,U,10))
+3 if REASON'="BAD GCNSEQNO ASSIGNED TO VA PRODUCT"
QUIT 0
+4 if $$EXMT^PSSDSAPI($PIECE(PSSDBCAR(PSSDWEX2),U,3))=1
QUIT 0
+5 SET MESSAGE=$$CHECKMSG(PSSDWEX2)_" could not be performed for Drug: "_$PIECE(PSSDBCAR(PSSDWEX2),U,2)_", please complete a manual check for appropriate Dosing."
+6 SET $PIECE(^TMP($JOB,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,PSSDWE2),U,7)=MESSAGE
+7 SET $PIECE(^TMP($JOB,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,PSSDWE2),U,10)=""
+8 if PSSDBASA
Begin DoDot:1
+9 SET ^TMP($JOB,PSSDBASF,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,1)=MESSAGE
+10 SET ^TMP($JOB,PSSDBASF,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,2)=""
End DoDot:1
+11 if PSSDBASB
Begin DoDot:1
+12 SET ^TMP($JOB,PSSDBASG,"OUT",PSSDWEX2,"EXCEPTIONS",1)=MESSAGE
+13 SET ^TMP($JOB,PSSDBASG,"OUT",PSSDWEX2,"EXCEPTIONS",2)=""
End DoDot:1
+14 SET $PIECE(PSSDBCAR(PSSDWEX2),U,27)=1
+15 QUIT 1
+16 ;;
TWEAK2 ;; loop through exception global, look for OR related tweaks
+1 DO TWEAK2^PSSDSEXE
+2 QUIT
+3 ;;
TWEAK3 ;; ensure itermittent with certain exceptions have general dosing info
+1 NEW PSSDWEX2,PSSDWE2,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 $$TWEAK31(NODE)
QUIT
End DoDot:2
End DoDot:1
+9 QUIT
+10 ;;
TWEAK31(NODE) ;; itermittent with bad frequency
+1 NEW REASON,MESSAGE
+2 SET REASON=$$UP^XLFSTR($PIECE(NODE,U,10))
+3 if REASON'="INVALID OR UNDEFINED FREQUENCY"
QUIT 0
+4 ; -- RTC 165417
+5 if PSSDBASA
Begin DoDot:1
+6 SET MESSAGE="Max Daily Dose Check could not be done for Drug: "_$PIECE(PSSDBCAR(PSSDWEX2),U,2)_", please complete a manual check for appropriate Dosing."
+7 SET $PIECE(^TMP($JOB,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,PSSDWE2),U,7)=MESSAGE
+8 SET $PIECE(^TMP($JOB,PSSDBASE,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,PSSDWE2),U,10)=""
+9 SET ^TMP($JOB,PSSDBASF,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,1)=MESSAGE
+10 SET ^TMP($JOB,PSSDBASF,"OUT","EXCEPTIONS","DOSE",PSSDWEX2,2)=""
End DoDot:1
+11 if $$SHOGEN(PSSDWEX2)
DO GETGNRL3^PSSDSEXE(PSSDWEX2)
+12 SET $PIECE(PSSDBCAR(PSSDWEX2),U,27)=1
+13 QUIT 1
+14 ;;
CHECKMSG(PSSLOOP) ;; max single if single dose, excluded or complex, else dosing
+1 ;;,1)"Dosing Checks")
QUIT $SELECT(($PIECE(PSSDBCAR(PSSLOOP),U,5)=0)!($PIECE(PSSDBCAR(PSSLOOP),U,15)=1)!($$ISCMPLEX(PSSLOOP)):"Maximum Single Dose Check",$PIECE(PSSDBCAR(PSSLOOP),U,30)=1:"Dosing Order Checks",1:$$ISCMPLET^PSSDSEXE(PSSLOOP))
+2 ;;
ISCMPLEX(PSSLOOP) ;; is complex order
+1 QUIT $SELECT($PIECE(PSSDBCAR(PSSLOOP),U,16)=1:1,$PIECE(PSSLOOP,";",5):1,1:0)
+2 ;;
