source: WorldVistAEHR/trunk/r/MAILMAN-XM/XMUDNC.m@ 1384

Last change on this file since 1384 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 7.9 KB
RevLine 
[613]1XMUDNC ;ISC-SF/GMB-Domain Name Change ;04/17/2002 11:48
2 ;;8.0;MailMan;;Jun 28, 2002
3 ; A domain name change happens in two steps, in two patches:
4 ; 1. The first patch adds the new name as a synonym to the site's
5 ; DOMAIN file entry at all sites. (Entry SYNONYM)
6 ; 2. When all sites have added the synonym, the second patch switches
7 ; the names in the DOMAIN file at all sites. The synonym becomes
8 ; the domain name, and old domain name becomes the synonym.
9 ; The domain name is changed in each TCP/IP script, too.
10 ; The domain name is changed in the Postmaster's basket.
11 ; The site's name is changed in file 4.3 MAILMAN SITE PARAMETERS.
12 ; (Entry CHANGE)
13SYNONYM ;
14 D BMES^XPDUTL("Add <new site name> as synonym for <current site name> in DOMAIN file.")
15 D REINDEX
16 N XMB,XMI,XMDOM,XMSUBDOM,XMSYN
17 ;D INIT("S") Q:'$D(^DOPT("XMSYN",$J))
18 S (XMB,XMI)=""
19 F S XMB=$O(^DIC(4.2,"B",XMB)) Q:XMB="" D
20 . F S XMI=$O(^DIC(4.2,"B",XMB,XMI)) Q:XMI="" D
21 . . N DIC,X,Y
22 . . S (X,XMDOM)=$P(^DIC(4.2,XMI,0),U,1)
23 . . S XMSUBDOM=""
24 . . S DIC="^DOPT(""XMSYN"",$J,"
25 . . S DIC(0)="XZ"
26 . . F D ^DIC Q:Y>0!($L(X,".")<4) D
27 . . . S XMSUBDOM=XMSUBDOM_$P(X,".")_"."
28 . . . S X=$P(X,".",2,99)
29 . . Q:Y<0 ; Quit if (sub) domain is not in the table
30 . . D BMES^XPDUTL("Domain: "_XMDOM)
31 . . S XMSYN=$P(Y(0),U,2)
32 . . I XMSYN="" S XMSYN=$P(XMDOM,".",1,$L(XMDOM,".")-2)_".MED.VA.GOV"
33 . . E S XMSYN=XMSUBDOM_XMSYN
34 . . D CHKSYN(XMI,XMSYN)
35 K ^DOPT("XMSYN",$J)
36 Q
37INIT(XMENTRY) ; Load table into global
38 ; XMENTRY - An entry point in a pre-init (for synonyms) or post-init
39 ; (for changes).
40 N DIK,I,X
41 K ^DOPT("XMSYN",$J)
42 F I=1:1 S X=$T(@XMENTRY+I) Q:X=" ;;" S ^DOPT("XMSYN",$J,I,0)=$E(X,4,255)
43 Q:'$D(^DOPT("XMSYN",$J))
44 S ^DOPT("XMSYN",$J,0)="Domain Synonyms^1N^"
45 S DIK="^DOPT(""XMSYN"",$J,"
46 D IXALL^DIK
47 Q
48CHKSYN(XMDIEN,XMSYN) ;
49 N XMSIEN
50 D MES^XPDUTL("Lookup Synonym: "_XMSYN)
51 S XMSIEN=$$FIND1^DIC(4.2,"","MQX",XMSYN,"B^C")
52 I $D(DIERR) D Q
53 . N XMI
54 . D MES^XPDUTL("*** Error on look up!")
55 . D MES^XPDUTL("*** Usually means more than one occurence.")
56 . I $D(^DIC(4.2,"B",XMSYN)) D MES^XPDUTL("*** Synonym is also a domain!")
57 . S XMI=0
58 . F S XMI=$O(^DIC(4.2,"C",XMSYN,XMI)) Q:'XMI D
59 . . D MES^XPDUTL("*** Synonym is for domain IEN "_XMI_", name "_$P(^DIC(4.2,XMI,0),U,1))
60 . D MES^XPDUTL("*** No action taken. Please investigate and fix.")
61 I XMSIEN=XMDIEN D MES^XPDUTL("Already there.") Q
62 I XMSIEN D Q
63 . I $D(^DIC(4.2,"B",XMSYN)) D MES^XPDUTL("*** Synonym is also a domain!")
64 . E D MES^XPDUTL("*** Synonym is for domain IEN "_XMSIEN_", name "_$P(^DIC(4.2,XMSIEN,0),U,1))
65 . D MES^XPDUTL("*** No action taken. Please investigate and fix.")
66 D MES^XPDUTL("Not found. Adding it.")
67 S XMFDA(4.23,"+1,"_XMDIEN_",",.01)=XMSYN
68 D UPDATE^DIE("","XMFDA")
69 I $D(DIERR) D MES^XPDUTL("*** Error adding it!")
70 Q
71CHANGE ;
72 D BMES^XPDUTL("Change <current site name> to <new site name> in DOMAIN file.")
73 D REINDEX
74 N XMB,XMI,XMDOM,XMSUBDOM,XMSYN
75 ;D INIT("C") Q:'$D(^DOPT("XMSYN",$J))
76 K ^TMP("XM",$J)
77 S (XMB,XMI)=""
78 F S XMB=$O(^DIC(4.2,"B",XMB)) Q:XMB="" D
79 . F S XMI=$O(^DIC(4.2,"B",XMB,XMI)) Q:XMI="" D
80 . . N DIC,X,Y,XMSTAT
81 . . S (X,XMDOM)=$P(^DIC(4.2,XMI,0),U,1)
82 . . S XMSUBDOM=""
83 . . S DIC="^DOPT(""XMSYN"",$J,"
84 . . S DIC(0)="XZ"
85 . . F D ^DIC Q:Y>0!($L(X,".")<4) D
86 . . . S XMSUBDOM=XMSUBDOM_$P(X,".")_"."
87 . . . S X=$P(X,".",2,99)
88 . . Q:Y<0 ; Quit if (sub) domain is not in the table
89 . . D BMES^XPDUTL("Domain: "_XMDOM)
90 . . S XMSYN=$P(Y(0),U,2)
91 . . I XMSYN="" S XMSYN=$P(XMDOM,".",1,$L(XMDOM,".")-2)_".MED.VA.GOV"
92 . . E S XMSYN=XMSUBDOM_XMSYN
93 . . D CHKNAME(XMI,XMDOM,XMSYN,.XMSTAT)
94 . . S ^TMP("XM",$J,XMDOM)=XMSYN_U_$G(XMSTAT,"ERROR")
95 I $G(^XMB("NUM"))'=$P(^XMB(1,1,0),U,1) S ^XMB("NUM")=$P(^XMB(1,1,0),U,1)
96 I ^XMB("NETNAME")'=$P(^DIC(4.2,^XMB("NUM"),0),U,1) D
97 . S (^XMB("NETNAME"),^XMB("NETNAME"))=$P(^DIC(4.2,^XMB("NUM"),0),U,1)
98 . D BMES^XPDUTL("The name of this site has been changed to "_^XMB("NETNAME"))
99 D CSUMM
100 Q
101CHKNAME(XMDIEN,XMDOM,XMSYN,XMSTAT) ;
102 N XMSIEN
103 D MES^XPDUTL("Lookup Synonym: "_XMSYN)
104 S XMSIEN=$$FIND1^DIC(4.2,"","MQX",XMSYN,"B^C")
105 I $D(DIERR) D Q
106 . N XMI
107 . D MES^XPDUTL("*** Error on look up!")
108 . D MES^XPDUTL("*** Usually means more than one occurence.")
109 . I $D(^DIC(4.2,"B",XMSYN)) D MES^XPDUTL("*** Synonym is also a domain!")
110 . S XMI=0
111 . F S XMI=$O(^DIC(4.2,"C",XMSYN,XMI)) Q:'XMI D
112 . . D MES^XPDUTL("*** Synonym is for domain IEN "_XMI_", name "_$P(^DIC(4.2,XMI,0),U,1))
113 . D MES^XPDUTL("*** No action taken. Please investigate and fix.")
114 I XMSIEN=XMDIEN D Q
115 . D MES^XPDUTL("Already there. Reversing domain/synonym:")
116 . D REVERSE(XMDIEN,XMDOM,XMSYN,.XMSTAT)
117 I XMSIEN D Q
118 . I $D(^DIC(4.2,"B",XMSYN)) D MES^XPDUTL("*** Synonym is also a domain!")
119 . E D MES^XPDUTL("*** Synonym is for domain IEN "_XMSIEN_", name "_$P(^DIC(4.2,XMSIEN,0),U,1))
120 . D MES^XPDUTL("*** No action taken. Please investigate and fix.")
121 D MES^XPDUTL("Not found. Adding it.")
122 S XMFDA(4.23,"+1,"_XMDIEN_",",.01)=XMSYN
123 D UPDATE^DIE("","XMFDA")
124 I $D(DIERR) D MES^XPDUTL("*** Error adding it!") Q
125 D MES^XPDUTL("Reversing domain/synonym:")
126 D REVERSE(XMDIEN,XMDOM,XMSYN,.XMSTAT)
127 Q
128REVERSE(XMDIEN,XMOLDNAM,XMNEWNAM,XMSTAT) ;
129 I '$D(^DIC(4.2,"C",XMOLDNAM,XMDIEN)) D Q:$D(DIERR)
130 . D MES^XPDUTL(XMOLDNAM_" is not yet a synonym of itself. Adding it.")
131 . S XMFDA(4.23,"+1,"_XMDIEN_",",.01)=XMOLDNAM
132 . D UPDATE^DIE("","XMFDA")
133 . I $D(DIERR) D MES^XPDUTL("*** Error adding it!")
134 E D MES^XPDUTL(XMOLDNAM_" is already a synonym of itself.")
135 D MES^XPDUTL("Change the domain name in the transmission scripts.")
136 N XMI,XMJ,XMTEXT
137 S XMI=0
138 F S XMI=$O(^DIC(4.2,XMDIEN,1,XMI)) Q:'XMI D
139 . S XMJ=0
140 . F S XMJ=$O(^DIC(4.2,XMDIEN,1,XMI,1,XMJ)) Q:'XMJ D
141 . . Q:^DIC(4.2,XMDIEN,1,XMI,1,XMJ,0)'[XMOLDNAM
142 . . S XMTEXT=^DIC(4.2,XMDIEN,1,XMI,1,XMJ,0)
143 . . S ^DIC(4.2,XMDIEN,1,XMI,1,XMJ,0)=$P(XMTEXT,XMOLDNAM,1)_XMNEWNAM_$P(XMTEXT,XMOLDNAM,2)
144 I $D(^XMB(3.7,.5,2,1000+XMDIEN,0)) D
145 . D MES^XPDUTL("Change the transmission queue name to "_XMNEWNAM_".")
146 . S XMFDA(3.701,1000+XMDIEN_",.5,",.01)=$E(XMNEWNAM,1,30)
147 . D FILE^DIE("","XMFDA")
148 . I $D(DIERR) D MES^XPDUTL("*** Error changing it!")
149 E D MES^XPDUTL("There is no transmission queue for this domain. That's OK.")
150 D MES^XPDUTL("Change the domain name to "_XMNEWNAM_".")
151 S XMFDA(4.2,XMDIEN_",",.01)=XMNEWNAM
152 D FILE^DIE("","XMFDA")
153 I $D(DIERR) D MES^XPDUTL("*** Error changing it!") Q
154 S XMSTAT="DONE"
155 Q
156CSUMM ;
157 N XMI,XMREC,XMOLD,XMNEW,XMCHK
158 S XMI=0
159 F S XMI=$O(^DOPT("XMSYN",$J,XMI)) Q:'XMI S XMREC=^(XMI,0) D
160 . S XMOLD=$P(XMREC,U,1)
161 . Q:$D(^TMP("XM",$J,XMOLD))
162 . S (XMNEW,XMCHK)=$P(XMREC,U,2) I XMNEW="" S XMNEW="xxx.MED.VA.GOV",XMCHK=$P(XMOLD,".",1,$L(XMOLD,".")-2)_".MED.VA.GOV"
163 . S ^TMP("XM",$J,XMOLD)=XMNEW_U_$S($D(^DIC(4.2,"B",XMCHK)):"OK",1:"???")
164 D BMES^XPDUTL("Summary for Domain Name Change")
165 D MES^XPDUTL("Status key:")
166 D MES^XPDUTL(" OK: Already changed, did not check further.")
167 D MES^XPDUTL(" DONE: Name changed during this install.")
168 D MES^XPDUTL(" ERROR: Error noted. See listing above and fix.")
169 D MES^XPDUTL(" ???: Not in your DOMAIN file. Consider adding it.")
170 D BMES^XPDUTL($$LJ^XLFSTR("Old Name",34)_" "_$$LJ^XLFSTR("New Name",37)_" Status")
171 D MES^XPDUTL($$LJ^XLFSTR("",34,"-")_" "_$$LJ^XLFSTR("",37,"-")_" ------")
172 S XMOLD=""
173 F S XMOLD=$O(^TMP("XM",$J,XMOLD)) Q:XMOLD="" S XMREC=^(XMOLD) D
174 . D MES^XPDUTL($$LJ^XLFSTR($E(XMOLD,1,34),35)_$$LJ^XLFSTR($E($P(XMREC,U,1),1,37),38)_$E($P(XMREC,U,2),1,6))
175 K ^DOPT("XMSYN",$J),^TMP("XM",$J)
176 Q
177REINDEX ;
178 D MES^XPDUTL("First, let's reindex the B and C xrefs.")
179 N DIK,DA,XMI
180 K ^DIC(4.2,"B"),^DIC(4.2,"C")
181 S DIK="^DIC(4.2,",DIK(1)=".01^B" D ENALL^DIK
182 S XMI=0
183 F S XMI=$O(^DIC(4.2,XMI)) Q:'XMI D
184 . N DIK,DA
185 . Q:'$O(^DIC(4.2,XMI,2,0))
186 . S DA(1)=XMI,DIK="^DIC(4.2,"_DA(1)_",2,",DIK(1)=".01^C" D ENALL^DIK
187 D MES^XPDUTL("Done reindexing. Let's get down to business...")
188 Q
189S ;;current site name^new site name (Add synonyms)
190 ;;ISC-SF.VA.GOV^FO-OAKLAND.MED.VA.GOV
191 ;;
192C ;;current site name^new site name (Change the names)
193 ;;ISC-SF.VA.GOV^FO-OAKLAND.MED.VA.GOV
194 ;;
Note: See TracBrowser for help on using the repository browser.