- 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 Feb 18, 2025@23:40 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