source: cprs/branches/tmg-cprs/m_files/TMGCHR.m@ 838

Last change on this file since 838 was 796, checked in by Kevin Toppenberg, 14 years ago

Initial upload
File size: 8.8 KB
Line 
1TMGCHR ;TMG/kst/Custom version of CHRISTEN ;03/25/06
2 ;;1.0;TMG-LIB;**1**;11/01/04
3
4 ;"CHRISTEN(INFO) This library will provide optional NON-INTERACTIVE versions of standard code.
5
6 ;"=============================================================================
7 ;"Kevin Toppenberg, MD 11-04
8 ;"
9 ;"Purpose:
10 ;"
11 ;"This library will provide optional NON-INTERACTIVE versions of standard code.
12 ;"
13 ;"CHRISTEN(INFO)
14 ;"
15 ;"Dependancies:
16 ;" TMGQIO
17 ;"=============================================================================
18
19MUDCHR ;ISC-SF/GMB-Christen Site ;04/17/2002 11:48
20 ;;8.0;MailMan;;Jun 28, 2002
21 ; Entry points used by MailMan options (not covered by DBIA):
22 ; CHRISTEN XMCHRIS - Edit MailMan Site Parameters
23 ;"
24 ;"K. Toppenberg's changes made November, 2004
25 ;"
26 ;"Input:
27 ;" Note: INFO variable is completely an OPTIONAL parameter.
28 ;" If not supplied, interactive mode used
29 ;" INFO("SILENT-OUTPUT") -- 1 = output is supressed.
30 ;" INFO("SILENT-INPUT") -- 1 = User-interactive input is supressed.
31 ;"
32 ;" ** if in SILENT-INPUT mode, THEN the following data should be supplied:
33 ;" ----------------------
34 ;" INFO("DOMAIN") -- Answer for 'DOMAIN' to edit-- should be an existing domain
35 ;" INFO("PARENT") -- Answer for 'PARENT' domain question
36 ;" INFO("TIMEZONE") -- Answer for 'TIME ZONE' question
37 ;" INFO("CONTINUE") -- Answer for "Are you sure you want to change the name of this facility"
38 ;"Output:
39 ;" If in SILENT-OUTPUT mode, then output that would normally go to the screen, will be routed to this array
40 ;" NOTE: INFO SHOULD BE PASSED BY REFERENCE if user wants this information passed back out.
41 ;" INFO("TEXT","LINES")=Number of output lines
42 ;" INFO("TEXT",1)= 1st output line
43 ;" INFO("TEXT",2)= 2nd output line, etc...
44 ;
45 ;
46CHRISTEN(INFO) ;Set up/Change MailMan Site Parameters
47 ;
48 NEW SILNTOUT SET SILNTOUT=$get(INFO("SILENT-OUTPUT"),0) ;//kt
49 NEW SILENTIN SET SILENTIN=$GET(INFO("SILENT-INPUT"),0) ;//KT
50 KILL INFO("TEXT") ;//kt
51
52 N XMREC,XMABORT
53 S XMABORT=0
54 S XMREC=$G(^XMB(1,1,0)) I '+XMREC,$O(^XMB(1,0)) G E
55 I XMREC="" D
56 . D INIT
57 E D
58 . D CHANGE
59 Q:XMABORT
60 D PARENT
61 D SCRIPT
62 G Q
63 ;
64 ;
65 ;======================================================================
66INIT ; Initial Christening
67 N DIC,DIE,Y,DA,XMFDA
68 ;
69 S DIC=4.2
70 IF SILENTIN=1 DO
71 . S DIC(0)="EM"
72 . SET X=$GET(INFO("DOMAIN"))
73 ELSE DO
74 . S DIC(0)="AEMQ"
75 D ^DIC
76 I Y<1 S XMABORT=1 D E1 Q
77 S XMFDA(4.3,"+1,",.01)=+Y
78 D UPDATE^DIE("","XMFDA")
79 K DIC,Y
80 do InputParent
81 ;"if SILENTIN>0 do ;"Note: Fields 3=PARENT, 1=TIME ZONE
82 ;". set DR="3///"_$get(INFO("PARENT"),"FORUM.VA.GOV") ;"3 '/'s means force the data in
83 ;". set DR=DR_";1///"_$get(INFO("PARENT"),"EST")
84 ;"else do
85 ;". S DR="3//FORUM.VA.GOV;1//EST" ;"2 '/'s means ask user, with default suggestion.
86 ;"S DIE=4.3 ;"MAILMAN SITE PARAMETERS
87 ;"S DA=1 ;"Record#/IEN = 1
88 ;"D ^DIE ;"Input selected data elements to a given record. (only for existing records)
89 I $D(Y) S XMABORT=1 D E1
90 Q
91 ;
92 ;
93 ;=======================================================================
94CHANGE ;
95 N XMSITE,DIE,DA,DR,DIC,X,Yi
96 IF $D(^XMB("NETNAME")) SET XMSITE=^XMB("NETNAME")
97 ELSE IF $D(^XMB("NAME")) SET XMSITE=^XMB("NAME")
98 ELSE IF $D(^DIC(4.2,+XMREC,0)) SET XMSITE=$P(^(0),U)
99 ELSE SET XMSITE=XMREC
100 I $$SURE(XMSITE)=0 S XMABORT=1 Q ; Are you sure?
101 S DIC=4.2
102 IF SILENTIN=0 DO
103 . S DIC(0)="AEMQ"
104 . S DIC("B")=$S($D(^DIC(4.2,+XMREC,0)):$P(^(0),U),1:XMSITE)
105 ELSE DO
106 . SET DIC(0)="EM"
107 . SET DIC("B")=""
108 . SET X=$GET(INFO("DOMAIN"))
109 D ^DIC
110 I Y=-1 S XMABORT=1 Q
111 I XMSITE'=$P(Y,U,2) D
112 . I +Y=^XMB("NUM") D
113 . . ; The domain name in file 4.2 has been changed.
114 . . ; The pointer to file 4.2 has stayed the same.
115 . . ; The filer won't fire the xrefs, so we need to do it manually
116 . . S (^XMB("NETNAME"),^XMB("NAME"))=$P(Y,U,2)
117 . E D
118 . . N XMFDA
119 . . S XMFDA(4.3,"1,",.01)=+Y
120 . . D FILE^DIE("","XMFDA")
121 . DO OUTP^TMGQIO(SILNTOUT,"!","!","The domain name for this facility is now: ",^XMB("NETNAME"))
122 E D
123 . DO OUTP^TMGQIO(SILNTOUT,"!","!","The domain name for this facility remains: ",^XMB("NETNAME"))
124 K DIC,Y
125 do InputParent
126 ;"S DR="3//FORUM.VA.GOV;1//EST"
127 ;"S DIE=4.3,DA=1
128 ;"D ^DIE
129 Q
130 ;
131 ;
132 ;=======================================================================
133InputParent
134 if SILENTIN>0 do ;"Note: Fields 3=PARENT, 1=TIME ZONE
135 . set DR="3///"_$get(INFO("PARENT"),"FORUM.VA.GOV") ;"3 '/'s means force the data in
136 . set DR=DR_";1///"_$get(INFO("PARENT"),"EST")
137 else do
138 . S DR="3//FORUM.VA.GOV;1//EST" ;"2 '/'s means ask user, with default suggestion.
139 S DIE=4.3 ;"MAILMAN SITE PARAMETERS
140 S DA=1 ;"Record#/IEN = 1
141 D ^DIE ;"Input selected data elements to a given record. (only for existing records)
142 quit
143 ;
144 ;
145 ;=======================================================================
146SURE(XMSITE) ; Function returns 1 if sure; 0 if not
147 N DIR,X,Y
148 N RESULT SET RESULT=0 ; Default to not sure
149 ;
150 DO OUTP^TMGQIO(SILNTOUT,"!","!"," * * * * WARNING * * * *","!","!")
151 DO OUTP^TMGQIO(SILNTOUT,"You are about to change the domain name of this facility","!")
152 DO OUTP^TMGQIO(SILNTOUT,"in the MailMan Site Parameters file.","!")
153 DO OUTP^TMGQIO(SILNTOUT,"Currently, this facility is named: ",XMSITE,"!","!")
154 DO OUTP^TMGQIO(SILNTOUT,"You must be extremely sure before you proceed!","!")
155 DO OUTP^TMGQIO(SILENTIN,"Are you sure you want to change the name of this facility? NO//")
156 DO INP^TMGQIO(.X,SILENTIN,120,$GET(INFO("CONTINUE")))
157 IF X="" SET X="NO"
158 IF "Yy"[$E(X_"N") SET RESULT=1 ;Yes, I'm sure!
159 Q RESULT
160 ;
161 ;
162PARENT ;
163 N XMPARENT
164 S XMPARENT=+$G(^XMB("PARENT"))
165 I XMPARENT S XMPARENT=$S($D(^DIC(4.2,XMPARENT,0)):$P(^(0),U),1:0)
166 I XMPARENT'=0 D
167 . DO OUTP^TMGQIO(SILNTOUT,"!","!",XMPARENT," has been initialized as your 'parent' domain.")
168 . DO OUTP^TMGQIO(SILNTOUT,"!","(Forum is usually the parent domain, unless this is a subordinate domain.)")
169 . DO OUTP^TMGQIO(SILNTOUT,"!","!","You may edit the MailMan Site Parameter file to change your parent domain.")
170 E D
171 . DO OUTP^TMGQIO(SILNTOUT,"!","!",$C(7),"*** YOUR PARENT DOMAIN HAS NOT BEEN INITIALIZED !!! ***")
172 . DO OUTP^TMGQIO(SILNTOUT,"!","!","You MUST edit the MailMan Site Parameter file to ENTER your parent domain.")
173 Q
174 ;
175 ;
176SCRIPT ;RESET AUSTIN SCRIPT
177 ;G SCRIPT^XMYPDOM
178 DO OUTP^TMGQIO(SILNTOUT,"!","!","We will not initialize your transmission scripts.")
179 Q
180 ;
181 ;
182 ;=======================================================================
183Q DO OUTP^TMGQIO(SILNTOUT,"!","!","Use the 'Subroutine editor' option under network management menu to add your")
184 DO OUTP^TMGQIO(SILNTOUT,"!","site passwords to the MINIENGINE script, and the 'Edit a script' option")
185 DO OUTP^TMGQIO(SILNTOUT,"!","to edit any domain scripts that you choose to.")
186 ;D ^XMYPDOM
187 Q
188 ;
189 ;
190 ;======================================================================
191PMB S Y=Y+1000
192 S ^XMB(3.7,.5,2,+Y,1,0)=^TMP("XM",I,1,0)
193 S ^XMB(3.7,.5,2,"B",$E($P(Y(0),U,1),1,30),+Y)=""
194 S ^XMB(3.7,.5,2,+Y,0)=$P(Y(0),U)
195 F J=0:0 DO Q:J'>0
196 . S J=$O(^TMP("XM",I,1,J))
197 . Q:J'>0
198 . S ^XMB(3.7,.5,2,+Y,1,J,0)=J
199 . W "."
200 Q
201 ;
202 ;
203E DO OUTP^TMGQIO(SILNTOUT,$C(7),"!","!")
204 DO OUTP^TMGQIO(SILNTOUT,"There is a FILE INTEGRITY problem in your MailMan Site Parameters file","!")
205 DO OUTP^TMGQIO(SILNTOUT,"There should only be one entry and that entry should be entry number 1.","!")
206E1 DO OUTP^TMGQIO(SILNTOUT,$C(7),"!")
207 DO OUTP^TMGQIO(SILNTOUT,"Your MailMan site parameters MUST be reviewed.","!")
208EQ DO OUTP^TMGQIO(SILNTOUT,"Then you can finish the INIT by executing POST^XMYPOST.","!","!")
209 Q
210E2 DO OUTP^TMGQIO(SILNTOUT,$C(7),"!","You do not yet have an entry in your MailMan Site Parameters File","!")
211 DO OUTP^TMGQIO(SILNTOUT,"Use FileMan to make an entry.","!")
212 G EQ
213
214
Note: See TracBrowser for help on using the repository browser.