XMXGRP ;ISC-SF/GMB-Group creation/enrollment ;03/31/2003 13:38
;;8.0;MailMan;**16**;Jun 28, 2002
; Entry points used by MailMan options (not covered by DBIA):
; ADDMBRS - Add new members / Edit existing members
; DELMBRS - Delete existing members
; DROP - A user chooses to drop
; JOIN - A user chooses to join
;
; DBIAs:
; 1544 - Use $$ISA^USRLM (Authorization/Subscription)
ADDMBRS(XMDUZ,XMGROUP,XMMBR,XMINSTR,XMTSK) ; Add users to groups, if they aren't
; already members. This API handles adding local users, devices,
; server options, mail groups, and remote users to mail groups.
; It does not handle adding distribution lists or fax recipients
; or fax groups.
;
; Optionally, forward existing messages which are addressed to the
; groups to the users, and/or add the users to the messages, so that
; they will receive responses. (LOCAL USERS ONLY!)
; XMDUZ - The user who is doing this. Must be authorized to edit
; the mail groups.
; XMGROUP - The name or IEN (or list of same) of the groups.
; XMMBR - The user (or list of users) to add to the groups.
; XMINSTR - Special instructions
; ("FLAGS") - Flags, may contain any combination of the following:
; "A" - Add users to messages, but don't forward.
; (Messages will be delivered the next time
; someone replies, and users will be able to
; Query/Search for them at any time.)
; "F" - Forward messages to users, if the users aren't
; already on the messages.
; Closed messages will be ignored. Users will not be
; added to them.
; Note: If FLAGS contains only an "A", then FDATE and TDATE apply.
; If FLAGS contains only an "F", then FDATE and TDATE apply.
; If FLAGS contains "A" and "F", then messages from FDATE thru
; TDATE will be "F"orwarded, and all other messages will have
; the users "A"dded to them, without forwarding.
; Note: Currently, FLAGS may not contain "A". We don't yet have a way
; to mark users (recipients) who have been added to a message, but will
; not receive them until someone replies on the message, or until the
; user searches for them and reads them. This is a problem, because
; if someone does a QD on them, they have no idea why these recipients
; haven't read the message. Perhaps we could mark them 'Parked until
; next reply.' That would require a new field, and other routines would
; have to be aware of and handle this new field. Until that happens,
; we are stripping any "A" from XMINSTR("FLAGS").
; ("FDATE") - Add users to messages originating on or after this
; date. Must be FM format. Default is from the
; beginning of time. Used in conjunction with FLAGS.
; ("TDATE") - Add users to messages originating on or before this
; date. Must be FM format. Default is to the present.
; Used in conjunction with FLAGS.
; XMTSK Output task number
N XMGRP,XMTO,XMCUT
D CHKGRPS(XMDUZ,.XMGROUP,.XMGRP) Q:'$D(XMGRP)
D CHKMBRS(XMDUZ,.XMMBR) Q:'$D(^TMP("XMY0",$J))
D ADD2GRPS(.XMGRP,.XMTO,.XMINSTR)
Q:'$D(XMTO) ; Quit if no local users added to groups.
Q:'$D(XMINSTR("FLAGS"))
I $G(XMINSTR("FDATE"),$O(^XMB(3.9,"C",2500000)))>$G(XMINSTR("TDATE"),DT) Q ; Quit if 'from' date is greater than 'to' date.
S XMCUT=$P(^XMB(3.7,XMDUZ,0),U,7)
I XMCUT>$G(XMINSTR("FDATE")) D
. S XMINSTR("FDATE")=XMCUT
. D ERRSET^XMXUTIL(37100,$$FMTE^XLFDT(XMCUT,5))
. ; You may not access any message prior to |1| unless someone forwards
. ; it to you.
D FAFMSGS^XMXGRP1(XMDUZ,.XMGRP,.XMTO,.XMINSTR,.XMTSK)
Q
CHKGRPS(XMDUZ,XMGROUP,XMGRP) ;
I $G(XMGROUP)]"",$O(XMGROUP(""))="" D Q
. D CHKGRP(XMDUZ,XMGROUP,.XMGRP)
N XMI
S XMI=""
F S XMI=$O(XMGROUP(XMI)) Q:XMI="" D
. D CHKGRP(XMDUZ,XMI,.XMGRP)
Q
CHKGRP(XMDUZ,XMGROUP,XMGRP) ;
N XMGNAME,XMGIEN,XMABORT
S XMABORT=0
D GRPOK(XMGROUP,.XMGNAME,.XMGIEN,.XMABORT) Q:XMABORT
D AUTHOK(XMDUZ,.XMGIEN,.XMABORT) Q:XMABORT
S XMGRP(XMGNAME)=XMGIEN
Q
GRPOK(XMGROUP,XMGNAME,XMGIEN,XMABORT) ;
; make sure group name is good, translate to group ien.
S XMGIEN=$$IEN^XMXAPIG(XMGROUP) I 'XMGIEN S XMABORT=1 Q
S XMGNAME=$$NAME^XMXAPIG(XMGIEN)
Q
AUTHOK(XMDUZ,XMGIEN,XMABORT) ;
; make sure user is authorized to add members to group.
N XMOK
S XMOK=0
I $T(ISA^USRLM)'="" S XMOK=$$ISA^USRLM(DUZ,"CLINICAL COORDINATOR") ; CAC?
I $D(^XUSEC("XMMGR",DUZ))!$D(^XUSEC("XM GROUP EDIT MASTER",DUZ))!XMOK I $S($P(^XMB(3.8,XMGIEN,0),U,2)="PU":1,'$P(^(0),U,6):1,1:0) Q ; If holds proper key, then group must be public or (private and) unrestricted.
I $D(^XMB(3.8,"AC",XMDUZ,XMGIEN)) Q ; User is coordinator
I $P($G(^XMB(3.8,XMGIEN,3)),U,1)=XMDUZ Q ; User is organizer
S XMABORT=1
N XMP
S XMP("PARAM","ID")="XMGROUP"
S XMP("PARAM","VALUE")=$$NAME^XMXAPIG(XMGIEN)
; You are not authorized to edit this mail group
D ERRSET^XMXUTIL(38200,.XMP)
Q
CHKMBRS(XMDUZ,XMMBR) ; Check the users to add.
N XMINSTR
D INIT^XMXADDR
S XMINSTR("ADDR FLAGS")="XY" ; Create only the ^TMP("XMY0") global.
D CHKADDR^XMXADDR(XMDUZ,.XMMBR,.XMINSTR)
Q:$D(^TMP("XMY0",$J))
D CLEANUP^XMXADDR
Q
ADD2GRPS(XMGRP,XMTO,XMINSTR) ; See if members already in the groups.
; If not, add them
; >> Question: May a broadcast or limited broadcast be added to a group?
N XMGN,XMGI,XMM,XMTRKNEW
S (XMGN,XMM)=""
F S XMGN=$O(XMGRP(XMGN)) Q:XMGN="" S XMGI=XMGRP(XMGN) D
. N XMNEWMBR
. F S XMM=$O(^TMP("XMY0",$J,XMM)) Q:XMM="" D
. . D AM(XMGI,XMM,^TMP("XMY0",$J,XMM),$G(^(XMM,1),"@"),.XMTO,.XMINSTR)
; If we added a member group, shouldn't we also forward the msgs to
; local members of the group, too?
D CLEANUP^XMXADDR
Q
AM(XMG,XMM,XMMIEN,XMTYPE,XMTO,XMINSTR) ; Add/edit a member (not delete)
N XMFDA,XMIEN,XMMULT,XMABORT
S XMABORT=0
D AMINIT(XMG,.XMM,XMMIEN,.XMMULT,.XMABORT) Q:$G(XMABORT)
S XMFDA(XMMULT,"?+1,"_XMG_",",.01)=XMM
S XMFDA(XMMULT,"?+1,"_XMG_",",1)=XMTYPE
I "AF"[$G(XMINSTR("FLAGS"),U),XMMULT=3.81 S XMTO($S(XMTYPE?1U:XMTYPE_":",1:"")_XMM)=""
D UPDATE^DIE("","XMFDA","XMIEN")
;I XMIEN(1,0)="+" S XMCNT=$G(XMCNT)+1
; Need to create array showing which were added and which were edited.
; Counts for each.
Q
AMINIT(XMG,XMM,XMMIEN,XMMULT,XMABORT) ;
I XMM["@" S XMMULT=3.812 Q ; Remote member
I ".D.H.S."[("."_$E(XMM,1,2)) D Q
. S XMMULT=3.812 ; Remote member
. S XMM=XMM_"@"_^XMB("NETNAME")
I $E(XMM,1,2)="G." D Q
. I XMMIEN=XMG D Q
. . S XMABORT=1
. . ; Group cannot be a member of itself.
. S XMM=XMMIEN
. S XMMULT=3.811 ; Group member
S XMM=XMMIEN
S XMMULT=3.81 ; Local member
Q
JOIN(XMDUZ,XMGROUP,XMINSTR,XMTSK) ; User chooses to join a group.
; XMGROUP - The name (or IEN) of the group. (Just one group!)
; XMINSTR - Special instructions. See ADDMBR, above
; Also, if XMINSTR("FLAGS")["F", may specify:
; ("SELF BSKT") - direct forwarded messages to a specific basket.
N XMABORT,XMGNAME,XMGIEN,XMTYPE,XMSELF,XMMBR
S XMABORT=0
D GRPOK(XMGROUP,.XMGNAME,.XMGIEN,.XMABORT) Q:XMABORT
D GRPINFO(XMDUZ,XMGIEN,.XMTYPE,.XMSELF,.XMMBR,.XMABORT) Q:XMABORT
I 'XMMBR D Q:XMABORT
. I 'XMSELF D Q
. . S XMABORT=1
. . N XMP
. . S XMP("PARAM","ID")="XMGROUP"
. . S XMP("PARAM","VALUE")=XMGNAME
. . D ERRSET^XMXUTIL(38022,.XMP) ; Self enrollment not allowed.
. N XMFDA ; Add user to group.
. S XMFDA(3.81,"?+1,"_XMGIEN_",",.01)=XMDUZ
. D UPDATE^DIE("","XMFDA")
Q:'$D(XMINSTR("FLAGS"))
D FAFMSGS^XMXGRP1(XMDUZ,XMGNAME,XMDUZ,.XMINSTR,.XMTSK)
Q
DROP(XMDUZ,XMGROUP) ; User chooses to drop from a group.
; XMGROUP - The name (or IEN) of the group.
N XMABORT,XMGNAME,XMGIEN,XMTYPE,XMSELF,XMMBR
S XMABORT=0
D GRPOK(XMGROUP,.XMGNAME,.XMGIEN,.XMABORT) Q:XMABORT
D GRPINFO(XMDUZ,XMGIEN,.XMTYPE,.XMSELF,.XMMBR,.XMABORT) Q:XMABORT
I XMMBR D
. I 'XMSELF,'$P($G(^XMB(1,1,2)),U,2) D Q
. . S XMABORT=1
. . N XMP
. . S XMP("PARAM","ID")="XMGROUP"
. . S XMP("PARAM","VALUE")=XMGNAME
. . D ERRSET^XMXUTIL(38022.1,.XMP) ; Self dis-enrollment not allowed.
. N DIR,X,Y,DA,DIK ; Drop user from group.
. S DA(1)=XMGIEN,DA=XMMBR,DIK="^XMB(3.8,"_XMGIEN_",1,"
. D ^DIK
Q
GRPINFO(XMDUZ,XMGIEN,XMTYPE,XMSELF,XMMBR,XMABORT) ;
N XMREC
S XMMBR=+$O(^XMB(3.8,XMGIEN,1,"B",XMDUZ,0)) ; Is user a member?
S XMREC=^XMB(3.8,XMGIEN,0)
S XMSELF=($P(XMREC,U,3)="y") ; Self enrollment allowed?
S XMTYPE=$P(XMREC,U,2) ; Public or Private?
I XMTYPE="PU"
E I XMTYPE="PR" D
. Q:XMMBR
. S XMABORT=1
. N XMP
. S XMP("PARAM","ID")="XMGROUP"
. S XMP("PARAM","VALUE")=$P(XMREC,U,1)
. D ERRSET^XMXUTIL(38201) ; Group is private.
;E D
;. S XMABORT=1
;. D ERRSET^XMXUTIL() ; Group must be designated as PUBLIC or PRIVATE.
Q
ADD2GRPZ(XMGRP,XMMBR,XMTO) ; See if members already in the groups.
; If not, add them
N XMGN,XMGI,XMM,XMTRKNEW
S (XMGN,XMM)="",XMTRKNEW=1
F S XMGN=$O(XMGRP(XMGN)) Q:XMGN="" S XMGI=XMGRP(XMGN) D
. N XMNEWMBR
. F S XMM=$O(XMMBR(XMM)) Q:XMM="" D
. . D AMZ(XMGI,XMMBR(XMM),$G(XMMBR(XMM,1),"@"),.XMTO)
. I $G(XMNEWMBR) D NOTIFY^XMXGRP1(XMGI,.XMNEWMBR)
Q
AMZ(XMG,XMM,XMTYPE,XMTO) ; Add/edit a member (not delete)
N XMFDA,XMIEN
S XMFDA(3.81,"?+1,"_XMG_",",.01)=XMM
S XMFDA(3.81,"?+1,"_XMG_",",1)=XMTYPE
S XMTO($S(XMTYPE?1U:XMTYPE_":",1:"")_XMM)=""
D UPDATE^DIE("","XMFDA","XMIEN")
;I XMIEN(1,0)="+" S XMCNT=$G(XMCNT)+1
; Need to create array showing which were added and which were edited.
; Counts for each.
Q
XMXGRP ;ISC-SF/GMB-Group creation/enrollment ;03/31/2003 13:38
+1 ;;8.0;MailMan;**16**;Jun 28, 2002
+2 ; Entry points used by MailMan options (not covered by DBIA):
+3 ; ADDMBRS - Add new members / Edit existing members
+4 ; DELMBRS - Delete existing members
+5 ; DROP - A user chooses to drop
+6 ; JOIN - A user chooses to join
+7 ;
+8 ; DBIAs:
+9 ; 1544 - Use $$ISA^USRLM (Authorization/Subscription)
ADDMBRS(XMDUZ,XMGROUP,XMMBR,XMINSTR,XMTSK) ; Add users to groups, if they aren't
+1 ; already members. This API handles adding local users, devices,
+2 ; server options, mail groups, and remote users to mail groups.
+3 ; It does not handle adding distribution lists or fax recipients
+4 ; or fax groups.
+5 ;
+6 ; Optionally, forward existing messages which are addressed to the
+7 ; groups to the users, and/or add the users to the messages, so that
+8 ; they will receive responses. (LOCAL USERS ONLY!)
+9 ; XMDUZ - The user who is doing this. Must be authorized to edit
+10 ; the mail groups.
+11 ; XMGROUP - The name or IEN (or list of same) of the groups.
+12 ; XMMBR - The user (or list of users) to add to the groups.
+13 ; XMINSTR - Special instructions
+14 ; ("FLAGS") - Flags, may contain any combination of the following:
+15 ; "A" - Add users to messages, but don't forward.
+16 ; (Messages will be delivered the next time
+17 ; someone replies, and users will be able to
+18 ; Query/Search for them at any time.)
+19 ; "F" - Forward messages to users, if the users aren't
+20 ; already on the messages.
+21 ; Closed messages will be ignored. Users will not be
+22 ; added to them.
+23 ; Note: If FLAGS contains only an "A", then FDATE and TDATE apply.
+24 ; If FLAGS contains only an "F", then FDATE and TDATE apply.
+25 ; If FLAGS contains "A" and "F", then messages from FDATE thru
+26 ; TDATE will be "F"orwarded, and all other messages will have
+27 ; the users "A"dded to them, without forwarding.
+28 ; Note: Currently, FLAGS may not contain "A". We don't yet have a way
+29 ; to mark users (recipients) who have been added to a message, but will
+30 ; not receive them until someone replies on the message, or until the
+31 ; user searches for them and reads them. This is a problem, because
+32 ; if someone does a QD on them, they have no idea why these recipients
+33 ; haven't read the message. Perhaps we could mark them 'Parked until
+34 ; next reply.' That would require a new field, and other routines would
+35 ; have to be aware of and handle this new field. Until that happens,
+36 ; we are stripping any "A" from XMINSTR("FLAGS").
+37 ; ("FDATE") - Add users to messages originating on or after this
+38 ; date. Must be FM format. Default is from the
+39 ; beginning of time. Used in conjunction with FLAGS.
+40 ; ("TDATE") - Add users to messages originating on or before this
+41 ; date. Must be FM format. Default is to the present.
+42 ; Used in conjunction with FLAGS.
+43 ; XMTSK Output task number
+44 NEW XMGRP,XMTO,XMCUT
+45 DO CHKGRPS(XMDUZ,.XMGROUP,.XMGRP)
IF '$DATA(XMGRP)
QUIT
+46 DO CHKMBRS(XMDUZ,.XMMBR)
IF '$DATA(^TMP("XMY0",$JOB))
QUIT
+47 DO ADD2GRPS(.XMGRP,.XMTO,.XMINSTR)
+48 ; Quit if no local users added to groups.
IF '$DATA(XMTO)
QUIT
+49 IF '$DATA(XMINSTR("FLAGS"))
QUIT
+50 ; Quit if 'from' date is greater than 'to' date.
IF $GET(XMINSTR("FDATE"),$ORDER(^XMB(3.9,"C",2500000)))>$GET(XMINSTR("TDATE"),DT)
QUIT
+51 SET XMCUT=$PIECE(^XMB(3.7,XMDUZ,0),U,7)
+52 IF XMCUT>$GET(XMINSTR("FDATE"))
Begin DoDot:1
+53 SET XMINSTR("FDATE")=XMCUT
+54 DO ERRSET^XMXUTIL(37100,$$FMTE^XLFDT(XMCUT,5))
+55 ; You may not access any message prior to |1| unless someone forwards
+56 ; it to you.
End DoDot:1
+57 DO FAFMSGS^XMXGRP1(XMDUZ,.XMGRP,.XMTO,.XMINSTR,.XMTSK)
+58 QUIT
CHKGRPS(XMDUZ,XMGROUP,XMGRP) ;
+1 IF $GET(XMGROUP)]""
IF $ORDER(XMGROUP(""))=""
Begin DoDot:1
+2 DO CHKGRP(XMDUZ,XMGROUP,.XMGRP)
End DoDot:1
QUIT
+3 NEW XMI
+4 SET XMI=""
+5 FOR
SET XMI=$ORDER(XMGROUP(XMI))
IF XMI=""
QUIT
Begin DoDot:1
+6 DO CHKGRP(XMDUZ,XMI,.XMGRP)
End DoDot:1
+7 QUIT
CHKGRP(XMDUZ,XMGROUP,XMGRP) ;
+1 NEW XMGNAME,XMGIEN,XMABORT
+2 SET XMABORT=0
+3 DO GRPOK(XMGROUP,.XMGNAME,.XMGIEN,.XMABORT)
IF XMABORT
QUIT
+4 DO AUTHOK(XMDUZ,.XMGIEN,.XMABORT)
IF XMABORT
QUIT
+5 SET XMGRP(XMGNAME)=XMGIEN
+6 QUIT
GRPOK(XMGROUP,XMGNAME,XMGIEN,XMABORT) ;
+1 ; make sure group name is good, translate to group ien.
+2 SET XMGIEN=$$IEN^XMXAPIG(XMGROUP)
IF 'XMGIEN
SET XMABORT=1
QUIT
+3 SET XMGNAME=$$NAME^XMXAPIG(XMGIEN)
+4 QUIT
AUTHOK(XMDUZ,XMGIEN,XMABORT) ;
+1 ; make sure user is authorized to add members to group.
+2 NEW XMOK
+3 SET XMOK=0
+4 ; CAC?
IF $TEXT(ISA^USRLM)'=""
SET XMOK=$$ISA^USRLM(DUZ,"CLINICAL COORDINATOR")
+5 ; If holds proper key, then group must be public or (private and) unrestricted.
IF $DATA(^XUSEC("XMMGR",DUZ))!$DATA(^XUSEC("XM GROUP EDIT MASTER",DUZ))!XMOK
IF $SELECT($PIECE(^XMB(3.8,XMGIEN,0),U,2)="PU":1,'$PIECE(^(0),U,6):1,1:0)
QUIT
+6 ; User is coordinator
IF $DATA(^XMB(3.8,"AC",XMDUZ,XMGIEN))
QUIT
+7 ; User is organizer
IF $PIECE($GET(^XMB(3.8,XMGIEN,3)),U,1)=XMDUZ
QUIT
+8 SET XMABORT=1
+9 NEW XMP
+10 SET XMP("PARAM","ID")="XMGROUP"
+11 SET XMP("PARAM","VALUE")=$$NAME^XMXAPIG(XMGIEN)
+12 ; You are not authorized to edit this mail group
+13 DO ERRSET^XMXUTIL(38200,.XMP)
+14 QUIT
CHKMBRS(XMDUZ,XMMBR) ; Check the users to add.
+1 NEW XMINSTR
+2 DO INIT^XMXADDR
+3 ; Create only the ^TMP("XMY0") global.
SET XMINSTR("ADDR FLAGS")="XY"
+4 DO CHKADDR^XMXADDR(XMDUZ,.XMMBR,.XMINSTR)
+5 IF $DATA(^TMP("XMY0",$JOB))
QUIT
+6 DO CLEANUP^XMXADDR
+7 QUIT
ADD2GRPS(XMGRP,XMTO,XMINSTR) ; See if members already in the groups.
+1 ; If not, add them
+2 ; >> Question: May a broadcast or limited broadcast be added to a group?
+3 NEW XMGN,XMGI,XMM,XMTRKNEW
+4 SET (XMGN,XMM)=""
+5 FOR
SET XMGN=$ORDER(XMGRP(XMGN))
IF XMGN=""
QUIT
SET XMGI=XMGRP(XMGN)
Begin DoDot:1
+6 NEW XMNEWMBR
+7 FOR
SET XMM=$ORDER(^TMP("XMY0",$JOB,XMM))
IF XMM=""
QUIT
Begin DoDot:2
+8 DO AM(XMGI,XMM,^TMP("XMY0",$JOB,XMM),$GET(^(XMM,1),"@"),.XMTO,.XMINSTR)
End DoDot:2
End DoDot:1
+9 ; If we added a member group, shouldn't we also forward the msgs to
+10 ; local members of the group, too?
+11 DO CLEANUP^XMXADDR
+12 QUIT
AM(XMG,XMM,XMMIEN,XMTYPE,XMTO,XMINSTR) ; Add/edit a member (not delete)
+1 NEW XMFDA,XMIEN,XMMULT,XMABORT
+2 SET XMABORT=0
+3 DO AMINIT(XMG,.XMM,XMMIEN,.XMMULT,.XMABORT)
IF $GET(XMABORT)
QUIT
+4 SET XMFDA(XMMULT,"?+1,"_XMG_",",.01)=XMM
+5 SET XMFDA(XMMULT,"?+1,"_XMG_",",1)=XMTYPE
+6 IF "AF"[$GET(XMINSTR("FLAGS"),U)
IF XMMULT=3.81
SET XMTO($SELECT(XMTYPE?1U:XMTYPE_":",1:"")_XMM)=""
+7 DO UPDATE^DIE("","XMFDA","XMIEN")
+8 ;I XMIEN(1,0)="+" S XMCNT=$G(XMCNT)+1
+9 ; Need to create array showing which were added and which were edited.
+10 ; Counts for each.
+11 QUIT
AMINIT(XMG,XMM,XMMIEN,XMMULT,XMABORT) ;
+1 ; Remote member
IF XMM["@"
SET XMMULT=3.812
QUIT
+2 IF ".D.H.S."[("."_$EXTRACT(XMM,1,2))
Begin DoDot:1
+3 ; Remote member
SET XMMULT=3.812
+4 SET XMM=XMM_"@"_^XMB("NETNAME")
End DoDot:1
QUIT
+5 IF $EXTRACT(XMM,1,2)="G."
Begin DoDot:1
+6 IF XMMIEN=XMG
Begin DoDot:2
+7 SET XMABORT=1
+8 ; Group cannot be a member of itself.
End DoDot:2
QUIT
+9 SET XMM=XMMIEN
+10 ; Group member
SET XMMULT=3.811
End DoDot:1
QUIT
+11 SET XMM=XMMIEN
+12 ; Local member
SET XMMULT=3.81
+13 QUIT
JOIN(XMDUZ,XMGROUP,XMINSTR,XMTSK) ; User chooses to join a group.
+1 ; XMGROUP - The name (or IEN) of the group. (Just one group!)
+2 ; XMINSTR - Special instructions. See ADDMBR, above
+3 ; Also, if XMINSTR("FLAGS")["F", may specify:
+4 ; ("SELF BSKT") - direct forwarded messages to a specific basket.
+5 NEW XMABORT,XMGNAME,XMGIEN,XMTYPE,XMSELF,XMMBR
+6 SET XMABORT=0
+7 DO GRPOK(XMGROUP,.XMGNAME,.XMGIEN,.XMABORT)
IF XMABORT
QUIT
+8 DO GRPINFO(XMDUZ,XMGIEN,.XMTYPE,.XMSELF,.XMMBR,.XMABORT)
IF XMABORT
QUIT
+9 IF 'XMMBR
Begin DoDot:1
+10 IF 'XMSELF
Begin DoDot:2
+11 SET XMABORT=1
+12 NEW XMP
+13 SET XMP("PARAM","ID")="XMGROUP"
+14 SET XMP("PARAM","VALUE")=XMGNAME
+15 ; Self enrollment not allowed.
DO ERRSET^XMXUTIL(38022,.XMP)
End DoDot:2
QUIT
+16 ; Add user to group.
NEW XMFDA
+17 SET XMFDA(3.81,"?+1,"_XMGIEN_",",.01)=XMDUZ
+18 DO UPDATE^DIE("","XMFDA")
End DoDot:1
IF XMABORT
QUIT
+19 IF '$DATA(XMINSTR("FLAGS"))
QUIT
+20 DO FAFMSGS^XMXGRP1(XMDUZ,XMGNAME,XMDUZ,.XMINSTR,.XMTSK)
+21 QUIT
DROP(XMDUZ,XMGROUP) ; User chooses to drop from a group.
+1 ; XMGROUP - The name (or IEN) of the group.
+2 NEW XMABORT,XMGNAME,XMGIEN,XMTYPE,XMSELF,XMMBR
+3 SET XMABORT=0
+4 DO GRPOK(XMGROUP,.XMGNAME,.XMGIEN,.XMABORT)
IF XMABORT
QUIT
+5 DO GRPINFO(XMDUZ,XMGIEN,.XMTYPE,.XMSELF,.XMMBR,.XMABORT)
IF XMABORT
QUIT
+6 IF XMMBR
Begin DoDot:1
+7 IF 'XMSELF
IF '$PIECE($GET(^XMB(1,1,2)),U,2)
Begin DoDot:2
+8 SET XMABORT=1
+9 NEW XMP
+10 SET XMP("PARAM","ID")="XMGROUP"
+11 SET XMP("PARAM","VALUE")=XMGNAME
+12 ; Self dis-enrollment not allowed.
DO ERRSET^XMXUTIL(38022.1,.XMP)
End DoDot:2
QUIT
+13 ; Drop user from group.
NEW DIR,X,Y,DA,DIK
+14 SET DA(1)=XMGIEN
SET DA=XMMBR
SET DIK="^XMB(3.8,"_XMGIEN_",1,"
+15 DO ^DIK
End DoDot:1
+16 QUIT
GRPINFO(XMDUZ,XMGIEN,XMTYPE,XMSELF,XMMBR,XMABORT) ;
+1 NEW XMREC
+2 ; Is user a member?
SET XMMBR=+$ORDER(^XMB(3.8,XMGIEN,1,"B",XMDUZ,0))
+3 SET XMREC=^XMB(3.8,XMGIEN,0)
+4 ; Self enrollment allowed?
SET XMSELF=($PIECE(XMREC,U,3)="y")
+5 ; Public or Private?
SET XMTYPE=$PIECE(XMREC,U,2)
+6 IF XMTYPE="PU"
+7 IF '$TEST
IF XMTYPE="PR"
Begin DoDot:1
+8 IF XMMBR
QUIT
+9 SET XMABORT=1
+10 NEW XMP
+11 SET XMP("PARAM","ID")="XMGROUP"
+12 SET XMP("PARAM","VALUE")=$PIECE(XMREC,U,1)
+13 ; Group is private.
DO ERRSET^XMXUTIL(38201)
End DoDot:1
+14 ;E D
+15 ;. S XMABORT=1
+16 ;. D ERRSET^XMXUTIL() ; Group must be designated as PUBLIC or PRIVATE.
+17 QUIT
ADD2GRPZ(XMGRP,XMMBR,XMTO) ; See if members already in the groups.
+1 ; If not, add them
+2 NEW XMGN,XMGI,XMM,XMTRKNEW
+3 SET (XMGN,XMM)=""
SET XMTRKNEW=1
+4 FOR
SET XMGN=$ORDER(XMGRP(XMGN))
IF XMGN=""
QUIT
SET XMGI=XMGRP(XMGN)
Begin DoDot:1
+5 NEW XMNEWMBR
+6 FOR
SET XMM=$ORDER(XMMBR(XMM))
IF XMM=""
QUIT
Begin DoDot:2
+7 DO AMZ(XMGI,XMMBR(XMM),$GET(XMMBR(XMM,1),"@"),.XMTO)
End DoDot:2
+8 IF $GET(XMNEWMBR)
DO NOTIFY^XMXGRP1(XMGI,.XMNEWMBR)
End DoDot:1
+9 QUIT
AMZ(XMG,XMM,XMTYPE,XMTO) ; Add/edit a member (not delete)
+1 NEW XMFDA,XMIEN
+2 SET XMFDA(3.81,"?+1,"_XMG_",",.01)=XMM
+3 SET XMFDA(3.81,"?+1,"_XMG_",",1)=XMTYPE
+4 SET XMTO($SELECT(XMTYPE?1U:XMTYPE_":",1:"")_XMM)=""
+5 DO UPDATE^DIE("","XMFDA","XMIEN")
+6 ;I XMIEN(1,0)="+" S XMCNT=$G(XMCNT)+1
+7 ; Need to create array showing which were added and which were edited.
+8 ; Counts for each.
+9 QUIT
