DG531075P ;ALB/JAM - DG*5.3*1075 INSTALL UTILITY;07/12/2021 15:21pm
;;5.3;Registration;**1075**;Jan 26 2022;Build 13
;
QUIT ;No direct entry
;
;---------------------------------------------------------------------------
;Patch DG*5.3*1075: Environment, Pre-Install, and Post-Install entry points.
;---------------------------------------------------------------------------
;
; Reference to DIEZ^DIKCUTL3 supported by ICR #3352
; Reference to BMES^XPDUTL supported by ICR #10141
; Reference to MES^XPDUTL supported by ICR #10141
; Reference to DELIX^DDMOD supported by ICR #2916
;
; This routine is also used as an Environmental Check routine, though it does nothing except make the HELP
; tag below available for the Installation question in the build.
Q
;
HELP ; Help for ?? on Installation Question POS1 (use direct writes in env check routine)
W !,"Enter 1 if patch is being installed in a Pre-Production (Mirror) system."
W !,"Enter 2 if patch is being installed in a Software Quality Assurance system."
W !,"Enter 3 if patch is being installed in a Development system."
Q
;
ENV ;Main entry point for Environment check
Q
;
PRE ;Main entry point for Pre-Install items
D BMES^XPDUTL(">>> Beginning the DG*5.3*1075 Pre-install routine...")
D PRE1
D BMES^XPDUTL(">>> Patch DG*5.3*1075 - Pre-install complete.")
Q
;
PRE1 ; ;Remove non-SAC compliant trigger on ELIGIBILITY field #.01 of PATIENT ELIGIBILITIES subfile #361 for PATIENT file #2
; ^^TRIGGER^2.0361^.03
; The patch DG*5.3*1075 will replace this with an updated trigger
;
D BMES^XPDUTL(" o Removing non-SAC compliant trigger on ELIGIBILITY (#.01) field")
D MES^XPDUTL(" of the PATIENT ELIGIBILITIES (#361) subfile")
D MES^XPDUTL(" of the PATIENT (#2) file")
N DGFILE,DGFIELD,DGREF
S DGFILE=2.0361,DGFIELD=.01,DGREF=3
D DELIX^DDMOD(DGFILE,DGFIELD,DGREF)
Q
POST ;Main entry point for Post-Install items
;
D BMES^XPDUTL(">>> Beginning the DG*5.3*1075 Post-install routine...")
D POST1
D POST2
D POST3
D POST4
D BMES^XPDUTL(">>> Patch DG*5.3*1075 - Post-install complete.")
Q
;
POST1 ; Modify port/host DG EE SUMMARY SERVER and SEVICE
; ICRs:
; 7190 : Read access to file 18.02
; 7191 : R/W access to file 18.12
;
N DGSRVR,DGIEN
D BMES^XPDUTL(" o Modify DG EE SUMMARY SERVER Endpoint and Port...")
S DGSRVR="DG EE SUMMARY SERVER"
; Get the IEN of the DG EE SUMMARY SERVER - if not found, notify user of the problem
S DGIEN=$$FIND1^DIC(18.12,,"B",DGSRVR)
I 'DGIEN D Q
. D BMES^XPDUTL("*** ERROR! ***")
. D MES^XPDUTL(" - DG EE SUMMARY SERVER missing from WEB SERVER file (#18.12)")
. D MES^XPDUTL(" - Submit a YOUR IT Services ticket with the Enterprise Service Desk")
. D MES^XPDUTL(" for assistance.")
; Set the DG EE SUMMARY SERVER to DISABLED so the update of the server won't cause errors
; The patch installation will set it back to ENABLED.
D DISABLE(DGIEN)
; Modify the server
D SERVER(DGIEN)
Q
;
SERVER(DGIEN) ; Modify the web server
N DGEXIT,DGTYPE,DGCOUNT,DGEPT,DGPORT,DGDATA
N DGIENS,DGSERVER,DGERR12,DGSERVICE
; Get the site type entered in the Installation question POS1
S DGTYPE=$G(XPDQUES("POS1"))
; DGTYPE will be a value of 1-3 (PRE-PROD, SQA, DEVELOPMENT) (if no value, this is a PRODUCTION system, set to 4)
I 'DGTYPE S DGTYPE=4
D BMES^XPDUTL(" o Setting up the server for "_$S(DGTYPE=1:"PRE-PROD",DGTYPE=2:"SQA",DGTYPE=3:"DEVELOPMENT",1:"PRODUCTION")_".")
S DGEXIT=0
; Get the matching endpoint and port for the site type
F DGCOUNT=1:1 S DGDATA=$P($T(TYPEMAP+DGCOUNT),";;",2) D Q:DGEXIT
. I $P(DGDATA,";",1)=DGTYPE S DGEPT=$P(DGDATA,";",3),DGPORT=$P(DGDATA,";",4),DGEXIT=1
S DGIENS=DGIEN_","
; PORT
S DGSERVER(18.12,DGIENS,.03)=DGPORT
; SERVER endpoint
S DGSERVER(18.12,DGIENS,.04)=DGEPT
; STATUS
; For Pre-Prod, set Status to disabled, otherwise, enable
S DGSERVER(18.12,DGIENS,.06)=$S(DGTYPE=1:0,1:1)
; SSL PORT
S DGSERVER(18.12,DGIENS,3.03)=DGPORT
;
D FILE^DIE("","DGSERVER","DGERR12") ; update existing entry
I '$D(DGERR12("DIERR",1,"TEXT",1)) D
. I $S(DGTYPE=1:0,1:1) D BMES^XPDUTL(" o '"_DGSRVR_"' server enabled.")
. D BMES^XPDUTL(" o WEB SERVER '"_DGSRVR_"' update succeeded.")
I $D(DGERR12("DIERR",1,"TEXT",1)) D BMES^XPDUTL(" o WEB SERVER '"_DGSRVR_"' Error: "_DGERR12("DIERR",1,"TEXT",1)) Q
Q
;
DISABLE(DGIEN) ; Get the DG EE SUMMARY server IEN and disable it - update of server will set it back to enabled (except for Pre-prod)
N DGSERVER,DGERR12
; Set STATUS to DISABLED
S DGSERVER(18.12,DGIEN_",",.06)=0
D FILE^DIE("","DGSERVER","DGERR12") ; update existing entry
D BMES^XPDUTL(" o '"_DGSRVR_"' server disabled.")
Q
;
POST2 ; Set the parameter to Date/Time
N DGERR
D BMES^XPDUTL(" o Setting parameter instance DG PATCH DG*5.3*1075 ACTIVE in the")
D MES^XPDUTL(" PARAMETER (#8989.5) file to date/time value of Aug 3, 2022@1700")
D EN^XPAR("PKG","DG PATCH DG*5.3*1075 ACTIVE",1,3220803.1700,.DGERR)
I $G(DGERR) D
. D BMES^XPDUTL("*** ERROR! ***")
. D MES^XPDUTL(" - Parameter set failed: "_DGERR)
. D MES^XPDUTL(" - Submit a YOUR IT Services ticket with the Enterprise Service Desk")
. D MES^XPDUTL(" for assistance.")
Q
;
POST3 ; Add HUD-VASH eligibility to file #8
NEW DGEC,DGPH,DGFDA,DGERR
S DGEC="HUD-VASH"
D BMES^XPDUTL(" o Adding 'HUD-VASH' 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(" - HUD-VASH 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("*** HUD-VASH entry already exists... No action required.")
; Add entry to file
S DGFDA(8,"+1,",.01)=DGEC
S DGFDA(8,"+1,",1)="RED"
S DGFDA(8,"+1,",2)="HUDV"
S DGFDA(8,"+1,",3)=13
S DGFDA(8,"+1,",4)="N"
S DGFDA(8,"+1,",5)=DGEC
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 HUD-VASH successfully added to ELIGIBILITY CODE (#8) file.")
I $D(DGERR) D
. D BMES^XPDUTL("*** ERROR! ***")
. D MES^XPDUTL(" - HUD-VASH 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
;
POST4 ; Recompile all input templates for fields that were modified
; - ELIGIBILITY (#.01) field of the PATIENT ELIGIBILITIES (#361) subfile of the PATIENT (#2) file
;
N DGFLD
D BMES^XPDUTL(" o Recompile all compiled input templates that contain the following field:")
D MES^XPDUTL(" PATIENT (#2) file: ")
D MES^XPDUTL(" - ELIGIBILITY (#.01) field of the PATIENT ELIGIBILITIES (#361) subfile")
;
;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.0361,.01)=""
D DIEZ^DIKCUTL3(2,.DGFLD)
Q
;
TYPEMAP ; Map the system type to the SERVER endpoint and Port values
;;1;PREPROD;prep.ves.domain.ext;443
;;2;SQA;sqa.ves.domain.ext;443
;;3;DEV;dev03.ves.domain.ext;443
;;4;PROD;ves.domain.ext;443
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG531075P 7526 printed Sep 23, 2025@20:11:35 Page 2
DG531075P ;ALB/JAM - DG*5.3*1075 INSTALL UTILITY;07/12/2021 15:21pm
+1 ;;5.3;Registration;**1075**;Jan 26 2022;Build 13
+2 ;
QUIT ;No direct entry
+1 ;
+2 ;---------------------------------------------------------------------------
+3 ;Patch DG*5.3*1075: Environment, Pre-Install, and Post-Install entry points.
+4 ;---------------------------------------------------------------------------
+5 ;
+6 ; Reference to DIEZ^DIKCUTL3 supported by ICR #3352
+7 ; Reference to BMES^XPDUTL supported by ICR #10141
+8 ; Reference to MES^XPDUTL supported by ICR #10141
+9 ; Reference to DELIX^DDMOD supported by ICR #2916
+10 ;
+11 ; This routine is also used as an Environmental Check routine, though it does nothing except make the HELP
+12 ; tag below available for the Installation question in the build.
+13 QUIT
+14 ;
HELP ; Help for ?? on Installation Question POS1 (use direct writes in env check routine)
+1 WRITE !,"Enter 1 if patch is being installed in a Pre-Production (Mirror) system."
+2 WRITE !,"Enter 2 if patch is being installed in a Software Quality Assurance system."
+3 WRITE !,"Enter 3 if patch is being installed in a Development system."
+4 QUIT
+5 ;
ENV ;Main entry point for Environment check
+1 QUIT
+2 ;
PRE ;Main entry point for Pre-Install items
+1 DO BMES^XPDUTL(">>> Beginning the DG*5.3*1075 Pre-install routine...")
+2 DO PRE1
+3 DO BMES^XPDUTL(">>> Patch DG*5.3*1075 - Pre-install complete.")
+4 QUIT
+5 ;
PRE1 ; ;Remove non-SAC compliant trigger on ELIGIBILITY field #.01 of PATIENT ELIGIBILITIES subfile #361 for PATIENT file #2
+1 ; ^^TRIGGER^2.0361^.03
+2 ; The patch DG*5.3*1075 will replace this with an updated trigger
+3 ;
+4 DO BMES^XPDUTL(" o Removing non-SAC compliant trigger on ELIGIBILITY (#.01) field")
+5 DO MES^XPDUTL(" of the PATIENT ELIGIBILITIES (#361) subfile")
+6 DO MES^XPDUTL(" of the PATIENT (#2) file")
+7 NEW DGFILE,DGFIELD,DGREF
+8 SET DGFILE=2.0361
SET DGFIELD=.01
SET DGREF=3
+9 DO DELIX^DDMOD(DGFILE,DGFIELD,DGREF)
+10 QUIT
POST ;Main entry point for Post-Install items
+1 ;
+2 DO BMES^XPDUTL(">>> Beginning the DG*5.3*1075 Post-install routine...")
+3 DO POST1
+4 DO POST2
+5 DO POST3
+6 DO POST4
+7 DO BMES^XPDUTL(">>> Patch DG*5.3*1075 - Post-install complete.")
+8 QUIT
+9 ;
POST1 ; Modify port/host DG EE SUMMARY SERVER and SEVICE
+1 ; ICRs:
+2 ; 7190 : Read access to file 18.02
+3 ; 7191 : R/W access to file 18.12
+4 ;
+5 NEW DGSRVR,DGIEN
+6 DO BMES^XPDUTL(" o Modify DG EE SUMMARY SERVER Endpoint and Port...")
+7 SET DGSRVR="DG EE SUMMARY SERVER"
+8 ; Get the IEN of the DG EE SUMMARY SERVER - if not found, notify user of the problem
+9 SET DGIEN=$$FIND1^DIC(18.12,,"B",DGSRVR)
+10 IF 'DGIEN
Begin DoDot:1
+11 DO BMES^XPDUTL("*** ERROR! ***")
+12 DO MES^XPDUTL(" - DG EE SUMMARY SERVER missing from WEB SERVER file (#18.12)")
+13 DO MES^XPDUTL(" - Submit a YOUR IT Services ticket with the Enterprise Service Desk")
+14 DO MES^XPDUTL(" for assistance.")
End DoDot:1
QUIT
+15 ; Set the DG EE SUMMARY SERVER to DISABLED so the update of the server won't cause errors
+16 ; The patch installation will set it back to ENABLED.
+17 DO DISABLE(DGIEN)
+18 ; Modify the server
+19 DO SERVER(DGIEN)
+20 QUIT
+21 ;
SERVER(DGIEN) ; Modify the web server
+1 NEW DGEXIT,DGTYPE,DGCOUNT,DGEPT,DGPORT,DGDATA
+2 NEW DGIENS,DGSERVER,DGERR12,DGSERVICE
+3 ; Get the site type entered in the Installation question POS1
+4 SET DGTYPE=$GET(XPDQUES("POS1"))
+5 ; DGTYPE will be a value of 1-3 (PRE-PROD, SQA, DEVELOPMENT) (if no value, this is a PRODUCTION system, set to 4)
+6 IF 'DGTYPE
SET DGTYPE=4
+7 DO BMES^XPDUTL(" o Setting up the server for "_$SELECT(DGTYPE=1:"PRE-PROD",DGTYPE=2:"SQA",DGTYPE=3:"DEVELOPMENT",1:"PRODUCTION")_".")
+8 SET DGEXIT=0
+9 ; Get the matching endpoint and port for the site type
+10 FOR DGCOUNT=1:1
SET DGDATA=$PIECE($TEXT(TYPEMAP+DGCOUNT),";;",2)
Begin DoDot:1
+11 IF $PIECE(DGDATA,";",1)=DGTYPE
SET DGEPT=$PIECE(DGDATA,";",3)
SET DGPORT=$PIECE(DGDATA,";",4)
SET DGEXIT=1
End DoDot:1
if DGEXIT
QUIT
+12 SET DGIENS=DGIEN_","
+13 ; PORT
+14 SET DGSERVER(18.12,DGIENS,.03)=DGPORT
+15 ; SERVER endpoint
+16 SET DGSERVER(18.12,DGIENS,.04)=DGEPT
+17 ; STATUS
+18 ; For Pre-Prod, set Status to disabled, otherwise, enable
+19 SET DGSERVER(18.12,DGIENS,.06)=$SELECT(DGTYPE=1:0,1:1)
+20 ; SSL PORT
+21 SET DGSERVER(18.12,DGIENS,3.03)=DGPORT
+22 ;
+23 ; update existing entry
DO FILE^DIE("","DGSERVER","DGERR12")
+24 IF '$DATA(DGERR12("DIERR",1,"TEXT",1))
Begin DoDot:1
+25 IF $SELECT(DGTYPE=1:0,1:1)
DO BMES^XPDUTL(" o '"_DGSRVR_"' server enabled.")
+26 DO BMES^XPDUTL(" o WEB SERVER '"_DGSRVR_"' update succeeded.")
End DoDot:1
+27 IF $DATA(DGERR12("DIERR",1,"TEXT",1))
DO BMES^XPDUTL(" o WEB SERVER '"_DGSRVR_"' Error: "_DGERR12("DIERR",1,"TEXT",1))
QUIT
+28 QUIT
+29 ;
DISABLE(DGIEN) ; Get the DG EE SUMMARY server IEN and disable it - update of server will set it back to enabled (except for Pre-prod)
+1 NEW DGSERVER,DGERR12
+2 ; Set STATUS to DISABLED
+3 SET DGSERVER(18.12,DGIEN_",",.06)=0
+4 ; update existing entry
DO FILE^DIE("","DGSERVER","DGERR12")
+5 DO BMES^XPDUTL(" o '"_DGSRVR_"' server disabled.")
+6 QUIT
+7 ;
POST2 ; Set the parameter to Date/Time
+1 NEW DGERR
+2 DO BMES^XPDUTL(" o Setting parameter instance DG PATCH DG*5.3*1075 ACTIVE in the")
+3 DO MES^XPDUTL(" PARAMETER (#8989.5) file to date/time value of Aug 3, 2022@1700")
+4 DO EN^XPAR("PKG","DG PATCH DG*5.3*1075 ACTIVE",1,3220803.1700,.DGERR)
+5 IF $GET(DGERR)
Begin DoDot:1
+6 DO BMES^XPDUTL("*** ERROR! ***")
+7 DO MES^XPDUTL(" - Parameter set failed: "_DGERR)
+8 DO MES^XPDUTL(" - Submit a YOUR IT Services ticket with the Enterprise Service Desk")
+9 DO MES^XPDUTL(" for assistance.")
End DoDot:1
+10 QUIT
+11 ;
POST3 ; Add HUD-VASH eligibility to file #8
+1 NEW DGEC,DGPH,DGFDA,DGERR
+2 SET DGEC="HUD-VASH"
+3 DO BMES^XPDUTL(" o Adding 'HUD-VASH' to the ELIGIBILITY CODE (#8) file.")
+4 SET DGPH=$$FIND1^DIC(8.1,"","X",DGEC)
+5 IF 'DGPH
Begin DoDot:1
+6 DO BMES^XPDUTL("*** ERROR! ***")
+7 DO MES^XPDUTL(" - HUD-VASH entry missing from MAS ELIGIBILITY CODE (#8.1) file")
+8 DO MES^XPDUTL(" - Submit a YOUR IT Services ticket with the Enterprise Service Desk")
+9 DO MES^XPDUTL(" for assistance.")
End DoDot:1
QUIT
+10 IF $$FIND1^DIC(8,"","X",DGEC)
Begin DoDot:1
+11 DO BMES^XPDUTL("*** HUD-VASH entry already exists... No action required.")
End DoDot:1
QUIT
+12 ; Add entry to file
+13 SET DGFDA(8,"+1,",.01)=DGEC
+14 SET DGFDA(8,"+1,",1)="RED"
+15 SET DGFDA(8,"+1,",2)="HUDV"
+16 SET DGFDA(8,"+1,",3)=13
+17 SET DGFDA(8,"+1,",4)="N"
+18 SET DGFDA(8,"+1,",5)=DGEC
+19 SET DGFDA(8,"+1,",7)=1
+20 SET DGFDA(8,"+1,",8)=DGEC
+21 SET DGFDA(8,"+1,",9)="VA STANDARD"
+22 SET DGFDA(8,"+1,",11)="VA"
+23 DO UPDATE^DIE("E","DGFDA","","DGERR")
+24 IF '$DATA(DGERR)
DO BMES^XPDUTL(" o HUD-VASH successfully added to ELIGIBILITY CODE (#8) file.")
+25 IF $DATA(DGERR)
Begin DoDot:1
+26 DO BMES^XPDUTL("*** ERROR! ***")
+27 DO MES^XPDUTL(" - HUD-VASH was NOT successfully added to the ELIGIBILITY CODE (#8) file.")
+28 DO MES^XPDUTL(" - Submit a YOUR IT Services ticket with the Enterprise Service Desk")
+29 DO MES^XPDUTL(" for assistance.")
End DoDot:1
+30 QUIT
+31 ;
POST4 ; Recompile all input templates for fields that were modified
+1 ; - ELIGIBILITY (#.01) field of the PATIENT ELIGIBILITIES (#361) subfile of the PATIENT (#2) file
+2 ;
+3 NEW DGFLD
+4 DO BMES^XPDUTL(" o Recompile all compiled input templates that contain the following field:")
+5 DO MES^XPDUTL(" PATIENT (#2) file: ")
+6 DO MES^XPDUTL(" - ELIGIBILITY (#.01) field of the PATIENT ELIGIBILITIES (#361) subfile")
+7 ;
+8 ;build array of file and field numbers for top-level file and fields being exported
+9 ;array format: DGFLD(file#,field)=""
+10 ;recompile all compiled input templates that contain the fields in the DGLFD array passed by reference
+11 ; PATIENT file #2
+12 SET DGFLD(2.0361,.01)=""
+13 DO DIEZ^DIKCUTL3(2,.DGFLD)
+14 QUIT
+15 ;
TYPEMAP ; Map the system type to the SERVER endpoint and Port values
+1 ;;1;PREPROD;prep.ves.domain.ext;443
+2 ;;2;SQA;sqa.ves.domain.ext;443
+3 ;;3;DEV;dev03.ves.domain.ext;443
+4 ;;4;PROD;ves.domain.ext;443
