Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DG531067P

DG531067P.m

Go to the documentation of this file. 
  1. 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
  1.  ; ICRs:
  1.  ; Reference to BMES^XPDUTL supported by ICR #10141
  1.  ; Reference to MES^XPDUTL supported by ICR #10141
  1.  ; Reference to EN^XPAR supported by ICR #2263 
  1.  ; Reference to DIEZ^DIKCUTL3 support by ICR #3352 
  1.  ;
  1.  Q
  1. PRE ; PRE INSTALL Main entry point
  1.  ; Rename VHAPs
  1.  D BMES^XPDUTL(">>> Beginning the DG*5.3*1067 Pre-install routine")
  1.  D BMES^XPDUTL("Updating the HEALTH BENEFIT PLAN file (#25.11)...")
  1.  ; Rename ACTIVE DUTY AND TRICARE SHARING AGREEMENT to TRICARE
  1.  D PRE1
  1.  ; Rename VA DOD DIRECT RESOURCE SHARING AGREEMENTS to VA DOD SHARING MEDICAL RESOURCES
  1.  D PRE2
  1.  ; Rename BENEFICIARY CHAMPVA to CHAMPVA STANDARD
  1.  D PRE3
  1.  ; Rename VETERAN BENEFICIARY PLAN - CAMP LEJEUNE FAMILY to CAMP LEJEUNE FAMILY
  1.  D PRE4
  1.  D BMES^XPDUTL(">>> DG*5.3*1067 Pre-install completed")
  1.  Q
  1. PRE1 ; Rename "ACTIVE DUTY AND TRICARE SHARING AGREEMENT" to "TRICARE"
  1.  N DGOLDNAME,DGIEN,DGDATA,DGSD,DGERR
  1.  S DGOLDNAME="ACTIVE DUTY AND TRICARE SHARING AGREEMENT"
  1.  S DGIEN=$O(^DGHBP(25.11,"B",DGOLDNAME,0))
  1.  I 'DGIEN  D MES^XPDUTL("ACTIVE DUTY AND TRICARE SHARING AGREEMENT not found - no action needed.") Q
  1.  ; Rename the old plan to the new plan name and change Short Desc field 
  1.  S DGDATA(.01)="TRICARE"
  1.  I $$UPD^DGENDBS(25.11,.DGIEN,.DGDATA,.DGERR) D
  1.  . D MES^XPDUTL("ACTIVE DUTY AND TRICARE SHARING AGREEMENT (ADTSA) plan renamed to")
  1.  . D MES^XPDUTL("TRICARE")
  1.  I $G(DGERR)'="" D
  1.  . D BMES^XPDUTL("**** Error updating the ACTIVE DUTY AND TRICARE SHARING AGREEMENT (ADTSA) plan.")
  1.  . D MES^XPDUTL(">>> Error: "_DGERR)
  1.  . D MES^XPDUTL(">>> DG*5.3*1067 Pre-install Routine Failed.")
  1.  . D MES^XPDUTL("    - Installation Terminated.")
  1.  . D MES^XPDUTL("    - Transport global removed from system.")
  1.  . S XPDABORT=1
  1.  Q
  1.  ;
  1. PRE2 ; Rename "VA DOD DIRECT RESOURCE SHARING AGREEMENTS" to "VA DOD SHARING MEDICAL RESOURCES"
  1.  N DGOLDNAME,DGIEN,DGDATA,DGSD,DGERR
  1.  S DGOLDNAME="VA DOD DIRECT RESOURCE SHARING AGREEMENTS"
  1.  S DGIEN=$O(^DGHBP(25.11,"B",DGOLDNAME,0))
  1.  I 'DGIEN  D MES^XPDUTL("VA DOD DIRECT RESOURCE SHARING AGREEMENTS not found - no action needed.") Q
  1.  ; Rename the old plan to the new plan name
  1.  S DGDATA(.01)="VA DOD SHARING MEDICAL RESOURCES"
  1.  I $$UPD^DGENDBS(25.11,.DGIEN,.DGDATA,.DGERR) D
  1.  . D MES^XPDUTL("VA DOD DIRECT RESOURCE SHARING AGREEMENTS plan renamed to")
  1.  . D MES^XPDUTL("VA DOD SHARING MEDICAL RESOURCES")
  1.  I $G(DGERR)'="" D
  1.  . D BMES^XPDUTL("**** Error updating the VA DOD DIRECT RESOURCE SHARING AGREEMENTS plan.")
  1.  . D MES^XPDUTL(">>> Error: "_DGERR)
  1.  . D MES^XPDUTL(">>> DG*5.3*1067 Pre-install Routine Failed.")
  1.  . D MES^XPDUTL("    - Installation Terminated.")
  1.  . D MES^XPDUTL("    - Transport global removed from system.")
  1.  . S XPDABORT=1
  1.  Q
  1.  ;
  1. PRE3 ; Rename "BENEFICIARY CHAMPVA" to "CHAMPVA STANDARD"
  1.  N DGOLDNAME,DGIEN,DGDATA,DGSD,DGERR
  1.  S DGOLDNAME="BENEFICIARY CHAMPVA"
  1.  S DGIEN=$O(^DGHBP(25.11,"B",DGOLDNAME,0))
  1.  I 'DGIEN  D MES^XPDUTL("BENEFICIARY CHAMPVA not found - no action needed.") Q
  1.  ; Rename the old plan to the new plan name and change Short Desc field 
  1.  S DGDATA(.01)="CHAMPVA STANDARD"
  1.  I $$UPD^DGENDBS(25.11,.DGIEN,.DGDATA,.DGERR) D
  1.  . D MES^XPDUTL("BENEFICIARY CHAMPVA plan renamed to")
  1.  . D MES^XPDUTL("CHAMPVA STANDARD")
  1.  I $G(DGERR)'="" D
  1.  . D BMES^XPDUTL("**** Error updating the BENEFICIARY CHAMPVA plan.")
  1.  . D MES^XPDUTL(">>> Error: "_DGERR)
  1.  . D MES^XPDUTL(">>> DG*5.3*1067 Pre-install Routine Failed.")
  1.  . D MES^XPDUTL("    - Installation Terminated.")
  1.  . D MES^XPDUTL("    - Transport global removed from system.")
  1.  . S XPDABORT=1
  1.  Q
  1.  ;
  1. PRE4 ; Rename "VETERAN BENEFICIARY PLAN - CAMP LEJEUNE FAMILY" to "CAMP LEJEUNE FAMILY"
  1.  N DGOLDNAME,DGIEN,DGDATA,DGSD,DGERR
  1.  S DGOLDNAME="VETERAN BENEFICIARY PLAN - CAMP LEJEUNE FAMILY"
  1.  S DGIEN=$O(^DGHBP(25.11,"B",DGOLDNAME,0))
  1.  I 'DGIEN  D MES^XPDUTL("VETERAN BENEFICIARY PLAN - CAMP LEJEUNE FAMILY not found - no action needed.") Q
  1.  ; Rename the old plan to the new plan name and change Short Desc field 
  1.  S DGDATA(.01)="CAMP LEJEUNE FAMILY"
  1.  I $$UPD^DGENDBS(25.11,.DGIEN,.DGDATA,.DGERR) D
  1.  . D MES^XPDUTL("VETERAN BENEFICIARY PLAN - CAMP LEJEUNE FAMILY plan renamed to")
  1.  . D MES^XPDUTL("CAMP LEJEUNE FAMILY")
  1.  I $G(DGERR)'="" D
  1.  . D BMES^XPDUTL("**** Error updating the VETERAN BENEFICIARY PLAN - CAMP LEJEUNE FAMILY plan.")
  1.  . D MES^XPDUTL(">>> Error: "_DGERR)
  1.  . D MES^XPDUTL(">>> DG*5.3*1067 Pre-install Routine Failed.")
  1.  . D MES^XPDUTL("    - Installation Terminated.")
  1.  . D MES^XPDUTL("    - Transport global removed from system.")
  1.  . S XPDABORT=1
  1.  Q
  1.  ;
  1. POST ; Main entry point for post-install 
  1.  ;
  1.  D BMES^XPDUTL(">>> Patch DG*5.3*1067 - Post-install started.")
  1.  ; Set the DG PATCH DG*5.3*1067 ACTIVE parameter to the timestamp in the PARAMETERS file (#8989.5)
  1.  D POST1
  1.  D POST2
  1.  D POST3
  1.  D BMES^XPDUTL(">>> Patch DG*5.3*1067 - Post-install complete.")
  1.  Q
  1. POST1 ; Set the parameter to Date/Time
  1.  N DGERR
  1.  D BMES^XPDUTL(" o Setting parameter instance DG PATCH DG*5.3*1067 ACTIVE in the")
  1.  D MES^XPDUTL("   PARAMETER (#8989.5) file to date/time value of Feb 26, 2022@1700")
  1.  D EN^XPAR("PKG","DG PATCH DG*5.3*1067 ACTIVE",1,3220226.1700,.DGERR)
  1.  I $G(DGERR) D
  1.  . D BMES^XPDUTL(" *** Parameter set failed: "_DGERR)
  1.  . D MES^XPDUTL("  Please log YOUR IT Services ticket. ***")
  1.  Q
  1.  ;
  1. POST2 ; Set the DG UAM API KEY parameter PROHIBIT EDITING (#.06) to 1 (YES)
  1.  N DGPARAM,DGUAMKEY,DGERR
  1.  ; Get the IEN of the Parameter Definition DG UAM API KEY
  1.  S DGPARAM=$$FIND1^DIC(8989.51,,"B","DG UAM API KEY")
  1.  Q:'DGPARAM
  1.  D BMES^XPDUTL(" o Setting parameter definition DG UAM API KEY in the PARAMETER")
  1.  D MES^XPDUTL("   DEFINITION (#8989.51) file to prohibit editing")
  1.  ; Set PROHIBIT EDITING (#.06) field to 1
  1.  S DGUAMKEY(8989.51,DGPARAM_",",.06)=1
  1.  D FILE^DIE("","DGUAMKEY","DGERR")
  1.  I $G(DGERR) D
  1.  . D BMES^XPDUTL(" *** Parameter set failed: "_DGERR)
  1.  . D MES^XPDUTL("  Please log YOUR IT Services ticket. ***")
  1.  Q
  1. POST3 ; Recompile all input templates for fields that were modified
  1.  N DGFLD
  1.  D BMES^XPDUTL(" o Recompile all compiled input templates that contain the following fields:")
  1.  D MES^XPDUTL("    PATIENT file(#2): ")
  1.  D MES^XPDUTL("    o K-RELATIONSHIP TO PATIENT field (#.212)")
  1.  D MES^XPDUTL("    o K2-RELATIONSHIP TO PATIENT field (#.2192)")
  1.  D MES^XPDUTL("    o E-RELATIONSHIP TO PATIENT field (#.332)")
  1.  D MES^XPDUTL("    o E2-RELATIONSHIP TO PATIENT field (#.3312)")
  1.  D MES^XPDUTL("    o D-RELATIONSHIP TO PATIENT field (#.342)")
  1.  D MES^XPDUTL("    o RELIGIOUS PREFERENCE field (#.08)")
  1.  D MES^XPDUTL("    o RACE INFORMATION field (#.01) of the RACE INFORMATION subfile (#2.02)")
  1.  D MES^XPDUTL("    o ETHNICITY INFORMATION field (#.01) of the")
  1.  D MES^XPDUTL("       ETHNICITY INFORMATION subfile (#2.06)")
  1.  ;
  1.  ;build array of file and field numbers for top-level file and fields being exported
  1.  ;array format: DGFLD(file#,field)=""
  1.  ;recompile all compiled input templates that contain the fields in the DGLFD array passed by reference
  1.  ; PATIENT file #2
  1.  S DGFLD(2,.212)=""
  1.  S DGFLD(2,.2192)=""
  1.  S DGFLD(2,.332)=""
  1.  S DGFLD(2,.3312)=""
  1.  S DGFLD(2,.342)=""
  1.  S DGFLD(2,.08)=""
  1.  S DGFLD(2.02,.01)=""
  1.  S DGFLD(2.06,.01)=""
  1.  D DIEZ^DIKCUTL3(2,.DGFLD)
  1.  Q