DG531143P ;ALB/JAM - PATCH DG*5.3*1143 POST-INSTALL ROUTINE ;05 May 2025 10:00 AM
;;5.3;Registration;**1143**;Aug 13, 1993;Build 36
; 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
; ICRs:
; 5421 : GENPORT^XOBWLIB
; 7190 : R/W access to file 18.02
; 7191 : R/W access to file 18.12
; 2240 : $$ENCRYP^XUSRB1
; 10096 : ^%ZSOF("DEL")
;
; 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 POS (use direct writes in env check routine)
W !,"Enter 1 if patch is being installed in a Preprod/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
;
Q
POST ;Main entry point for Post-Install items
;
D BMES^XPDUTL(">>> Beginning the DG*5.3*1143 Post-install routine...")
; Get the site type entered in the Installation question POS
S DGTYPE=$G(XPDQUES("POS1"))
; DGTYPE will be a value of 1-3 (MIRROR/PRE-PROD, SQA, DEVELOPMENT) (if no value, this is a PRODUCTION system)
I 'DGTYPE S DGTYPE=4
D POST1
D POST2(DGTYPE)
D POST3(DGTYPE)
D POST4
D POST5
D BMES^XPDUTL(">>> Patch DG*5.3*1143 - Post-install complete.")
Q
;
POST1 ; Set MAS PARAMETER for Real-time Address Update
N DGFDA,DGERR,X,Y
D BMES^XPDUTL(" o Set ENABLE REALTIME ADDRESS UPDATE (#1403) field")
D MES^XPDUTL(" in the MAS PARAMETERS (#43) file")
; Set MAS Parameter to NO
S DGFDA(43,"1,",1403)=0 D FILE^DIE("","DGFDA","DGERR")
I '$D(DGERR) D MES^XPDUTL(" o ENABLE REALTIME ADDRESS UPDATE (#1403) field set to "_$$GET1^DIQ(43,1,1403,"E"))
I $D(DGERR) D
. D BMES^XPDUTL(" *** ERROR: "_DGERR("DIERR",1,"TEXT",1))
. D MES^XPDUTL(" Please log YOUR IT Services ticket. ***")
;
Q
POST2(DGTYPE) ; Setup DG RTAU CONTACTINFO SERVICE AND DG RTAU SERVER
; DGTYPE will be a value of 1-4 (MIRROR/PRE-PROD, SQA, DEVELOPMENT PRODUCTION)
N DGSRVR,DGSRVC
D BMES^XPDUTL(" o Post-install set up for SSL Configuration...")
S DGSRVR="DG RTAU SERVER"
S DGSRVC="DG RTAU CONTACTINFO"
; If the DG RTAU SERVER is installed, set it to DISABLED so the update of the server won't cause errors
; The patch installation will set it back to ENABLED.
D DISABLE
D SERVICE
D SERVER(DGTYPE)
Q
;
SERVICE ; Set up service - use REGREST^XOBWLIB
N DGI,DGILOWCASE,DGCNTXTRT
D BMES^XPDUTL(" >> Updating WEB SERVICE (#18.02) file...")
S DGCNTXTRT="/ves-contact-brk/contact-info"
D REGREST^XOBWLIB(DGSRVC,DGCNTXTRT) ; REGREST^XOBWLIB handles all messaging.
Q
;
SERVER(DGTYPE) ; set up web server
; DGTYPE will be a value of 1-4 (MIRROR/PRE-PROD, SQA, DEVELOPMENT, PRODUCTION)
N DGEXIT,DGCOUNT,DGEPT,DGPW,DGPORT,DGDATA
N DGIEN,DGIENS,DGSERVER,DGFDAI,DGERR,DGERR12,DGERR02,DGSRVIEN,DGSERVICE
D MES^XPDUTL(" o Setting up the server for "_$S(DGTYPE=1:"MIRROR/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 DGIEN("SRV")=$$FIND1^DIC(18.12,,"B",DGSRVR)
I DGIEN("SRV") S DGIENS("SRV")=DGIEN("SRV")_","
E S DGIENS("SRV")="+1,"
; NAME
S DGSERVER(18.12,DGIENS("SRV"),.01)=DGSRVR
; PORT
S DGSERVER(18.12,DGIENS("SRV"),.03)=DGPORT
; SERVER endpoint
S DGSERVER(18.12,DGIENS("SRV"),.04)=DGEPT
; STATUS
; For Mirror, set Status to disabled, otherwise, enable
;S DGSERVER(18.12,DGIENS("SRV"),.06)=$S(DGTYPE=1:0,1:1)
; ENABLE SERVER
S DGSERVER(18.12,DGIENS("SRV"),.06)=1
; SSL ENABLED
S DGSERVER(18.12,DGIENS("SRV"),3.01)=1
; SSL CONFIGURATION
S DGSERVER(18.12,DGIENS("SRV"),3.02)="encrypt_only_tlsv12"
; SSL PORT
S DGSERVER(18.12,DGIENS("SRV"),3.03)=DGPORT
;
I DGIEN("SRV") D FILE^DIE("","DGSERVER","DGERR12") ; update existing entry
I 'DGIEN("SRV") D UPDATE^DIE("","DGSERVER","DGFDAI","DGERR") ; create new entry
I $D(DGFDAI) S DGIENS("SRV")=DGFDAI(1)_",",DGIEN("SRV")=DGFDAI(1)
I '$D(DGERR12("DIERR",1,"TEXT",1)) D BMES^XPDUTL(" o WEB SERVER '"_DGSRVR_"' addition/update succeeded.")
I $D(DGERR12("DIERR",1,"TEXT",1)) D BMES^XPDUTL(" o WEB SERVER '"_DGSRVR_"' Error: "_DGERR12("DIERR",1,"TEXT",1)) Q
; once server is set up add the web service
S DGIENS("SRC")="+1,"
S DGSRVIEN=0
F S DGSRVIEN=$O(^XOB(18.12,DGIEN("SRV"),100,"B",DGSRVIEN)) Q:'DGSRVIEN D
. I $$GET1^DIQ(18.02,DGSRVIEN,.01)=DGSRVC S DGIENS("SRC")=DGSRVIEN_","
I DGIENS("SRC")'="+1," Q ; don't update subentry pointers if already exist.
K DGSERVICE,DGFDAI
S DGSERVICE(18.121,DGIENS("SRC")_DGIENS("SRV"),.01)=DGSRVC
S DGSERVICE(18.121,DGIENS("SRC")_DGIENS("SRV"),.06)="ENABLED"
D UPDATE^DIE("E","DGSERVICE","DGFDAI","DGERR02") ; create new entry
I $D(DGERR02("DIERR",1,"TEXT",1)) D MES^XPDUTL(" o "_DGERR02("DIERR",1,"TEXT",1))
I '$D(DGERR02("DIERR",1,"TEXT",1)) D BMES^XPDUTL(" o '"_DGSRVC_"' service successfully authorized on server.")
Q
;
DISABLE ; Disable DG RTAU SERVER server if it exists - update of server will set it back to enabled (except for Mirror)
N DGIEN,DGSERVER,DGERR12
S DGIEN("SRV")=$$FIND1^DIC(18.12,,"B",DGSRVR)
I 'DGIEN("SRV") Q
; Set STATUS to DISABLED
S DGSERVER(18.12,DGIEN("SRV")_",",.06)=0
D FILE^DIE("","DGSERVER","DGERR12") ; update existing entry
D BMES^XPDUTL(" o '"_DGSRVR_"' server temporarily disabled.")
Q
;
POST3(DGTYPE) ; Set the API Key for the site into the parameter DG RTAU API KEY
; DGTYPE will be a value of 1-4 (MIRROR/PRE-PROD, SQA, DEVELOPMENT PRODUCTION)
N DGFDA,DGERR,DGKEY
;
; If API already defined, quit
S DGKEY=$$GET^XPAR("PKG","DG RTAU API KEY",1)
I DGKEY'="" Q
; Prod Key: 6ekfHkOzlN0KTV37vFBR1kqbOaSn7Po41ceMmd3h
; Non-Prod Key: 1xXofbhGbO37Ccb1ml0kmyCFL5y4dSafoKMl3d00
S DGKEY=$S(DGTYPE=4:"6ekfHkOzlN0KTV37vFBR1kqbOaSn7Po41ceMmd3h",1:"1xXofbhGbO37Ccb1ml0kmyCFL5y4dSafoKMl3d00")
D BMES^XPDUTL(" o Set Parameter instance DG RTAU API KEY in the PARAMETER (#8989.5) file")
D EN^XPAR("PKG","DG RTAU API KEY",1,DGKEY,.DGERR)
I '$G(DGERR) D MES^XPDUTL(" o DG RTAU API KEY Parameter set successfully.")
I $G(DGERR) D
. D BMES^XPDUTL(" *** Parameter set failed: "_DGERR)
. D MES^XPDUTL(" Please log YOUR IT Services ticket. ***")
Q
;
POST4 ; Set the DG RTAU API KEY parameter PROHIBIT EDITING (#.06) to 1 (YES)
N DGPARAM,DGRTAKEY,DGERR
; Get the IEN of the Parameter Definition DG UAM API KEY
S DGPARAM=$$FIND1^DIC(8989.51,,"B","DG RTAU API KEY")
Q:'DGPARAM
D BMES^XPDUTL(" o Setting parameter definition DG RTAU API KEY in the PARAMETER")
D MES^XPDUTL(" DEFINITION (#8989.51) file to prohibit editing")
; Set PROHIBIT EDITING (#.06) field to 1
S DGRTAKEY(8989.51,DGPARAM_",",.06)=1
D FILE^DIE("","DGRTAKEY","DGERR")
I $G(DGERR) D
. D BMES^XPDUTL(" *** Parameter set failed: "_DGERR)
. D MES^XPDUTL(" Please log YOUR IT Services ticket. ***")
Q
;
POST5 ; Recompile templates
; 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
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 RESIDENTIAL ADDRESS FIELDS")
D MES^XPDUTL(" o MAILING ADDRESS FIELDS")
D MES^XPDUTL(" o TEMPORARY ADDRESS FIELDS")
D MES^XPDUTL(" o CONFIDENTIAL ADDRESS FIELDS")
D MES^XPDUTL(" o EMAIL ADDRESS AND CELL PHONE FIELDS")
D MES^XPDUTL(" o HOME, OFFICE, TEMPORARY AND CONFIDENTIAL PHONE FIELDS")
;
; Residential Address
; Line 1
S DGFLD(2,.1151)=""
; Line 2
S DGFLD(2,.1152)=""
; Line 3
S DGFLD(2,.1153)=""
; City
S DGFLD(2,.1154)=""
; State
S DGFLD(2,.1155)=""
; Zip+5
S DGFLD(2,.1156)=""
; County
S DGFLD(2,.1157)=""
; Province
S DGFLD(2,.11571)=""
; Postal Code
S DGFLD(2,.11572)=""
; Country
S DGFLD(2,.11573)=""
; Home Phone
S DGFLD(2,.131)=""
; Work phone
S DGFLD(2,.132)=""
; Mailing Address
; Line 1
S DGFLD(2,.111)=""
; Line 2
S DGFLD(2,.112)=""
; Line 3
S DGFLD(2,.113)=""
; City
S DGFLD(2,.114)=""
; State
S DGFLD(2,.115)=""
; Zip
S DGFLD(2,.116)=""
; County
S DGFLD(2,.117)=""
; Province
S DGFLD(2,.1171)=""
; Postal Code
S DGFLD(2,.1172)=""
; Country
S DGFLD(2,.1173)=""
; Zip+4
S DGFLD(2,.1112)=""
; Bad Address Indicator
S DGFLD(2,.121)=""
; Temporary Address
; Line 1
S DGFLD(2,.1211)=""
; Line 2
S DGFLD(2,.1212)=""
; Line 3
S DGFLD(2,.1213)=""
; City
S DGFLD(2,.1214)=""
; State
S DGFLD(2,.1215)=""
; Zip
S DGFLD(2,.1216)=""
; Start Date
S DGFLD(2,.1217)=""
; End Date
S DGFLD(2,.1218)=""
; Address Active?
S DGFLD(2,.12105)=""
; Temp Phone
S DGFLD(2,.1219)=""
; County
S DGFLD(2,.12111)=""
; Zip+4
S DGFLD(2,.12112)=""
; Province
S DGFLD(2,.1221)=""
; Postal Code
S DGFLD(2,.1222)=""
; Country
S DGFLD(2,.1223)=""
; Confidential Address
; Line 1
S DGFLD(2,.1411)=""
; Line 2
S DGFLD(2,.1412)=""
; Line 3
S DGFLD(2,.1413)=""
; City
S DGFLD(2,.1414)=""
; State
S DGFLD(2,.1415)=""
; Zip
S DGFLD(2,.1416)=""
; Start Date
S DGFLD(2,.1417)=""
; End Date
S DGFLD(2,.1418)=""
; Address Active?
S DGFLD(2,.14105)=""
; County
S DGFLD(2,.14111)=""
; Province
S DGFLD(2,.14114)=""
; Postal Code
S DGFLD(2,.14115)=""
; Country
S DGFLD(2,.14116)=""
; Conf Phone
S DGFLD(2,.1315)=""
; CASS Indicator
S DGFLD(2,.14117)=""
;
; EMAIL
S DGFLD(2,.133)=""
; Cell number
S DGFLD(2,.134)=""
;
D DIEZ^DIKCUTL3(2,.DGFLD)
Q
;
TYPEMAP ; Map the system type to the SERVER endpoint and Port values
;;1;MIRROR;prep.ves.domain.ext;443
;;2;SQA;sqa.ves.domain.ext;443
;;3;DEV;dev.ves.domain.ext;443
;;4;PROD;ves.domain.ext;443
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG531143P 10472 printed May 25, 2026@12:39:54 Page 2
DG531143P ;ALB/JAM - PATCH DG*5.3*1143 POST-INSTALL ROUTINE ;05 May 2025 10:00 AM
+1 ;;5.3;Registration;**1143**;Aug 13, 1993;Build 36
+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 ; ICRs:
+8 ; 5421 : GENPORT^XOBWLIB
+9 ; 7190 : R/W access to file 18.02
+10 ; 7191 : R/W access to file 18.12
+11 ; 2240 : $$ENCRYP^XUSRB1
+12 ; 10096 : ^%ZSOF("DEL")
+13 ;
+14 ; This routine is also used as an Environmental Check routine, though it does nothing except make the HELP
+15 ; tag below available for the Installation question in the build.
+16 QUIT
+17 ;
HELP ; Help for ?? on Installation Question POS (use direct writes in env check routine)
+1 WRITE !,"Enter 1 if patch is being installed in a Preprod/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 ;
+2 QUIT
POST ;Main entry point for Post-Install items
+1 ;
+2 DO BMES^XPDUTL(">>> Beginning the DG*5.3*1143 Post-install routine...")
+3 ; Get the site type entered in the Installation question POS
+4 SET DGTYPE=$GET(XPDQUES("POS1"))
+5 ; DGTYPE will be a value of 1-3 (MIRROR/PRE-PROD, SQA, DEVELOPMENT) (if no value, this is a PRODUCTION system)
+6 IF 'DGTYPE
SET DGTYPE=4
+7 DO POST1
+8 DO POST2(DGTYPE)
+9 DO POST3(DGTYPE)
+10 DO POST4
+11 DO POST5
+12 DO BMES^XPDUTL(">>> Patch DG*5.3*1143 - Post-install complete.")
+13 QUIT
+14 ;
POST1 ; Set MAS PARAMETER for Real-time Address Update
+1 NEW DGFDA,DGERR,X,Y
+2 DO BMES^XPDUTL(" o Set ENABLE REALTIME ADDRESS UPDATE (#1403) field")
+3 DO MES^XPDUTL(" in the MAS PARAMETERS (#43) file")
+4 ; Set MAS Parameter to NO
+5 SET DGFDA(43,"1,",1403)=0
DO FILE^DIE("","DGFDA","DGERR")
+6 IF '$DATA(DGERR)
DO MES^XPDUTL(" o ENABLE REALTIME ADDRESS UPDATE (#1403) field set to "_$$GET1^DIQ(43,1,1403,"E"))
+7 IF $DATA(DGERR)
Begin DoDot:1
+8 DO BMES^XPDUTL(" *** ERROR: "_DGERR("DIERR",1,"TEXT",1))
+9 DO MES^XPDUTL(" Please log YOUR IT Services ticket. ***")
End DoDot:1
+10 ;
+11 QUIT
POST2(DGTYPE) ; Setup DG RTAU CONTACTINFO SERVICE AND DG RTAU SERVER
+1 ; DGTYPE will be a value of 1-4 (MIRROR/PRE-PROD, SQA, DEVELOPMENT PRODUCTION)
+2 NEW DGSRVR,DGSRVC
+3 DO BMES^XPDUTL(" o Post-install set up for SSL Configuration...")
+4 SET DGSRVR="DG RTAU SERVER"
+5 SET DGSRVC="DG RTAU CONTACTINFO"
+6 ; If the DG RTAU SERVER is installed, set it to DISABLED so the update of the server won't cause errors
+7 ; The patch installation will set it back to ENABLED.
+8 DO DISABLE
+9 DO SERVICE
+10 DO SERVER(DGTYPE)
+11 QUIT
+12 ;
SERVICE ; Set up service - use REGREST^XOBWLIB
+1 NEW DGI,DGILOWCASE,DGCNTXTRT
+2 DO BMES^XPDUTL(" >> Updating WEB SERVICE (#18.02) file...")
+3 SET DGCNTXTRT="/ves-contact-brk/contact-info"
+4 ; REGREST^XOBWLIB handles all messaging.
DO REGREST^XOBWLIB(DGSRVC,DGCNTXTRT)
+5 QUIT
+6 ;
SERVER(DGTYPE) ; set up web server
+1 ; DGTYPE will be a value of 1-4 (MIRROR/PRE-PROD, SQA, DEVELOPMENT, PRODUCTION)
+2 NEW DGEXIT,DGCOUNT,DGEPT,DGPW,DGPORT,DGDATA
+3 NEW DGIEN,DGIENS,DGSERVER,DGFDAI,DGERR,DGERR12,DGERR02,DGSRVIEN,DGSERVICE
+4 DO MES^XPDUTL(" o Setting up the server for "_$SELECT(DGTYPE=1:"MIRROR/PRE-PROD",DGTYPE=2:"SQA",DGTYPE=3:"DEVELOPMENT",1:"PRODUCTION")_".")
+5 SET DGEXIT=0
+6 ; Get the matching endpoint and port for the site type
+7 FOR DGCOUNT=1:1
SET DGDATA=$PIECE($TEXT(TYPEMAP+DGCOUNT),";;",2)
Begin DoDot:1
+8 IF $PIECE(DGDATA,";",1)=DGTYPE
SET DGEPT=$PIECE(DGDATA,";",3)
SET DGPORT=$PIECE(DGDATA,";",4)
SET DGEXIT=1
End DoDot:1
if DGEXIT
QUIT
+9 SET DGIEN("SRV")=$$FIND1^DIC(18.12,,"B",DGSRVR)
+10 IF DGIEN("SRV")
SET DGIENS("SRV")=DGIEN("SRV")_","
+11 IF '$TEST
SET DGIENS("SRV")="+1,"
+12 ; NAME
+13 SET DGSERVER(18.12,DGIENS("SRV"),.01)=DGSRVR
+14 ; PORT
+15 SET DGSERVER(18.12,DGIENS("SRV"),.03)=DGPORT
+16 ; SERVER endpoint
+17 SET DGSERVER(18.12,DGIENS("SRV"),.04)=DGEPT
+18 ; STATUS
+19 ; For Mirror, set Status to disabled, otherwise, enable
+20 ;S DGSERVER(18.12,DGIENS("SRV"),.06)=$S(DGTYPE=1:0,1:1)
+21 ; ENABLE SERVER
+22 SET DGSERVER(18.12,DGIENS("SRV"),.06)=1
+23 ; SSL ENABLED
+24 SET DGSERVER(18.12,DGIENS("SRV"),3.01)=1
+25 ; SSL CONFIGURATION
+26 SET DGSERVER(18.12,DGIENS("SRV"),3.02)="encrypt_only_tlsv12"
+27 ; SSL PORT
+28 SET DGSERVER(18.12,DGIENS("SRV"),3.03)=DGPORT
+29 ;
+30 ; update existing entry
IF DGIEN("SRV")
DO FILE^DIE("","DGSERVER","DGERR12")
+31 ; create new entry
IF 'DGIEN("SRV")
DO UPDATE^DIE("","DGSERVER","DGFDAI","DGERR")
+32 IF $DATA(DGFDAI)
SET DGIENS("SRV")=DGFDAI(1)_","
SET DGIEN("SRV")=DGFDAI(1)
+33 IF '$DATA(DGERR12("DIERR",1,"TEXT",1))
DO BMES^XPDUTL(" o WEB SERVER '"_DGSRVR_"' addition/update succeeded.")
+34 IF $DATA(DGERR12("DIERR",1,"TEXT",1))
DO BMES^XPDUTL(" o WEB SERVER '"_DGSRVR_"' Error: "_DGERR12("DIERR",1,"TEXT",1))
QUIT
+35 ; once server is set up add the web service
+36 SET DGIENS("SRC")="+1,"
+37 SET DGSRVIEN=0
+38 FOR
SET DGSRVIEN=$ORDER(^XOB(18.12,DGIEN("SRV"),100,"B",DGSRVIEN))
if 'DGSRVIEN
QUIT
Begin DoDot:1
+39 IF $$GET1^DIQ(18.02,DGSRVIEN,.01)=DGSRVC
SET DGIENS("SRC")=DGSRVIEN_","
End DoDot:1
+40 ; don't update subentry pointers if already exist.
IF DGIENS("SRC")'="+1,"
QUIT
+41 KILL DGSERVICE,DGFDAI
+42 SET DGSERVICE(18.121,DGIENS("SRC")_DGIENS("SRV"),.01)=DGSRVC
+43 SET DGSERVICE(18.121,DGIENS("SRC")_DGIENS("SRV"),.06)="ENABLED"
+44 ; create new entry
DO UPDATE^DIE("E","DGSERVICE","DGFDAI","DGERR02")
+45 IF $DATA(DGERR02("DIERR",1,"TEXT",1))
DO MES^XPDUTL(" o "_DGERR02("DIERR",1,"TEXT",1))
+46 IF '$DATA(DGERR02("DIERR",1,"TEXT",1))
DO BMES^XPDUTL(" o '"_DGSRVC_"' service successfully authorized on server.")
+47 QUIT
+48 ;
DISABLE ; Disable DG RTAU SERVER server if it exists - update of server will set it back to enabled (except for Mirror)
+1 NEW DGIEN,DGSERVER,DGERR12
+2 SET DGIEN("SRV")=$$FIND1^DIC(18.12,,"B",DGSRVR)
+3 IF 'DGIEN("SRV")
QUIT
+4 ; Set STATUS to DISABLED
+5 SET DGSERVER(18.12,DGIEN("SRV")_",",.06)=0
+6 ; update existing entry
DO FILE^DIE("","DGSERVER","DGERR12")
+7 DO BMES^XPDUTL(" o '"_DGSRVR_"' server temporarily disabled.")
+8 QUIT
+9 ;
POST3(DGTYPE) ; Set the API Key for the site into the parameter DG RTAU API KEY
+1 ; DGTYPE will be a value of 1-4 (MIRROR/PRE-PROD, SQA, DEVELOPMENT PRODUCTION)
+2 NEW DGFDA,DGERR,DGKEY
+3 ;
+4 ; If API already defined, quit
+5 SET DGKEY=$$GET^XPAR("PKG","DG RTAU API KEY",1)
+6 IF DGKEY'=""
QUIT
+7 ; Prod Key: 6ekfHkOzlN0KTV37vFBR1kqbOaSn7Po41ceMmd3h
+8 ; Non-Prod Key: 1xXofbhGbO37Ccb1ml0kmyCFL5y4dSafoKMl3d00
+9 SET DGKEY=$SELECT(DGTYPE=4:"6ekfHkOzlN0KTV37vFBR1kqbOaSn7Po41ceMmd3h",1:"1xXofbhGbO37Ccb1ml0kmyCFL5y4dSafoKMl3d00")
+10 DO BMES^XPDUTL(" o Set Parameter instance DG RTAU API KEY in the PARAMETER (#8989.5) file")
+11 DO EN^XPAR("PKG","DG RTAU API KEY",1,DGKEY,.DGERR)
+12 IF '$GET(DGERR)
DO MES^XPDUTL(" o DG RTAU API KEY Parameter set successfully.")
+13 IF $GET(DGERR)
Begin DoDot:1
+14 DO BMES^XPDUTL(" *** Parameter set failed: "_DGERR)
+15 DO MES^XPDUTL(" Please log YOUR IT Services ticket. ***")
End DoDot:1
+16 QUIT
+17 ;
POST4 ; Set the DG RTAU API KEY parameter PROHIBIT EDITING (#.06) to 1 (YES)
+1 NEW DGPARAM,DGRTAKEY,DGERR
+2 ; Get the IEN of the Parameter Definition DG UAM API KEY
+3 SET DGPARAM=$$FIND1^DIC(8989.51,,"B","DG RTAU API KEY")
+4 if 'DGPARAM
QUIT
+5 DO BMES^XPDUTL(" o Setting parameter definition DG RTAU 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 DGRTAKEY(8989.51,DGPARAM_",",.06)=1
+9 DO FILE^DIE("","DGRTAKEY","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
+14 ;
POST5 ; Recompile templates
+1 ; Build array of file and field numbers for top-level file and fields being exported
+2 ; Array format: DGFLD(file#,field)=""
+3 ; Recompile all compiled input templates that contain the fields in the DGLFD array passed by reference
+4 ; PATIENT file #2
+5 NEW DGFLD
+6 DO BMES^XPDUTL(" o Recompile all compiled input templates that contain the following fields:")
+7 DO MES^XPDUTL(" PATIENT file(#2): ")
+8 DO MES^XPDUTL(" o RESIDENTIAL ADDRESS FIELDS")
+9 DO MES^XPDUTL(" o MAILING ADDRESS FIELDS")
+10 DO MES^XPDUTL(" o TEMPORARY ADDRESS FIELDS")
+11 DO MES^XPDUTL(" o CONFIDENTIAL ADDRESS FIELDS")
+12 DO MES^XPDUTL(" o EMAIL ADDRESS AND CELL PHONE FIELDS")
+13 DO MES^XPDUTL(" o HOME, OFFICE, TEMPORARY AND CONFIDENTIAL PHONE FIELDS")
+14 ;
+15 ; Residential Address
+16 ; Line 1
+17 SET DGFLD(2,.1151)=""
+18 ; Line 2
+19 SET DGFLD(2,.1152)=""
+20 ; Line 3
+21 SET DGFLD(2,.1153)=""
+22 ; City
+23 SET DGFLD(2,.1154)=""
+24 ; State
+25 SET DGFLD(2,.1155)=""
+26 ; Zip+5
+27 SET DGFLD(2,.1156)=""
+28 ; County
+29 SET DGFLD(2,.1157)=""
+30 ; Province
+31 SET DGFLD(2,.11571)=""
+32 ; Postal Code
+33 SET DGFLD(2,.11572)=""
+34 ; Country
+35 SET DGFLD(2,.11573)=""
+36 ; Home Phone
+37 SET DGFLD(2,.131)=""
+38 ; Work phone
+39 SET DGFLD(2,.132)=""
+40 ; Mailing Address
+41 ; Line 1
+42 SET DGFLD(2,.111)=""
+43 ; Line 2
+44 SET DGFLD(2,.112)=""
+45 ; Line 3
+46 SET DGFLD(2,.113)=""
+47 ; City
+48 SET DGFLD(2,.114)=""
+49 ; State
+50 SET DGFLD(2,.115)=""
+51 ; Zip
+52 SET DGFLD(2,.116)=""
+53 ; County
+54 SET DGFLD(2,.117)=""
+55 ; Province
+56 SET DGFLD(2,.1171)=""
+57 ; Postal Code
+58 SET DGFLD(2,.1172)=""
+59 ; Country
+60 SET DGFLD(2,.1173)=""
+61 ; Zip+4
+62 SET DGFLD(2,.1112)=""
+63 ; Bad Address Indicator
+64 SET DGFLD(2,.121)=""
+65 ; Temporary Address
+66 ; Line 1
+67 SET DGFLD(2,.1211)=""
+68 ; Line 2
+69 SET DGFLD(2,.1212)=""
+70 ; Line 3
+71 SET DGFLD(2,.1213)=""
+72 ; City
+73 SET DGFLD(2,.1214)=""
+74 ; State
+75 SET DGFLD(2,.1215)=""
+76 ; Zip
+77 SET DGFLD(2,.1216)=""
+78 ; Start Date
+79 SET DGFLD(2,.1217)=""
+80 ; End Date
+81 SET DGFLD(2,.1218)=""
+82 ; Address Active?
+83 SET DGFLD(2,.12105)=""
+84 ; Temp Phone
+85 SET DGFLD(2,.1219)=""
+86 ; County
+87 SET DGFLD(2,.12111)=""
+88 ; Zip+4
+89 SET DGFLD(2,.12112)=""
+90 ; Province
+91 SET DGFLD(2,.1221)=""
+92 ; Postal Code
+93 SET DGFLD(2,.1222)=""
+94 ; Country
+95 SET DGFLD(2,.1223)=""
+96 ; Confidential Address
+97 ; Line 1
+98 SET DGFLD(2,.1411)=""
+99 ; Line 2
+100 SET DGFLD(2,.1412)=""
+101 ; Line 3
+102 SET DGFLD(2,.1413)=""
+103 ; City
+104 SET DGFLD(2,.1414)=""
+105 ; State
+106 SET DGFLD(2,.1415)=""
+107 ; Zip
+108 SET DGFLD(2,.1416)=""
+109 ; Start Date
+110 SET DGFLD(2,.1417)=""
+111 ; End Date
+112 SET DGFLD(2,.1418)=""
+113 ; Address Active?
+114 SET DGFLD(2,.14105)=""
+115 ; County
+116 SET DGFLD(2,.14111)=""
+117 ; Province
+118 SET DGFLD(2,.14114)=""
+119 ; Postal Code
+120 SET DGFLD(2,.14115)=""
+121 ; Country
+122 SET DGFLD(2,.14116)=""
+123 ; Conf Phone
+124 SET DGFLD(2,.1315)=""
+125 ; CASS Indicator
+126 SET DGFLD(2,.14117)=""
+127 ;
+128 ; EMAIL
+129 SET DGFLD(2,.133)=""
+130 ; Cell number
+131 SET DGFLD(2,.134)=""
+132 ;
+133 DO DIEZ^DIKCUTL3(2,.DGFLD)
+134 QUIT
+135 ;
TYPEMAP ; Map the system type to the SERVER endpoint and Port values
+1 ;;1;MIRROR;prep.ves.domain.ext;443
+2 ;;2;SQA;sqa.ves.domain.ext;443
+3 ;;3;DEV;dev.ves.domain.ext;443
+4 ;;4;PROD;ves.domain.ext;443
