source: WorldVistAEHR/trunk/r/MAILMAN-XM/XMVGROUP.m@ 1005

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

initial load of WorldVistAEHR

File size: 8.3 KB
Line 
1XMVGROUP ;ISC-SF/GMB-Group creation/enrollment ;04/15/2003 12:50
2 ;;8.0;MailMan;**18**;Jun 28, 2002
3 ; Replaces JOIN, ENT^XMA7G & ^XMA7G1 (ISC-WASH/RJ/THM/CAP/JA)
4 ; Entry points used by MailMan options (not covered by DBIA):
5 ; EDITMG XMEDITMG - Mail Group Edit
6 ; ENROLL XMENROLL - Enroll in / Disenroll from a group
7 ; LCOORD XMMGR-MAIL-GRP-COORDINATOR
8 ; RCOORD XMMGR-MAIL-GRP-COORD-W/REMOTES
9 ; PERSONAL XMEDITPERSGROUP - Edit user's personal group.
10 ;
11 ; DBIAs:
12 ; 1544 - Use $$ISA^USRLM (Authorization/Subscription)
13ENROLL ; Enroll in / Disenroll from a group
14 N DIC,Y,XMABORT,XMIEN,XMSELF,XMIA
15 S XMABORT=0
16 S:'$D(XMDUZ) XMDUZ=DUZ
17 S XMSELF=+$P($G(^XMB(1,1,2)),U,2) ; Is self-disenrollment allowed in a non-self enrolling mail group?
18 F D Q:XMABORT
19 . S DIC="^XMB(3.8,",DIC(0)="AEQMZ"
20 . S DIC("S")="I $S($P(^(0),U,2)=""PU"":1,$D(^XMB(3.8,+Y,1,""B"",XMDUZ)):1,1:0)"
21 . S DIC("W")="W:$D(^XMB(3.8,+Y,1,""B"",XMDUZ)) ?35,"""_$$EZBLD^DIALOG(38020)_""" I $P(^XMB(3.8,+Y,0),U,3)'=""y"" W ?43,"""_$$EZBLD^DIALOG(38021)_"""" ; Member / ...Self Enrollment Not Allowed.
22 . W !
23 . D ^DIC I Y<0 S XMABORT=1 Q
24 . S XMIEN=+Y
25 . I $D(^XMB(3.8,XMIEN,1,"B",XMDUZ)) D Q
26 . . I $P(^XMB(3.8,XMIEN,0),U,3)'="y",'XMSELF W !,$$EZBLD^DIALOG(38022.1) Q ;Self enrollment is not allowed for this mail group.
27 . . D DROP(XMIEN,XMDUZ)
28 . I $P(^XMB(3.8,XMIEN,0),U,3)'="y" W !,$$EZBLD^DIALOG(38022) Q ;Self enrollment is not allowed for this mail group.
29 . D JOIN(XMIEN,XMDUZ)
30 Q
31JOIN(XMIEN,XMDUZ) ; Enroll in a group
32 N XMFDA
33 S XMFDA(3.81,"+1,"_XMIEN_",",.01)=XMDUZ
34 D UPDATE^DIE("","XMFDA")
35 W !,$$EZBLD^DIALOG(38023) ;You are now a member.
36 N DIR,X,Y
37 S DIR(0)="Y"
38 ; Do you want past messages to this group to be forwarded to you?
39 D BLD^DIALOG(38023.1,"","","DIR(""A"")")
40 S DIR("B")=$$EZBLD^DIALOG(39053) ; no
41 D BLD^DIALOG(38232,"","","DIR(""?"")")
42 ;Answer YES to forward past mail group messages.
43 ;You will be asked for a time frame to search,
44 ;and then MailMan will create a task to find and forward
45 ;existing mail group messages.
46 D ^DIR Q:$D(DIRUT)!'Y
47 N XMINSTR,XMTSK,XMABORT
48 I '$D(XMV) N XMV,XMDISPI,XMDUN,XMNOSEND,XMPRIV D INITAPI^XMVVITAE
49 S XMABORT=0,XMINSTR("FLAGS")="F"
50 D FWDBSKT(XMDUZ,.XMINSTR,.XMABORT) Q:XMABORT
51 D FWDDATES^XMVGRP(XMDUZ,.XMINSTR,.XMABORT) Q:XMABORT
52 D FAFMSGS^XMXGRP1(XMDUZ,$P($G(^XMB(3.8,XMIEN,0)),U,1),XMDUZ,.XMINSTR,.XMTSK)
53 D FWDTSK(XMTSK)
54 Q
55FWDBSKT(XMDUZ,XMINSTR,XMABORT) ; Select basket to forward to
56 N XMDIC,XMK
57 S XMDIC("B")=$$EZBLD^DIALOG(37005) ;IN
58 D SELBSKT^XMJBU(XMDUZ,39022,"L",.XMDIC,.XMK) I XMK=U S XMABORT=1 Q
59 S XMINSTR("SELF BSKT")=XMK
60 Q
61FWDTSK(XMTSK) ;
62 W !
63 ;Task #|1| will find and forward past messages.
64 N XMTEXT
65 D BLD^DIALOG(38023.9,XMTSK,"","XMTEXT","F")
66 D MSG^DIALOG("WM","",IOM,"","XMTEXT")
67 Q
68DROP(XMIEN,XMDUZ) ; Disenroll from a group
69 N DIR,X,Y
70 S DIR(0)="Y"
71 I $P(^XMB(3.8,XMIEN,0),U,3)'="y" D
72 . ;You're a member. Self enrollment is not allowed for this mail group.
73 . ;If you drop out, you will not be able to re-join. (To re-join later,
74 . ;you will have to ask the group coordinator to re-enroll you.)
75 . ;You are a member. Do you want to drop out
76 . D BLD^DIALOG(38024.1,"","","DIR(""A"")")
77 E D ;You are a member. Do you want to drop out
78 . S DIR("A")=$$EZBLD^DIALOG(38024)
79 S DIR("B")=$$EZBLD^DIALOG(39053) ;No
80 ;Enter YES to remove yourself from the group; NO to remain a member.
81 D BLD^DIALOG(38025,"","","DIR(""?"")")
82 D ^DIR Q:$D(DIRUT)!'Y
83 K DIR,X,Y
84 N DA,DIK
85 S DA(1)=XMIEN,DA=$O(^XMB(3.8,XMIEN,1,"B",XMDUZ,0)),DIK="^XMB(3.8,"_XMIEN_",1,"
86 D ^DIK
87 W !,$$EZBLD^DIALOG(38026) ;You are no longer a member.
88 Q
89PERSONAL ; Enter/Edit Personal Group
90 ; See entry EDIT for info on XMIA & XMTRKNEW
91 N DIC,DLAYGO,X,Y,XMABORT,XMIA,XMTRKNEW
92 S XMABORT=0,(XMIA,XMTRKNEW)=1
93 S DIC="^XMB(3.8,",DIC(0)="AEQMZL",DLAYGO=3.8
94 ; Group is private, and user is organizer
95 S DIC("S")="I $P(^(0),U,2)=""PR"",$P($G(^XMB(3.8,+Y,3)),U)=$G(XMDUZ,DUZ)"
96 F D Q:XMABORT
97 . W !
98 . D ^DIC I Y<0 S XMABORT=1 Q
99 . N XMDR,XMNEW
100 . S XMNEW=$P(Y,U,3)
101 . S:XMNEW XMDR="4////PR;5////"_$G(XMDUZ,DUZ)_";10////1;"
102 . S XMDR=$G(XMDR)_".01T;2;3" ; name, members, description
103 . S XMDR=XMDR_";10;12" ; restrictions, remote members
104 . D EDIT(+Y,XMDR,XMNEW)
105 Q
106EDIT(XMG,DR,XMNEW) ; Edit mail group
107 ; XMIA is used for interaction on the REMOTE MEMBER input transform
108 ; to facilitate lookup. XMTRKNEW is used by the AC xref on the
109 ; .01 field of the LOCAL MEMBER multiple. If local members are added
110 ; to the group, XMNEWMBR is set by the AC xref.
111 N DIE,DIDEL,Y,DIC,DA,XMNEWMBR
112 S (DIDEL,DIE)=3.8,DA=XMG
113 S:$P(^XMB(1,1,0),U,19) DR=DR_";14;15" ; fax recipients, fax groups
114 D ^DIE
115 I 'XMNEW,$D(XMNEWMBR) D FWD(XMG,.XMNEWMBR)
116 Q
117FWD(XMG,XMTO) ; Forward past mail group messages to new local members
118 N XMI
119 S XMI=""
120 F S XMI=$O(XMTO(XMI)) Q:'XMI K:'$D(^XMB(3.8,XMG,1,"B",XMI)) XMTO(XMI)
121 Q:'$D(XMTO)
122 I '$D(XMV) N XMV,XMDISPI,XMDUN,XMNOSEND,XMPRIV D INITAPI^XMVVITAE
123 D NOTIFY^XMXGRP1(XMG,.XMTO)
124 N XMINSTR,XMTSK,XMABORT
125 S XMABORT=0
126 D ENFWD^XMVGRP(XMDUZ,.XMINSTR,.XMABORT) Q:XMABORT
127 D FAFMSGS^XMXGRP1(XMDUZ,$P(^XMB(3.8,XMG,0),U,1),.XMTO,.XMINSTR,.XMTSK)
128 D FWDTSK(XMTSK)
129 Q
130LAYGO(X) ; Prevent someone from adding a (private) group with the same name as a public one.
131 ; This function is invoked by the LAYGO field of ^XMB(3.8,.01)
132 ; Returns 1 if group X may be created; 0 if not.
133 N IEN,LAYGO
134 S IEN="",LAYGO=1
135 F S IEN=$O(^XMB(3.8,"B",X,IEN)) Q:IEN="" D Q:'LAYGO
136 . Q:$P(^XMB(3.8,IEN,0),U,2)="PR"
137 . S LAYGO=0 ;Can't add it because public group '|1|' already exists.
138 . D EN^DDIOL($$EZBLD^DIALOG(38027,X),"","!,$C(7)")
139 Q LAYGO
140REMOTE(XMADDR,XMIA) ; Serves as input transform for 'remote member'
141 ; Allow remote addressees or local devices or local servers
142 N XMERROR,XMRESTR,XMINSTR,XMFULL,XMPREFIX,DIX,DO,XMFWDADD
143 S XMINSTR("ADDR FLAGS")="X" ; do not create ^TMP(, just check.
144 I XMADDR[":" D Q:'$D(XMADDR)
145 . D RTYPE^XMXADDR($P(XMADDR,":")) I $D(XMERROR) K XMADDR Q
146 . D PREFIX^XMXADDR(.XMADDR,.XMPREFIX) I $D(XMERROR) K XMADDR Q
147 I XMADDR'["@",".D.d.H.h.S.s."'[("."_$E(XMADDR,1,2)),'$D(XMPREFIX) K XMADDR Q
148 D ADDRESS^XMXADDR(DUZ,XMADDR,.XMFULL,.XMERROR)
149 I $D(XMERROR) K XMADDR Q
150 I XMFULL'["@" D
151 . I ".D.H.S."[("."_$E(XMFULL,1,2)) S XMFULL=XMFULL_"@"_^XMB("NETNAME") Q
152 . ;I $G(XMPREFIX)'="" S XMFULL=XMFULL_"@"_^XMB("NETNAME") Q
153 I XMFULL'["@" D Q
154 . K XMADDR
155 . D EN^DDIOL($$EZBLD^DIALOG(38028)) ;It can't be a local address, except for Device or Server.
156 . I $E(XMFULL,1,2)="G." D EN^DDIOL($$EZBLD^DIALOG(38029)) ;Put the group in the MEMBER GROUP multiple.
157 . E D EN^DDIOL($$EZBLD^DIALOG(38030)) ;Put the person in the MEMBER multiple.
158 . I $G(XMPREFIX)'="" D EN^DDIOL($$EZBLD^DIALOG(38031,XMPREFIX)) ;Put '|1|' in the TYPE field.
159 I $G(XMPREFIX)'="" S XMFULL=XMPREFIX_":"_XMFULL
160 S XMADDR=XMFULL
161 Q
162EDITMG ; Mail Group Edit
163 ; See entry EDIT for info on XMIA & XMTRKNEW
164 N DIC,XMABORT,DLAYGO,X,Y,XMIA,XMTRKNEW,XMREC
165 S XMABORT=0,(XMIA,XMTRKNEW)=1,DLAYGO=3.8
166 S DIC(0)="AEQLM",DIC="^XMB(3.8,"
167 S DIC("S")=$$GRPSCR(0)
168 F D Q:XMABORT
169 . W !
170 . D ^DIC I Y<0 S XMABORT=1 Q
171 . N XMDR
172 . S XMDR=".01T;2;3" ; name, members, description
173 . ; type - if type is public, ask about self enrollment,
174 . ; else ask about restrictions.
175 . S XMDR=XMDR_";4;I X=""PU"" S Y=7;10;S Y=5;7"
176 . S XMDR=XMDR_";5:6.9" ; organizer, coordinator, authorized senders
177 . S XMDR=XMDR_";10.1:13.9" ; member groups, remote members, distr list
178 . D EDIT(+Y,XMDR,$P(Y,U,3))
179 Q
180GRPSCR(XMCOORD) ; Who may edit a mail group?
181 N XMSCR,XMOK
182 S XMOK=0
183 I $T(ISA^USRLM)'="" S XMOK=$$ISA^USRLM(DUZ,"CLINICAL COORDINATOR")
184 I $D(^XUSEC("XMMGR",DUZ))!$D(^XUSEC("XM GROUP EDIT MASTER",DUZ))!XMOK D
185 . ; Screen whether group is public or (private and) unrestricted
186 . S XMSCR="N XMREC S XMREC=^(0) I $P(XMREC,U,2)=""PU""!'$P(XMREC,U,6)!"
187 E S XMSCR="I " ; Or, at the very minimum,
188 ; Screen whether user is organizer or coordinator.
189 Q XMSCR_"($P($G(^XMB(3.8,+Y,3)),U,1)=$G(XMDUZ,DUZ))"_$S($G(XMCOORD):"!$D(^XMB(3.8,""AC"",$G(XMDUZ,DUZ),+Y))",1:"")
190 ;
191LCOORD ; Mail Group Coordinator edit w/o remote members
192 D COORD(0)
193 Q
194RCOORD ; Mail Group Coordinator edit w/remote members
195 D COORD(1)
196 Q
197COORD(XMREMOTE) ;
198 ; See entry EDIT for info on XMIA & XMTRKNEW
199 N DIC,XMABORT,DLAYGO,X,Y,XMIA,XMTRKNEW
200 S XMABORT=0,(XMIA,XMTRKNEW)=1
201 S DIC(0)="AEQM",DIC="^XMB(3.8,"
202 S DIC("S")=$$GRPSCR(1)
203 F D Q:XMABORT
204 . W !
205 . D ^DIC I Y<0 S XMABORT=1 Q
206 . ; edit local members, member groups, & perhaps, remote members
207 . D EDIT(+Y,"2;11"_$S(XMREMOTE:";12",1:""),0)
208 Q
Note: See TracBrowser for help on using the repository browser.