XMDBZGOV ;ALB/JTW - ZZ ALL GOV DOMAINS; Feb 07, 2020@7:35
;;1.0;MailMan;**2**;AUG 13, 1993;Build 7
;
; Post-init routine to update all GOV domains
; with RELAY DOMAIN of DOMAIN.EXT
;
Q
;
POST ; Update GOV DOMAINS
N XMDBIEN,XMDBERR,XMDBFDA,XMDBNIEN,XMDBCNT,XMDBGOV,XMDBFRM,XMDBFIEN
S XMDBIEN="",XMDBCNT=0
;Update GOV domain to be ZZGOV, set Flags to C (closed), and remove Relay Domain
F S XMDBIEN=$O(^DIC(4.2,XMDBIEN)) Q:XMDBIEN="" I ($P($G(^DIC(4.2,XMDBIEN,0)),U,1)="GOV")!($P($G(^DIC(4.2,XMDBIEN,0)),U,1)="gov") D
.S XMDBNIEN=$P($G(^DIC(4.2,XMDBIEN,0)),U,3) Q:XMDBNIEN=""
.I $P($G(^DIC(4.2,XMDBNIEN,0)),U,1)="DOMAIN.EXT" D
..K XMDBERR,XMDBFDA
..S XMDBFDA(4.2,XMDBIEN_",",.01)="ZZGOV"
..S XMDBFDA(4.2,XMDBIEN_",",1)="C"
..S XMDBFDA(4.2,XMDBIEN_",",2)="@"
..D FILE^DIE(,"XMDBFDA","XMDBERR")
..I '$D(XMDBERR) D BMES^XPDUTL(">>>....Domain with IEN:"_XMDBIEN_" was updated") S XMDBCNT=XMDBCNT+1
..I $D(XMDBERR) D BMES^XPDUTL(">>>....Unable to update IEN: "_XMDBIEN_".") D
...D BMES^XPDUTL("*** Please contact support for assistance. ***")
;Update the DOMAIN.EXT domain to remove the GOV synonym
I $O(^DIC(4.2,"B","DOMAIN.EXT",""))'="" S XMDBFRM=$O(^DIC(4.2,"B","DOMAIN.EXT","")) D
.I $O(^DIC(4.2,"C","GOV",XMDBFRM,""))'="" S XMDBFIEN=$O(^DIC(4.2,"C","GOV",XMDBFRM,"")) K XMDBFDA S XMDBFDA(4.23,XMDBFIEN_","_XMDBFRM_",",.01)="@" D
..K XMDBERR D FILE^DIE(,"XMDBFDA","XMDBERR")
..I '$D(XMDBERR) D BMES^XPDUTL(">>>....DOMAIN.EXT domain with IEN:"_XMDBFRM_" was updated") S XMDBCNT=XMDBCNT+1
..I $D(XMDBERR) D BMES^XPDUTL(">>>....Unable to update IEN: "_XMDBFRM_".") D
...D BMES^XPDUTL("*** Please contact support for assistance. ***")
I XMDBCNT'=0 D BMES^XPDUTL(">>>...."_XMDBCNT_" record(s) updated.")
I XMDBCNT=0 D BMES^XPDUTL(">>>...."_"No records updated.")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMDBZGOV 1823 printed Apr 09, 2024@21:12:58 Page 2
XMDBZGOV ;ALB/JTW - ZZ ALL GOV DOMAINS; Feb 07, 2020@7:35
+1 ;;1.0;MailMan;**2**;AUG 13, 1993;Build 7
+2 ;
+3 ; Post-init routine to update all GOV domains
+4 ; with RELAY DOMAIN of DOMAIN.EXT
+5 ;
+6 QUIT
+7 ;
POST ; Update GOV DOMAINS
+1 NEW XMDBIEN,XMDBERR,XMDBFDA,XMDBNIEN,XMDBCNT,XMDBGOV,XMDBFRM,XMDBFIEN
+2 SET XMDBIEN=""
SET XMDBCNT=0
+3 ;Update GOV domain to be ZZGOV, set Flags to C (closed), and remove Relay Domain
+4 FOR
SET XMDBIEN=$ORDER(^DIC(4.2,XMDBIEN))
if XMDBIEN=""
QUIT
IF ($PIECE($GET(^DIC(4.2,XMDBIEN,0)),U,1)="GOV")!($PIECE($GET(^DIC(4.2,XMDBIEN,0)),U,1)="gov")
Begin DoDot:1
+5 SET XMDBNIEN=$PIECE($GET(^DIC(4.2,XMDBIEN,0)),U,3)
if XMDBNIEN=""
QUIT
+6 IF $PIECE($GET(^DIC(4.2,XMDBNIEN,0)),U,1)="DOMAIN.EXT"
Begin DoDot:2
+7 KILL XMDBERR,XMDBFDA
+8 SET XMDBFDA(4.2,XMDBIEN_",",.01)="ZZGOV"
+9 SET XMDBFDA(4.2,XMDBIEN_",",1)="C"
+10 SET XMDBFDA(4.2,XMDBIEN_",",2)="@"
+11 DO FILE^DIE(,"XMDBFDA","XMDBERR")
+12 IF '$DATA(XMDBERR)
DO BMES^XPDUTL(">>>....Domain with IEN:"_XMDBIEN_" was updated")
SET XMDBCNT=XMDBCNT+1
+13 IF $DATA(XMDBERR)
DO BMES^XPDUTL(">>>....Unable to update IEN: "_XMDBIEN_".")
Begin DoDot:3
+14 DO BMES^XPDUTL("*** Please contact support for assistance. ***")
End DoDot:3
End DoDot:2
End DoDot:1
+15 ;Update the DOMAIN.EXT domain to remove the GOV synonym
+16 IF $ORDER(^DIC(4.2,"B","DOMAIN.EXT",""))'=""
SET XMDBFRM=$ORDER(^DIC(4.2,"B","DOMAIN.EXT",""))
Begin DoDot:1
+17 IF $ORDER(^DIC(4.2,"C","GOV",XMDBFRM,""))'=""
SET XMDBFIEN=$ORDER(^DIC(4.2,"C","GOV",XMDBFRM,""))
KILL XMDBFDA
SET XMDBFDA(4.23,XMDBFIEN_","_XMDBFRM_",",.01)="@"
Begin DoDot:2
+18 KILL XMDBERR
DO FILE^DIE(,"XMDBFDA","XMDBERR")
+19 IF '$DATA(XMDBERR)
DO BMES^XPDUTL(">>>....DOMAIN.EXT domain with IEN:"_XMDBFRM_" was updated")
SET XMDBCNT=XMDBCNT+1
+20 IF $DATA(XMDBERR)
DO BMES^XPDUTL(">>>....Unable to update IEN: "_XMDBFRM_".")
Begin DoDot:3
+21 DO BMES^XPDUTL("*** Please contact support for assistance. ***")
End DoDot:3
End DoDot:2
End DoDot:1
+22 IF XMDBCNT'=0
DO BMES^XPDUTL(">>>...."_XMDBCNT_" record(s) updated.")
+23 IF XMDBCNT=0
DO BMES^XPDUTL(">>>...."_"No records updated.")
+24 QUIT
