- 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 Jan 18, 2025@03:15:02 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