DG531067P ;ALB/JAM - PATCH DG*5.3*1067 PRE/POST-INSTALL ROUTINE ;17 November 2021 10:00 AM
;;5.3;Registration;**1067**;Aug 13, 1993;Build 23
; ICRs:
; Reference to BMES^XPDUTL supported by ICR #10141
; Reference to MES^XPDUTL supported by ICR #10141
; Reference to EN^XPAR supported by ICR #2263
; Reference to DIEZ^DIKCUTL3 support by ICR #3352
;
Q
PRE ; PRE INSTALL Main entry point
; Rename VHAPs
D BMES^XPDUTL(">>> Beginning the DG*5.3*1067 Pre-install routine")
D BMES^XPDUTL("Updating the HEALTH BENEFIT PLAN file (#25.11)...")
; Rename ACTIVE DUTY AND TRICARE SHARING AGREEMENT to TRICARE
D PRE1
; Rename VA DOD DIRECT RESOURCE SHARING AGREEMENTS to VA DOD SHARING MEDICAL RESOURCES
D PRE2
; Rename BENEFICIARY CHAMPVA to CHAMPVA STANDARD
D PRE3
; Rename VETERAN BENEFICIARY PLAN - CAMP LEJEUNE FAMILY to CAMP LEJEUNE FAMILY
D PRE4
D BMES^XPDUTL(">>> DG*5.3*1067 Pre-install completed")
Q
PRE1 ; Rename "ACTIVE DUTY AND TRICARE SHARING AGREEMENT" to "TRICARE"
N DGOLDNAME,DGIEN,DGDATA,DGSD,DGERR
S DGOLDNAME="ACTIVE DUTY AND TRICARE SHARING AGREEMENT"
S DGIEN=$O(^DGHBP(25.11,"B",DGOLDNAME,0))
I 'DGIEN D MES^XPDUTL("ACTIVE DUTY AND TRICARE SHARING AGREEMENT not found - no action needed.") Q
; Rename the old plan to the new plan name and change Short Desc field
S DGDATA(.01)="TRICARE"
I $$UPD^DGENDBS(25.11,.DGIEN,.DGDATA,.DGERR) D
. D MES^XPDUTL("ACTIVE DUTY AND TRICARE SHARING AGREEMENT (ADTSA) plan renamed to")
. D MES^XPDUTL("TRICARE")
I $G(DGERR)'="" D
. D BMES^XPDUTL("**** Error updating the ACTIVE DUTY AND TRICARE SHARING AGREEMENT (ADTSA) plan.")
. D MES^XPDUTL(">>> Error: "_DGERR)
. D MES^XPDUTL(">>> DG*5.3*1067 Pre-install Routine Failed.")
. D MES^XPDUTL(" - Installation Terminated.")
. D MES^XPDUTL(" - Transport global removed from system.")
. S XPDABORT=1
Q
;
PRE2 ; Rename "VA DOD DIRECT RESOURCE SHARING AGREEMENTS" to "VA DOD SHARING MEDICAL RESOURCES"
N DGOLDNAME,DGIEN,DGDATA,DGSD,DGERR
S DGOLDNAME="VA DOD DIRECT RESOURCE SHARING AGREEMENTS"
S DGIEN=$O(^DGHBP(25.11,"B",DGOLDNAME,0))
I 'DGIEN D MES^XPDUTL("VA DOD DIRECT RESOURCE SHARING AGREEMENTS not found - no action needed.") Q
; Rename the old plan to the new plan name
S DGDATA(.01)="VA DOD SHARING MEDICAL RESOURCES"
I $$UPD^DGENDBS(25.11,.DGIEN,.DGDATA,.DGERR) D
. D MES^XPDUTL("VA DOD DIRECT RESOURCE SHARING AGREEMENTS plan renamed to")
. D MES^XPDUTL("VA DOD SHARING MEDICAL RESOURCES")
I $G(DGERR)'="" D
. D BMES^XPDUTL("**** Error updating the VA DOD DIRECT RESOURCE SHARING AGREEMENTS plan.")
. D MES^XPDUTL(">>> Error: "_DGERR)
. D MES^XPDUTL(">>> DG*5.3*1067 Pre-install Routine Failed.")
. D MES^XPDUTL(" - Installation Terminated.")
. D MES^XPDUTL(" - Transport global removed from system.")
. S XPDABORT=1
Q
;
PRE3 ; Rename "BENEFICIARY CHAMPVA" to "CHAMPVA STANDARD"
N DGOLDNAME,DGIEN,DGDATA,DGSD,DGERR
S DGOLDNAME="BENEFICIARY CHAMPVA"
S DGIEN=$O(^DGHBP(25.11,"B",DGOLDNAME,0))
I 'DGIEN D MES^XPDUTL("BENEFICIARY CHAMPVA not found - no action needed.") Q
; Rename the old plan to the new plan name and change Short Desc field
S DGDATA(.01)="CHAMPVA STANDARD"
I $$UPD^DGENDBS(25.11,.DGIEN,.DGDATA,.DGERR) D
. D MES^XPDUTL("BENEFICIARY CHAMPVA plan renamed to")
. D MES^XPDUTL("CHAMPVA STANDARD")
I $G(DGERR)'="" D
. D BMES^XPDUTL("**** Error updating the BENEFICIARY CHAMPVA plan.")
. D MES^XPDUTL(">>> Error: "_DGERR)
. D MES^XPDUTL(">>> DG*5.3*1067 Pre-install Routine Failed.")
. D MES^XPDUTL(" - Installation Terminated.")
. D MES^XPDUTL(" - Transport global removed from system.")
. S XPDABORT=1
Q
;
PRE4 ; Rename "VETERAN BENEFICIARY PLAN - CAMP LEJEUNE FAMILY" to "CAMP LEJEUNE FAMILY"
N DGOLDNAME,DGIEN,DGDATA,DGSD,DGERR
S DGOLDNAME="VETERAN BENEFICIARY PLAN - CAMP LEJEUNE FAMILY"
S DGIEN=$O(^DGHBP(25.11,"B",DGOLDNAME,0))
I 'DGIEN D MES^XPDUTL("VETERAN BENEFICIARY PLAN - CAMP LEJEUNE FAMILY not found - no action needed.") Q
; Rename the old plan to the new plan name and change Short Desc field
S DGDATA(.01)="CAMP LEJEUNE FAMILY"
I $$UPD^DGENDBS(25.11,.DGIEN,.DGDATA,.DGERR) D
. D MES^XPDUTL("VETERAN BENEFICIARY PLAN - CAMP LEJEUNE FAMILY plan renamed to")
. D MES^XPDUTL("CAMP LEJEUNE FAMILY")
I $G(DGERR)'="" D
. D BMES^XPDUTL("**** Error updating the VETERAN BENEFICIARY PLAN - CAMP LEJEUNE FAMILY plan.")
. D MES^XPDUTL(">>> Error: "_DGERR)
. D MES^XPDUTL(">>> DG*5.3*1067 Pre-install Routine Failed.")
. D MES^XPDUTL(" - Installation Terminated.")
. D MES^XPDUTL(" - Transport global removed from system.")
. S XPDABORT=1
Q
;
POST ; Main entry point for post-install
;
D BMES^XPDUTL(">>> Patch DG*5.3*1067 - Post-install started.")
; Set the DG PATCH DG*5.3*1067 ACTIVE parameter to the timestamp in the PARAMETERS file (#8989.5)
D POST1
D POST2
D POST3
D BMES^XPDUTL(">>> Patch DG*5.3*1067 - Post-install complete.")
Q
POST1 ; Set the parameter to Date/Time
N DGERR
D BMES^XPDUTL(" o Setting parameter instance DG PATCH DG*5.3*1067 ACTIVE in the")
D MES^XPDUTL(" PARAMETER (#8989.5) file to date/time value of Feb 26, 2022@1700")
D EN^XPAR("PKG","DG PATCH DG*5.3*1067 ACTIVE",1,3220226.1700,.DGERR)
I $G(DGERR) D
. D BMES^XPDUTL(" *** Parameter set failed: "_DGERR)
. D MES^XPDUTL(" Please log YOUR IT Services ticket. ***")
Q
;
POST2 ; Set the DG UAM API KEY parameter PROHIBIT EDITING (#.06) to 1 (YES)
N DGPARAM,DGUAMKEY,DGERR
; Get the IEN of the Parameter Definition DG UAM API KEY
S DGPARAM=$$FIND1^DIC(8989.51,,"B","DG UAM API KEY")
Q:'DGPARAM
D BMES^XPDUTL(" o Setting parameter definition DG UAM API KEY in the PARAMETER")
D MES^XPDUTL(" DEFINITION (#8989.51) file to prohibit editing")
; Set PROHIBIT EDITING (#.06) field to 1
S DGUAMKEY(8989.51,DGPARAM_",",.06)=1
D FILE^DIE("","DGUAMKEY","DGERR")
I $G(DGERR) D
. D BMES^XPDUTL(" *** Parameter set failed: "_DGERR)
. D MES^XPDUTL(" Please log YOUR IT Services ticket. ***")
Q
POST3 ; Recompile all input templates for fields that were modified
N DGFLD
D BMES^XPDUTL(" o Recompile all compiled input templates that contain the following fields:")
D MES^XPDUTL(" PATIENT file(#2): ")
D MES^XPDUTL(" o K-RELATIONSHIP TO PATIENT field (#.212)")
D MES^XPDUTL(" o K2-RELATIONSHIP TO PATIENT field (#.2192)")
D MES^XPDUTL(" o E-RELATIONSHIP TO PATIENT field (#.332)")
D MES^XPDUTL(" o E2-RELATIONSHIP TO PATIENT field (#.3312)")
D MES^XPDUTL(" o D-RELATIONSHIP TO PATIENT field (#.342)")
D MES^XPDUTL(" o RELIGIOUS PREFERENCE field (#.08)")
D MES^XPDUTL(" o RACE INFORMATION field (#.01) of the RACE INFORMATION subfile (#2.02)")
D MES^XPDUTL(" o ETHNICITY INFORMATION field (#.01) of the")
D MES^XPDUTL(" ETHNICITY INFORMATION subfile (#2.06)")
;
;build array of file and field numbers for top-level file and fields being exported
;array format: DGFLD(file#,field)=""
;recompile all compiled input templates that contain the fields in the DGLFD array passed by reference
; PATIENT file #2
S DGFLD(2,.212)=""
S DGFLD(2,.2192)=""
S DGFLD(2,.332)=""
S DGFLD(2,.3312)=""
S DGFLD(2,.342)=""
S DGFLD(2,.08)=""
S DGFLD(2.02,.01)=""
S DGFLD(2.06,.01)=""
D DIEZ^DIKCUTL3(2,.DGFLD)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG531067P 7340 printed Dec 13, 2024@02:35:47 Page 2
DG531067P ;ALB/JAM - PATCH DG*5.3*1067 PRE/POST-INSTALL ROUTINE ;17 November 2021 10:00 AM
+1 ;;5.3;Registration;**1067**;Aug 13, 1993;Build 23
+2 ; ICRs:
+3 ; Reference to BMES^XPDUTL supported by ICR #10141
+4 ; Reference to MES^XPDUTL supported by ICR #10141
+5 ; Reference to EN^XPAR supported by ICR #2263
+6 ; Reference to DIEZ^DIKCUTL3 support by ICR #3352
+7 ;
+8 QUIT
PRE ; PRE INSTALL Main entry point
+1 ; Rename VHAPs
+2 DO BMES^XPDUTL(">>> Beginning the DG*5.3*1067 Pre-install routine")
+3 DO BMES^XPDUTL("Updating the HEALTH BENEFIT PLAN file (#25.11)...")
+4 ; Rename ACTIVE DUTY AND TRICARE SHARING AGREEMENT to TRICARE
+5 DO PRE1
+6 ; Rename VA DOD DIRECT RESOURCE SHARING AGREEMENTS to VA DOD SHARING MEDICAL RESOURCES
+7 DO PRE2
+8 ; Rename BENEFICIARY CHAMPVA to CHAMPVA STANDARD
+9 DO PRE3
+10 ; Rename VETERAN BENEFICIARY PLAN - CAMP LEJEUNE FAMILY to CAMP LEJEUNE FAMILY
+11 DO PRE4
+12 DO BMES^XPDUTL(">>> DG*5.3*1067 Pre-install completed")
+13 QUIT
PRE1 ; Rename "ACTIVE DUTY AND TRICARE SHARING AGREEMENT" to "TRICARE"
+1 NEW DGOLDNAME,DGIEN,DGDATA,DGSD,DGERR
+2 SET DGOLDNAME="ACTIVE DUTY AND TRICARE SHARING AGREEMENT"
+3 SET DGIEN=$ORDER(^DGHBP(25.11,"B",DGOLDNAME,0))
+4 IF 'DGIEN
DO MES^XPDUTL("ACTIVE DUTY AND TRICARE SHARING AGREEMENT not found - no action needed.")
QUIT
+5 ; Rename the old plan to the new plan name and change Short Desc field
+6 SET DGDATA(.01)="TRICARE"
+7 IF $$UPD^DGENDBS(25.11,.DGIEN,.DGDATA,.DGERR)
Begin DoDot:1
+8 DO MES^XPDUTL("ACTIVE DUTY AND TRICARE SHARING AGREEMENT (ADTSA) plan renamed to")
+9 DO MES^XPDUTL("TRICARE")
End DoDot:1
+10 IF $GET(DGERR)'=""
Begin DoDot:1
+11 DO BMES^XPDUTL("**** Error updating the ACTIVE DUTY AND TRICARE SHARING AGREEMENT (ADTSA) plan.")
+12 DO MES^XPDUTL(">>> Error: "_DGERR)
+13 DO MES^XPDUTL(">>> DG*5.3*1067 Pre-install Routine Failed.")
+14 DO MES^XPDUTL(" - Installation Terminated.")
+15 DO MES^XPDUTL(" - Transport global removed from system.")
+16 SET XPDABORT=1
End DoDot:1
+17 QUIT
+18 ;
PRE2 ; Rename "VA DOD DIRECT RESOURCE SHARING AGREEMENTS" to "VA DOD SHARING MEDICAL RESOURCES"
+1 NEW DGOLDNAME,DGIEN,DGDATA,DGSD,DGERR
+2 SET DGOLDNAME="VA DOD DIRECT RESOURCE SHARING AGREEMENTS"
+3 SET DGIEN=$ORDER(^DGHBP(25.11,"B",DGOLDNAME,0))
+4 IF 'DGIEN
DO MES^XPDUTL("VA DOD DIRECT RESOURCE SHARING AGREEMENTS not found - no action needed.")
QUIT
+5 ; Rename the old plan to the new plan name
+6 SET DGDATA(.01)="VA DOD SHARING MEDICAL RESOURCES"
+7 IF $$UPD^DGENDBS(25.11,.DGIEN,.DGDATA,.DGERR)
Begin DoDot:1
+8 DO MES^XPDUTL("VA DOD DIRECT RESOURCE SHARING AGREEMENTS plan renamed to")
+9 DO MES^XPDUTL("VA DOD SHARING MEDICAL RESOURCES")
End DoDot:1
+10 IF $GET(DGERR)'=""
Begin DoDot:1
+11 DO BMES^XPDUTL("**** Error updating the VA DOD DIRECT RESOURCE SHARING AGREEMENTS plan.")
+12 DO MES^XPDUTL(">>> Error: "_DGERR)
+13 DO MES^XPDUTL(">>> DG*5.3*1067 Pre-install Routine Failed.")
+14 DO MES^XPDUTL(" - Installation Terminated.")
+15 DO MES^XPDUTL(" - Transport global removed from system.")
+16 SET XPDABORT=1
End DoDot:1
+17 QUIT
+18 ;
PRE3 ; Rename "BENEFICIARY CHAMPVA" to "CHAMPVA STANDARD"
+1 NEW DGOLDNAME,DGIEN,DGDATA,DGSD,DGERR
+2 SET DGOLDNAME="BENEFICIARY CHAMPVA"
+3 SET DGIEN=$ORDER(^DGHBP(25.11,"B",DGOLDNAME,0))
+4 IF 'DGIEN
DO MES^XPDUTL("BENEFICIARY CHAMPVA not found - no action needed.")
QUIT
+5 ; Rename the old plan to the new plan name and change Short Desc field
+6 SET DGDATA(.01)="CHAMPVA STANDARD"
+7 IF $$UPD^DGENDBS(25.11,.DGIEN,.DGDATA,.DGERR)
Begin DoDot:1
+8 DO MES^XPDUTL("BENEFICIARY CHAMPVA plan renamed to")
+9 DO MES^XPDUTL("CHAMPVA STANDARD")
End DoDot:1
+10 IF $GET(DGERR)'=""
Begin DoDot:1
+11 DO BMES^XPDUTL("**** Error updating the BENEFICIARY CHAMPVA plan.")
+12 DO MES^XPDUTL(">>> Error: "_DGERR)
+13 DO MES^XPDUTL(">>> DG*5.3*1067 Pre-install Routine Failed.")
+14 DO MES^XPDUTL(" - Installation Terminated.")
+15 DO MES^XPDUTL(" - Transport global removed from system.")
+16 SET XPDABORT=1
End DoDot:1
+17 QUIT
+18 ;
PRE4 ; Rename "VETERAN BENEFICIARY PLAN - CAMP LEJEUNE FAMILY" to "CAMP LEJEUNE FAMILY"
+1 NEW DGOLDNAME,DGIEN,DGDATA,DGSD,DGERR
+2 SET DGOLDNAME="VETERAN BENEFICIARY PLAN - CAMP LEJEUNE FAMILY"
+3 SET DGIEN=$ORDER(^DGHBP(25.11,"B",DGOLDNAME,0))
+4 IF 'DGIEN
DO MES^XPDUTL("VETERAN BENEFICIARY PLAN - CAMP LEJEUNE FAMILY not found - no action needed.")
QUIT
+5 ; Rename the old plan to the new plan name and change Short Desc field
+6 SET DGDATA(.01)="CAMP LEJEUNE FAMILY"
+7 IF $$UPD^DGENDBS(25.11,.DGIEN,.DGDATA,.DGERR)
Begin DoDot:1
+8 DO MES^XPDUTL("VETERAN BENEFICIARY PLAN - CAMP LEJEUNE FAMILY plan renamed to")
+9 DO MES^XPDUTL("CAMP LEJEUNE FAMILY")
End DoDot:1
+10 IF $GET(DGERR)'=""
Begin DoDot:1
+11 DO BMES^XPDUTL("**** Error updating the VETERAN BENEFICIARY PLAN - CAMP LEJEUNE FAMILY plan.")
+12 DO MES^XPDUTL(">>> Error: "_DGERR)
+13 DO MES^XPDUTL(">>> DG*5.3*1067 Pre-install Routine Failed.")
+14 DO MES^XPDUTL(" - Installation Terminated.")
+15 DO MES^XPDUTL(" - Transport global removed from system.")
+16 SET XPDABORT=1
End DoDot:1
+17 QUIT
+18 ;
POST ; Main entry point for post-install
+1 ;
+2 DO BMES^XPDUTL(">>> Patch DG*5.3*1067 - Post-install started.")
+3 ; Set the DG PATCH DG*5.3*1067 ACTIVE parameter to the timestamp in the PARAMETERS file (#8989.5)
+4 DO POST1
+5 DO POST2
+6 DO POST3
+7 DO BMES^XPDUTL(">>> Patch DG*5.3*1067 - Post-install complete.")
+8 QUIT
POST1 ; Set the parameter to Date/Time
+1 NEW DGERR
+2 DO BMES^XPDUTL(" o Setting parameter instance DG PATCH DG*5.3*1067 ACTIVE in the")
+3 DO MES^XPDUTL(" PARAMETER (#8989.5) file to date/time value of Feb 26, 2022@1700")
+4 DO EN^XPAR("PKG","DG PATCH DG*5.3*1067 ACTIVE",1,3220226.1700,.DGERR)
+5 IF $GET(DGERR)
Begin DoDot:1
+6 DO BMES^XPDUTL(" *** Parameter set failed: "_DGERR)
+7 DO MES^XPDUTL(" Please log YOUR IT Services ticket. ***")
End DoDot:1
+8 QUIT
+9 ;
POST2 ; Set the DG UAM API KEY parameter PROHIBIT EDITING (#.06) to 1 (YES)
+1 NEW DGPARAM,DGUAMKEY,DGERR
+2 ; Get the IEN of the Parameter Definition DG UAM API KEY
+3 SET DGPARAM=$$FIND1^DIC(8989.51,,"B","DG UAM API KEY")
+4 if 'DGPARAM
QUIT
+5 DO BMES^XPDUTL(" o Setting parameter definition DG UAM API KEY in the PARAMETER")
+6 DO MES^XPDUTL(" DEFINITION (#8989.51) file to prohibit editing")
+7 ; Set PROHIBIT EDITING (#.06) field to 1
+8 SET DGUAMKEY(8989.51,DGPARAM_",",.06)=1
+9 DO FILE^DIE("","DGUAMKEY","DGERR")
+10 IF $GET(DGERR)
Begin DoDot:1
+11 DO BMES^XPDUTL(" *** Parameter set failed: "_DGERR)
+12 DO MES^XPDUTL(" Please log YOUR IT Services ticket. ***")
End DoDot:1
+13 QUIT
POST3 ; Recompile all input templates for fields that were modified
+1 NEW DGFLD
+2 DO BMES^XPDUTL(" o Recompile all compiled input templates that contain the following fields:")
+3 DO MES^XPDUTL(" PATIENT file(#2): ")
+4 DO MES^XPDUTL(" o K-RELATIONSHIP TO PATIENT field (#.212)")
+5 DO MES^XPDUTL(" o K2-RELATIONSHIP TO PATIENT field (#.2192)")
+6 DO MES^XPDUTL(" o E-RELATIONSHIP TO PATIENT field (#.332)")
+7 DO MES^XPDUTL(" o E2-RELATIONSHIP TO PATIENT field (#.3312)")
+8 DO MES^XPDUTL(" o D-RELATIONSHIP TO PATIENT field (#.342)")
+9 DO MES^XPDUTL(" o RELIGIOUS PREFERENCE field (#.08)")
+10 DO MES^XPDUTL(" o RACE INFORMATION field (#.01) of the RACE INFORMATION subfile (#2.02)")
+11 DO MES^XPDUTL(" o ETHNICITY INFORMATION field (#.01) of the")
+12 DO MES^XPDUTL(" ETHNICITY INFORMATION subfile (#2.06)")
+13 ;
+14 ;build array of file and field numbers for top-level file and fields being exported
+15 ;array format: DGFLD(file#,field)=""
+16 ;recompile all compiled input templates that contain the fields in the DGLFD array passed by reference
+17 ; PATIENT file #2
+18 SET DGFLD(2,.212)=""
+19 SET DGFLD(2,.2192)=""
+20 SET DGFLD(2,.332)=""
+21 SET DGFLD(2,.3312)=""
+22 SET DGFLD(2,.342)=""
+23 SET DGFLD(2,.08)=""
+24 SET DGFLD(2.02,.01)=""
+25 SET DGFLD(2.06,.01)=""
+26 DO DIEZ^DIKCUTL3(2,.DGFLD)
+27 QUIT
