source: FOIAVistA/trunk/r/MAILMAN-XM/XMXADDRG.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 8.7 KB
Line 
1XMXADDRG ;ISC-SF/GMB-Expand group ;04/15/2003 13:05
2 ;;8.0;MailMan;**18**;Jun 28, 2002
3 ; Replaces ^XMA21G (ISC-WASH/CAP)
4EXPAND(XMDUZ,XMADDR,XMSTRIKE,XMPREFIX,XMLATER,XMFULL,XMG) ;
5 ; XMG IEN of group in ^XMB(3.8)
6 ; XMGN Name of group
7 ; XMGPRIV Restrictions on use of group
8 ; XMGMREC Group member's ^XMB(3.7,x,0 record
9 ; XMGCIRCL Array used to guard against circular references
10 N XMGREC,XMGN,XMGPRIV,XMSCREEN,XMGCIRCL,XMIASAVE,XMGMBRS
11 I $D(XMRESTR("NOFPG")) D Q ;Must be sender or hold XM GROUP PRIORITY
12 . ;key to forward priority mail to groups.
13 . D SETERR^XMXADDR4($G(XMIA),"!",39130)
14 S XMADDR=$E(XMADDR,3,999)
15 ; Screen: Group is public OR user is organizer
16 ; OR group is unrestricted and user is member
17 S XMSCREEN="N XMR S XMR=^(0) I $S($P(XMR,U,2)=""PU"":1,$P($G(^XMB(3.8,+Y,3),.5),U)=XMDUZ:1,+$P(XMR,U,6):0,$D(^XMB(3.8,+Y,1,""B"",XMDUZ)):1,1:0)"
18 I $G(XMIA) D Q:$D(XMERROR)
19 . N DIC,X
20 . S X=XMADDR
21 . S DIC("S")=XMSCREEN
22 . S DIC="^XMB(3.8,"
23 . S DIC(0)="MEZ"
24 . D ^DIC
25 . I Y<0 D SETERR^XMXADDR4(XMADDR'="?","",39002) Q ;Not found.
26 . S XMG=+Y
27 . S XMGN=$P(Y,U,2)
28 . S XMGREC=Y(0)
29 E D Q:$D(XMERROR)
30 . S XMG=$$FIND1^DIC(3.8,"","MO",XMADDR,"",XMSCREEN) I 'XMG D SETERR^XMXADDR4(0,"",$S($D(DIERR):39131,1:39132)) Q ; Mail group ambiguous. / Mail group not found.
31 . S XMGREC=^XMB(3.8,XMG,0)
32 . S XMGN=$P(XMGREC,U)
33 I $D(^XMB(3.8,XMG,4,"B")),'$D(^("B",XMDUZ))!$D(XMRESTR("NET RECEIVE")) D Q
34 . ; If the group has authorized senders, then the sender must be local.
35 . ; Incoming network mail may not address such a group.
36 . D SETERR^XMXADDR4(0,"",39133) ;Sender not authorized to group.
37 . Q:'$G(XMIA)
38 . N XMABORT,XMTEXT
39 . S XMABORT=0
40 . W @IOF
41 . ;You may not send mail directly to this group.
42 . ;You must send it to an authorized sender for the group.
43 . D BLD^DIALOG(39134,"","","XMTEXT","F")
44 . D MSG^DIALOG("WE","","","","XMTEXT")
45 . D AUTHSEND^XMHIG(XMG,XMABORT)
46 S XMGPRIV=$P(XMGREC,U,6)
47 S XMFULL="G."_XMGN_$S($G(XMINSTR("ADDR FLAGS"))["Y":"",XMGPRIV:$$EZBLD^DIALOG(39135),1:"") ;[Private Mail Group]
48 I $G(XMINSTR("ADDR FLAGS"))["X" Q
49 I XMSTRIKE Q:$D(^TMP("XMY0",$J,XMFULL,"L")) W:$G(XMIA) $$EZBLD^DIALOG(39136) ;Deleting Members ...
50 I $G(XMIA),'XMSTRIKE D Q:$D(XMERROR)
51 . I XMLATER="",$G(XMBIGGRP),$$BIG(XMG) D LATERIT(XMFULL,.XMLATER)
52 . I XMLATER="?" D QLATER^XMXADDR(XMFULL,.XMLATER)
53 I XMLATER,'$G(XMIA) Q
54 I $D(XMIA) S XMIASAVE=XMIA
55 I $D(^TMP("XM",$J,"GRPERR")) K ^TMP("XM",$J,"GRPERR")
56 D EXPGROUP(XMDUZ,XMG,XMGREC,XMSTRIKE,XMPREFIX,XMLATER,.XMGCIRCL)
57 I '$G(XMGMBRS),'XMLATER D
58 . D SETERR^XMXADDR4($G(XMIA),"",39137) ;Mail group has no members
59 I $D(^TMP("XM",$J,"GRPERR")) D
60 . D GRPERR^XMXADDR4(XMDUZ,XMG,XMGN)
61 . K ^TMP("XM",$J,"GRPERR")
62 K XMIA
63 I $D(XMIASAVE) S XMIA=XMIASAVE
64 Q
65BIG(XMIEN) ; Function returns 1 if big group, 0 if not
66 Q:$D(^XMB(3.8,XMIEN,5,"B")) 1 ; has member groups
67 Q:$D(^XMB(3.8,XMIEN,7,"B")) 1 ; has distribution list
68 ;Q:$D(^XMB(3.8,XMIEN,9,"B")) 1 ; has fax groups
69 N XMCNT,XMNODE
70 S XMCNT=0
71 F XMNODE=1,6,8 D ; local, remote, & fax members
72 . Q:'$D(^XMB(3.8,XMIEN,XMNODE,0))
73 . S XMCNT=XMCNT+$P($G(^XMB(3.8,XMIEN,XMNODE,0)),U,4)
74 Q XMCNT'<XMBIGGRP
75LATERIT(XMFULL,XMLATER) ;
76 N DIR,X,Y,DIRUT
77 ;This group seems to be fairly big. If you don't need to 'minus'
78 ;anyone from it, then you can save some time by queuing it for 'Later'
79 ;delivery. Would you like to queue this group for later delivery
80 D BLD^DIALOG(39138,"","","DIR(""A"")")
81 S DIR(0)="Y"
82 S DIR("B")=$$EZBLD^DIALOG(39053) ;No
83 ;Answer NO if
84 ; - You need to delete any group members from the message.
85 ;Answer YES if
86 ; - You don't need to delete any group members from the message
87 ; - and you'd like to save a bit of time.
88 D BLD^DIALOG(39139,"","","DIR(""?"")")
89 D ^DIR I $D(DIRUT) D Q
90 . D SETERR^XMXADDR4(0,"",37002) ;up-arrow or time out.
91 . D EN^DDIOL(XMFULL_$$EZBLD^DIALOG(39015)) ;removed from recipient list.
92 Q:'Y
93 S XMLATER="?"
94 Q
95EXPGROUP(XMDUZ,XMG,XMGREC,XMSTRIKE,XMPREFIX,XMLATER,XMGCIRCL) ;
96 ;Q:'$$AUTHGRP(XMDUZ,XMG,XMGREC)
97 S XMGCIRCL(XMG)=""
98 S $P(^XMB(3.8,XMG,0),U,4,5)=$P(XMGREC,U,4)+1_U_DT ; # references to group^date last ref'd
99 I $G(XMIA) D
100 . W !
101 . D DISPCNT(XMG,1,39141) ;Local
102 . D DISPCNT(XMG,5,39142) ;Member Group(s)
103 . D DISPCNT(XMG,6,39143) ;Remote
104 . D DISPCNT(XMG,7,39144) ;Distribution List(s)
105 . D DISPCNT(XMG,8,39145) ;Fax Recipient(s)
106 . D DISPCNT(XMG,9,39146) ;Fax Group(s)
107 . I $X>1 W ":",!
108 D INDIV(XMDUZ,XMG,XMSTRIKE,XMPREFIX,XMLATER) I XMLATER,'$G(XMIA) K XMGCIRCL(XMG) Q
109 D GROUP(XMDUZ,XMG,XMSTRIKE,XMPREFIX,XMLATER,.XMGCIRCL) I XMLATER,'$G(XMIA) K XMGCIRCL(XMG) Q
110 D REMOTE(XMDUZ,XMG,XMSTRIKE,XMPREFIX,XMLATER) I XMLATER,'$G(XMIA) K XMGCIRCL(XMG) Q
111 D DISTR^XMXADDR4(XMDUZ,XMG,XMSTRIKE,XMPREFIX,XMLATER) I XMLATER,'$G(XMIA) K XMGCIRCL(XMG) Q
112 I $P(^XMB(1,1,0),U,19) D FAXGROUP^XMXADDR4(XMDUZ,XMG,XMSTRIKE,XMPREFIX,XMLATER) I XMLATER,'$G(XMIA) K XMGCIRCL(XMG) Q
113 I $P(^XMB(1,1,0),U,19) D FAXINDIV^XMXADDR4(XMDUZ,XMG,XMSTRIKE,XMPREFIX,XMLATER) I XMLATER,'$G(XMIA) K XMGCIRCL(XMG) Q
114 K XMGCIRCL(XMG)
115 Q
116DISPCNT(XMIEN,XMNODE,XMDESCR) ;
117 N XMCNT
118 S XMDESCR=$$EZBLD^DIALOG(XMDESCR)
119 S XMCNT=$P($G(^XMB(3.8,XMIEN,XMNODE,0)),U,4) Q:'XMCNT
120 I $X+3+$L(XMCNT)+$L(XMDESCR)>IOM W ",",!
121 E W:$X>4 ", "
122 W XMCNT," ",XMDESCR
123 Q
124AUTHGRP(XMDUZ,XMG,XMGREC) ;
125 ; Screen: Group is public OR user is owner
126 ; OR group is unrestricted and user is member
127 N XMOWNER
128 I $P(XMGREC,U,2)="PU" Q 1 ; Group is public
129 S XMOWNER=$P(^XMB(3.8,XMG,3),U,1) S:XMOWNER="" XMOWNER=.5
130 I XMDUZ=XMOWNER Q 1 ; User is owner of group
131 I +$P(XMGREC,U,6)=0,$D(^XMB(3.8,XMG,1,"B",XMDUZ)) Q 1 ; Group is unrestricted and user is a member
132 D SETERR^XMXADDR4($G(XMIA),"!",39147,$P(XMGREC,U,1))
133 Q 0 ;You may not access group '|1|'.
134INDIV(XMDUZ,XMG,XMSTRIKE,XMPREFIX,XMLATER) ;
135 ; XMGM Group member
136 N XMI,XMGM,XMCNT,XMREC,XMTYPE
137 S XMI=0,XMCNT=0
138 F S XMI=$O(^XMB(3.8,XMG,1,XMI)) Q:'XMI S XMREC=^(XMI,0) D I XMLATER,'$G(XMIA) Q
139 . S XMGM=$P(XMREC,U,1),XMTYPE=$P(XMREC,U,2)
140 . ; If SHARED,MAIL or no mailbox, then delete from group.
141 . I XMGM=.6!'$D(^XMB(3.7,XMGM))!'$D(^VA(200,XMGM,0)) D DELETE2^XMXADDR4(XMG,1,XMI) Q
142 . N XMFULL,XMERROR,XMFWDADD
143 . D PERSON^XMXADDR1(XMDUZ,XMGM,"","","","",.XMFULL)
144 . I $D(XMERROR) D Q
145 . . ; Commenting out because I'm not sure it should be reported.
146 . . ;S XMFULL=$P($G(^VA(200,XMGM,0)),U,1)
147 . . ;I XMFULL="" S XMFULL="USER #"_XMGM
148 . . ;S ^TMP("XM",$J,"GRPERR",XMG,"L",XMFULL)=XMERROR
149 . S XMGMBRS=1
150 . I 'XMLATER D INDIV^XMXADDR(XMDUZ,XMGM,XMSTRIKE,$S(XMPREFIX'="":XMPREFIX,1:XMTYPE),XMLATER)
151 . Q:'$G(XMIA)
152 . I XMCNT,XMCNT#16=0 D Q:'$G(XMIA)
153 . . N DIR,Y
154 . . S DIR("A")=$$EZBLD^DIALOG(39148) ;Do you want to see more members
155 . . S DIR(0)="Y",DIR("B")=$$EZBLD^DIALOG(39053) ;No
156 . . D ^DIR
157 . . S XMIA=+Y ; The '+' takes care of $D(DIRUT)
158 . S XMCNT=XMCNT+1
159 . W:XMCNT#4-1=0 !
160 . W ?XMCNT-1#4*20,$E($S(XMPREFIX'="":XMPREFIX_":",XMTYPE="":"",1:XMTYPE_":")_XMFULL,1,19)
161 Q
162GROUP(XMDUZ,XMG,XMSTRIKE,XMPREFIX,XMLATER,XMGCIRCL) ;
163 N XMIEN,XMI,XMREC,XMTYPE
164 S XMI=0
165 F S XMI=$O(^XMB(3.8,XMG,5,XMI)) Q:'XMI S XMREC=^(XMI,0) D I XMLATER,'$G(XMIA) Q
166 . S XMIEN=$P(XMREC,U,1),XMTYPE=$P(XMREC,U,2)
167 . I '$D(^XMB(3.8,XMIEN,0)) D DELETE2^XMXADDR4(XMG,5,XMI) Q
168 . S XMREC=^XMB(3.8,XMIEN,0)
169 . W:$G(XMIA) !,$S(XMPREFIX'="":"",XMTYPE="":"",1:XMTYPE_":"),"G.",$P(XMREC,U,1),":"
170 . I $D(XMGCIRCL(XMIEN)) D Q
171 . . ; Circular (infinite loop) reference! Don't go there!
172 . . S ^TMP("XM",$J,"GRPERR",XMG,"C",$P(XMREC,U,1))="" Q
173 . . Q:'$G(XMIASAVE)
174 . . N XMTEXT
175 . . ;Mail group contains circular reference to G.|1|.
176 . . ;Circular reference ignored.
177 . . ;This circular reference should be investigated and eliminated.
178 . . D BLD^DIALOG(39140,$P(XMGREC,U,1),"","XMTEXT","F")
179 . . D MSG^DIALOG("WE","","","","XMTEXT")
180 . D EXPGROUP(XMDUZ,XMIEN,XMREC,XMSTRIKE,$S(XMPREFIX'="":XMPREFIX,1:XMTYPE),XMLATER,.XMGCIRCL)
181 . W:$G(XMIA) !,$$EZBLD^DIALOG(39149,$P(XMREC,U,1)) ;Finished with group |1|.
182 Q
183REMOTE(XMDUZ,XMG,XMSTRIKE,XMPREFIX,XMLATER) ;
184 N XMGM,XMI
185 S XMI=0
186 F S XMI=$O(^XMB(3.8,XMG,6,XMI)) Q:XMI'>0 D I XMLATER,'$G(XMIA) Q
187 . S XMGM=$P(^XMB(3.8,XMG,6,XMI,0),U)
188 . Q:XMGM="" ; Really should delete it from the remotes.
189 . W:$G(XMIA) !,XMGM
190 . Q:XMLATER
191 . D DOREMOTE(XMDUZ,XMGM,XMSTRIKE,XMPREFIX,XMLATER)
192 Q
193DOREMOTE(XMDUZ,XMGM,XMSTRIKE,XMPREFIX,XMLATER) ;
194 N XMERROR,XMFWDADD
195 I XMGM[":" D Q:$D(XMERROR)
196 . I XMPREFIX="" D
197 . . D PREFIX^XMXADDR(.XMGM,.XMPREFIX)
198 . E D
199 . . D PREFIX^XMXADDR(.XMGM)
200 . I $D(XMERROR) S ^TMP("XM",$J,"GRPERR",XMG,"R",XMGM)=$$GETERR^XMXADDR4
201 D REMOTE^XMXADDR3(XMDUZ,XMGM,XMSTRIKE,XMPREFIX,XMLATER)
202 I '$D(XMERROR) S XMGMBRS=1 Q
203 ;37000 - up-arrow out.
204 ;37001 - time out.
205 ;37002 - up-arrow or time out.
206 ;39015.1 - Not a current recipient.
207 ;39133 - Sender not authorized to group.
208 I "^37000^37001^37002^39015.1^39133^"[(U_XMERROR_U) S XMGMBRS=1 Q
209 S ^TMP("XM",$J,"GRPERR",XMG,"R",XMGM)=$$GETERR^XMXADDR4
210 Q
Note: See TracBrowser for help on using the repository browser.