DG531140P ;ALB/JAM - PATCH DG*5.3*1140 INSTALL UTILITIES ;2/25/25 09:12am
;;5.3;Registration;**1140**;Aug 13, 1993;Build 10
;
; Reference to BMES^XPDUTL in ICR #10141
; Reference to MES^XPDUTL in ICR #10141
;
;No direct entry
QUIT
;
;--------------------------------------------------------------------------
;Patch DG*5.3*1140: Environment, Pre-Install, and Post-Install entry points.
;--------------------------------------------------------------------------
;
ENV ;Main entry point for Environment check
Q
;
PRE ;Main entry point for Pre-Install items
;
D BMES^XPDUTL(">>> Beginning the DG*5.3*1140 Pre-install routine...")
D PRE1
D BMES^XPDUTL(">>> Patch DG*5.3*1140 Pre-install complete.")
Q
;
PRE1 ; Rename VHAP "VFMP MEDS BY MAIL ELIGIBILITY" to "MEDS BY MAIL BENEFICIARY"
; Change Short Description to "MbM Rx"
D BMES^XPDUTL(" - Updating the HEALTH BENEFIT PLAN file (#25.11)...")
D MES^XPDUTL(" - Renaming VFMP MEDS BY MAIL ELIGIBILITY plan.")
N DGOLDNAME,DGNEWNAME,DGIEN,DGDATA,DGERR
S DGOLDNAME="VFMP MEDS BY MAIL ELIGIBILITY"
S DGNEWNAME="MEDS BY MAIL BENEFICIARY"
D CHKDUP
S DGIEN=$O(^DGHBP(25.11,"B",DGOLDNAME,0))
I 'DGIEN D MES^XPDUTL(" - "_DGOLDNAME_" does not exist... No action required.") Q
; Rename the old plan to the new plan name
S DGDATA(.01)=DGNEWNAME
I $$UPD^DGENDBS(25.11,.DGIEN,.DGDATA,.DGERR) D Q
. D BMES^XPDUTL(" - "_DGOLDNAME_" plan renamed to")
. D MES^XPDUTL(" "_DGNEWNAME)
I $G(DGERR)'="" D
. D MES^XPDUTL("*** ERROR! ***")
. D MES^XPDUTL(" - The "_DGOLDNAME_" plan was not updated.")
. D MES^XPDUTL(" - Error: "_DGERR)
. D MES^XPDUTL(" - Submit a YOUR IT Services ticket with the Enterprise Service Desk")
. D MES^XPDUTL(" for assistance.")
. D MES^XPDUTL(">>> DG*5.3*1140 Pre-install Routine Failed.")
. D MES^XPDUTL(" - Installation Terminated.")
. D MES^XPDUTL(" - Transport global removed from system.")
. S XPDABORT=1
Q
;
CHKDUP ; Check for the case of both old and new name plan exist
; Check if the new VHAP name already exists
D BMES^XPDUTL(" check for Duplicate "_DGOLDNAME_" "_DGNEWNAME)
S DGIEN=$O(^DGHBP(25.11,"B",DGNEWNAME,0))
; If it doesn't exist, quit
I 'DGIEN Q
; Check if the old name VHAP also exists
S DGIEN=$O(^DGHBP(25.11,"B",DGOLDNAME,0))
; Old name is gone - quit
I 'DGIEN Q
; The old and new name VHAP entries both exist - Delete the old name entry
S DGDATA(.01)="@"
I $$UPD^DGENDBS(25.11,.DGIEN,.DGDATA,.DGERR) D Q
. D BMES^XPDUTL(" - Duplicate "_DGOLDNAME_" removed.")
E D
. D MES^XPDUTL("*** ERROR! ***")
. D MES^XPDUTL(" - The duplicate "_DGOLDNAME_" plan was not removed.")
. D MES^XPDUTL(" - Error: "_DGERR)
. D MES^XPDUTL(" - Submit a YOUR IT Services ticket with the Enterprise Service Desk")
. D MES^XPDUTL(" for assistance.")
. D MES^XPDUTL(">>> DG*5.3*1140 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 items
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG531140P 3129 printed Sep 23, 2025@20:11:53 Page 2
DG531140P ;ALB/JAM - PATCH DG*5.3*1140 INSTALL UTILITIES ;2/25/25 09:12am
+1 ;;5.3;Registration;**1140**;Aug 13, 1993;Build 10
+2 ;
+3 ; Reference to BMES^XPDUTL in ICR #10141
+4 ; Reference to MES^XPDUTL in ICR #10141
+5 ;
+6 ;No direct entry
+7 QUIT
+8 ;
+9 ;--------------------------------------------------------------------------
+10 ;Patch DG*5.3*1140: Environment, Pre-Install, and Post-Install entry points.
+11 ;--------------------------------------------------------------------------
+12 ;
ENV ;Main entry point for Environment check
+1 QUIT
+2 ;
PRE ;Main entry point for Pre-Install items
+1 ;
+2 DO BMES^XPDUTL(">>> Beginning the DG*5.3*1140 Pre-install routine...")
+3 DO PRE1
+4 DO BMES^XPDUTL(">>> Patch DG*5.3*1140 Pre-install complete.")
+5 QUIT
+6 ;
PRE1 ; Rename VHAP "VFMP MEDS BY MAIL ELIGIBILITY" to "MEDS BY MAIL BENEFICIARY"
+1 ; Change Short Description to "MbM Rx"
+2 DO BMES^XPDUTL(" - Updating the HEALTH BENEFIT PLAN file (#25.11)...")
+3 DO MES^XPDUTL(" - Renaming VFMP MEDS BY MAIL ELIGIBILITY plan.")
+4 NEW DGOLDNAME,DGNEWNAME,DGIEN,DGDATA,DGERR
+5 SET DGOLDNAME="VFMP MEDS BY MAIL ELIGIBILITY"
+6 SET DGNEWNAME="MEDS BY MAIL BENEFICIARY"
+7 DO CHKDUP
+8 SET DGIEN=$ORDER(^DGHBP(25.11,"B",DGOLDNAME,0))
+9 IF 'DGIEN
DO MES^XPDUTL(" - "_DGOLDNAME_" does not exist... No action required.")
QUIT
+10 ; Rename the old plan to the new plan name
+11 SET DGDATA(.01)=DGNEWNAME
+12 IF $$UPD^DGENDBS(25.11,.DGIEN,.DGDATA,.DGERR)
Begin DoDot:1
+13 DO BMES^XPDUTL(" - "_DGOLDNAME_" plan renamed to")
+14 DO MES^XPDUTL(" "_DGNEWNAME)
End DoDot:1
QUIT
+15 IF $GET(DGERR)'=""
Begin DoDot:1
+16 DO MES^XPDUTL("*** ERROR! ***")
+17 DO MES^XPDUTL(" - The "_DGOLDNAME_" plan was not updated.")
+18 DO MES^XPDUTL(" - Error: "_DGERR)
+19 DO MES^XPDUTL(" - Submit a YOUR IT Services ticket with the Enterprise Service Desk")
+20 DO MES^XPDUTL(" for assistance.")
+21 DO MES^XPDUTL(">>> DG*5.3*1140 Pre-install Routine Failed.")
+22 DO MES^XPDUTL(" - Installation Terminated.")
+23 DO MES^XPDUTL(" - Transport global removed from system.")
+24 SET XPDABORT=1
End DoDot:1
+25 QUIT
+26 ;
CHKDUP ; Check for the case of both old and new name plan exist
+1 ; Check if the new VHAP name already exists
+2 DO BMES^XPDUTL(" check for Duplicate "_DGOLDNAME_" "_DGNEWNAME)
+3 SET DGIEN=$ORDER(^DGHBP(25.11,"B",DGNEWNAME,0))
+4 ; If it doesn't exist, quit
+5 IF 'DGIEN
QUIT
+6 ; Check if the old name VHAP also exists
+7 SET DGIEN=$ORDER(^DGHBP(25.11,"B",DGOLDNAME,0))
+8 ; Old name is gone - quit
+9 IF 'DGIEN
QUIT
+10 ; The old and new name VHAP entries both exist - Delete the old name entry
+11 SET DGDATA(.01)="@"
+12 IF $$UPD^DGENDBS(25.11,.DGIEN,.DGDATA,.DGERR)
Begin DoDot:1
+13 DO BMES^XPDUTL(" - Duplicate "_DGOLDNAME_" removed.")
End DoDot:1
QUIT
+14 IF '$TEST
Begin DoDot:1
+15 DO MES^XPDUTL("*** ERROR! ***")
+16 DO MES^XPDUTL(" - The duplicate "_DGOLDNAME_" plan was not removed.")
+17 DO MES^XPDUTL(" - Error: "_DGERR)
+18 DO MES^XPDUTL(" - Submit a YOUR IT Services ticket with the Enterprise Service Desk")
+19 DO MES^XPDUTL(" for assistance.")
+20 DO MES^XPDUTL(">>> DG*5.3*1140 Pre-install Routine Failed.")
+21 DO MES^XPDUTL(" - Installation Terminated.")
+22 DO MES^XPDUTL(" - Transport global removed from system.")
+23 SET XPDABORT=1
End DoDot:1
+24 QUIT
+25 ;
POST ;Main entry point for Post-Install items
+1 ;
+2 QUIT
