DG531098P ;ALB/ARF - DG*5.3*1098 INSTALL UTILITY;07/12/2021 15:21pm
;;5.3;Registration;**1098**;Jan 26 2022;Build 13
;
QUIT ;No direct entry
;
;---------------------------------------------------------------------------
;Patch DG*5.3*1098: Environment, Pre-Install, and Post-Install entry points.
;---------------------------------------------------------------------------
;
; Reference to BMES^XPDUTL supported by ICR #10141
; Reference to MES^XPDUTL supported by ICR #10141
;
ENV ;Main entry point for Environment check
Q
;
PRE ;Main entry point for Pre-Install items
Q
;
POST ;Main entry point for Post-Install items
;
D BMES^XPDUTL(">>> Beginning the DG*5.3*1098 Post-install routine...")
D POST1
D POST2
D BMES^XPDUTL(">>> Patch DG*5.3*1098 - Post-install complete.")
Q
;
POST1 ; Add WORLD WAR II eligibility to ELIGIBILITY CODE (#8) file
;
NEW DGEC,DGPH,DGFDA,DGERR
S DGEC="WORLD WAR II"
D BMES^XPDUTL(" o Adding 'WORLD WAR II' to the ELIGIBILITY CODE (#8) file.")
S DGPH=$$FIND1^DIC(8.1,"","X",DGEC)
I 'DGPH D Q
. D BMES^XPDUTL("*** ERROR! ***")
. D MES^XPDUTL(" - WORLD WAR II entry missing from MAS ELIGIBILITY CODE (#8.1) file")
. D MES^XPDUTL(" - Submit a YOUR IT Services ticket with the Enterprise Service Desk")
. D MES^XPDUTL(" for assistance.")
I $$FIND1^DIC(8,"","X",DGEC) D Q
. D BMES^XPDUTL("*** WORLD WAR II entry already exists... No action required.")
; Add entry to file
S DGFDA(8,"+1,",.01)=DGEC
S DGFDA(8,"+1,",.12)="0"
S DGFDA(8,"+1,",1)="B"
S DGFDA(8,"+1,",2)="WWII"
S DGFDA(8,"+1,",3)=2
S DGFDA(8,"+1,",4)="Y"
S DGFDA(8,"+1,",5)=DGEC
S DGFDA(8,"+1,",6)=""
S DGFDA(8,"+1,",7)=1
S DGFDA(8,"+1,",8)=DGEC
S DGFDA(8,"+1,",9)="VA STANDARD"
S DGFDA(8,"+1,",11)="VA"
D UPDATE^DIE("E","DGFDA","","DGERR")
I '$D(DGERR) D BMES^XPDUTL(" o WORLD WAR II successfully added to ELIGIBILITY CODE (#8) file.")
I $D(DGERR) D
. D BMES^XPDUTL("*** ERROR! ***")
. D MES^XPDUTL(" - WORLD WAR II was NOT successfully added to the ELIGIBILITY CODE (#8) file.")
. D MES^XPDUTL(" - Submit a YOUR IT Services ticket with the Enterprise Service Desk")
. D MES^XPDUTL(" for assistance.")
Q
POST2 ; Set WORLD WAR I eligibility code to INACTIVE in the ELIGIBILITY CODE (#8) file
;
NEW DGEC,DGPH,DGFDA,DGERR
S DGEC="WORLD WAR I"
D BMES^XPDUTL(" o Setting 'WORLD WAR I' entry in the ELIGIBILITY CODE (#8) file to INACTIVE.")
S DGPH=$$FIND1^DIC(8,"","X",DGEC) ;find the IEN of the WORLD WAR I entry in file #8 ELIGIBILITY CODE file
I 'DGPH D Q
. D BMES^XPDUTL("*** ERROR! ***")
. D MES^XPDUTL(" - WORLD WAR I entry missing from ELIGIBILITY CODE (#8) file")
. D MES^XPDUTL(" - Submit a YOUR IT Services ticket with the Enterprise Service Desk")
. D MES^XPDUTL(" for assistance.")
; Quit if the INACTIVE field is already set to YES
I $$GET1^DIQ(8,DGPH,6,"I") D Q
. D BMES^XPDUTL("*** WORLD WAR I is already set to INACTIVE...No action required.")
; Set the INACTIVE field in the WORLD WAR I entry in the ELIGIBILITY CODE (#8) file
S DGFDA(8,DGPH_",",6)=1 ;the INACTIVE field (#6) is set to 1-YES
D UPDATE^DIE("E","DGFDA","","DGERR")
I '$D(DGERR) D BMES^XPDUTL(" o WORLD WAR I entry successfully set to INACTIVE in ELIGIBILITY CODE (#8) file.")
I $D(DGERR) D
. D BMES^XPDUTL("*** ERROR! ***")
. D MES^XPDUTL(" - WORLD WAR I entry was NOT successfully set to INACTIVE in the ELIGIBILITY CODE (#8) file.")
. D MES^XPDUTL(" - Submit a YOUR IT Services ticket with the Enterprise Service Desk")
. D MES^XPDUTL(" for assistance.")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG531098P 3608 printed Apr 09, 2024@21:45:24 Page 2
DG531098P ;ALB/ARF - DG*5.3*1098 INSTALL UTILITY;07/12/2021 15:21pm
+1 ;;5.3;Registration;**1098**;Jan 26 2022;Build 13
+2 ;
QUIT ;No direct entry
+1 ;
+2 ;---------------------------------------------------------------------------
+3 ;Patch DG*5.3*1098: Environment, Pre-Install, and Post-Install entry points.
+4 ;---------------------------------------------------------------------------
+5 ;
+6 ; Reference to BMES^XPDUTL supported by ICR #10141
+7 ; Reference to MES^XPDUTL supported by ICR #10141
+8 ;
ENV ;Main entry point for Environment check
+1 QUIT
+2 ;
PRE ;Main entry point for Pre-Install items
+1 QUIT
+2 ;
POST ;Main entry point for Post-Install items
+1 ;
+2 DO BMES^XPDUTL(">>> Beginning the DG*5.3*1098 Post-install routine...")
+3 DO POST1
+4 DO POST2
+5 DO BMES^XPDUTL(">>> Patch DG*5.3*1098 - Post-install complete.")
+6 QUIT
+7 ;
POST1 ; Add WORLD WAR II eligibility to ELIGIBILITY CODE (#8) file
+1 ;
+2 NEW DGEC,DGPH,DGFDA,DGERR
+3 SET DGEC="WORLD WAR II"
+4 DO BMES^XPDUTL(" o Adding 'WORLD WAR II' to the ELIGIBILITY CODE (#8) file.")
+5 SET DGPH=$$FIND1^DIC(8.1,"","X",DGEC)
+6 IF 'DGPH
Begin DoDot:1
+7 DO BMES^XPDUTL("*** ERROR! ***")
+8 DO MES^XPDUTL(" - WORLD WAR II entry missing from MAS ELIGIBILITY CODE (#8.1) file")
+9 DO MES^XPDUTL(" - Submit a YOUR IT Services ticket with the Enterprise Service Desk")
+10 DO MES^XPDUTL(" for assistance.")
End DoDot:1
QUIT
+11 IF $$FIND1^DIC(8,"","X",DGEC)
Begin DoDot:1
+12 DO BMES^XPDUTL("*** WORLD WAR II entry already exists... No action required.")
End DoDot:1
QUIT
+13 ; Add entry to file
+14 SET DGFDA(8,"+1,",.01)=DGEC
+15 SET DGFDA(8,"+1,",.12)="0"
+16 SET DGFDA(8,"+1,",1)="B"
+17 SET DGFDA(8,"+1,",2)="WWII"
+18 SET DGFDA(8,"+1,",3)=2
+19 SET DGFDA(8,"+1,",4)="Y"
+20 SET DGFDA(8,"+1,",5)=DGEC
+21 SET DGFDA(8,"+1,",6)=""
+22 SET DGFDA(8,"+1,",7)=1
+23 SET DGFDA(8,"+1,",8)=DGEC
+24 SET DGFDA(8,"+1,",9)="VA STANDARD"
+25 SET DGFDA(8,"+1,",11)="VA"
+26 DO UPDATE^DIE("E","DGFDA","","DGERR")
+27 IF '$DATA(DGERR)
DO BMES^XPDUTL(" o WORLD WAR II successfully added to ELIGIBILITY CODE (#8) file.")
+28 IF $DATA(DGERR)
Begin DoDot:1
+29 DO BMES^XPDUTL("*** ERROR! ***")
+30 DO MES^XPDUTL(" - WORLD WAR II was NOT successfully added to the ELIGIBILITY CODE (#8) file.")
+31 DO MES^XPDUTL(" - Submit a YOUR IT Services ticket with the Enterprise Service Desk")
+32 DO MES^XPDUTL(" for assistance.")
End DoDot:1
+33 QUIT
POST2 ; Set WORLD WAR I eligibility code to INACTIVE in the ELIGIBILITY CODE (#8) file
+1 ;
+2 NEW DGEC,DGPH,DGFDA,DGERR
+3 SET DGEC="WORLD WAR I"
+4 DO BMES^XPDUTL(" o Setting 'WORLD WAR I' entry in the ELIGIBILITY CODE (#8) file to INACTIVE.")
+5 ;find the IEN of the WORLD WAR I entry in file #8 ELIGIBILITY CODE file
SET DGPH=$$FIND1^DIC(8,"","X",DGEC)
+6 IF 'DGPH
Begin DoDot:1
+7 DO BMES^XPDUTL("*** ERROR! ***")
+8 DO MES^XPDUTL(" - WORLD WAR I entry missing from ELIGIBILITY CODE (#8) file")
+9 DO MES^XPDUTL(" - Submit a YOUR IT Services ticket with the Enterprise Service Desk")
+10 DO MES^XPDUTL(" for assistance.")
End DoDot:1
QUIT
+11 ; Quit if the INACTIVE field is already set to YES
+12 IF $$GET1^DIQ(8,DGPH,6,"I")
Begin DoDot:1
+13 DO BMES^XPDUTL("*** WORLD WAR I is already set to INACTIVE...No action required.")
End DoDot:1
QUIT
+14 ; Set the INACTIVE field in the WORLD WAR I entry in the ELIGIBILITY CODE (#8) file
+15 ;the INACTIVE field (#6) is set to 1-YES
SET DGFDA(8,DGPH_",",6)=1
+16 DO UPDATE^DIE("E","DGFDA","","DGERR")
+17 IF '$DATA(DGERR)
DO BMES^XPDUTL(" o WORLD WAR I entry successfully set to INACTIVE in ELIGIBILITY CODE (#8) file.")
+18 IF $DATA(DGERR)
Begin DoDot:1
+19 DO BMES^XPDUTL("*** ERROR! ***")
+20 DO MES^XPDUTL(" - WORLD WAR I entry was NOT successfully set to INACTIVE in the ELIGIBILITY CODE (#8) file.")
+21 DO MES^XPDUTL(" - Submit a YOUR IT Services ticket with the Enterprise Service Desk")
+22 DO MES^XPDUTL(" for assistance.")
End DoDot:1
+23 QUIT
