- 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 Feb 19, 2025@00:01:50 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