211 lines
8.7 KiB
Mathematica
211 lines
8.7 KiB
Mathematica
XMXADDRG ;ISC-SF/GMB-Expand group ;04/15/2003 13:05
|
|
;;8.0;MailMan;**18**;Jun 28, 2002
|
|
; Replaces ^XMA21G (ISC-WASH/CAP)
|
|
EXPAND(XMDUZ,XMADDR,XMSTRIKE,XMPREFIX,XMLATER,XMFULL,XMG) ;
|
|
; XMG IEN of group in ^XMB(3.8)
|
|
; XMGN Name of group
|
|
; XMGPRIV Restrictions on use of group
|
|
; XMGMREC Group member's ^XMB(3.7,x,0 record
|
|
; XMGCIRCL Array used to guard against circular references
|
|
N XMGREC,XMGN,XMGPRIV,XMSCREEN,XMGCIRCL,XMIASAVE,XMGMBRS
|
|
I $D(XMRESTR("NOFPG")) D Q ;Must be sender or hold XM GROUP PRIORITY
|
|
. ;key to forward priority mail to groups.
|
|
. D SETERR^XMXADDR4($G(XMIA),"!",39130)
|
|
S XMADDR=$E(XMADDR,3,999)
|
|
; Screen: Group is public OR user is organizer
|
|
; OR group is unrestricted and user is member
|
|
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)"
|
|
I $G(XMIA) D Q:$D(XMERROR)
|
|
. N DIC,X
|
|
. S X=XMADDR
|
|
. S DIC("S")=XMSCREEN
|
|
. S DIC="^XMB(3.8,"
|
|
. S DIC(0)="MEZ"
|
|
. D ^DIC
|
|
. I Y<0 D SETERR^XMXADDR4(XMADDR'="?","",39002) Q ;Not found.
|
|
. S XMG=+Y
|
|
. S XMGN=$P(Y,U,2)
|
|
. S XMGREC=Y(0)
|
|
E D Q:$D(XMERROR)
|
|
. 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.
|
|
. S XMGREC=^XMB(3.8,XMG,0)
|
|
. S XMGN=$P(XMGREC,U)
|
|
I $D(^XMB(3.8,XMG,4,"B")),'$D(^("B",XMDUZ))!$D(XMRESTR("NET RECEIVE")) D Q
|
|
. ; If the group has authorized senders, then the sender must be local.
|
|
. ; Incoming network mail may not address such a group.
|
|
. D SETERR^XMXADDR4(0,"",39133) ;Sender not authorized to group.
|
|
. Q:'$G(XMIA)
|
|
. N XMABORT,XMTEXT
|
|
. S XMABORT=0
|
|
. W @IOF
|
|
. ;You may not send mail directly to this group.
|
|
. ;You must send it to an authorized sender for the group.
|
|
. D BLD^DIALOG(39134,"","","XMTEXT","F")
|
|
. D MSG^DIALOG("WE","","","","XMTEXT")
|
|
. D AUTHSEND^XMHIG(XMG,XMABORT)
|
|
S XMGPRIV=$P(XMGREC,U,6)
|
|
S XMFULL="G."_XMGN_$S($G(XMINSTR("ADDR FLAGS"))["Y":"",XMGPRIV:$$EZBLD^DIALOG(39135),1:"") ;[Private Mail Group]
|
|
I $G(XMINSTR("ADDR FLAGS"))["X" Q
|
|
I XMSTRIKE Q:$D(^TMP("XMY0",$J,XMFULL,"L")) W:$G(XMIA) $$EZBLD^DIALOG(39136) ;Deleting Members ...
|
|
I $G(XMIA),'XMSTRIKE D Q:$D(XMERROR)
|
|
. I XMLATER="",$G(XMBIGGRP),$$BIG(XMG) D LATERIT(XMFULL,.XMLATER)
|
|
. I XMLATER="?" D QLATER^XMXADDR(XMFULL,.XMLATER)
|
|
I XMLATER,'$G(XMIA) Q
|
|
I $D(XMIA) S XMIASAVE=XMIA
|
|
I $D(^TMP("XM",$J,"GRPERR")) K ^TMP("XM",$J,"GRPERR")
|
|
D EXPGROUP(XMDUZ,XMG,XMGREC,XMSTRIKE,XMPREFIX,XMLATER,.XMGCIRCL)
|
|
I '$G(XMGMBRS),'XMLATER D
|
|
. D SETERR^XMXADDR4($G(XMIA),"",39137) ;Mail group has no members
|
|
I $D(^TMP("XM",$J,"GRPERR")) D
|
|
. D GRPERR^XMXADDR4(XMDUZ,XMG,XMGN)
|
|
. K ^TMP("XM",$J,"GRPERR")
|
|
K XMIA
|
|
I $D(XMIASAVE) S XMIA=XMIASAVE
|
|
Q
|
|
BIG(XMIEN) ; Function returns 1 if big group, 0 if not
|
|
Q:$D(^XMB(3.8,XMIEN,5,"B")) 1 ; has member groups
|
|
Q:$D(^XMB(3.8,XMIEN,7,"B")) 1 ; has distribution list
|
|
;Q:$D(^XMB(3.8,XMIEN,9,"B")) 1 ; has fax groups
|
|
N XMCNT,XMNODE
|
|
S XMCNT=0
|
|
F XMNODE=1,6,8 D ; local, remote, & fax members
|
|
. Q:'$D(^XMB(3.8,XMIEN,XMNODE,0))
|
|
. S XMCNT=XMCNT+$P($G(^XMB(3.8,XMIEN,XMNODE,0)),U,4)
|
|
Q XMCNT'<XMBIGGRP
|
|
LATERIT(XMFULL,XMLATER) ;
|
|
N DIR,X,Y,DIRUT
|
|
;This group seems to be fairly big. If you don't need to 'minus'
|
|
;anyone from it, then you can save some time by queuing it for 'Later'
|
|
;delivery. Would you like to queue this group for later delivery
|
|
D BLD^DIALOG(39138,"","","DIR(""A"")")
|
|
S DIR(0)="Y"
|
|
S DIR("B")=$$EZBLD^DIALOG(39053) ;No
|
|
;Answer NO if
|
|
; - You need to delete any group members from the message.
|
|
;Answer YES if
|
|
; - You don't need to delete any group members from the message
|
|
; - and you'd like to save a bit of time.
|
|
D BLD^DIALOG(39139,"","","DIR(""?"")")
|
|
D ^DIR I $D(DIRUT) D Q
|
|
. D SETERR^XMXADDR4(0,"",37002) ;up-arrow or time out.
|
|
. D EN^DDIOL(XMFULL_$$EZBLD^DIALOG(39015)) ;removed from recipient list.
|
|
Q:'Y
|
|
S XMLATER="?"
|
|
Q
|
|
EXPGROUP(XMDUZ,XMG,XMGREC,XMSTRIKE,XMPREFIX,XMLATER,XMGCIRCL) ;
|
|
;Q:'$$AUTHGRP(XMDUZ,XMG,XMGREC)
|
|
S XMGCIRCL(XMG)=""
|
|
S $P(^XMB(3.8,XMG,0),U,4,5)=$P(XMGREC,U,4)+1_U_DT ; # references to group^date last ref'd
|
|
I $G(XMIA) D
|
|
. W !
|
|
. D DISPCNT(XMG,1,39141) ;Local
|
|
. D DISPCNT(XMG,5,39142) ;Member Group(s)
|
|
. D DISPCNT(XMG,6,39143) ;Remote
|
|
. D DISPCNT(XMG,7,39144) ;Distribution List(s)
|
|
. D DISPCNT(XMG,8,39145) ;Fax Recipient(s)
|
|
. D DISPCNT(XMG,9,39146) ;Fax Group(s)
|
|
. I $X>1 W ":",!
|
|
D INDIV(XMDUZ,XMG,XMSTRIKE,XMPREFIX,XMLATER) I XMLATER,'$G(XMIA) K XMGCIRCL(XMG) Q
|
|
D GROUP(XMDUZ,XMG,XMSTRIKE,XMPREFIX,XMLATER,.XMGCIRCL) I XMLATER,'$G(XMIA) K XMGCIRCL(XMG) Q
|
|
D REMOTE(XMDUZ,XMG,XMSTRIKE,XMPREFIX,XMLATER) I XMLATER,'$G(XMIA) K XMGCIRCL(XMG) Q
|
|
D DISTR^XMXADDR4(XMDUZ,XMG,XMSTRIKE,XMPREFIX,XMLATER) I XMLATER,'$G(XMIA) K XMGCIRCL(XMG) Q
|
|
I $P(^XMB(1,1,0),U,19) D FAXGROUP^XMXADDR4(XMDUZ,XMG,XMSTRIKE,XMPREFIX,XMLATER) I XMLATER,'$G(XMIA) K XMGCIRCL(XMG) Q
|
|
I $P(^XMB(1,1,0),U,19) D FAXINDIV^XMXADDR4(XMDUZ,XMG,XMSTRIKE,XMPREFIX,XMLATER) I XMLATER,'$G(XMIA) K XMGCIRCL(XMG) Q
|
|
K XMGCIRCL(XMG)
|
|
Q
|
|
DISPCNT(XMIEN,XMNODE,XMDESCR) ;
|
|
N XMCNT
|
|
S XMDESCR=$$EZBLD^DIALOG(XMDESCR)
|
|
S XMCNT=$P($G(^XMB(3.8,XMIEN,XMNODE,0)),U,4) Q:'XMCNT
|
|
I $X+3+$L(XMCNT)+$L(XMDESCR)>IOM W ",",!
|
|
E W:$X>4 ", "
|
|
W XMCNT," ",XMDESCR
|
|
Q
|
|
AUTHGRP(XMDUZ,XMG,XMGREC) ;
|
|
; Screen: Group is public OR user is owner
|
|
; OR group is unrestricted and user is member
|
|
N XMOWNER
|
|
I $P(XMGREC,U,2)="PU" Q 1 ; Group is public
|
|
S XMOWNER=$P(^XMB(3.8,XMG,3),U,1) S:XMOWNER="" XMOWNER=.5
|
|
I XMDUZ=XMOWNER Q 1 ; User is owner of group
|
|
I +$P(XMGREC,U,6)=0,$D(^XMB(3.8,XMG,1,"B",XMDUZ)) Q 1 ; Group is unrestricted and user is a member
|
|
D SETERR^XMXADDR4($G(XMIA),"!",39147,$P(XMGREC,U,1))
|
|
Q 0 ;You may not access group '|1|'.
|
|
INDIV(XMDUZ,XMG,XMSTRIKE,XMPREFIX,XMLATER) ;
|
|
; XMGM Group member
|
|
N XMI,XMGM,XMCNT,XMREC,XMTYPE
|
|
S XMI=0,XMCNT=0
|
|
F S XMI=$O(^XMB(3.8,XMG,1,XMI)) Q:'XMI S XMREC=^(XMI,0) D I XMLATER,'$G(XMIA) Q
|
|
. S XMGM=$P(XMREC,U,1),XMTYPE=$P(XMREC,U,2)
|
|
. ; If SHARED,MAIL or no mailbox, then delete from group.
|
|
. I XMGM=.6!'$D(^XMB(3.7,XMGM))!'$D(^VA(200,XMGM,0)) D DELETE2^XMXADDR4(XMG,1,XMI) Q
|
|
. N XMFULL,XMERROR,XMFWDADD
|
|
. D PERSON^XMXADDR1(XMDUZ,XMGM,"","","","",.XMFULL)
|
|
. I $D(XMERROR) D Q
|
|
. . ; Commenting out because I'm not sure it should be reported.
|
|
. . ;S XMFULL=$P($G(^VA(200,XMGM,0)),U,1)
|
|
. . ;I XMFULL="" S XMFULL="USER #"_XMGM
|
|
. . ;S ^TMP("XM",$J,"GRPERR",XMG,"L",XMFULL)=XMERROR
|
|
. S XMGMBRS=1
|
|
. I 'XMLATER D INDIV^XMXADDR(XMDUZ,XMGM,XMSTRIKE,$S(XMPREFIX'="":XMPREFIX,1:XMTYPE),XMLATER)
|
|
. Q:'$G(XMIA)
|
|
. I XMCNT,XMCNT#16=0 D Q:'$G(XMIA)
|
|
. . N DIR,Y
|
|
. . S DIR("A")=$$EZBLD^DIALOG(39148) ;Do you want to see more members
|
|
. . S DIR(0)="Y",DIR("B")=$$EZBLD^DIALOG(39053) ;No
|
|
. . D ^DIR
|
|
. . S XMIA=+Y ; The '+' takes care of $D(DIRUT)
|
|
. S XMCNT=XMCNT+1
|
|
. W:XMCNT#4-1=0 !
|
|
. W ?XMCNT-1#4*20,$E($S(XMPREFIX'="":XMPREFIX_":",XMTYPE="":"",1:XMTYPE_":")_XMFULL,1,19)
|
|
Q
|
|
GROUP(XMDUZ,XMG,XMSTRIKE,XMPREFIX,XMLATER,XMGCIRCL) ;
|
|
N XMIEN,XMI,XMREC,XMTYPE
|
|
S XMI=0
|
|
F S XMI=$O(^XMB(3.8,XMG,5,XMI)) Q:'XMI S XMREC=^(XMI,0) D I XMLATER,'$G(XMIA) Q
|
|
. S XMIEN=$P(XMREC,U,1),XMTYPE=$P(XMREC,U,2)
|
|
. I '$D(^XMB(3.8,XMIEN,0)) D DELETE2^XMXADDR4(XMG,5,XMI) Q
|
|
. S XMREC=^XMB(3.8,XMIEN,0)
|
|
. W:$G(XMIA) !,$S(XMPREFIX'="":"",XMTYPE="":"",1:XMTYPE_":"),"G.",$P(XMREC,U,1),":"
|
|
. I $D(XMGCIRCL(XMIEN)) D Q
|
|
. . ; Circular (infinite loop) reference! Don't go there!
|
|
. . S ^TMP("XM",$J,"GRPERR",XMG,"C",$P(XMREC,U,1))="" Q
|
|
. . Q:'$G(XMIASAVE)
|
|
. . N XMTEXT
|
|
. . ;Mail group contains circular reference to G.|1|.
|
|
. . ;Circular reference ignored.
|
|
. . ;This circular reference should be investigated and eliminated.
|
|
. . D BLD^DIALOG(39140,$P(XMGREC,U,1),"","XMTEXT","F")
|
|
. . D MSG^DIALOG("WE","","","","XMTEXT")
|
|
. D EXPGROUP(XMDUZ,XMIEN,XMREC,XMSTRIKE,$S(XMPREFIX'="":XMPREFIX,1:XMTYPE),XMLATER,.XMGCIRCL)
|
|
. W:$G(XMIA) !,$$EZBLD^DIALOG(39149,$P(XMREC,U,1)) ;Finished with group |1|.
|
|
Q
|
|
REMOTE(XMDUZ,XMG,XMSTRIKE,XMPREFIX,XMLATER) ;
|
|
N XMGM,XMI
|
|
S XMI=0
|
|
F S XMI=$O(^XMB(3.8,XMG,6,XMI)) Q:XMI'>0 D I XMLATER,'$G(XMIA) Q
|
|
. S XMGM=$P(^XMB(3.8,XMG,6,XMI,0),U)
|
|
. Q:XMGM="" ; Really should delete it from the remotes.
|
|
. W:$G(XMIA) !,XMGM
|
|
. Q:XMLATER
|
|
. D DOREMOTE(XMDUZ,XMGM,XMSTRIKE,XMPREFIX,XMLATER)
|
|
Q
|
|
DOREMOTE(XMDUZ,XMGM,XMSTRIKE,XMPREFIX,XMLATER) ;
|
|
N XMERROR,XMFWDADD
|
|
I XMGM[":" D Q:$D(XMERROR)
|
|
. I XMPREFIX="" D
|
|
. . D PREFIX^XMXADDR(.XMGM,.XMPREFIX)
|
|
. E D
|
|
. . D PREFIX^XMXADDR(.XMGM)
|
|
. I $D(XMERROR) S ^TMP("XM",$J,"GRPERR",XMG,"R",XMGM)=$$GETERR^XMXADDR4
|
|
D REMOTE^XMXADDR3(XMDUZ,XMGM,XMSTRIKE,XMPREFIX,XMLATER)
|
|
I '$D(XMERROR) S XMGMBRS=1 Q
|
|
;37000 - up-arrow out.
|
|
;37001 - time out.
|
|
;37002 - up-arrow or time out.
|
|
;39015.1 - Not a current recipient.
|
|
;39133 - Sender not authorized to group.
|
|
I "^37000^37001^37002^39015.1^39133^"[(U_XMERROR_U) S XMGMBRS=1 Q
|
|
S ^TMP("XM",$J,"GRPERR",XMG,"R",XMGM)=$$GETERR^XMXADDR4
|
|
Q
|