source: FOIAVistA/trunk/r/MAILMAN-XM/XMVGRP.m@ 1113

Last change on this file since 1113 was 628, checked in by George Lilly, 16 years ago

initial load of FOIAVistA 6/30/08 version
File size: 7.0 KB
Line 
1XMVGRP ;ISC-SF/GMB-Group creation/enrollment ;03/07/2002 07:01
2 ;;8.0;MailMan;;Jun 28, 2002
3 ; Entry points used by MailMan options (not covered by DBIA):
4 ; ENLOCAL XMxxxxx - Add local users to mail groups
5ENLOCAL1(XMXQUSER) ; Add local user(s) to group(s) - called from Kernel
6 ; XMXQUSER - first user being added (duz or name)
7 I '$D(XMV) N XMV,XMDISPI,XMDUN,XMNOSEND,XMPRIV
8 D INITAPI^XMVVITAE
9ENLOCAL ; Add local user(s) to mail group(s).
10 N XMGRP,XMMBR,XMINSTR,XMTSK,XMTO,XMABORT
11 S XMABORT=0
12 D ENGRP(.XMGRP,.XMABORT) Q:XMABORT!'$D(XMGRP) ; select groups
13 D ENUSER(.XMMBR,.XMABORT,.XMXQUSER) Q:XMABORT ; select users
14 D ENCONF(.XMGRP,.XMMBR,.XMABORT) Q:XMABORT ; confirm it
15 D ADD2GRPZ^XMXGRP(.XMGRP,.XMMBR,.XMTO) ; add users to groups
16 W !!,$$EZBLD^DIALOG(38233) ; Users have been added to the mail groups
17 D ENFWD(XMDUZ,.XMINSTR,.XMABORT) Q:XMABORT ; forward msgs?
18 D FAFMSGS^XMXGRP1(XMDUZ,.XMGRP,.XMTO,.XMINSTR,.XMTSK) ; yup.
19 D FWDTSK^XMVGROUP(XMTSK) ; tell the user the task number.
20 Q
21ENGRP(XMGRP,XMABORT) ;
22 N Y
23 F D Q:Y=-1!XMABORT
24 . N DIC,DIR,X,XMDEL
25 . S DIR("A")=$$EZBLD^DIALOG($S($D(XMGRP):38211,1:38210)) ; Another mail group / Allocate mail group
26 . S DIR("PRE")="I $E(X)=""-"" S XMDEL=1,X=$E(X,2,99)"
27 . D BLD^DIALOG(38213,"","","DIR(""?"")")
28 . ;Enter the name of the mail group you wish to allocate.
29 . ;Precede any mail group name with '-' to remove it.
30 . ;You'll only be able to select mail groups you're authorized to edit.
31 . ;Enter ?? for a list of mail groups you've already selected,
32 . ;and for mail group help.
33 . S DIR("??")="^D HELPGRP^XMVGRP"
34 . S DIR(0)="PO^3.8:FEMQ"
35 . S DIC("S")=$$GRPSCR^XMVGROUP(1)
36 . D ^DIR I $D(DTOUT)!$D(DUOUT) S XMABORT=1 Q
37 . Q:Y=-1
38 . I '$G(XMDEL) S XMGRP($P(Y,U,2))=+Y Q
39 . I '$D(XMGRP($P(Y,U,2))) W $C(7),$$EZBLD^DIALOG(38214) Q ; ?? Not on current list.
40 . K XMGRP($P(Y,U,2))
41 . W $$EZBLD^DIALOG(38215) ; Deleted from current list.
42 Q
43HELPGRP ;
44 I '$D(XMGRP) W !,$$EZBLD^DIALOG(38216) ; You haven't selected any mail groups yet.
45 E D SHOWGRP
46 N DIR,X,Y,DIRUT,DTOUT,DIRUT
47 S DIR("A")=$$EZBLD^DIALOG(38217) ; Want mail group help
48 S DIR(0)="Y"
49 S DIR("B")=$$EZBLD^DIALOG(39053) ; NO
50 D ^DIR Q:'Y
51 ;D HELP^XMHIG
52 N DIC,X,Y,DLAYGO
53 S DIC(0)="AEQM",DIC="^XMB(3.8,"
54 S DIC("S")=$$GRPSCR^XMVGROUP(1)
55 F W ! D ^DIC Q:Y<0 D
56 . D DISPLAY^XMHIG(+Y)
57 Q
58SHOWGRP ;
59 N XMI,XMJ,XML,XMLN
60 W !!,$$EZBLD^DIALOG(38218) ; You've selected the following mail groups:
61 S XML=0,XMI="" F S XMI=$O(XMGRP(XMI)) Q:XMI="" I $L(XMI)>XML S XML=$L(XMI)
62 S XML=XML+3,XMLN=80\XML
63 S XMI=""
64 F XMJ=0:1 S XMI=$O(XMGRP(XMI)) Q:XMI="" D
65 . W:'(XMJ#XMLN) ! W ?(XMJ#XMLN*XML),XMI
66 Q
67ENUSER(XMMBR,XMABORT,XMUSER) ;
68 N XMX,XMDONE
69 W !
70 S XMDONE=0
71 F D Q:XMDONE!XMABORT
72 . N XMDEL
73 . W !,$$EZBLD^DIALOG($S($D(XMMBR):38221,1:38220)) ; Another user: / Add user:
74 . I $G(XMUSER)'="" D
75 . . S XMX=XMUSER
76 . . K XMUSER
77 . . W XMX
78 . E D Q:XMX=""
79 . . R XMX:DTIME S:'$T XMX=U I XMX[U S XMABORT=1 Q
80 . . I XMX="" D Q
81 . . . I $D(XMMBR) S XMDONE=1 Q
82 . . . W $C(7)," ??",!,$$EZBLD^DIALOG(38222) ; You must select a user, or enter ^ to exit.
83 . . I XMX?1."?" D HELPUSR(XMX) S:XMX'="?" XMX="" Q
84 . . I $E(XMX)="-" S XMDEL=1,XMX=$E(XMX,2,99) W:XMX="" " ??",$C(7)
85 . N DIC,D,X,Y,DLAYGO,XMNAME
86 . S X=$$UP^XLFSTR(XMX)
87 . S DIC("S")="I $L($P(^(0),U,3)),$D(^XMB(3.7,+Y,2))" ; User must have an access code & mailbox
88 . S DIC("W")="I Y'=DUZ D USERINFO^XMXADDR1(Y)"
89 . S DIC="^VA(200,"
90 . S DIC(0)="FEMN" ; 'N' means if user enters a DUZ, ask "OK?"
91 . S D="B^BB^C^D" ; name^alias^initial^nickname
92 . D MIX^DIC1 I $D(DTOUT)!$D(DUOUT) S XMABORT=1 Q
93 . I Y<0 W " ??",$C(7) Q
94 . S XMNAME=$$NAME^XMXUTIL(+Y) ; $P(Y,U,2)
95 . I '$G(XMDEL) S XMMBR(XMNAME)=+Y Q
96 . I '$D(XMMBR(XMNAME)) W !,$C(7),$$EZBLD^DIALOG(38214) Q ; ?? Not on current list.
97 . K XMMBR(XMNAME)
98 . W !,$$EZBLD^DIALOG(38215) ; Deleted from current list.
99 Q
100HELPUSR(XMX) ;
101 I XMX="?" D Q
102 . N XMTEXT
103 . D BLD^DIALOG(38223,"","","XMTEXT","F")
104 . D MSG^DIALOG("WH","","","","XMTEXT")
105 . ;Enter the name of the user you wish to add to the group(s).
106 . ;Precede any user name with '-' to remove it.
107 . ;You'll only be able to select users with mailboxes and access codes.
108 . ;Enter ?? for a list of users you've already selected,
109 . ;and for user help.
110 I '$D(XMMBR) W !,$$EZBLD^DIALOG(38226) ;You haven't selected any users yet.
111 E D SHOWUSR
112 N DIR,X,Y,DIRUT,DTOUT,DIRUT
113 S DIR("A")=$$EZBLD^DIALOG(38224) ; Want user help
114 S DIR(0)="Y"
115 S DIR("B")=$$EZBLD^DIALOG(39053) ; NO
116 D ^DIR Q:'Y
117 D HELP^XMHIU
118 Q
119SHOWUSR ;
120 N XMI,XMJ,XML,XMLN
121 W !!,$$EZBLD^DIALOG(38225) ; You've selected the following users:
122 S XML=0,XMI="" F S XMI=$O(XMMBR(XMI)) Q:XMI="" I $L(XMI)>XML S XML=$L(XMI)
123 S XML=XML+3,XMLN=80\XML
124 S XMI=""
125 F XMJ=0:1 S XMI=$O(XMMBR(XMI)) Q:XMI="" D
126 . W:'(XMJ#XMLN) ! W ?(XMJ#XMLN*XML),XMI
127 Q
128ENCONF(XMGRP,XMMBR,XMABORT) ;
129 D SHOWGRP
130 D SHOWUSR
131 W !
132 N DIR,X,Y
133 D BLD^DIALOG(38230,"","","DIR(""A"")") ; You are adding users to mail groups. Do you wish to proceed
134 S DIR(0)="Y"
135 S DIR("B")=$$EZBLD^DIALOG(39054) ; yes
136 D ^DIR I 'Y S XMABORT=1
137 Q
138ENFWD(XMDUZ,XMINSTR,XMABORT) ;
139 W !
140 N DIR,X,Y
141 D BLD^DIALOG(38231,"","","DIR(""A"")")
142 ;Do you wish to forward past mail group messages
143 ;to the user(s) you just added to the mail group(s)
144 D BLD^DIALOG(38232,"","","DIR(""?"")")
145 ;Answer YES to forward past mail group messages.
146 ;You will be asked for a time frame to search,
147 ;and then MailMan will create a task to find and forward
148 ;existing mail group messages.
149 S DIR(0)="Y"
150 S DIR("B")=$$EZBLD^DIALOG(39053) ; no
151 D ^DIR I $D(DIRUT)!'Y S XMABORT=1 Q
152 D FWDDATES(XMDUZ,.XMINSTR,.XMABORT) Q:XMABORT
153 S XMINSTR("FLAGS")="F"
154 Q
155FWDDATES(XMDUZ,XMINSTR,XMABORT) ;
156 ; Message sent on or before date
157 N DIR,Y,X,XMOLDEST,XMTEXT
158 ;S XMOLDEST=$O(^XMB(3.9,"C",""))
159 F S XMOLDEST=$O(^XMB(3.9,"C","")) Q:XMOLDEST?1N.N K ^XMB(3.9,"C",XMOLDEST) ; kill bogus nodes
160 ; You will now choose a date range for the messages to be searched
161 ; and forwarded. The oldest message is from XMOLDEST.
162 W !
163 D BLD^DIALOG(38023.5,$$FMTE^XLFDT(XMOLDEST,5),"","XMTEXT","F")
164 D MSG^DIALOG("WM","",IOM,"","XMTEXT")
165 I $P(^XMB(3.7,XMDUZ,0),U,7) D
166 . N XMCUT
167 . S XMCUT=$P(^XMB(3.7,XMDUZ,0),U,7)
168 . Q:XMCUT<XMOLDEST
169 . ; You may not access any message prior to |1| unless someone
170 . ; forwards it to you.
171 . D BLD^DIALOG(37100,$$FMTE^XLFDT(XMCUT,5),"","XMTEXT","F")
172 . D MSG^DIALOG("WE","",IOM,"","XMTEXT")
173 . S XMOLDEST=XMCUT
174 W !
175 S DIR(0)="DO^"_XMOLDEST_":DT:EX"
176 S DIR("A")=$$EZBLD^DIALOG(34444) ; Message sent on or after
177 D BLD^DIALOG(34444.1,"","","DIR(""?"")")
178 ; Enter a date. It must include day, month, and year.
179 S DIR("B")=$$FMTE^XLFDT($$MAX^XLFMTH(XMOLDEST,$$FMADD^XLFDT(DT,-365)),5)
180 D ^DIR I $D(DIRUT) S XMABORT=1 Q
181 S XMINSTR("FDATE")=Y
182 ; Message sent on or before date
183 I XMINSTR("FDATE")=DT S XMINSTR("TDATE")=DT Q
184 K DIR,Y,X
185 S DIR(0)="DO^"_XMINSTR("FDATE")_":DT:EX"
186 S DIR("A")=$$EZBLD^DIALOG(34445) ; Message sent on or before
187 D BLD^DIALOG(34444.1,"","","DIR(""?"")")
188 ; Enter a date. It must include day, month, and year.
189 S DIR("B")=$$FMTE^XLFDT(DT,5)
190 D ^DIR I $D(DIRUT) S XMABORT=1 Q
191 S XMINSTR("TDATE")=Y
192 Q
Note: See TracBrowser for help on using the repository browser.