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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMXADDRG 9083 printed Oct 16, 2024@18:14:44 Page 2
XMXADDRG ;ISC-SF/GMB-Expand group ;04/15/2003 13:05
+1 ;;8.0;MailMan;**18**;Jun 28, 2002
+2 ; Replaces ^XMA21G (ISC-WASH/CAP)
EXPAND(XMDUZ,XMADDR,XMSTRIKE,XMPREFIX,XMLATER,XMFULL,XMG) ;
+1 ; XMG IEN of group in ^XMB(3.8)
+2 ; XMGN Name of group
+3 ; XMGPRIV Restrictions on use of group
+4 ; XMGMREC Group member's ^XMB(3.7,x,0 record
+5 ; XMGCIRCL Array used to guard against circular references
+6 NEW XMGREC,XMGN,XMGPRIV,XMSCREEN,XMGCIRCL,XMIASAVE,XMGMBRS
+7 ;Must be sender or hold XM GROUP PRIORITY
IF $DATA(XMRESTR("NOFPG"))
Begin DoDot:1
+8 ;key to forward priority mail to groups.
+9 DO SETERR^XMXADDR4($GET(XMIA),"!",39130)
End DoDot:1
QUIT
+10 SET XMADDR=$EXTRACT(XMADDR,3,999)
+11 ; Screen: Group is public OR user is organizer
+12 ; OR group is unrestricted and user is member
+13 SET 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)"
+14 IF $GET(XMIA)
Begin DoDot:1
+15 NEW DIC,X
+16 SET X=XMADDR
+17 SET DIC("S")=XMSCREEN
+18 SET DIC="^XMB(3.8,"
+19 SET DIC(0)="MEZ"
+20 DO ^DIC
+21 ;Not found.
IF Y<0
DO SETERR^XMXADDR4(XMADDR'="?","",39002)
QUIT
+22 SET XMG=+Y
+23 SET XMGN=$PIECE(Y,U,2)
+24 SET XMGREC=Y(0)
End DoDot:1
if $DATA(XMERROR)
QUIT
+25 IF '$TEST
Begin DoDot:1
+26 ; Mail group ambiguous. / Mail group not found.
SET XMG=$$FIND1^DIC(3.8,"","MO",XMADDR,"",XMSCREEN)
IF 'XMG
DO SETERR^XMXADDR4(0,"",$SELECT($DATA(DIERR):39131,1:39132))
QUIT
+27 SET XMGREC=^XMB(3.8,XMG,0)
+28 SET XMGN=$PIECE(XMGREC,U)
End DoDot:1
if $DATA(XMERROR)
QUIT
+29 IF $DATA(^XMB(3.8,XMG,4,"B"))
IF '$DATA(^("B",XMDUZ))!$DATA(XMRESTR("NET RECEIVE"))
Begin DoDot:1
+30 ; If the group has authorized senders, then the sender must be local.
+31 ; Incoming network mail may not address such a group.
+32 ;Sender not authorized to group.
DO SETERR^XMXADDR4(0,"",39133)
+33 if '$GET(XMIA)
QUIT
+34 NEW XMABORT,XMTEXT
+35 SET XMABORT=0
+36 WRITE @IOF
+37 ;You may not send mail directly to this group.
+38 ;You must send it to an authorized sender for the group.
+39 DO BLD^DIALOG(39134,"","","XMTEXT","F")
+40 DO MSG^DIALOG("WE","","","","XMTEXT")
+41 DO AUTHSEND^XMHIG(XMG,XMABORT)
End DoDot:1
QUIT
+42 SET XMGPRIV=$PIECE(XMGREC,U,6)
+43 ;[Private Mail Group]
SET XMFULL="G."_XMGN_$SELECT($GET(XMINSTR("ADDR FLAGS"))["Y":"",XMGPRIV:$$EZBLD^DIALOG(39135),1:"")
+44 IF $GET(XMINSTR("ADDR FLAGS"))["X"
QUIT
+45 ;Deleting Members ...
IF XMSTRIKE
if $DATA(^TMP("XMY0",$JOB,XMFULL,"L"))
QUIT
if $GET(XMIA)
WRITE $$EZBLD^DIALOG(39136)
+46 IF $GET(XMIA)
IF 'XMSTRIKE
Begin DoDot:1
+47 IF XMLATER=""
IF $GET(XMBIGGRP)
IF $$BIG(XMG)
DO LATERIT(XMFULL,.XMLATER)
+48 IF XMLATER="?"
DO QLATER^XMXADDR(XMFULL,.XMLATER)
End DoDot:1
if $DATA(XMERROR)
QUIT
+49 IF XMLATER
IF '$GET(XMIA)
QUIT
+50 IF $DATA(XMIA)
SET XMIASAVE=XMIA
+51 IF $DATA(^TMP("XM",$JOB,"GRPERR"))
KILL ^TMP("XM",$JOB,"GRPERR")
+52 DO EXPGROUP(XMDUZ,XMG,XMGREC,XMSTRIKE,XMPREFIX,XMLATER,.XMGCIRCL)
+53 IF '$GET(XMGMBRS)
IF 'XMLATER
Begin DoDot:1
+54 ;Mail group has no members
DO SETERR^XMXADDR4($GET(XMIA),"",39137)
End DoDot:1
+55 IF $DATA(^TMP("XM",$JOB,"GRPERR"))
Begin DoDot:1
+56 DO GRPERR^XMXADDR4(XMDUZ,XMG,XMGN)
+57 KILL ^TMP("XM",$JOB,"GRPERR")
End DoDot:1
+58 KILL XMIA
+59 IF $DATA(XMIASAVE)
SET XMIA=XMIASAVE
+60 QUIT
BIG(XMIEN) ; Function returns 1 if big group, 0 if not
+1 ; has member groups
if $DATA(^XMB(3.8,XMIEN,5,"B"))
QUIT 1
+2 ; has distribution list
if $DATA(^XMB(3.8,XMIEN,7,"B"))
QUIT 1
+3 ;Q:$D(^XMB(3.8,XMIEN,9,"B")) 1 ; has fax groups
+4 NEW XMCNT,XMNODE
+5 SET XMCNT=0
+6 ; local, remote, & fax members
FOR XMNODE=1,6,8
Begin DoDot:1
+7 if '$DATA(^XMB(3.8,XMIEN,XMNODE,0))
QUIT
+8 SET XMCNT=XMCNT+$PIECE($GET(^XMB(3.8,XMIEN,XMNODE,0)),U,4)
End DoDot:1
+9 QUIT XMCNT'<XMBIGGRP
LATERIT(XMFULL,XMLATER) ;
+1 NEW DIR,X,Y,DIRUT
+2 ;This group seems to be fairly big. If you don't need to 'minus'
+3 ;anyone from it, then you can save some time by queuing it for 'Later'
+4 ;delivery. Would you like to queue this group for later delivery
+5 DO BLD^DIALOG(39138,"","","DIR(""A"")")
+6 SET DIR(0)="Y"
+7 ;No
SET DIR("B")=$$EZBLD^DIALOG(39053)
+8 ;Answer NO if
+9 ; - You need to delete any group members from the message.
+10 ;Answer YES if
+11 ; - You don't need to delete any group members from the message
+12 ; - and you'd like to save a bit of time.
+13 DO BLD^DIALOG(39139,"","","DIR(""?"")")
+14 DO ^DIR
IF $DATA(DIRUT)
Begin DoDot:1
+15 ;up-arrow or time out.
DO SETERR^XMXADDR4(0,"",37002)
+16 ;removed from recipient list.
DO EN^DDIOL(XMFULL_$$EZBLD^DIALOG(39015))
End DoDot:1
QUIT
+17 if 'Y
QUIT
+18 SET XMLATER="?"
+19 QUIT
EXPGROUP(XMDUZ,XMG,XMGREC,XMSTRIKE,XMPREFIX,XMLATER,XMGCIRCL) ;
+1 ;Q:'$$AUTHGRP(XMDUZ,XMG,XMGREC)
+2 SET XMGCIRCL(XMG)=""
+3 ; # references to group^date last ref'd
SET $PIECE(^XMB(3.8,XMG,0),U,4,5)=$PIECE(XMGREC,U,4)+1_U_DT
+4 IF $GET(XMIA)
Begin DoDot:1
+5 WRITE !
+6 ;Local
DO DISPCNT(XMG,1,39141)
+7 ;Member Group(s)
DO DISPCNT(XMG,5,39142)
+8 ;Remote
DO DISPCNT(XMG,6,39143)
+9 ;Distribution List(s)
DO DISPCNT(XMG,7,39144)
+10 ;Fax Recipient(s)
DO DISPCNT(XMG,8,39145)
+11 ;Fax Group(s)
DO DISPCNT(XMG,9,39146)
+12 IF $X>1
WRITE ":",!
End DoDot:1
+13 DO INDIV(XMDUZ,XMG,XMSTRIKE,XMPREFIX,XMLATER)
IF XMLATER
IF '$GET(XMIA)
KILL XMGCIRCL(XMG)
QUIT
+14 DO GROUP(XMDUZ,XMG,XMSTRIKE,XMPREFIX,XMLATER,.XMGCIRCL)
IF XMLATER
IF '$GET(XMIA)
KILL XMGCIRCL(XMG)
QUIT
+15 DO REMOTE(XMDUZ,XMG,XMSTRIKE,XMPREFIX,XMLATER)
IF XMLATER
IF '$GET(XMIA)
KILL XMGCIRCL(XMG)
QUIT
+16 DO DISTR^XMXADDR4(XMDUZ,XMG,XMSTRIKE,XMPREFIX,XMLATER)
IF XMLATER
IF '$GET(XMIA)
KILL XMGCIRCL(XMG)
QUIT
+17 IF $PIECE(^XMB(1,1,0),U,19)
DO FAXGROUP^XMXADDR4(XMDUZ,XMG,XMSTRIKE,XMPREFIX,XMLATER)
IF XMLATER
IF '$GET(XMIA)
KILL XMGCIRCL(XMG)
QUIT
+18 IF $PIECE(^XMB(1,1,0),U,19)
DO FAXINDIV^XMXADDR4(XMDUZ,XMG,XMSTRIKE,XMPREFIX,XMLATER)
IF XMLATER
IF '$GET(XMIA)
KILL XMGCIRCL(XMG)
QUIT
+19 KILL XMGCIRCL(XMG)
+20 QUIT
DISPCNT(XMIEN,XMNODE,XMDESCR) ;
+1 NEW XMCNT
+2 SET XMDESCR=$$EZBLD^DIALOG(XMDESCR)
+3 SET XMCNT=$PIECE($GET(^XMB(3.8,XMIEN,XMNODE,0)),U,4)
if 'XMCNT
QUIT
+4 IF $X+3+$LENGTH(XMCNT)+$LENGTH(XMDESCR)>IOM
WRITE ",",!
+5 IF '$TEST
if $X>4
WRITE ", "
+6 WRITE XMCNT," ",XMDESCR
+7 QUIT
AUTHGRP(XMDUZ,XMG,XMGREC) ;
+1 ; Screen: Group is public OR user is owner
+2 ; OR group is unrestricted and user is member
+3 NEW XMOWNER
+4 ; Group is public
IF $PIECE(XMGREC,U,2)="PU"
QUIT 1
+5 SET XMOWNER=$PIECE(^XMB(3.8,XMG,3),U,1)
if XMOWNER=""
SET XMOWNER=.5
+6 ; User is owner of group
IF XMDUZ=XMOWNER
QUIT 1
+7 ; Group is unrestricted and user is a member
IF +$PIECE(XMGREC,U,6)=0
IF $DATA(^XMB(3.8,XMG,1,"B",XMDUZ))
QUIT 1
+8 DO SETERR^XMXADDR4($GET(XMIA),"!",39147,$PIECE(XMGREC,U,1))
+9 ;You may not access group '|1|'.
QUIT 0
INDIV(XMDUZ,XMG,XMSTRIKE,XMPREFIX,XMLATER) ;
+1 ; XMGM Group member
+2 NEW XMI,XMGM,XMCNT,XMREC,XMTYPE
+3 SET XMI=0
SET XMCNT=0
+4 FOR
SET XMI=$ORDER(^XMB(3.8,XMG,1,XMI))
if 'XMI
QUIT
SET XMREC=^(XMI,0)
Begin DoDot:1
+5 SET XMGM=$PIECE(XMREC,U,1)
SET XMTYPE=$PIECE(XMREC,U,2)
+6 ; If SHARED,MAIL or no mailbox, then delete from group.
+7 IF XMGM=.6!'$DATA(^XMB(3.7,XMGM))!'$DATA(^VA(200,XMGM,0))
DO DELETE2^XMXADDR4(XMG,1,XMI)
QUIT
+8 NEW XMFULL,XMERROR,XMFWDADD
+9 DO PERSON^XMXADDR1(XMDUZ,XMGM,"","","","",.XMFULL)
+10 IF $DATA(XMERROR)
Begin DoDot:2
+11 ; Commenting out because I'm not sure it should be reported.
+12 ;S XMFULL=$P($G(^VA(200,XMGM,0)),U,1)
+13 ;I XMFULL="" S XMFULL="USER #"_XMGM
+14 ;S ^TMP("XM",$J,"GRPERR",XMG,"L",XMFULL)=XMERROR
End DoDot:2
QUIT
+15 SET XMGMBRS=1
+16 IF 'XMLATER
DO INDIV^XMXADDR(XMDUZ,XMGM,XMSTRIKE,$SELECT(XMPREFIX'="":XMPREFIX,1:XMTYPE),XMLATER)
+17 if '$GET(XMIA)
QUIT
+18 IF XMCNT
IF XMCNT#16=0
Begin DoDot:2
+19 NEW DIR,Y
+20 ;Do you want to see more members
SET DIR("A")=$$EZBLD^DIALOG(39148)
+21 ;No
SET DIR(0)="Y"
SET DIR("B")=$$EZBLD^DIALOG(39053)
+22 DO ^DIR
+23 ; The '+' takes care of $D(DIRUT)
SET XMIA=+Y
End DoDot:2
if '$GET(XMIA)
QUIT
+24 SET XMCNT=XMCNT+1
+25 if XMCNT#4-1=0
WRITE !
+26 WRITE ?XMCNT-1#4*20,$EXTRACT($SELECT(XMPREFIX'="":XMPREFIX_":",XMTYPE="":"",1:XMTYPE_":")_XMFULL,1,19)
End DoDot:1
IF XMLATER
IF '$GET(XMIA)
QUIT
+27 QUIT
GROUP(XMDUZ,XMG,XMSTRIKE,XMPREFIX,XMLATER,XMGCIRCL) ;
+1 NEW XMIEN,XMI,XMREC,XMTYPE
+2 SET XMI=0
+3 FOR
SET XMI=$ORDER(^XMB(3.8,XMG,5,XMI))
if 'XMI
QUIT
SET XMREC=^(XMI,0)
Begin DoDot:1
+4 SET XMIEN=$PIECE(XMREC,U,1)
SET XMTYPE=$PIECE(XMREC,U,2)
+5 IF '$DATA(^XMB(3.8,XMIEN,0))
DO DELETE2^XMXADDR4(XMG,5,XMI)
QUIT
+6 SET XMREC=^XMB(3.8,XMIEN,0)
+7 if $GET(XMIA)
WRITE !,$SELECT(XMPREFIX'="":"",XMTYPE="":"",1:XMTYPE_":"),"G.",$PIECE(XMREC,U,1),":"
+8 IF $DATA(XMGCIRCL(XMIEN))
Begin DoDot:2
+9 ; Circular (infinite loop) reference! Don't go there!
+10 SET ^TMP("XM",$JOB,"GRPERR",XMG,"C",$PIECE(XMREC,U,1))=""
QUIT
+11 if '$GET(XMIASAVE)
QUIT
+12 NEW XMTEXT
+13 ;Mail group contains circular reference to G.|1|.
+14 ;Circular reference ignored.
+15 ;This circular reference should be investigated and eliminated.
+16 DO BLD^DIALOG(39140,$PIECE(XMGREC,U,1),"","XMTEXT","F")
+17 DO MSG^DIALOG("WE","","","","XMTEXT")
End DoDot:2
QUIT
+18 DO EXPGROUP(XMDUZ,XMIEN,XMREC,XMSTRIKE,$SELECT(XMPREFIX'="":XMPREFIX,1:XMTYPE),XMLATER,.XMGCIRCL)
+19 ;Finished with group |1|.
if $GET(XMIA)
WRITE !,$$EZBLD^DIALOG(39149,$PIECE(XMREC,U,1))
End DoDot:1
IF XMLATER
IF '$GET(XMIA)
QUIT
+20 QUIT
REMOTE(XMDUZ,XMG,XMSTRIKE,XMPREFIX,XMLATER) ;
+1 NEW XMGM,XMI
+2 SET XMI=0
+3 FOR
SET XMI=$ORDER(^XMB(3.8,XMG,6,XMI))
if XMI'>0
QUIT
Begin DoDot:1
+4 SET XMGM=$PIECE(^XMB(3.8,XMG,6,XMI,0),U)
+5 ; Really should delete it from the remotes.
if XMGM=""
QUIT
+6 if $GET(XMIA)
WRITE !,XMGM
+7 if XMLATER
QUIT
+8 DO DOREMOTE(XMDUZ,XMGM,XMSTRIKE,XMPREFIX,XMLATER)
End DoDot:1
IF XMLATER
IF '$GET(XMIA)
QUIT
+9 QUIT
DOREMOTE(XMDUZ,XMGM,XMSTRIKE,XMPREFIX,XMLATER) ;
+1 NEW XMERROR,XMFWDADD
+2 IF XMGM[":"
Begin DoDot:1
+3 IF XMPREFIX=""
Begin DoDot:2
+4 DO PREFIX^XMXADDR(.XMGM,.XMPREFIX)
End DoDot:2
+5 IF '$TEST
Begin DoDot:2
+6 DO PREFIX^XMXADDR(.XMGM)
End DoDot:2
+7 IF $DATA(XMERROR)
SET ^TMP("XM",$JOB,"GRPERR",XMG,"R",XMGM)=$$GETERR^XMXADDR4
End DoDot:1
if $DATA(XMERROR)
QUIT
+8 DO REMOTE^XMXADDR3(XMDUZ,XMGM,XMSTRIKE,XMPREFIX,XMLATER)
+9 IF '$DATA(XMERROR)
SET XMGMBRS=1
QUIT
+10 ;37000 - up-arrow out.
+11 ;37001 - time out.
+12 ;37002 - up-arrow or time out.
+13 ;39015.1 - Not a current recipient.
+14 ;39133 - Sender not authorized to group.
+15 IF "^37000^37001^37002^39015.1^39133^"[(U_XMERROR_U)
SET XMGMBRS=1
QUIT
+16 SET ^TMP("XM",$JOB,"GRPERR",XMG,"R",XMGM)=$$GETERR^XMXADDR4
+17 QUIT
