PSSDSEXF ;BIR/CMF-Exceptions for Dose call Continuation ;02/24/09
;;1.0;PHARMACY DATA MANAGEMENT;**224**;9/30/97;Build 3
;
;Called from PSSDSEXE, 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:
;
;;
TWEAK200 ;; loop through exception then error globals, ensure no duplicate generic messages
N PSSDXLP,PSSREPL,PSSDEMSG
S PSSDXLP=""
F S PSSDXLP=$O(^TMP($J,PSSDBASF,"OUT","EXCEPTIONS","DOSE",PSSDXLP)) Q:PSSDXLP="" D
.S PSSDXLP("MSG")="",PSSDXLP("RSN")="",PSSDXLP("TYP")="",PSSDXLP("FLG")=""
.S PSSDXLP("MSG")=$G(^TMP($J,PSSDBASF,"OUT","EXCEPTIONS","DOSE",PSSDXLP,1))
.Q:PSSDXLP("MSG")=""
.S PSSDXLP("TYP")=$S(PSSDXLP("MSG")["Maximum Single":"S",PSSDXLP("MSG")["Max Daily":"D",1:"B")
.S PSSDXLP("RSN")=$G(^TMP($J,PSSDBASF,"OUT","EXCEPTIONS","DOSE",PSSDXLP,2))
.D:PSSDXLP("RSN")="" TWEAK205(.PSSDXLP)
.D:PSSDXLP("FLG")=1
..S PSSREPL("Maximum Single Dose Check")="Dosing Checks"
..S PSSREPL("Max Daily Dose Check")="Dosing Checks"
..S PSSDEMSG=$$REPLACE^XLFSTR(PSSDXLP("MSG"),.PSSREPL)
..S ^TMP($J,PSSDBASF,"OUT","EXCEPTIONS","DOSE",PSSDXLP,1)=PSSDEMSG
..S $P(PSSDBCAR(PSSDXLP),U,27)=1
..Q
.Q
;;
TWEAK205(PSSDXLP) ;; look for errors matching the exception, remove if found, return flag to TWEAK200
N PSSDWLP,PSSDWCNT
S PSSDWLP=PSSDXLP
S PSSDWCNT=""
F S PSSDWCNT=$O(^TMP($J,PSSDBASF,"OUT","DOSE","ERROR",PSSDWLP,PSSDWCNT)) Q:'PSSDWCNT D
.S PSSDWLP("MSG")=$G(^TMP($J,PSSDBASF,"OUT","DOSE","ERROR",PSSDWLP,PSSDWCNT,"MSG"))
.Q:PSSDWLP("MSG")=""
.S PSSDWLP("RSN")=$G(^TMP($J,PSSDBASF,"OUT","DOSE","ERROR",PSSDWLP,PSSDWCNT,"TEXT"))
.D:PSSDWLP("RSN")=""
..S PSSDWLP("MSG")="",PSSDWLP("RSN")="",PSSDWLP("TYP")=""
..S PSSDWLP("TYP")=$S(PSSDWLP("MSG")["Maximum Single":"S",PSSDWLP("MSG")["Max Daily":"D",1:"B")
..S:PSSDWLP("TYP")'=PSSDXLP("TYP") PSSDXLP("FLG")=1
..K ^TMP($J,PSSDBASF,"OUT","DOSE","ERROR",PSSDWLP,PSSDWCNT)
.Q
;;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSSDSEXF 2143 printed Dec 13, 2024@02:31:19 Page 2
PSSDSEXF ;BIR/CMF-Exceptions for Dose call Continuation ;02/24/09
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**224**;9/30/97;Build 3
+2 ;
+3 ;Called from PSSDSEXE, 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 ;;
TWEAK200 ;; loop through exception then error globals, ensure no duplicate generic messages
+1 NEW PSSDXLP,PSSREPL,PSSDEMSG
+2 SET PSSDXLP=""
+3 FOR
SET PSSDXLP=$ORDER(^TMP($JOB,PSSDBASF,"OUT","EXCEPTIONS","DOSE",PSSDXLP))
if PSSDXLP=""
QUIT
Begin DoDot:1
+4 SET PSSDXLP("MSG")=""
SET PSSDXLP("RSN")=""
SET PSSDXLP("TYP")=""
SET PSSDXLP("FLG")=""
+5 SET PSSDXLP("MSG")=$GET(^TMP($JOB,PSSDBASF,"OUT","EXCEPTIONS","DOSE",PSSDXLP,1))
+6 if PSSDXLP("MSG")=""
QUIT
+7 SET PSSDXLP("TYP")=$SELECT(PSSDXLP("MSG")["Maximum Single":"S",PSSDXLP("MSG")["Max Daily":"D",1:"B")
+8 SET PSSDXLP("RSN")=$GET(^TMP($JOB,PSSDBASF,"OUT","EXCEPTIONS","DOSE",PSSDXLP,2))
+9 if PSSDXLP("RSN")=""
DO TWEAK205(.PSSDXLP)
+10 if PSSDXLP("FLG")=1
Begin DoDot:2
+11 SET PSSREPL("Maximum Single Dose Check")="Dosing Checks"
+12 SET PSSREPL("Max Daily Dose Check")="Dosing Checks"
+13 SET PSSDEMSG=$$REPLACE^XLFSTR(PSSDXLP("MSG"),.PSSREPL)
+14 SET ^TMP($JOB,PSSDBASF,"OUT","EXCEPTIONS","DOSE",PSSDXLP,1)=PSSDEMSG
+15 SET $PIECE(PSSDBCAR(PSSDXLP),U,27)=1
+16 QUIT
End DoDot:2
+17 QUIT
End DoDot:1
+18 ;;
TWEAK205(PSSDXLP) ;; look for errors matching the exception, remove if found, return flag to TWEAK200
+1 NEW PSSDWLP,PSSDWCNT
+2 SET PSSDWLP=PSSDXLP
+3 SET PSSDWCNT=""
+4 FOR
SET PSSDWCNT=$ORDER(^TMP($JOB,PSSDBASF,"OUT","DOSE","ERROR",PSSDWLP,PSSDWCNT))
if 'PSSDWCNT
QUIT
Begin DoDot:1
+5 SET PSSDWLP("MSG")=$GET(^TMP($JOB,PSSDBASF,"OUT","DOSE","ERROR",PSSDWLP,PSSDWCNT,"MSG"))
+6 if PSSDWLP("MSG")=""
QUIT
+7 SET PSSDWLP("RSN")=$GET(^TMP($JOB,PSSDBASF,"OUT","DOSE","ERROR",PSSDWLP,PSSDWCNT,"TEXT"))
+8 if PSSDWLP("RSN")=""
Begin DoDot:2
+9 SET PSSDWLP("MSG")=""
SET PSSDWLP("RSN")=""
SET PSSDWLP("TYP")=""
+10 SET PSSDWLP("TYP")=$SELECT(PSSDWLP("MSG")["Maximum Single":"S",PSSDWLP("MSG")["Max Daily":"D",1:"B")
+11 if PSSDWLP("TYP")'=PSSDXLP("TYP")
SET PSSDXLP("FLG")=1
+12 KILL ^TMP($JOB,PSSDBASF,"OUT","DOSE","ERROR",PSSDWLP,PSSDWCNT)
End DoDot:2
+13 QUIT
End DoDot:1
+14 ;;