SDPCE2 ;MJK/ALB - Process PCE - Bulletin ;01 APR 1993
;;5.3;Scheduling;**27**;08/13/93
;
; **** See SDPCE0 for variable definitions ****
;
BULL(DFN,SDT,SDCL,SDEVENT,SDERR,SDVSIT,SDACT) ;
; input:
; o Required Variables:
; DFN := ifn of patient
; SDT := visit date [internal date format]
; SDCL := ifn of clinic
; SDEVENT() := event info array
; SDERR() := error info array
; SDACT := activity [free text]
; SDVSIT() := visit info array
;
;
N SDBUL,XMDUZ,XMSUB,XMTEXT,SDLN,VA,SDTYPE,SDMSG,SDATA,STATUS
;
; -- check status... if cancelled or no-show quit
S SDATA=$G(^DPT(DFN,"S",SDT,0))
S STATUS=+$$STATUS^SDAM1(DFN,SDT,SDCL,SDATA,$G(SDDA))
IF "^4^5^6^7^9^10^"[U_STATUS_U G BULLQ
;
; -- should message be sent
S SDMSG=$$MSG() IF SDMSG="" G BULLQ
;
; -- if no notifications to process then quit
IF '$D(SDERR("ERROR")),'$D(SDERR("WARNING")) G BULLQ
;
; -- if (no 'errors' to process) and ('warnings' are NOT to be processed) then quit
IF '$D(SDERR("ERROR")),SDMSG'["WARNING" G BULLQ
;
; use site specified mg and bull is only sent if mg defined
D XMY^SDUTL2(+$P($G(^DG(43,1,"SCLR")),U,26),0,0) G BULLQ:'$D(XMY)
S XMSUB="Scheduling API Error/Warning",XMTEXT="SDBUL("
D SET("The following background error has occurred:")
D SET("")
D SET(" Activity: "_SDACT)
D SET(" Visit File Entry #: "_SDVSIT)
D SET(" Visit Date: "_$$FTIME^VALM1(SDT))
D SET(" Clinic: "_$P($G(^SC(+SDCL,0)),U))
D PID^VADPT6
D SET(" Patient: "_$P($G(^DPT(+DFN,0)),U)_" ("_VA("BID")_")")
D SET("")
F SDTYPE="ERROR","WARNING" IF SDMSG[SDTYPE D TYPE(SDTYPE)
D ^XMD
BULLQ K XMY Q
;
SET(X) ; -- set text into array
S SDLN=$G(SDLN)+1,SDBUL(SDLN,0)=X Q
;
TYPE(SDTYPE) ; -- insert errors/warnings into msg
N SDI,X,Y,SDCNT
S SDCNT=0
D SET(SDTYPE_" #:")
D SET($E("-------------",1,$L(SDTYPE)+3))
S SDI=0 F S SDI=$O(SDERR(SDTYPE,SDI)) Q:'SDI D
. S X=SDERR(SDTYPE,SDI),Y=$P(X,U,2),SDCNT=SDCNT+1
. D SET(" "_$P(X,U)_$E(" ",1,8-$L($P(X,U)))_"-> "_$E(Y,1,60)) S Y=$E(Y,61,999)
. F Q:Y="" D SET(" "_$E(Y,1,60)) S Y=$E(Y,61,999)
IF 'SDCNT D SET(" <none reported>")
D SET(""),SET("")
Q
;
MSG() ; -- msg flag 'ERROR' or 'WARNING' or 'ERROR+WARNING'
N Y,X
S Y=$P($G(^DG(43,1,"SCLR")),U,27),X=""
I Y["E" S X=X_"ERROR/"
I Y["W" S X=X_"WARNING"
Q X
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDPCE2 2481 printed Apr 09, 2024@21:42:27 Page 2
SDPCE2 ;MJK/ALB - Process PCE - Bulletin ;01 APR 1993
+1 ;;5.3;Scheduling;**27**;08/13/93
+2 ;
+3 ; **** See SDPCE0 for variable definitions ****
+4 ;
BULL(DFN,SDT,SDCL,SDEVENT,SDERR,SDVSIT,SDACT) ;
+1 ; input:
+2 ; o Required Variables:
+3 ; DFN := ifn of patient
+4 ; SDT := visit date [internal date format]
+5 ; SDCL := ifn of clinic
+6 ; SDEVENT() := event info array
+7 ; SDERR() := error info array
+8 ; SDACT := activity [free text]
+9 ; SDVSIT() := visit info array
+10 ;
+11 ;
+12 NEW SDBUL,XMDUZ,XMSUB,XMTEXT,SDLN,VA,SDTYPE,SDMSG,SDATA,STATUS
+13 ;
+14 ; -- check status... if cancelled or no-show quit
+15 SET SDATA=$GET(^DPT(DFN,"S",SDT,0))
+16 SET STATUS=+$$STATUS^SDAM1(DFN,SDT,SDCL,SDATA,$GET(SDDA))
+17 IF "^4^5^6^7^9^10^"[U_STATUS_U
GOTO BULLQ
+18 ;
+19 ; -- should message be sent
+20 SET SDMSG=$$MSG()
IF SDMSG=""
GOTO BULLQ
+21 ;
+22 ; -- if no notifications to process then quit
+23 IF '$DATA(SDERR("ERROR"))
IF '$DATA(SDERR("WARNING"))
GOTO BULLQ
+24 ;
+25 ; -- if (no 'errors' to process) and ('warnings' are NOT to be processed) then quit
+26 IF '$DATA(SDERR("ERROR"))
IF SDMSG'["WARNING"
GOTO BULLQ
+27 ;
+28 ; use site specified mg and bull is only sent if mg defined
+29 DO XMY^SDUTL2(+$PIECE($GET(^DG(43,1,"SCLR")),U,26),0,0)
if '$DATA(XMY)
GOTO BULLQ
+30 SET XMSUB="Scheduling API Error/Warning"
SET XMTEXT="SDBUL("
+31 DO SET("The following background error has occurred:")
+32 DO SET("")
+33 DO SET(" Activity: "_SDACT)
+34 DO SET(" Visit File Entry #: "_SDVSIT)
+35 DO SET(" Visit Date: "_$$FTIME^VALM1(SDT))
+36 DO SET(" Clinic: "_$PIECE($GET(^SC(+SDCL,0)),U))
+37 DO PID^VADPT6
+38 DO SET(" Patient: "_$PIECE($GET(^DPT(+DFN,0)),U)_" ("_VA("BID")_")")
+39 DO SET("")
+40 FOR SDTYPE="ERROR","WARNING"
IF SDMSG[SDTYPE
DO TYPE(SDTYPE)
+41 DO ^XMD
BULLQ KILL XMY
QUIT
+1 ;
SET(X) ; -- set text into array
+1 SET SDLN=$GET(SDLN)+1
SET SDBUL(SDLN,0)=X
QUIT
+2 ;
TYPE(SDTYPE) ; -- insert errors/warnings into msg
+1 NEW SDI,X,Y,SDCNT
+2 SET SDCNT=0
+3 DO SET(SDTYPE_" #:")
+4 DO SET($EXTRACT("-------------",1,$LENGTH(SDTYPE)+3))
+5 SET SDI=0
FOR
SET SDI=$ORDER(SDERR(SDTYPE,SDI))
if 'SDI
QUIT
Begin DoDot:1
+6 SET X=SDERR(SDTYPE,SDI)
SET Y=$PIECE(X,U,2)
SET SDCNT=SDCNT+1
+7 DO SET(" "_$PIECE(X,U)_$EXTRACT(" ",1,8-$LENGTH($PIECE(X,U)))_"-> "_$EXTRACT(Y,1,60))
SET Y=$EXTRACT(Y,61,999)
+8 FOR
if Y=""
QUIT
DO SET(" "_$EXTRACT(Y,1,60))
SET Y=$EXTRACT(Y,61,999)
End DoDot:1
+9 IF 'SDCNT
DO SET(" <none reported>")
+10 DO SET("")
DO SET("")
+11 QUIT
+12 ;
MSG() ; -- msg flag 'ERROR' or 'WARNING' or 'ERROR+WARNING'
+1 NEW Y,X
+2 SET Y=$PIECE($GET(^DG(43,1,"SCLR")),U,27)
SET X=""
+3 IF Y["E"
SET X=X_"ERROR/"
+4 IF Y["W"
SET X=X_"WARNING"
+5 QUIT X
+6 ;
