SD53P750 ;ALB/DBE - PCMM CPRS HEADER ENABLE TLS ; 10/13/2020
;;5.3;Scheduling;**750**;Aug 13, 1993;Build 1
;
Q
;
; Private ICR:
; #6171 - READ WRITE ACCESS TO WEB SERVER FILE
;
UPDATE ;update PCMM HWSC web server entries
;
;enable tls for both pcmm hwsc entries
D ENABLTLS("PCMMR TEST")
D ENABLTLS("PCMMR")
;
;disable pcmmr test hwsc entry in all environments
D DISABLE("PCMMR TEST")
;
;disable pcmmr production entry in test environments only
I '$$PROD^XUPROD D DISABLE("PCMMR")
;
Q
;
ENABLTLS(SDSERVER) ;enable tls for hwsc server entry
;
Q:$G(SDSERVER)=""
N SDWSIEN,SDFDA,SDERR ;sdwsien=pcmm web server entry ien
;
D BMES^XPDUTL(">>>Enabling SSL for the '"_SDSERVER_"' entry in the Web Server (#18.12) file...")
;
S SDWSIEN=0 S SDWSIEN=$O(^XOB(18.12,"B",SDSERVER,SDWSIEN)) Q:'SDWSIEN D ;identify pcmm web server entry ien (no duplicates allowed)
.I $P(^XOB(18.12,SDWSIEN,0),U,1)=SDSERVER D ;verify correct name
..S SDFDA(18.12,SDWSIEN_",",3.01)=1 ;ssl enabled
..S SDFDA(18.12,SDWSIEN_",",3.02)="encrypt_only_tlsv12" ;ssl/tls configuration
..S SDFDA(18.12,SDWSIEN_",",3.03)=443 ;ssl port number
..K SDERR D FILE^DIE(,"SDFDA","SDERR")
..I '$D(SDERR) D MES^XPDUTL(" >>>...'"_SDSERVER_"' server entry (IEN #"_SDWSIEN_") successfully updated")
..I $D(SDERR) D MES^XPDUTL(" >>>...Error updating '"_SDSERVER_"' server entry (IEN #"_SDWSIEN_")") D
...D MES^XPDUTL(" ERROR: "_$G(SDERR("DIERR","1"))) ;print error code to help identify filing issue
...D MES^XPDUTL(" *** Please contact support for assistance. ***")
K SDSERVER
Q
;
DISABLE(SDSERVER) ;disable hwsc server entry
;
Q:$G(SDSERVER)=""
N SDWSIEN,SDFDA,SDERR ;sdwsien=pcmm web service entry ien
;
D BMES^XPDUTL(">>>Disabling the '"_SDSERVER_"' entry in the Web Server (#18.12) file...")
;
S SDWSIEN=0 S SDWSIEN=$O(^XOB(18.12,"B",SDSERVER,SDWSIEN)) Q:'SDWSIEN D ;identify pcmm web server entry ien (no duplicates allowed)
.I $P(^XOB(18.12,SDWSIEN,0),U,1)=SDSERVER D ;verify correct name
..S SDFDA(18.12,SDWSIEN_",",.06)=0 ;disable server
..K SDERR D FILE^DIE(,"SDFDA","SDERR")
..I '$D(SDERR) D MES^XPDUTL(" >>>...'"_SDSERVER_"' server entry (IEN #"_SDWSIEN_") successfully disabled")
..I $D(SDERR) D MES^XPDUTL(" >>>...Error updating '"_SDSERVER_"' server entry (IEN #"_SDWSIEN_")") D
...D MES^XPDUTL(" ERROR: "_$G(SDERR("DIERR","1"))) ;print error code to help identify filing issue
...D MES^XPDUTL(" *** Please contact support for assistance. ***")
K SDSERVER
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSD53P750 2551 printed Dec 13, 2024@02:46:38 Page 2
SD53P750 ;ALB/DBE - PCMM CPRS HEADER ENABLE TLS ; 10/13/2020
+1 ;;5.3;Scheduling;**750**;Aug 13, 1993;Build 1
+2 ;
+3 QUIT
+4 ;
+5 ; Private ICR:
+6 ; #6171 - READ WRITE ACCESS TO WEB SERVER FILE
+7 ;
UPDATE ;update PCMM HWSC web server entries
+1 ;
+2 ;enable tls for both pcmm hwsc entries
+3 DO ENABLTLS("PCMMR TEST")
+4 DO ENABLTLS("PCMMR")
+5 ;
+6 ;disable pcmmr test hwsc entry in all environments
+7 DO DISABLE("PCMMR TEST")
+8 ;
+9 ;disable pcmmr production entry in test environments only
+10 IF '$$PROD^XUPROD
DO DISABLE("PCMMR")
+11 ;
+12 QUIT
+13 ;
ENABLTLS(SDSERVER) ;enable tls for hwsc server entry
+1 ;
+2 if $GET(SDSERVER)=""
QUIT
+3 ;sdwsien=pcmm web server entry ien
NEW SDWSIEN,SDFDA,SDERR
+4 ;
+5 DO BMES^XPDUTL(">>>Enabling SSL for the '"_SDSERVER_"' entry in the Web Server (#18.12) file...")
+6 ;
+7 ;identify pcmm web server entry ien (no duplicates allowed)
SET SDWSIEN=0
SET SDWSIEN=$ORDER(^XOB(18.12,"B",SDSERVER,SDWSIEN))
if 'SDWSIEN
QUIT
Begin DoDot:1
+8 ;verify correct name
IF $PIECE(^XOB(18.12,SDWSIEN,0),U,1)=SDSERVER
Begin DoDot:2
+9 ;ssl enabled
SET SDFDA(18.12,SDWSIEN_",",3.01)=1
+10 ;ssl/tls configuration
SET SDFDA(18.12,SDWSIEN_",",3.02)="encrypt_only_tlsv12"
+11 ;ssl port number
SET SDFDA(18.12,SDWSIEN_",",3.03)=443
+12 KILL SDERR
DO FILE^DIE(,"SDFDA","SDERR")
+13 IF '$DATA(SDERR)
DO MES^XPDUTL(" >>>...'"_SDSERVER_"' server entry (IEN #"_SDWSIEN_") successfully updated")
+14 IF $DATA(SDERR)
DO MES^XPDUTL(" >>>...Error updating '"_SDSERVER_"' server entry (IEN #"_SDWSIEN_")")
Begin DoDot:3
+15 ;print error code to help identify filing issue
DO MES^XPDUTL(" ERROR: "_$GET(SDERR("DIERR","1")))
+16 DO MES^XPDUTL(" *** Please contact support for assistance. ***")
End DoDot:3
End DoDot:2
End DoDot:1
+17 KILL SDSERVER
+18 QUIT
+19 ;
DISABLE(SDSERVER) ;disable hwsc server entry
+1 ;
+2 if $GET(SDSERVER)=""
QUIT
+3 ;sdwsien=pcmm web service entry ien
NEW SDWSIEN,SDFDA,SDERR
+4 ;
+5 DO BMES^XPDUTL(">>>Disabling the '"_SDSERVER_"' entry in the Web Server (#18.12) file...")
+6 ;
+7 ;identify pcmm web server entry ien (no duplicates allowed)
SET SDWSIEN=0
SET SDWSIEN=$ORDER(^XOB(18.12,"B",SDSERVER,SDWSIEN))
if 'SDWSIEN
QUIT
Begin DoDot:1
+8 ;verify correct name
IF $PIECE(^XOB(18.12,SDWSIEN,0),U,1)=SDSERVER
Begin DoDot:2
+9 ;disable server
SET SDFDA(18.12,SDWSIEN_",",.06)=0
+10 KILL SDERR
DO FILE^DIE(,"SDFDA","SDERR")
+11 IF '$DATA(SDERR)
DO MES^XPDUTL(" >>>...'"_SDSERVER_"' server entry (IEN #"_SDWSIEN_") successfully disabled")
+12 IF $DATA(SDERR)
DO MES^XPDUTL(" >>>...Error updating '"_SDSERVER_"' server entry (IEN #"_SDWSIEN_")")
Begin DoDot:3
+13 ;print error code to help identify filing issue
DO MES^XPDUTL(" ERROR: "_$GET(SDERR("DIERR","1")))
+14 DO MES^XPDUTL(" *** Please contact support for assistance. ***")
End DoDot:3
End DoDot:2
End DoDot:1
+15 KILL SDSERVER
+16 QUIT
