- 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 Mar 13, 2025@21:29:09 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
