Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XMXADDRG

XMXADDRG.m

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