source: WorldVistAEHR/trunk/r/MAILMAN-XM/XMXGRP.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: 9.2 KB
Line 
1XMXGRP ;ISC-SF/GMB-Group creation/enrollment ;03/31/2003 13:38
2 ;;8.0;MailMan;**16**;Jun 28, 2002
3 ; Entry points used by MailMan options (not covered by DBIA):
4 ; ADDMBRS - Add new members / Edit existing members
5 ; DELMBRS - Delete existing members
6 ; DROP - A user chooses to drop
7 ; JOIN - A user chooses to join
8 ;
9 ; DBIAs:
10 ; 1544 - Use $$ISA^USRLM (Authorization/Subscription)
11ADDMBRS(XMDUZ,XMGROUP,XMMBR,XMINSTR,XMTSK) ; Add users to groups, if they aren't
12 ; already members. This API handles adding local users, devices,
13 ; server options, mail groups, and remote users to mail groups.
14 ; It does not handle adding distribution lists or fax recipients
15 ; or fax groups.
16 ;
17 ; Optionally, forward existing messages which are addressed to the
18 ; groups to the users, and/or add the users to the messages, so that
19 ; they will receive responses. (LOCAL USERS ONLY!)
20 ; XMDUZ - The user who is doing this. Must be authorized to edit
21 ; the mail groups.
22 ; XMGROUP - The name or IEN (or list of same) of the groups.
23 ; XMMBR - The user (or list of users) to add to the groups.
24 ; XMINSTR - Special instructions
25 ; ("FLAGS") - Flags, may contain any combination of the following:
26 ; "A" - Add users to messages, but don't forward.
27 ; (Messages will be delivered the next time
28 ; someone replies, and users will be able to
29 ; Query/Search for them at any time.)
30 ; "F" - Forward messages to users, if the users aren't
31 ; already on the messages.
32 ; Closed messages will be ignored. Users will not be
33 ; added to them.
34 ; Note: If FLAGS contains only an "A", then FDATE and TDATE apply.
35 ; If FLAGS contains only an "F", then FDATE and TDATE apply.
36 ; If FLAGS contains "A" and "F", then messages from FDATE thru
37 ; TDATE will be "F"orwarded, and all other messages will have
38 ; the users "A"dded to them, without forwarding.
39 ; Note: Currently, FLAGS may not contain "A". We don't yet have a way
40 ; to mark users (recipients) who have been added to a message, but will
41 ; not receive them until someone replies on the message, or until the
42 ; user searches for them and reads them. This is a problem, because
43 ; if someone does a QD on them, they have no idea why these recipients
44 ; haven't read the message. Perhaps we could mark them 'Parked until
45 ; next reply.' That would require a new field, and other routines would
46 ; have to be aware of and handle this new field. Until that happens,
47 ; we are stripping any "A" from XMINSTR("FLAGS").
48 ; ("FDATE") - Add users to messages originating on or after this
49 ; date. Must be FM format. Default is from the
50 ; beginning of time. Used in conjunction with FLAGS.
51 ; ("TDATE") - Add users to messages originating on or before this
52 ; date. Must be FM format. Default is to the present.
53 ; Used in conjunction with FLAGS.
54 ; XMTSK Output task number
55 N XMGRP,XMTO,XMCUT
56 D CHKGRPS(XMDUZ,.XMGROUP,.XMGRP) Q:'$D(XMGRP)
57 D CHKMBRS(XMDUZ,.XMMBR) Q:'$D(^TMP("XMY0",$J))
58 D ADD2GRPS(.XMGRP,.XMTO,.XMINSTR)
59 Q:'$D(XMTO) ; Quit if no local users added to groups.
60 Q:'$D(XMINSTR("FLAGS"))
61 I $G(XMINSTR("FDATE"),$O(^XMB(3.9,"C",2500000)))>$G(XMINSTR("TDATE"),DT) Q ; Quit if 'from' date is greater than 'to' date.
62 S XMCUT=$P(^XMB(3.7,XMDUZ,0),U,7)
63 I XMCUT>$G(XMINSTR("FDATE")) D
64 . S XMINSTR("FDATE")=XMCUT
65 . D ERRSET^XMXUTIL(37100,$$FMTE^XLFDT(XMCUT,5))
66 . ; You may not access any message prior to |1| unless someone forwards
67 . ; it to you.
68 D FAFMSGS^XMXGRP1(XMDUZ,.XMGRP,.XMTO,.XMINSTR,.XMTSK)
69 Q
70CHKGRPS(XMDUZ,XMGROUP,XMGRP) ;
71 I $G(XMGROUP)]"",$O(XMGROUP(""))="" D Q
72 . D CHKGRP(XMDUZ,XMGROUP,.XMGRP)
73 N XMI
74 S XMI=""
75 F S XMI=$O(XMGROUP(XMI)) Q:XMI="" D
76 . D CHKGRP(XMDUZ,XMI,.XMGRP)
77 Q
78CHKGRP(XMDUZ,XMGROUP,XMGRP) ;
79 N XMGNAME,XMGIEN,XMABORT
80 S XMABORT=0
81 D GRPOK(XMGROUP,.XMGNAME,.XMGIEN,.XMABORT) Q:XMABORT
82 D AUTHOK(XMDUZ,.XMGIEN,.XMABORT) Q:XMABORT
83 S XMGRP(XMGNAME)=XMGIEN
84 Q
85GRPOK(XMGROUP,XMGNAME,XMGIEN,XMABORT) ;
86 ; make sure group name is good, translate to group ien.
87 S XMGIEN=$$IEN^XMXAPIG(XMGROUP) I 'XMGIEN S XMABORT=1 Q
88 S XMGNAME=$$NAME^XMXAPIG(XMGIEN)
89 Q
90AUTHOK(XMDUZ,XMGIEN,XMABORT) ;
91 ; make sure user is authorized to add members to group.
92 N XMOK
93 S XMOK=0
94 I $T(ISA^USRLM)'="" S XMOK=$$ISA^USRLM(DUZ,"CLINICAL COORDINATOR") ; CAC?
95 I $D(^XUSEC("XMMGR",DUZ))!$D(^XUSEC("XM GROUP EDIT MASTER",DUZ))!XMOK I $S($P(^XMB(3.8,XMGIEN,0),U,2)="PU":1,'$P(^(0),U,6):1,1:0) Q ; If holds proper key, then group must be public or (private and) unrestricted.
96 I $D(^XMB(3.8,"AC",XMDUZ,XMGIEN)) Q ; User is coordinator
97 I $P($G(^XMB(3.8,XMGIEN,3)),U,1)=XMDUZ Q ; User is organizer
98 S XMABORT=1
99 N XMP
100 S XMP("PARAM","ID")="XMGROUP"
101 S XMP("PARAM","VALUE")=$$NAME^XMXAPIG(XMGIEN)
102 ; You are not authorized to edit this mail group
103 D ERRSET^XMXUTIL(38200,.XMP)
104 Q
105CHKMBRS(XMDUZ,XMMBR) ; Check the users to add.
106 N XMINSTR
107 D INIT^XMXADDR
108 S XMINSTR("ADDR FLAGS")="XY" ; Create only the ^TMP("XMY0") global.
109 D CHKADDR^XMXADDR(XMDUZ,.XMMBR,.XMINSTR)
110 Q:$D(^TMP("XMY0",$J))
111 D CLEANUP^XMXADDR
112 Q
113ADD2GRPS(XMGRP,XMTO,XMINSTR) ; See if members already in the groups.
114 ; If not, add them
115 ; >> Question: May a broadcast or limited broadcast be added to a group?
116 N XMGN,XMGI,XMM,XMTRKNEW
117 S (XMGN,XMM)=""
118 F S XMGN=$O(XMGRP(XMGN)) Q:XMGN="" S XMGI=XMGRP(XMGN) D
119 . N XMNEWMBR
120 . F S XMM=$O(^TMP("XMY0",$J,XMM)) Q:XMM="" D
121 . . D AM(XMGI,XMM,^TMP("XMY0",$J,XMM),$G(^(XMM,1),"@"),.XMTO,.XMINSTR)
122 ; If we added a member group, shouldn't we also forward the msgs to
123 ; local members of the group, too?
124 D CLEANUP^XMXADDR
125 Q
126AM(XMG,XMM,XMMIEN,XMTYPE,XMTO,XMINSTR) ; Add/edit a member (not delete)
127 N XMFDA,XMIEN,XMMULT,XMABORT
128 S XMABORT=0
129 D AMINIT(XMG,.XMM,XMMIEN,.XMMULT,.XMABORT) Q:$G(XMABORT)
130 S XMFDA(XMMULT,"?+1,"_XMG_",",.01)=XMM
131 S XMFDA(XMMULT,"?+1,"_XMG_",",1)=XMTYPE
132 I "AF"[$G(XMINSTR("FLAGS"),U),XMMULT=3.81 S XMTO($S(XMTYPE?1U:XMTYPE_":",1:"")_XMM)=""
133 D UPDATE^DIE("","XMFDA","XMIEN")
134 ;I XMIEN(1,0)="+" S XMCNT=$G(XMCNT)+1
135 ; Need to create array showing which were added and which were edited.
136 ; Counts for each.
137 Q
138AMINIT(XMG,XMM,XMMIEN,XMMULT,XMABORT) ;
139 I XMM["@" S XMMULT=3.812 Q ; Remote member
140 I ".D.H.S."[("."_$E(XMM,1,2)) D Q
141 . S XMMULT=3.812 ; Remote member
142 . S XMM=XMM_"@"_^XMB("NETNAME")
143 I $E(XMM,1,2)="G." D Q
144 . I XMMIEN=XMG D Q
145 . . S XMABORT=1
146 . . ; Group cannot be a member of itself.
147 . S XMM=XMMIEN
148 . S XMMULT=3.811 ; Group member
149 S XMM=XMMIEN
150 S XMMULT=3.81 ; Local member
151 Q
152JOIN(XMDUZ,XMGROUP,XMINSTR,XMTSK) ; User chooses to join a group.
153 ; XMGROUP - The name (or IEN) of the group. (Just one group!)
154 ; XMINSTR - Special instructions. See ADDMBR, above
155 ; Also, if XMINSTR("FLAGS")["F", may specify:
156 ; ("SELF BSKT") - direct forwarded messages to a specific basket.
157 N XMABORT,XMGNAME,XMGIEN,XMTYPE,XMSELF,XMMBR
158 S XMABORT=0
159 D GRPOK(XMGROUP,.XMGNAME,.XMGIEN,.XMABORT) Q:XMABORT
160 D GRPINFO(XMDUZ,XMGIEN,.XMTYPE,.XMSELF,.XMMBR,.XMABORT) Q:XMABORT
161 I 'XMMBR D Q:XMABORT
162 . I 'XMSELF D Q
163 . . S XMABORT=1
164 . . N XMP
165 . . S XMP("PARAM","ID")="XMGROUP"
166 . . S XMP("PARAM","VALUE")=XMGNAME
167 . . D ERRSET^XMXUTIL(38022,.XMP) ; Self enrollment not allowed.
168 . N XMFDA ; Add user to group.
169 . S XMFDA(3.81,"?+1,"_XMGIEN_",",.01)=XMDUZ
170 . D UPDATE^DIE("","XMFDA")
171 Q:'$D(XMINSTR("FLAGS"))
172 D FAFMSGS^XMXGRP1(XMDUZ,XMGNAME,XMDUZ,.XMINSTR,.XMTSK)
173 Q
174DROP(XMDUZ,XMGROUP) ; User chooses to drop from a group.
175 ; XMGROUP - The name (or IEN) of the group.
176 N XMABORT,XMGNAME,XMGIEN,XMTYPE,XMSELF,XMMBR
177 S XMABORT=0
178 D GRPOK(XMGROUP,.XMGNAME,.XMGIEN,.XMABORT) Q:XMABORT
179 D GRPINFO(XMDUZ,XMGIEN,.XMTYPE,.XMSELF,.XMMBR,.XMABORT) Q:XMABORT
180 I XMMBR D
181 . I 'XMSELF,'$P($G(^XMB(1,1,2)),U,2) D Q
182 . . S XMABORT=1
183 . . N XMP
184 . . S XMP("PARAM","ID")="XMGROUP"
185 . . S XMP("PARAM","VALUE")=XMGNAME
186 . . D ERRSET^XMXUTIL(38022.1,.XMP) ; Self dis-enrollment not allowed.
187 . N DIR,X,Y,DA,DIK ; Drop user from group.
188 . S DA(1)=XMGIEN,DA=XMMBR,DIK="^XMB(3.8,"_XMGIEN_",1,"
189 . D ^DIK
190 Q
191GRPINFO(XMDUZ,XMGIEN,XMTYPE,XMSELF,XMMBR,XMABORT) ;
192 N XMREC
193 S XMMBR=+$O(^XMB(3.8,XMGIEN,1,"B",XMDUZ,0)) ; Is user a member?
194 S XMREC=^XMB(3.8,XMGIEN,0)
195 S XMSELF=($P(XMREC,U,3)="y") ; Self enrollment allowed?
196 S XMTYPE=$P(XMREC,U,2) ; Public or Private?
197 I XMTYPE="PU"
198 E I XMTYPE="PR" D
199 . Q:XMMBR
200 . S XMABORT=1
201 . N XMP
202 . S XMP("PARAM","ID")="XMGROUP"
203 . S XMP("PARAM","VALUE")=$P(XMREC,U,1)
204 . D ERRSET^XMXUTIL(38201) ; Group is private.
205 ;E D
206 ;. S XMABORT=1
207 ;. D ERRSET^XMXUTIL() ; Group must be designated as PUBLIC or PRIVATE.
208 Q
209ADD2GRPZ(XMGRP,XMMBR,XMTO) ; See if members already in the groups.
210 ; If not, add them
211 N XMGN,XMGI,XMM,XMTRKNEW
212 S (XMGN,XMM)="",XMTRKNEW=1
213 F S XMGN=$O(XMGRP(XMGN)) Q:XMGN="" S XMGI=XMGRP(XMGN) D
214 . N XMNEWMBR
215 . F S XMM=$O(XMMBR(XMM)) Q:XMM="" D
216 . . D AMZ(XMGI,XMMBR(XMM),$G(XMMBR(XMM,1),"@"),.XMTO)
217 . I $G(XMNEWMBR) D NOTIFY^XMXGRP1(XMGI,.XMNEWMBR)
218 Q
219AMZ(XMG,XMM,XMTYPE,XMTO) ; Add/edit a member (not delete)
220 N XMFDA,XMIEN
221 S XMFDA(3.81,"?+1,"_XMG_",",.01)=XMM
222 S XMFDA(3.81,"?+1,"_XMG_",",1)=XMTYPE
223 S XMTO($S(XMTYPE?1U:XMTYPE_":",1:"")_XMM)=""
224 D UPDATE^DIE("","XMFDA","XMIEN")
225 ;I XMIEN(1,0)="+" S XMCNT=$G(XMCNT)+1
226 ; Need to create array showing which were added and which were edited.
227 ; Counts for each.
228 Q
Note: See TracBrowser for help on using the repository browser.