XMDB1P4 ;OAK/LMB - v4 MAILMAN DOMAIN POST INSTALL UPDATE; 22 Aug 2024
;;1.0;MAILMAN DOMAIN UPDATES;**4**;Nov 8, 2016;Build 14
;;Per VHA Directive 2004-038, this routine should not be modified
Q
;
POST ;post install entry point
N XUIEN,XMDB,FERR,XUDOMAIN
S XMDB=$G(XUDOMAIN,"SURGERYSRA.DOMAIN.EXT")
S XUIEN=$$ADDENT(XMDB) IF XUIEN=0 Q
I $$ADDSUB(XUIEN)=0 Q
I $$ADDWF(XUIEN)=0 Q
D:$$PROD^XUPROD'=0 BMES^XPDUTL("NOTE: Flag was set to 'S' due to PRODUCTION environment.")
D:$$PROD^XUPROD=0 BMES^XPDUTL("NOTE: Flag was set to 'C' due to NON-PRODUCTION environment.")
Q
;
ADDENT(XMDB) ;add DOMAIN entry if matching entry not found
N FDA
S FDA(4.2,"?+1,",.01)=XMDB
S FDA(4.2,"?+1,",1)="S" ;default
S:$$PROD^XUPROD=0 FDA(4.2,"?+1,",1)="C" ;for non-production environments
D UPDATE^DIE("E","FDA","IEN","DIERR")
I $D(DIERR) D BMES^XPDUTL("Error adding/modifying domain "_$G(DIERR)) Q 0
Q 1
;
ADDSUB(XUIEN) ;Add/modify TRANSMISSION SCRIPT subfile
K FDA,DIERR,IENS
S XUIEN=IEN(1)
S IENS="?+2,"_XUIEN_","
S FDA(4.21,IENS,.01)="TCP/IP"
S FDA(4.21,IENS,1)=1
S FDA(4.21,IENS,1.1)=5
S FDA(4.21,IENS,1.2)="SMTP"
S FDA(4.21,IENS,1.3)="NULL DEVICE"
S FDA(4.21,IENS,1.4)="ecp.surgerysra.domain.ext"
D UPDATE^DIE("","FDA","XUIEN","DIERR")
I $D(DIERR) D BMES^XPDUTL("Error adding subfile to domain "_$G(DIERR)) Q 0
Q 1
;
ADDWF(XUIEN) ;Set TEXT of WP field using the same TRANSMISSION SCRIPT called by FO-HINES.DOMAIN.EXT
K DIERR,IENS
N FIEN,XFM,XFMC,XFMX,TXIEN,LASTLINE,FWP
I $$FIND1^DIC(4.2,"","","FO-HINES.DOMAIN.EXT")'=0 D
.S FIEN=$$FIND1^DIC(4.2,"","","FO-HINES.DOMAIN.EXT")
.S FIEN1=","_FIEN_","
.S TXIEN=$$FIND1^DIC(4.21,FIEN1,"","TCP")
.I TXIEN>0 D
..S FIEN2=TXIEN_","_FIEN
..S XFM=$$GET1^DIQ(4.21,FIEN2,2,"","FWP")
..S LASTLINE=$ORDER(FWP(""),-1)
..I LASTLINE=2,FWP(2)?1"C ".E S XFMC=FWP(2)
..I LASTLINE=3,FWP(3)?1"C ".E S XFMX=FWP(2),XFMC=FWP(3)
I $D(XFMC)=0 D
.S XFMC="**If PRODUCTION - I need a SCRIPT to call. Contact support.**"
.D:$$PROD^XUPROD'=0 BMES^XPDUTL("**WARNING: No SCRIPT could be identified! Contact support.**")
S XUIEN=IEN(1)
S IENS="1,"_XUIEN_","
S ^TMP($J,"WP",1)="O H=SURGERYSRA.DOMAIN.EXT,P=TCP/IP-MAILMAN"
S:$G(XFMX)'="" ^TMP($J,"WP",2)=XFMX,^TMP($J,"WP",3)=XFMC
S:$G(XFMX)="" ^TMP($J,"WP",2)=XFMC
D WP^DIE(4.21,IENS,2,"","^TMP($J,""WP"")","DIERR")
K FWP,IEN,^TMP($J,"WP"),FIEN,XFM,XUIEN,IENS,FIEN1,FIEN2,TXIEN
I $D(DIERR) D BMES^XPDUTL("Error adding TEXT for "_XMDB_$G(DIERR)) Q 0
Q 1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMDB1P4 2517 printed Jan 29, 2026@15:09:57 Page 2
XMDB1P4 ;OAK/LMB - v4 MAILMAN DOMAIN POST INSTALL UPDATE; 22 Aug 2024
+1 ;;1.0;MAILMAN DOMAIN UPDATES;**4**;Nov 8, 2016;Build 14
+2 ;;Per VHA Directive 2004-038, this routine should not be modified
+3 QUIT
+4 ;
POST ;post install entry point
+1 NEW XUIEN,XMDB,FERR,XUDOMAIN
+2 SET XMDB=$GET(XUDOMAIN,"SURGERYSRA.DOMAIN.EXT")
+3 SET XUIEN=$$ADDENT(XMDB)
IF XUIEN=0
QUIT
+4 IF $$ADDSUB(XUIEN)=0
QUIT
+5 IF $$ADDWF(XUIEN)=0
QUIT
+6 if $$PROD^XUPROD'=0
DO BMES^XPDUTL("NOTE: Flag was set to 'S' due to PRODUCTION environment.")
+7 if $$PROD^XUPROD=0
DO BMES^XPDUTL("NOTE: Flag was set to 'C' due to NON-PRODUCTION environment.")
+8 QUIT
+9 ;
ADDENT(XMDB) ;add DOMAIN entry if matching entry not found
+1 NEW FDA
+2 SET FDA(4.2,"?+1,",.01)=XMDB
+3 ;default
SET FDA(4.2,"?+1,",1)="S"
+4 ;for non-production environments
if $$PROD^XUPROD=0
SET FDA(4.2,"?+1,",1)="C"
+5 DO UPDATE^DIE("E","FDA","IEN","DIERR")
+6 IF $DATA(DIERR)
DO BMES^XPDUTL("Error adding/modifying domain "_$GET(DIERR))
QUIT 0
+7 QUIT 1
+8 ;
ADDSUB(XUIEN) ;Add/modify TRANSMISSION SCRIPT subfile
+1 KILL FDA,DIERR,IENS
+2 SET XUIEN=IEN(1)
+3 SET IENS="?+2,"_XUIEN_","
+4 SET FDA(4.21,IENS,.01)="TCP/IP"
+5 SET FDA(4.21,IENS,1)=1
+6 SET FDA(4.21,IENS,1.1)=5
+7 SET FDA(4.21,IENS,1.2)="SMTP"
+8 SET FDA(4.21,IENS,1.3)="NULL DEVICE"
+9 SET FDA(4.21,IENS,1.4)="ecp.surgerysra.domain.ext"
+10 DO UPDATE^DIE("","FDA","XUIEN","DIERR")
+11 IF $DATA(DIERR)
DO BMES^XPDUTL("Error adding subfile to domain "_$GET(DIERR))
QUIT 0
+12 QUIT 1
+13 ;
ADDWF(XUIEN) ;Set TEXT of WP field using the same TRANSMISSION SCRIPT called by FO-HINES.DOMAIN.EXT
+1 KILL DIERR,IENS
+2 NEW FIEN,XFM,XFMC,XFMX,TXIEN,LASTLINE,FWP
+3 IF $$FIND1^DIC(4.2,"","","FO-HINES.DOMAIN.EXT")'=0
Begin DoDot:1
+4 SET FIEN=$$FIND1^DIC(4.2,"","","FO-HINES.DOMAIN.EXT")
+5 SET FIEN1=","_FIEN_","
+6 SET TXIEN=$$FIND1^DIC(4.21,FIEN1,"","TCP")
+7 IF TXIEN>0
Begin DoDot:2
+8 SET FIEN2=TXIEN_","_FIEN
+9 SET XFM=$$GET1^DIQ(4.21,FIEN2,2,"","FWP")
+10 SET LASTLINE=$ORDER(FWP(""),-1)
+11 IF LASTLINE=2
IF FWP(2)?1"C ".E
SET XFMC=FWP(2)
+12 IF LASTLINE=3
IF FWP(3)?1"C ".E
SET XFMX=FWP(2)
SET XFMC=FWP(3)
End DoDot:2
End DoDot:1
+13 IF $DATA(XFMC)=0
Begin DoDot:1
+14 SET XFMC="**If PRODUCTION - I need a SCRIPT to call. Contact support.**"
+15 if $$PROD^XUPROD'=0
DO BMES^XPDUTL("**WARNING: No SCRIPT could be identified! Contact support.**")
End DoDot:1
+16 SET XUIEN=IEN(1)
+17 SET IENS="1,"_XUIEN_","
+18 SET ^TMP($JOB,"WP",1)="O H=SURGERYSRA.DOMAIN.EXT,P=TCP/IP-MAILMAN"
+19 if $GET(XFMX)'=""
SET ^TMP($JOB,"WP",2)=XFMX
SET ^TMP($JOB,"WP",3)=XFMC
+20 if $GET(XFMX)=""
SET ^TMP($JOB,"WP",2)=XFMC
+21 DO WP^DIE(4.21,IENS,2,"","^TMP($J,""WP"")","DIERR")
+22 KILL FWP,IEN,^TMP($JOB,"WP"),FIEN,XFM,XUIEN,IENS,FIEN1,FIEN2,TXIEN
+23 IF $DATA(DIERR)
DO BMES^XPDUTL("Error adding TEXT for "_XMDB_$GET(DIERR))
QUIT 0
+24 QUIT 1
