| 1 | XMXADDRG ;ISC-SF/GMB-Expand group ;04/15/2003 13:05
|
|---|
| 2 | ;;8.0;MailMan;**18**;Jun 28, 2002
|
|---|
| 3 | ; Replaces ^XMA21G (ISC-WASH/CAP)
|
|---|
| 4 | EXPAND(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
|
|---|
| 65 | BIG(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
|
|---|
| 75 | LATERIT(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
|
|---|
| 95 | EXPGROUP(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
|
|---|
| 116 | DISPCNT(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
|
|---|
| 124 | AUTHGRP(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|'.
|
|---|
| 134 | INDIV(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
|
|---|
| 162 | GROUP(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
|
|---|
| 183 | REMOTE(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
|
|---|
| 193 | DOREMOTE(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
|
|---|
