VAQBUL07 ;ALB/JRP - BULLETINS;26-JUL-93
;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
PURGE(ERRARR) ;SEND PURGING ERROR BULLETIN
;INPUT : ERRARR - Array of errors subscripted by entry number in
; transaction file (full global ref)
;OUTPUT : 0 - Bulletin sent
; -1^ErrorText - Bulletin not sent
;NOTES : ERRARR should be in the format
; ERRARR(Transaction's IFN)=Error text
;
;CHECK INPUT
Q:($G(ERRARR)="") "-1^Did not pass reference to error array"
Q:('$D(@ERRARR)) 0
;DECLARE VARIABLES
N SUBJ,SENTBY,FWRDBY,XMY,TMPARR,TRANPTR,X,STOPPED,LINE
S TMPARR="^TMP(""VAQ-BUL"","_$J_")"
K @TMPARR
S LINE=1
;DETERMINE IF PURGER WAS STOPPED
S STOPPED=$D(@ERRARR@("STOPPED"))
I (STOPPED) D
.S @TMPARR@(LINE,0)="** Purger was stopped before completion **"
.S LINE=LINE+1
.S @TMPARR@(LINE,0)=""
.S LINE=LINE+1
.S @TMPARR@(LINE,0)=""
.S LINE=LINE+1
;BUILD MESSAGE
S @TMPARR@(LINE,0)="The following PDX Transaction(s) could not be purged ..."
S LINE=LINE+1
S @TMPARR@(LINE,0)=""
S LINE=LINE+1
S TRANPTR=""
F S TRANPTR=$O(@ERRARR@(TRANPTR)) Q:(TRANPTR="") D
.Q:(TRANPTR="STOPPED")
.S @TMPARR@(LINE,0)=""
.S LINE=LINE+1
.S X=$G(@ERRARR@(TRANPTR))
.S @TMPARR@(LINE,0)="Entry #: "_TRANPTR
.S LINE=LINE+1
.S @TMPARR@(LINE,0)=" Global: ^VAT(394.61,"_TRANPTR_")"
.S LINE=LINE+1
.S @TMPARR@(LINE,0)=" Reason: "_X
.S LINE=LINE+1
S @TMPARR@(LINE,0)=""
S LINE=LINE+1
S @TMPARR@(LINE,0)=""
S LINE=LINE+1
S @TMPARR@(LINE,0)="** Please remember that PDX Transactions may also **"
S LINE=LINE+1
S @TMPARR@(LINE,0)="** have associated data stored in file number 394.62 **"
S LINE=LINE+1
S @TMPARR@(LINE,0)=""
S LINE=LINE+1
;SET UP CALL TO SEND BULLETIN
S SUBJ="PDX TRANSACTIONS COULD NOT BE PURGED"
S SENTBY="PDX"
S FWRDBY="Patient Data eXchange"
S XMY("G.VAQ PDX ERRORS")=""
;SEND BULLETIN
S X=$$SENDBULL^VAQBUL(SUBJ,SENTBY,FWRDBY,TMPARR)
S:(X>0) X=0
;CLEAN UP
K @TMPARR
Q X
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAQBUL07 2009 printed Apr 09, 2024@21:27:55 Page 2
VAQBUL07 ;ALB/JRP - BULLETINS;26-JUL-93
+1 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
PURGE(ERRARR) ;SEND PURGING ERROR BULLETIN
+1 ;INPUT : ERRARR - Array of errors subscripted by entry number in
+2 ; transaction file (full global ref)
+3 ;OUTPUT : 0 - Bulletin sent
+4 ; -1^ErrorText - Bulletin not sent
+5 ;NOTES : ERRARR should be in the format
+6 ; ERRARR(Transaction's IFN)=Error text
+7 ;
+8 ;CHECK INPUT
+9 if ($GET(ERRARR)="")
QUIT "-1^Did not pass reference to error array"
+10 if ('$DATA(@ERRARR))
QUIT 0
+11 ;DECLARE VARIABLES
+12 NEW SUBJ,SENTBY,FWRDBY,XMY,TMPARR,TRANPTR,X,STOPPED,LINE
+13 SET TMPARR="^TMP(""VAQ-BUL"","_$JOB_")"
+14 KILL @TMPARR
+15 SET LINE=1
+16 ;DETERMINE IF PURGER WAS STOPPED
+17 SET STOPPED=$DATA(@ERRARR@("STOPPED"))
+18 IF (STOPPED)
Begin DoDot:1
+19 SET @TMPARR@(LINE,0)="** Purger was stopped before completion **"
+20 SET LINE=LINE+1
+21 SET @TMPARR@(LINE,0)=""
+22 SET LINE=LINE+1
+23 SET @TMPARR@(LINE,0)=""
+24 SET LINE=LINE+1
End DoDot:1
+25 ;BUILD MESSAGE
+26 SET @TMPARR@(LINE,0)="The following PDX Transaction(s) could not be purged ..."
+27 SET LINE=LINE+1
+28 SET @TMPARR@(LINE,0)=""
+29 SET LINE=LINE+1
+30 SET TRANPTR=""
+31 FOR
SET TRANPTR=$ORDER(@ERRARR@(TRANPTR))
if (TRANPTR="")
QUIT
Begin DoDot:1
+32 if (TRANPTR="STOPPED")
QUIT
+33 SET @TMPARR@(LINE,0)=""
+34 SET LINE=LINE+1
+35 SET X=$GET(@ERRARR@(TRANPTR))
+36 SET @TMPARR@(LINE,0)="Entry #: "_TRANPTR
+37 SET LINE=LINE+1
+38 SET @TMPARR@(LINE,0)=" Global: ^VAT(394.61,"_TRANPTR_")"
+39 SET LINE=LINE+1
+40 SET @TMPARR@(LINE,0)=" Reason: "_X
+41 SET LINE=LINE+1
End DoDot:1
+42 SET @TMPARR@(LINE,0)=""
+43 SET LINE=LINE+1
+44 SET @TMPARR@(LINE,0)=""
+45 SET LINE=LINE+1
+46 SET @TMPARR@(LINE,0)="** Please remember that PDX Transactions may also **"
+47 SET LINE=LINE+1
+48 SET @TMPARR@(LINE,0)="** have associated data stored in file number 394.62 **"
+49 SET LINE=LINE+1
+50 SET @TMPARR@(LINE,0)=""
+51 SET LINE=LINE+1
+52 ;SET UP CALL TO SEND BULLETIN
+53 SET SUBJ="PDX TRANSACTIONS COULD NOT BE PURGED"
+54 SET SENTBY="PDX"
+55 SET FWRDBY="Patient Data eXchange"
+56 SET XMY("G.VAQ PDX ERRORS")=""
+57 ;SEND BULLETIN
+58 SET X=$$SENDBULL^VAQBUL(SUBJ,SENTBY,FWRDBY,TMPARR)
+59 if (X>0)
SET X=0
+60 ;CLEAN UP
+61 KILL @TMPARR
+62 QUIT X
