XMVGROUP ;ISC-SF/GMB-Group creation/enrollment ;04/15/2003 12:50
;;8.0;MailMan;**18**;Jun 28, 2002
; Replaces JOIN, ENT^XMA7G & ^XMA7G1 (ISC-WASH/RJ/THM/CAP/JA)
; Entry points used by MailMan options (not covered by DBIA):
; EDITMG XMEDITMG - Mail Group Edit
; ENROLL XMENROLL - Enroll in / Disenroll from a group
; LCOORD XMMGR-MAIL-GRP-COORDINATOR
; RCOORD XMMGR-MAIL-GRP-COORD-W/REMOTES
; PERSONAL XMEDITPERSGROUP - Edit user's personal group.
;
; DBIAs:
; 1544 - Use $$ISA^USRLM (Authorization/Subscription)
ENROLL ; Enroll in / Disenroll from a group
N DIC,Y,XMABORT,XMIEN,XMSELF,XMIA
S XMABORT=0
S:'$D(XMDUZ) XMDUZ=DUZ
S XMSELF=+$P($G(^XMB(1,1,2)),U,2) ; Is self-disenrollment allowed in a non-self enrolling mail group?
F D Q:XMABORT
. S DIC="^XMB(3.8,",DIC(0)="AEQMZ"
. S DIC("S")="I $S($P(^(0),U,2)=""PU"":1,$D(^XMB(3.8,+Y,1,""B"",XMDUZ)):1,1:0)"
. S DIC("W")="W:$D(^XMB(3.8,+Y,1,""B"",XMDUZ)) ?35,"""_$$EZBLD^DIALOG(38020)_""" I $P(^XMB(3.8,+Y,0),U,3)'=""y"" W ?43,"""_$$EZBLD^DIALOG(38021)_"""" ; Member / ...Self Enrollment Not Allowed.
. W !
. D ^DIC I Y<0 S XMABORT=1 Q
. S XMIEN=+Y
. I $D(^XMB(3.8,XMIEN,1,"B",XMDUZ)) D Q
. . I $P(^XMB(3.8,XMIEN,0),U,3)'="y",'XMSELF W !,$$EZBLD^DIALOG(38022.1) Q ;Self enrollment is not allowed for this mail group.
. . D DROP(XMIEN,XMDUZ)
. I $P(^XMB(3.8,XMIEN,0),U,3)'="y" W !,$$EZBLD^DIALOG(38022) Q ;Self enrollment is not allowed for this mail group.
. D JOIN(XMIEN,XMDUZ)
Q
JOIN(XMIEN,XMDUZ) ; Enroll in a group
N XMFDA
S XMFDA(3.81,"+1,"_XMIEN_",",.01)=XMDUZ
D UPDATE^DIE("","XMFDA")
W !,$$EZBLD^DIALOG(38023) ;You are now a member.
N DIR,X,Y
S DIR(0)="Y"
; Do you want past messages to this group to be forwarded to you?
D BLD^DIALOG(38023.1,"","","DIR(""A"")")
S DIR("B")=$$EZBLD^DIALOG(39053) ; no
D BLD^DIALOG(38232,"","","DIR(""?"")")
;Answer YES to forward past mail group messages.
;You will be asked for a time frame to search,
;and then MailMan will create a task to find and forward
;existing mail group messages.
D ^DIR Q:$D(DIRUT)!'Y
N XMINSTR,XMTSK,XMABORT
I '$D(XMV) N XMV,XMDISPI,XMDUN,XMNOSEND,XMPRIV D INITAPI^XMVVITAE
S XMABORT=0,XMINSTR("FLAGS")="F"
D FWDBSKT(XMDUZ,.XMINSTR,.XMABORT) Q:XMABORT
D FWDDATES^XMVGRP(XMDUZ,.XMINSTR,.XMABORT) Q:XMABORT
D FAFMSGS^XMXGRP1(XMDUZ,$P($G(^XMB(3.8,XMIEN,0)),U,1),XMDUZ,.XMINSTR,.XMTSK)
D FWDTSK(XMTSK)
Q
FWDBSKT(XMDUZ,XMINSTR,XMABORT) ; Select basket to forward to
N XMDIC,XMK
S XMDIC("B")=$$EZBLD^DIALOG(37005) ;IN
D SELBSKT^XMJBU(XMDUZ,39022,"L",.XMDIC,.XMK) I XMK=U S XMABORT=1 Q
S XMINSTR("SELF BSKT")=XMK
Q
FWDTSK(XMTSK) ;
W !
;Task #|1| will find and forward past messages.
N XMTEXT
D BLD^DIALOG(38023.9,XMTSK,"","XMTEXT","F")
D MSG^DIALOG("WM","",IOM,"","XMTEXT")
Q
DROP(XMIEN,XMDUZ) ; Disenroll from a group
N DIR,X,Y
S DIR(0)="Y"
I $P(^XMB(3.8,XMIEN,0),U,3)'="y" D
. ;You're a member. Self enrollment is not allowed for this mail group.
. ;If you drop out, you will not be able to re-join. (To re-join later,
. ;you will have to ask the group coordinator to re-enroll you.)
. ;You are a member. Do you want to drop out
. D BLD^DIALOG(38024.1,"","","DIR(""A"")")
E D ;You are a member. Do you want to drop out
. S DIR("A")=$$EZBLD^DIALOG(38024)
S DIR("B")=$$EZBLD^DIALOG(39053) ;No
;Enter YES to remove yourself from the group; NO to remain a member.
D BLD^DIALOG(38025,"","","DIR(""?"")")
D ^DIR Q:$D(DIRUT)!'Y
K DIR,X,Y
N DA,DIK
S DA(1)=XMIEN,DA=$O(^XMB(3.8,XMIEN,1,"B",XMDUZ,0)),DIK="^XMB(3.8,"_XMIEN_",1,"
D ^DIK
W !,$$EZBLD^DIALOG(38026) ;You are no longer a member.
Q
PERSONAL ; Enter/Edit Personal Group
; See entry EDIT for info on XMIA & XMTRKNEW
N DIC,DLAYGO,X,Y,XMABORT,XMIA,XMTRKNEW
S XMABORT=0,(XMIA,XMTRKNEW)=1
S DIC="^XMB(3.8,",DIC(0)="AEQMZL",DLAYGO=3.8
; Group is private, and user is organizer
S DIC("S")="I $P(^(0),U,2)=""PR"",$P($G(^XMB(3.8,+Y,3)),U)=$G(XMDUZ,DUZ)"
F D Q:XMABORT
. W !
. D ^DIC I Y<0 S XMABORT=1 Q
. N XMDR,XMNEW
. S XMNEW=$P(Y,U,3)
. S:XMNEW XMDR="4////PR;5////"_$G(XMDUZ,DUZ)_";10////1;"
. S XMDR=$G(XMDR)_".01T;2;3" ; name, members, description
. S XMDR=XMDR_";10;12" ; restrictions, remote members
. D EDIT(+Y,XMDR,XMNEW)
Q
EDIT(XMG,DR,XMNEW) ; Edit mail group
; XMIA is used for interaction on the REMOTE MEMBER input transform
; to facilitate lookup. XMTRKNEW is used by the AC xref on the
; .01 field of the LOCAL MEMBER multiple. If local members are added
; to the group, XMNEWMBR is set by the AC xref.
N DIE,DIDEL,Y,DIC,DA,XMNEWMBR
S (DIDEL,DIE)=3.8,DA=XMG
S:$P(^XMB(1,1,0),U,19) DR=DR_";14;15" ; fax recipients, fax groups
D ^DIE
I 'XMNEW,$D(XMNEWMBR) D FWD(XMG,.XMNEWMBR)
Q
FWD(XMG,XMTO) ; Forward past mail group messages to new local members
N XMI
S XMI=""
F S XMI=$O(XMTO(XMI)) Q:'XMI K:'$D(^XMB(3.8,XMG,1,"B",XMI)) XMTO(XMI)
Q:'$D(XMTO)
I '$D(XMV) N XMV,XMDISPI,XMDUN,XMNOSEND,XMPRIV D INITAPI^XMVVITAE
D NOTIFY^XMXGRP1(XMG,.XMTO)
N XMINSTR,XMTSK,XMABORT
S XMABORT=0
D ENFWD^XMVGRP(XMDUZ,.XMINSTR,.XMABORT) Q:XMABORT
D FAFMSGS^XMXGRP1(XMDUZ,$P(^XMB(3.8,XMG,0),U,1),.XMTO,.XMINSTR,.XMTSK)
D FWDTSK(XMTSK)
Q
LAYGO(X) ; Prevent someone from adding a (private) group with the same name as a public one.
; This function is invoked by the LAYGO field of ^XMB(3.8,.01)
; Returns 1 if group X may be created; 0 if not.
N IEN,LAYGO
S IEN="",LAYGO=1
F S IEN=$O(^XMB(3.8,"B",X,IEN)) Q:IEN="" D Q:'LAYGO
. Q:$P(^XMB(3.8,IEN,0),U,2)="PR"
. S LAYGO=0 ;Can't add it because public group '|1|' already exists.
. D EN^DDIOL($$EZBLD^DIALOG(38027,X),"","!,$C(7)")
Q LAYGO
REMOTE(XMADDR,XMIA) ; Serves as input transform for 'remote member'
; Allow remote addressees or local devices or local servers
N XMERROR,XMRESTR,XMINSTR,XMFULL,XMPREFIX,DIX,DO,XMFWDADD
S XMINSTR("ADDR FLAGS")="X" ; do not create ^TMP(, just check.
I XMADDR[":" D Q:'$D(XMADDR)
. D RTYPE^XMXADDR($P(XMADDR,":")) I $D(XMERROR) K XMADDR Q
. D PREFIX^XMXADDR(.XMADDR,.XMPREFIX) I $D(XMERROR) K XMADDR Q
I XMADDR'["@",".D.d.H.h.S.s."'[("."_$E(XMADDR,1,2)),'$D(XMPREFIX) K XMADDR Q
D ADDRESS^XMXADDR(DUZ,XMADDR,.XMFULL,.XMERROR)
I $D(XMERROR) K XMADDR Q
I XMFULL'["@" D
. I ".D.H.S."[("."_$E(XMFULL,1,2)) S XMFULL=XMFULL_"@"_^XMB("NETNAME") Q
. ;I $G(XMPREFIX)'="" S XMFULL=XMFULL_"@"_^XMB("NETNAME") Q
I XMFULL'["@" D Q
. K XMADDR
. D EN^DDIOL($$EZBLD^DIALOG(38028)) ;It can't be a local address, except for Device or Server.
. I $E(XMFULL,1,2)="G." D EN^DDIOL($$EZBLD^DIALOG(38029)) ;Put the group in the MEMBER GROUP multiple.
. E D EN^DDIOL($$EZBLD^DIALOG(38030)) ;Put the person in the MEMBER multiple.
. I $G(XMPREFIX)'="" D EN^DDIOL($$EZBLD^DIALOG(38031,XMPREFIX)) ;Put '|1|' in the TYPE field.
I $G(XMPREFIX)'="" S XMFULL=XMPREFIX_":"_XMFULL
S XMADDR=XMFULL
Q
EDITMG ; Mail Group Edit
; See entry EDIT for info on XMIA & XMTRKNEW
N DIC,XMABORT,DLAYGO,X,Y,XMIA,XMTRKNEW,XMREC
S XMABORT=0,(XMIA,XMTRKNEW)=1,DLAYGO=3.8
S DIC(0)="AEQLM",DIC="^XMB(3.8,"
S DIC("S")=$$GRPSCR(0)
F D Q:XMABORT
. W !
. D ^DIC I Y<0 S XMABORT=1 Q
. N XMDR
. S XMDR=".01T;2;3" ; name, members, description
. ; type - if type is public, ask about self enrollment,
. ; else ask about restrictions.
. S XMDR=XMDR_";4;I X=""PU"" S Y=7;10;S Y=5;7"
. S XMDR=XMDR_";5:6.9" ; organizer, coordinator, authorized senders
. S XMDR=XMDR_";10.1:13.9" ; member groups, remote members, distr list
. D EDIT(+Y,XMDR,$P(Y,U,3))
Q
GRPSCR(XMCOORD) ; Who may edit a mail group?
N XMSCR,XMOK
S XMOK=0
I $T(ISA^USRLM)'="" S XMOK=$$ISA^USRLM(DUZ,"CLINICAL COORDINATOR")
I $D(^XUSEC("XMMGR",DUZ))!$D(^XUSEC("XM GROUP EDIT MASTER",DUZ))!XMOK D
. ; Screen whether group is public or (private and) unrestricted
. S XMSCR="N XMREC S XMREC=^(0) I $P(XMREC,U,2)=""PU""!'$P(XMREC,U,6)!"
E S XMSCR="I " ; Or, at the very minimum,
; Screen whether user is organizer or coordinator.
Q XMSCR_"($P($G(^XMB(3.8,+Y,3)),U,1)=$G(XMDUZ,DUZ))"_$S($G(XMCOORD):"!$D(^XMB(3.8,""AC"",$G(XMDUZ,DUZ),+Y))",1:"")
;
LCOORD ; Mail Group Coordinator edit w/o remote members
D COORD(0)
Q
RCOORD ; Mail Group Coordinator edit w/remote members
D COORD(1)
Q
COORD(XMREMOTE) ;
; See entry EDIT for info on XMIA & XMTRKNEW
N DIC,XMABORT,DLAYGO,X,Y,XMIA,XMTRKNEW
S XMABORT=0,(XMIA,XMTRKNEW)=1
S DIC(0)="AEQM",DIC="^XMB(3.8,"
S DIC("S")=$$GRPSCR(1)
F D Q:XMABORT
. W !
. D ^DIC I Y<0 S XMABORT=1 Q
. ; edit local members, member groups, & perhaps, remote members
. D EDIT(+Y,"2;11"_$S(XMREMOTE:";12",1:""),0)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMVGROUP 8718 printed Sep 23, 2025@19:49:50 Page 2
XMVGROUP ;ISC-SF/GMB-Group creation/enrollment ;04/15/2003 12:50
+1 ;;8.0;MailMan;**18**;Jun 28, 2002
+2 ; Replaces JOIN, ENT^XMA7G & ^XMA7G1 (ISC-WASH/RJ/THM/CAP/JA)
+3 ; Entry points used by MailMan options (not covered by DBIA):
+4 ; EDITMG XMEDITMG - Mail Group Edit
+5 ; ENROLL XMENROLL - Enroll in / Disenroll from a group
+6 ; LCOORD XMMGR-MAIL-GRP-COORDINATOR
+7 ; RCOORD XMMGR-MAIL-GRP-COORD-W/REMOTES
+8 ; PERSONAL XMEDITPERSGROUP - Edit user's personal group.
+9 ;
+10 ; DBIAs:
+11 ; 1544 - Use $$ISA^USRLM (Authorization/Subscription)
ENROLL ; Enroll in / Disenroll from a group
+1 NEW DIC,Y,XMABORT,XMIEN,XMSELF,XMIA
+2 SET XMABORT=0
+3 if '$DATA(XMDUZ)
SET XMDUZ=DUZ
+4 ; Is self-disenrollment allowed in a non-self enrolling mail group?
SET XMSELF=+$PIECE($GET(^XMB(1,1,2)),U,2)
+5 FOR
Begin DoDot:1
+6 SET DIC="^XMB(3.8,"
SET DIC(0)="AEQMZ"
+7 SET DIC("S")="I $S($P(^(0),U,2)=""PU"":1,$D(^XMB(3.8,+Y,1,""B"",XMDUZ)):1,1:0)"
+8 ; Member / ...Self Enrollment Not Allowed.
SET DIC("W")="W:$D(^XMB(3.8,+Y,1,""B"",XMDUZ)) ?35,"""_$$EZBLD^DIALOG(38020)_""" I $P(^XMB(3.8,+Y,0),U,3)'=""y"" W ?43,"""_$$EZBLD^DIALOG(38021)_""""
+9 WRITE !
+10 DO ^DIC
IF Y<0
SET XMABORT=1
QUIT
+11 SET XMIEN=+Y
+12 IF $DATA(^XMB(3.8,XMIEN,1,"B",XMDUZ))
Begin DoDot:2
+13 ;Self enrollment is not allowed for this mail group.
IF $PIECE(^XMB(3.8,XMIEN,0),U,3)'="y"
IF 'XMSELF
WRITE !,$$EZBLD^DIALOG(38022.1)
QUIT
+14 DO DROP(XMIEN,XMDUZ)
End DoDot:2
QUIT
+15 ;Self enrollment is not allowed for this mail group.
IF $PIECE(^XMB(3.8,XMIEN,0),U,3)'="y"
WRITE !,$$EZBLD^DIALOG(38022)
QUIT
+16 DO JOIN(XMIEN,XMDUZ)
End DoDot:1
if XMABORT
QUIT
+17 QUIT
JOIN(XMIEN,XMDUZ) ; Enroll in a group
+1 NEW XMFDA
+2 SET XMFDA(3.81,"+1,"_XMIEN_",",.01)=XMDUZ
+3 DO UPDATE^DIE("","XMFDA")
+4 ;You are now a member.
WRITE !,$$EZBLD^DIALOG(38023)
+5 NEW DIR,X,Y
+6 SET DIR(0)="Y"
+7 ; Do you want past messages to this group to be forwarded to you?
+8 DO BLD^DIALOG(38023.1,"","","DIR(""A"")")
+9 ; no
SET DIR("B")=$$EZBLD^DIALOG(39053)
+10 DO BLD^DIALOG(38232,"","","DIR(""?"")")
+11 ;Answer YES to forward past mail group messages.
+12 ;You will be asked for a time frame to search,
+13 ;and then MailMan will create a task to find and forward
+14 ;existing mail group messages.
+15 DO ^DIR
if $DATA(DIRUT)!'Y
QUIT
+16 NEW XMINSTR,XMTSK,XMABORT
+17 IF '$DATA(XMV)
NEW XMV,XMDISPI,XMDUN,XMNOSEND,XMPRIV
DO INITAPI^XMVVITAE
+18 SET XMABORT=0
SET XMINSTR("FLAGS")="F"
+19 DO FWDBSKT(XMDUZ,.XMINSTR,.XMABORT)
if XMABORT
QUIT
+20 DO FWDDATES^XMVGRP(XMDUZ,.XMINSTR,.XMABORT)
if XMABORT
QUIT
+21 DO FAFMSGS^XMXGRP1(XMDUZ,$PIECE($GET(^XMB(3.8,XMIEN,0)),U,1),XMDUZ,.XMINSTR,.XMTSK)
+22 DO FWDTSK(XMTSK)
+23 QUIT
FWDBSKT(XMDUZ,XMINSTR,XMABORT) ; Select basket to forward to
+1 NEW XMDIC,XMK
+2 ;IN
SET XMDIC("B")=$$EZBLD^DIALOG(37005)
+3 DO SELBSKT^XMJBU(XMDUZ,39022,"L",.XMDIC,.XMK)
IF XMK=U
SET XMABORT=1
QUIT
+4 SET XMINSTR("SELF BSKT")=XMK
+5 QUIT
FWDTSK(XMTSK) ;
+1 WRITE !
+2 ;Task #|1| will find and forward past messages.
+3 NEW XMTEXT
+4 DO BLD^DIALOG(38023.9,XMTSK,"","XMTEXT","F")
+5 DO MSG^DIALOG("WM","",IOM,"","XMTEXT")
+6 QUIT
DROP(XMIEN,XMDUZ) ; Disenroll from a group
+1 NEW DIR,X,Y
+2 SET DIR(0)="Y"
+3 IF $PIECE(^XMB(3.8,XMIEN,0),U,3)'="y"
Begin DoDot:1
+4 ;You're a member. Self enrollment is not allowed for this mail group.
+5 ;If you drop out, you will not be able to re-join. (To re-join later,
+6 ;you will have to ask the group coordinator to re-enroll you.)
+7 ;You are a member. Do you want to drop out
+8 DO BLD^DIALOG(38024.1,"","","DIR(""A"")")
End DoDot:1
+9 ;You are a member. Do you want to drop out
IF '$TEST
Begin DoDot:1
+10 SET DIR("A")=$$EZBLD^DIALOG(38024)
End DoDot:1
+11 ;No
SET DIR("B")=$$EZBLD^DIALOG(39053)
+12 ;Enter YES to remove yourself from the group; NO to remain a member.
+13 DO BLD^DIALOG(38025,"","","DIR(""?"")")
+14 DO ^DIR
if $DATA(DIRUT)!'Y
QUIT
+15 KILL DIR,X,Y
+16 NEW DA,DIK
+17 SET DA(1)=XMIEN
SET DA=$ORDER(^XMB(3.8,XMIEN,1,"B",XMDUZ,0))
SET DIK="^XMB(3.8,"_XMIEN_",1,"
+18 DO ^DIK
+19 ;You are no longer a member.
WRITE !,$$EZBLD^DIALOG(38026)
+20 QUIT
PERSONAL ; Enter/Edit Personal Group
+1 ; See entry EDIT for info on XMIA & XMTRKNEW
+2 NEW DIC,DLAYGO,X,Y,XMABORT,XMIA,XMTRKNEW
+3 SET XMABORT=0
SET (XMIA,XMTRKNEW)=1
+4 SET DIC="^XMB(3.8,"
SET DIC(0)="AEQMZL"
SET DLAYGO=3.8
+5 ; Group is private, and user is organizer
+6 SET DIC("S")="I $P(^(0),U,2)=""PR"",$P($G(^XMB(3.8,+Y,3)),U)=$G(XMDUZ,DUZ)"
+7 FOR
Begin DoDot:1
+8 WRITE !
+9 DO ^DIC
IF Y<0
SET XMABORT=1
QUIT
+10 NEW XMDR,XMNEW
+11 SET XMNEW=$PIECE(Y,U,3)
+12 if XMNEW
SET XMDR="4////PR;5////"_$GET(XMDUZ,DUZ)_";10////1;"
+13 ; name, members, description
SET XMDR=$GET(XMDR)_".01T;2;3"
+14 ; restrictions, remote members
SET XMDR=XMDR_";10;12"
+15 DO EDIT(+Y,XMDR,XMNEW)
End DoDot:1
if XMABORT
QUIT
+16 QUIT
EDIT(XMG,DR,XMNEW) ; Edit mail group
+1 ; XMIA is used for interaction on the REMOTE MEMBER input transform
+2 ; to facilitate lookup. XMTRKNEW is used by the AC xref on the
+3 ; .01 field of the LOCAL MEMBER multiple. If local members are added
+4 ; to the group, XMNEWMBR is set by the AC xref.
+5 NEW DIE,DIDEL,Y,DIC,DA,XMNEWMBR
+6 SET (DIDEL,DIE)=3.8
SET DA=XMG
+7 ; fax recipients, fax groups
if $PIECE(^XMB(1,1,0),U,19)
SET DR=DR_";14;15"
+8 DO ^DIE
+9 IF 'XMNEW
IF $DATA(XMNEWMBR)
DO FWD(XMG,.XMNEWMBR)
+10 QUIT
FWD(XMG,XMTO) ; Forward past mail group messages to new local members
+1 NEW XMI
+2 SET XMI=""
+3 FOR
SET XMI=$ORDER(XMTO(XMI))
if 'XMI
QUIT
if '$DATA(^XMB(3.8,XMG,1,"B",XMI))
KILL XMTO(XMI)
+4 if '$DATA(XMTO)
QUIT
+5 IF '$DATA(XMV)
NEW XMV,XMDISPI,XMDUN,XMNOSEND,XMPRIV
DO INITAPI^XMVVITAE
+6 DO NOTIFY^XMXGRP1(XMG,.XMTO)
+7 NEW XMINSTR,XMTSK,XMABORT
+8 SET XMABORT=0
+9 DO ENFWD^XMVGRP(XMDUZ,.XMINSTR,.XMABORT)
if XMABORT
QUIT
+10 DO FAFMSGS^XMXGRP1(XMDUZ,$PIECE(^XMB(3.8,XMG,0),U,1),.XMTO,.XMINSTR,.XMTSK)
+11 DO FWDTSK(XMTSK)
+12 QUIT
LAYGO(X) ; Prevent someone from adding a (private) group with the same name as a public one.
+1 ; This function is invoked by the LAYGO field of ^XMB(3.8,.01)
+2 ; Returns 1 if group X may be created; 0 if not.
+3 NEW IEN,LAYGO
+4 SET IEN=""
SET LAYGO=1
+5 FOR
SET IEN=$ORDER(^XMB(3.8,"B",X,IEN))
if IEN=""
QUIT
Begin DoDot:1
+6 if $PIECE(^XMB(3.8,IEN,0),U,2)="PR"
QUIT
+7 ;Can't add it because public group '|1|' already exists.
SET LAYGO=0
+8 DO EN^DDIOL($$EZBLD^DIALOG(38027,X),"","!,$C(7)")
End DoDot:1
if 'LAYGO
QUIT
+9 QUIT LAYGO
REMOTE(XMADDR,XMIA) ; Serves as input transform for 'remote member'
+1 ; Allow remote addressees or local devices or local servers
+2 NEW XMERROR,XMRESTR,XMINSTR,XMFULL,XMPREFIX,DIX,DO,XMFWDADD
+3 ; do not create ^TMP(, just check.
SET XMINSTR("ADDR FLAGS")="X"
+4 IF XMADDR[":"
Begin DoDot:1
+5 DO RTYPE^XMXADDR($PIECE(XMADDR,":"))
IF $DATA(XMERROR)
KILL XMADDR
QUIT
+6 DO PREFIX^XMXADDR(.XMADDR,.XMPREFIX)
IF $DATA(XMERROR)
KILL XMADDR
QUIT
End DoDot:1
if '$DATA(XMADDR)
QUIT
+7 IF XMADDR'["@"
IF ".D.d.H.h.S.s."'[("."_$EXTRACT(XMADDR,1,2))
IF '$DATA(XMPREFIX)
KILL XMADDR
QUIT
+8 DO ADDRESS^XMXADDR(DUZ,XMADDR,.XMFULL,.XMERROR)
+9 IF $DATA(XMERROR)
KILL XMADDR
QUIT
+10 IF XMFULL'["@"
Begin DoDot:1
+11 IF ".D.H.S."[("."_$EXTRACT(XMFULL,1,2))
SET XMFULL=XMFULL_"@"_^XMB("NETNAME")
QUIT
+12 ;I $G(XMPREFIX)'="" S XMFULL=XMFULL_"@"_^XMB("NETNAME") Q
End DoDot:1
+13 IF XMFULL'["@"
Begin DoDot:1
+14 KILL XMADDR
+15 ;It can't be a local address, except for Device or Server.
DO EN^DDIOL($$EZBLD^DIALOG(38028))
+16 ;Put the group in the MEMBER GROUP multiple.
IF $EXTRACT(XMFULL,1,2)="G."
DO EN^DDIOL($$EZBLD^DIALOG(38029))
+17 ;Put the person in the MEMBER multiple.
IF '$TEST
DO EN^DDIOL($$EZBLD^DIALOG(38030))
+18 ;Put '|1|' in the TYPE field.
IF $GET(XMPREFIX)'=""
DO EN^DDIOL($$EZBLD^DIALOG(38031,XMPREFIX))
End DoDot:1
QUIT
+19 IF $GET(XMPREFIX)'=""
SET XMFULL=XMPREFIX_":"_XMFULL
+20 SET XMADDR=XMFULL
+21 QUIT
EDITMG ; Mail Group Edit
+1 ; See entry EDIT for info on XMIA & XMTRKNEW
+2 NEW DIC,XMABORT,DLAYGO,X,Y,XMIA,XMTRKNEW,XMREC
+3 SET XMABORT=0
SET (XMIA,XMTRKNEW)=1
SET DLAYGO=3.8
+4 SET DIC(0)="AEQLM"
SET DIC="^XMB(3.8,"
+5 SET DIC("S")=$$GRPSCR(0)
+6 FOR
Begin DoDot:1
+7 WRITE !
+8 DO ^DIC
IF Y<0
SET XMABORT=1
QUIT
+9 NEW XMDR
+10 ; name, members, description
SET XMDR=".01T;2;3"
+11 ; type - if type is public, ask about self enrollment,
+12 ; else ask about restrictions.
+13 SET XMDR=XMDR_";4;I X=""PU"" S Y=7;10;S Y=5;7"
+14 ; organizer, coordinator, authorized senders
SET XMDR=XMDR_";5:6.9"
+15 ; member groups, remote members, distr list
SET XMDR=XMDR_";10.1:13.9"
+16 DO EDIT(+Y,XMDR,$PIECE(Y,U,3))
End DoDot:1
if XMABORT
QUIT
+17 QUIT
GRPSCR(XMCOORD) ; Who may edit a mail group?
+1 NEW XMSCR,XMOK
+2 SET XMOK=0
+3 IF $TEXT(ISA^USRLM)'=""
SET XMOK=$$ISA^USRLM(DUZ,"CLINICAL COORDINATOR")
+4 IF $DATA(^XUSEC("XMMGR",DUZ))!$DATA(^XUSEC("XM GROUP EDIT MASTER",DUZ))!XMOK
Begin DoDot:1
+5 ; Screen whether group is public or (private and) unrestricted
+6 SET XMSCR="N XMREC S XMREC=^(0) I $P(XMREC,U,2)=""PU""!'$P(XMREC,U,6)!"
End DoDot:1
+7 ; Or, at the very minimum,
IF '$TEST
SET XMSCR="I "
+8 ; Screen whether user is organizer or coordinator.
+9 QUIT XMSCR_"($P($G(^XMB(3.8,+Y,3)),U,1)=$G(XMDUZ,DUZ))"_$SELECT($GET(XMCOORD):"!$D(^XMB(3.8,""AC"",$G(XMDUZ,DUZ),+Y))",1:"")
+10 ;
LCOORD ; Mail Group Coordinator edit w/o remote members
+1 DO COORD(0)
+2 QUIT
RCOORD ; Mail Group Coordinator edit w/remote members
+1 DO COORD(1)
+2 QUIT
COORD(XMREMOTE) ;
+1 ; See entry EDIT for info on XMIA & XMTRKNEW
+2 NEW DIC,XMABORT,DLAYGO,X,Y,XMIA,XMTRKNEW
+3 SET XMABORT=0
SET (XMIA,XMTRKNEW)=1
+4 SET DIC(0)="AEQM"
SET DIC="^XMB(3.8,"
+5 SET DIC("S")=$$GRPSCR(1)
+6 FOR
Begin DoDot:1
+7 WRITE !
+8 DO ^DIC
IF Y<0
SET XMABORT=1
QUIT
+9 ; edit local members, member groups, & perhaps, remote members
+10 DO EDIT(+Y,"2;11"_$SELECT(XMREMOTE:";12",1:""),0)
End DoDot:1
if XMABORT
QUIT
+11 QUIT
