source: WorldVistAEHR/trunk/r/MAILMAN-XM/XMUDCHR.m@ 1800

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

initial load of WorldVistAEHR

File size: 3.4 KB
RevLine 
[613]1XMUDCHR ;ISC-SF/GMB-Christen Site ;04/17/2002 11:48
2 ;;8.0;MailMan;;Jun 28, 2002
3 ; Entry points used by MailMan options (not covered by DBIA):
4 ; CHRISTEN XMCHRIS - Edit MailMan Site Parameters
5CHRISTEN ;Set up/Change MailMan Site Parameters
6 N XMREC,XMABORT
7 S XMABORT=0
8 S XMREC=$G(^XMB(1,1,0)) I '+XMREC,$O(^XMB(1,0)) G E
9 I XMREC="" D
10 . D INIT
11 E D
12 . D CHANGE
13 Q:XMABORT
14 D PARENT
15 D SCRIPT
16 G Q
17INIT ; Initial Christening
18 N DIC,DIE,Y,DA,XMFDA
19 S DIC=4.2,DIC(0)="AEMQ"
20 D ^DIC I Y<1 S XMABORT=1 D E1 Q
21 S XMFDA(4.3,"+1,",.01)=+Y
22 D UPDATE^DIE("","XMFDA")
23 K DIC,Y
24 S DR="3//FORUM.VA.GOV;1//EST"
25 S DIE=4.3,DA=1
26 D ^DIE I $D(Y) S XMABORT=1 D E1
27 Q
28CHANGE ;
29 N XMSITE,DIE,DA,DR,DIC,X,Y
30 S XMSITE=$S($D(^XMB("NETNAME")):^XMB("NETNAME"),$D(^XMB("NAME")):^XMB("NAME"),$D(^DIC(4.2,+XMREC,0)):$P(^(0),U),1:XMREC)
31 I '$$SURE(XMSITE) S XMABORT=1 Q ; Are you sure?
32 S DIC=4.2,DIC(0)="AEMQ",DIC("B")=$S($D(^DIC(4.2,+XMREC,0)):$P(^(0),U),1:XMSITE)
33 D ^DIC I Y=-1 S XMABORT=1 Q
34 I XMSITE'=$P(Y,U,2) D
35 . I +Y=^XMB("NUM") D
36 . . ; The domain name in file 4.2 has been changed.
37 . . ; The pointer to file 4.2 has stayed the same.
38 . . ; The filer won't fire the xrefs, so we need to do it manually
39 . . S (^XMB("NETNAME"),^XMB("NAME"))=$P(Y,U,2)
40 . E D
41 . . N XMFDA
42 . . S XMFDA(4.3,"1,",.01)=+Y
43 . . D FILE^DIE("","XMFDA")
44 . W !!,"The domain name for this facility is now: ",^XMB("NETNAME")
45 E D
46 . W !!,"The domain name for this facility remains: ",^XMB("NETNAME")
47 K DIC,Y
48 S DR="3//FORUM.VA.GOV;1//EST"
49 S DIE=4.3,DA=1
50 D ^DIE
51 Q
52SURE(XMSITE) ; Function returns 1 if sure; 0 if not
53 N DIR,X,Y
54 W !!!," * * * * WARNING * * * *"
55 W !!,"You are about to change the domain name of this facility"
56 W !,"in the MailMan Site Parameters file."
57 W !!,"Currently, this facility is named: ",XMSITE
58 W !!,"You must be extremely sure before you proceed!",!
59 S DIR("A")="Are you sure you want to change the name of this facility"
60 S DIR("B")="NO"
61 S DIR(0)="Y"
62 D ^DIR Q:Y 1 ; Sure do!
63 Q 0 ; Nope, I'm not sure!
64PARENT ;
65 N XMPARENT
66 S XMPARENT=+$G(^XMB("PARENT"))
67 I XMPARENT S XMPARENT=$S($D(^DIC(4.2,XMPARENT,0)):$P(^(0),U),1:0)
68 I XMPARENT'=0 D
69 . W !!,XMPARENT," has been initialized as your 'parent' domain."
70 . W !,"(Forum is usually the parent domain, unless this is a subordinate domain.)"
71 . W !!,"You may edit the MailMan Site Parameter file to change your parent domain."
72 E D
73 . W !!,$C(7),"*** YOUR PARENT DOMAIN HAS NOT BEEN INITIALIZED !!! ***"
74 . W !!,"You MUST edit the MailMan Site Parameter file to ENTER your parent domain."
75 Q
76SCRIPT ;RESET AUSTIN SCRIPT
77 ;G SCRIPT^XMYPDOM
78 W !!,"We will not initialize your transmission scripts."
79 Q
80Q W !!,"Use the 'Subroutine editor' option under network management menu to add your"
81 W !,"site passwords to the MINIENGINE script, and the 'Edit a script' option"
82 W !,"to edit any domain scripts that you choose to."
83 ;D ^XMYPDOM
84 Q
85PMB S Y=Y+1000,^XMB(3.7,.5,2,+Y,1,0)=^TMP("XM",I,1,0),^XMB(3.7,.5,2,"B",$E($P(Y(0),U,1),1,30),+Y)="",^XMB(3.7,.5,2,+Y,0)=$P(Y(0),U)
86 F J=0:0 S J=$O(^TMP("XM",I,1,J)) Q:J'>0 S ^XMB(3.7,.5,2,+Y,1,J,0)=J W "."
87 Q
88E W $C(7),!!,"There is a FILE INTEGRITY problem in your MailMan Site Parameters file",!,"There should only be one entry and that entry should be entry number 1.",!
89E1 W $C(7),!,"Your MailMan site parameters MUST be reviewed."
90EQ W !!,"Then you can finish the INIT by executing POST^XMYPOST.",! Q
91E2 W $C(7),!,"You do not yet have an entry in your MailMan Site Parameters File",!,"Use FileMan to make an entry." G EQ
Note: See TracBrowser for help on using the repository browser.