EAS1113P ;ALB/TGH - Patch EAS*1.0*113 Post Install ;02/20/2015 8:43am
;;1.0;ENROLLMENT APPLICATION SYSTEM;**113**;FEB 20, 2015;Build 53
;;Per VA Directive 6402, this routine should not be modified.
;
; EAS*1*113 Post Install will add BT CLAIMS PROCESSING Mail Group to
; EAS BT CLAIMS PROCESSING Bulletin
;
EN ;
; If the BT CLAIMS PROCESSING Mail Group is already set up for the EAS
; BT CLAIMS PROCESSING Bulletin, Quit and write message to screen and do
; not continue
N BUL,MG
S MG=$$FIND1^DIC(3.8,,"BX","BT CLAIMS PROCESSING")
S BUL=$$FIND1^DIC(3.6,,"BX","EAS BT CLAIMS PROCESSING")
I $D(^XMB(3.6,BUL,2,"B",MG)) D Q
. N ARR
. S ARR(1)="========================================================"
. S ARR(2)="Mail Group already set. Update of Bulletin Not Required."
. S ARR(3)="========================================================"
. D BMES^XPDUTL(.ARR)
;
; Otherwise, set Mail Group into Bulletin
N IENS,FDA,ERROR,ERR,TXT
S IENS="+1,"_BUL_","
S FDA(3.62,IENS,.01)=MG
D UPDATE^DIE("","FDA","","ERROR")
;
; Process errors if any exist and display to screen
S ERR="" F S ERR=$O(ERROR("DIERR",ERR)) Q:ERR="" D
. S TXT="" F S TXT=$O(ERROR("DIERR",ERR,"TEXT",TXT)) Q:TXT="" D
. . D ERROR(ERROR("DIERR",ERR,"TEXT",TXT))
;
; Print success message to screen if no Errors
I '$D(ERROR("DIERR")) D
. N ARR
. S ARR(1)="========================================================"
. S ARR(2)="BT CLAIMS PROCESSING Mail Group has been successfully"
. S ARR(3)="added to EAS BT CLAIMS PROCESSING Bulletin."
. S ARR(4)="========================================================"
. D BMES^XPDUTL(.ARR)
;
Q ; EN
;
ERROR(ERRMSG) ;Display error message
;
N ARR
S ARR(1)="===================================================="
S ARR(2)="= ERROR ="
S ARR(3)="===================================================="
S ARR(4)="While updating Bulletin with Mail Group"
S ARR(5)="===================================================="
S ARR(6)="**ERROR MSG: "_ERRMSG
;
D BMES^XPDUTL(.ARR)
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEAS1113P 2085 printed Dec 13, 2024@01:53:05 Page 2
EAS1113P ;ALB/TGH - Patch EAS*1.0*113 Post Install ;02/20/2015 8:43am
+1 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**113**;FEB 20, 2015;Build 53
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; EAS*1*113 Post Install will add BT CLAIMS PROCESSING Mail Group to
+5 ; EAS BT CLAIMS PROCESSING Bulletin
+6 ;
EN ;
+1 ; If the BT CLAIMS PROCESSING Mail Group is already set up for the EAS
+2 ; BT CLAIMS PROCESSING Bulletin, Quit and write message to screen and do
+3 ; not continue
+4 NEW BUL,MG
+5 SET MG=$$FIND1^DIC(3.8,,"BX","BT CLAIMS PROCESSING")
+6 SET BUL=$$FIND1^DIC(3.6,,"BX","EAS BT CLAIMS PROCESSING")
+7 IF $DATA(^XMB(3.6,BUL,2,"B",MG))
Begin DoDot:1
+8 NEW ARR
+9 SET ARR(1)="========================================================"
+10 SET ARR(2)="Mail Group already set. Update of Bulletin Not Required."
+11 SET ARR(3)="========================================================"
+12 DO BMES^XPDUTL(.ARR)
End DoDot:1
QUIT
+13 ;
+14 ; Otherwise, set Mail Group into Bulletin
+15 NEW IENS,FDA,ERROR,ERR,TXT
+16 SET IENS="+1,"_BUL_","
+17 SET FDA(3.62,IENS,.01)=MG
+18 DO UPDATE^DIE("","FDA","","ERROR")
+19 ;
+20 ; Process errors if any exist and display to screen
+21 SET ERR=""
FOR
SET ERR=$ORDER(ERROR("DIERR",ERR))
if ERR=""
QUIT
Begin DoDot:1
+22 SET TXT=""
FOR
SET TXT=$ORDER(ERROR("DIERR",ERR,"TEXT",TXT))
if TXT=""
QUIT
Begin DoDot:2
+23 DO ERROR(ERROR("DIERR",ERR,"TEXT",TXT))
End DoDot:2
End DoDot:1
+24 ;
+25 ; Print success message to screen if no Errors
+26 IF '$DATA(ERROR("DIERR"))
Begin DoDot:1
+27 NEW ARR
+28 SET ARR(1)="========================================================"
+29 SET ARR(2)="BT CLAIMS PROCESSING Mail Group has been successfully"
+30 SET ARR(3)="added to EAS BT CLAIMS PROCESSING Bulletin."
+31 SET ARR(4)="========================================================"
+32 DO BMES^XPDUTL(.ARR)
End DoDot:1
+33 ;
+34 ; EN
QUIT
+35 ;
ERROR(ERRMSG) ;Display error message
+1 ;
+2 NEW ARR
+3 SET ARR(1)="===================================================="
+4 SET ARR(2)="= ERROR ="
+5 SET ARR(3)="===================================================="
+6 SET ARR(4)="While updating Bulletin with Mail Group"
+7 SET ARR(5)="===================================================="
+8 SET ARR(6)="**ERROR MSG: "_ERRMSG
+9 ;
+10 DO BMES^XPDUTL(.ARR)
+11 ;
+12 QUIT
