| 1 | XMVGROUP ;ISC-SF/GMB-Group creation/enrollment ;04/15/2003 12:50
|
|---|
| 2 | ;;8.0;MailMan;**18**;Jun 28, 2002
|
|---|
| 3 | ; Replaces JOIN, ENT^XMA7G & ^XMA7G1 (ISC-WASH/RJ/THM/CAP/JA)
|
|---|
| 4 | ; Entry points used by MailMan options (not covered by DBIA):
|
|---|
| 5 | ; EDITMG XMEDITMG - Mail Group Edit
|
|---|
| 6 | ; ENROLL XMENROLL - Enroll in / Disenroll from a group
|
|---|
| 7 | ; LCOORD XMMGR-MAIL-GRP-COORDINATOR
|
|---|
| 8 | ; RCOORD XMMGR-MAIL-GRP-COORD-W/REMOTES
|
|---|
| 9 | ; PERSONAL XMEDITPERSGROUP - Edit user's personal group.
|
|---|
| 10 | ;
|
|---|
| 11 | ; DBIAs:
|
|---|
| 12 | ; 1544 - Use $$ISA^USRLM (Authorization/Subscription)
|
|---|
| 13 | ENROLL ; Enroll in / Disenroll from a group
|
|---|
| 14 | N DIC,Y,XMABORT,XMIEN,XMSELF,XMIA
|
|---|
| 15 | S XMABORT=0
|
|---|
| 16 | S:'$D(XMDUZ) XMDUZ=DUZ
|
|---|
| 17 | S XMSELF=+$P($G(^XMB(1,1,2)),U,2) ; Is self-disenrollment allowed in a non-self enrolling mail group?
|
|---|
| 18 | F D Q:XMABORT
|
|---|
| 19 | . S DIC="^XMB(3.8,",DIC(0)="AEQMZ"
|
|---|
| 20 | . S DIC("S")="I $S($P(^(0),U,2)=""PU"":1,$D(^XMB(3.8,+Y,1,""B"",XMDUZ)):1,1:0)"
|
|---|
| 21 | . 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.
|
|---|
| 22 | . W !
|
|---|
| 23 | . D ^DIC I Y<0 S XMABORT=1 Q
|
|---|
| 24 | . S XMIEN=+Y
|
|---|
| 25 | . I $D(^XMB(3.8,XMIEN,1,"B",XMDUZ)) D Q
|
|---|
| 26 | . . 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.
|
|---|
| 27 | . . D DROP(XMIEN,XMDUZ)
|
|---|
| 28 | . I $P(^XMB(3.8,XMIEN,0),U,3)'="y" W !,$$EZBLD^DIALOG(38022) Q ;Self enrollment is not allowed for this mail group.
|
|---|
| 29 | . D JOIN(XMIEN,XMDUZ)
|
|---|
| 30 | Q
|
|---|
| 31 | JOIN(XMIEN,XMDUZ) ; Enroll in a group
|
|---|
| 32 | N XMFDA
|
|---|
| 33 | S XMFDA(3.81,"+1,"_XMIEN_",",.01)=XMDUZ
|
|---|
| 34 | D UPDATE^DIE("","XMFDA")
|
|---|
| 35 | W !,$$EZBLD^DIALOG(38023) ;You are now a member.
|
|---|
| 36 | N DIR,X,Y
|
|---|
| 37 | S DIR(0)="Y"
|
|---|
| 38 | ; Do you want past messages to this group to be forwarded to you?
|
|---|
| 39 | D BLD^DIALOG(38023.1,"","","DIR(""A"")")
|
|---|
| 40 | S DIR("B")=$$EZBLD^DIALOG(39053) ; no
|
|---|
| 41 | D BLD^DIALOG(38232,"","","DIR(""?"")")
|
|---|
| 42 | ;Answer YES to forward past mail group messages.
|
|---|
| 43 | ;You will be asked for a time frame to search,
|
|---|
| 44 | ;and then MailMan will create a task to find and forward
|
|---|
| 45 | ;existing mail group messages.
|
|---|
| 46 | D ^DIR Q:$D(DIRUT)!'Y
|
|---|
| 47 | N XMINSTR,XMTSK,XMABORT
|
|---|
| 48 | I '$D(XMV) N XMV,XMDISPI,XMDUN,XMNOSEND,XMPRIV D INITAPI^XMVVITAE
|
|---|
| 49 | S XMABORT=0,XMINSTR("FLAGS")="F"
|
|---|
| 50 | D FWDBSKT(XMDUZ,.XMINSTR,.XMABORT) Q:XMABORT
|
|---|
| 51 | D FWDDATES^XMVGRP(XMDUZ,.XMINSTR,.XMABORT) Q:XMABORT
|
|---|
| 52 | D FAFMSGS^XMXGRP1(XMDUZ,$P($G(^XMB(3.8,XMIEN,0)),U,1),XMDUZ,.XMINSTR,.XMTSK)
|
|---|
| 53 | D FWDTSK(XMTSK)
|
|---|
| 54 | Q
|
|---|
| 55 | FWDBSKT(XMDUZ,XMINSTR,XMABORT) ; Select basket to forward to
|
|---|
| 56 | N XMDIC,XMK
|
|---|
| 57 | S XMDIC("B")=$$EZBLD^DIALOG(37005) ;IN
|
|---|
| 58 | D SELBSKT^XMJBU(XMDUZ,39022,"L",.XMDIC,.XMK) I XMK=U S XMABORT=1 Q
|
|---|
| 59 | S XMINSTR("SELF BSKT")=XMK
|
|---|
| 60 | Q
|
|---|
| 61 | FWDTSK(XMTSK) ;
|
|---|
| 62 | W !
|
|---|
| 63 | ;Task #|1| will find and forward past messages.
|
|---|
| 64 | N XMTEXT
|
|---|
| 65 | D BLD^DIALOG(38023.9,XMTSK,"","XMTEXT","F")
|
|---|
| 66 | D MSG^DIALOG("WM","",IOM,"","XMTEXT")
|
|---|
| 67 | Q
|
|---|
| 68 | DROP(XMIEN,XMDUZ) ; Disenroll from a group
|
|---|
| 69 | N DIR,X,Y
|
|---|
| 70 | S DIR(0)="Y"
|
|---|
| 71 | I $P(^XMB(3.8,XMIEN,0),U,3)'="y" D
|
|---|
| 72 | . ;You're a member. Self enrollment is not allowed for this mail group.
|
|---|
| 73 | . ;If you drop out, you will not be able to re-join. (To re-join later,
|
|---|
| 74 | . ;you will have to ask the group coordinator to re-enroll you.)
|
|---|
| 75 | . ;You are a member. Do you want to drop out
|
|---|
| 76 | . D BLD^DIALOG(38024.1,"","","DIR(""A"")")
|
|---|
| 77 | E D ;You are a member. Do you want to drop out
|
|---|
| 78 | . S DIR("A")=$$EZBLD^DIALOG(38024)
|
|---|
| 79 | S DIR("B")=$$EZBLD^DIALOG(39053) ;No
|
|---|
| 80 | ;Enter YES to remove yourself from the group; NO to remain a member.
|
|---|
| 81 | D BLD^DIALOG(38025,"","","DIR(""?"")")
|
|---|
| 82 | D ^DIR Q:$D(DIRUT)!'Y
|
|---|
| 83 | K DIR,X,Y
|
|---|
| 84 | N DA,DIK
|
|---|
| 85 | S DA(1)=XMIEN,DA=$O(^XMB(3.8,XMIEN,1,"B",XMDUZ,0)),DIK="^XMB(3.8,"_XMIEN_",1,"
|
|---|
| 86 | D ^DIK
|
|---|
| 87 | W !,$$EZBLD^DIALOG(38026) ;You are no longer a member.
|
|---|
| 88 | Q
|
|---|
| 89 | PERSONAL ; Enter/Edit Personal Group
|
|---|
| 90 | ; See entry EDIT for info on XMIA & XMTRKNEW
|
|---|
| 91 | N DIC,DLAYGO,X,Y,XMABORT,XMIA,XMTRKNEW
|
|---|
| 92 | S XMABORT=0,(XMIA,XMTRKNEW)=1
|
|---|
| 93 | S DIC="^XMB(3.8,",DIC(0)="AEQMZL",DLAYGO=3.8
|
|---|
| 94 | ; Group is private, and user is organizer
|
|---|
| 95 | S DIC("S")="I $P(^(0),U,2)=""PR"",$P($G(^XMB(3.8,+Y,3)),U)=$G(XMDUZ,DUZ)"
|
|---|
| 96 | F D Q:XMABORT
|
|---|
| 97 | . W !
|
|---|
| 98 | . D ^DIC I Y<0 S XMABORT=1 Q
|
|---|
| 99 | . N XMDR,XMNEW
|
|---|
| 100 | . S XMNEW=$P(Y,U,3)
|
|---|
| 101 | . S:XMNEW XMDR="4////PR;5////"_$G(XMDUZ,DUZ)_";10////1;"
|
|---|
| 102 | . S XMDR=$G(XMDR)_".01T;2;3" ; name, members, description
|
|---|
| 103 | . S XMDR=XMDR_";10;12" ; restrictions, remote members
|
|---|
| 104 | . D EDIT(+Y,XMDR,XMNEW)
|
|---|
| 105 | Q
|
|---|
| 106 | EDIT(XMG,DR,XMNEW) ; Edit mail group
|
|---|
| 107 | ; XMIA is used for interaction on the REMOTE MEMBER input transform
|
|---|
| 108 | ; to facilitate lookup. XMTRKNEW is used by the AC xref on the
|
|---|
| 109 | ; .01 field of the LOCAL MEMBER multiple. If local members are added
|
|---|
| 110 | ; to the group, XMNEWMBR is set by the AC xref.
|
|---|
| 111 | N DIE,DIDEL,Y,DIC,DA,XMNEWMBR
|
|---|
| 112 | S (DIDEL,DIE)=3.8,DA=XMG
|
|---|
| 113 | S:$P(^XMB(1,1,0),U,19) DR=DR_";14;15" ; fax recipients, fax groups
|
|---|
| 114 | D ^DIE
|
|---|
| 115 | I 'XMNEW,$D(XMNEWMBR) D FWD(XMG,.XMNEWMBR)
|
|---|
| 116 | Q
|
|---|
| 117 | FWD(XMG,XMTO) ; Forward past mail group messages to new local members
|
|---|
| 118 | N XMI
|
|---|
| 119 | S XMI=""
|
|---|
| 120 | F S XMI=$O(XMTO(XMI)) Q:'XMI K:'$D(^XMB(3.8,XMG,1,"B",XMI)) XMTO(XMI)
|
|---|
| 121 | Q:'$D(XMTO)
|
|---|
| 122 | I '$D(XMV) N XMV,XMDISPI,XMDUN,XMNOSEND,XMPRIV D INITAPI^XMVVITAE
|
|---|
| 123 | D NOTIFY^XMXGRP1(XMG,.XMTO)
|
|---|
| 124 | N XMINSTR,XMTSK,XMABORT
|
|---|
| 125 | S XMABORT=0
|
|---|
| 126 | D ENFWD^XMVGRP(XMDUZ,.XMINSTR,.XMABORT) Q:XMABORT
|
|---|
| 127 | D FAFMSGS^XMXGRP1(XMDUZ,$P(^XMB(3.8,XMG,0),U,1),.XMTO,.XMINSTR,.XMTSK)
|
|---|
| 128 | D FWDTSK(XMTSK)
|
|---|
| 129 | Q
|
|---|
| 130 | LAYGO(X) ; Prevent someone from adding a (private) group with the same name as a public one.
|
|---|
| 131 | ; This function is invoked by the LAYGO field of ^XMB(3.8,.01)
|
|---|
| 132 | ; Returns 1 if group X may be created; 0 if not.
|
|---|
| 133 | N IEN,LAYGO
|
|---|
| 134 | S IEN="",LAYGO=1
|
|---|
| 135 | F S IEN=$O(^XMB(3.8,"B",X,IEN)) Q:IEN="" D Q:'LAYGO
|
|---|
| 136 | . Q:$P(^XMB(3.8,IEN,0),U,2)="PR"
|
|---|
| 137 | . S LAYGO=0 ;Can't add it because public group '|1|' already exists.
|
|---|
| 138 | . D EN^DDIOL($$EZBLD^DIALOG(38027,X),"","!,$C(7)")
|
|---|
| 139 | Q LAYGO
|
|---|
| 140 | REMOTE(XMADDR,XMIA) ; Serves as input transform for 'remote member'
|
|---|
| 141 | ; Allow remote addressees or local devices or local servers
|
|---|
| 142 | N XMERROR,XMRESTR,XMINSTR,XMFULL,XMPREFIX,DIX,DO,XMFWDADD
|
|---|
| 143 | S XMINSTR("ADDR FLAGS")="X" ; do not create ^TMP(, just check.
|
|---|
| 144 | I XMADDR[":" D Q:'$D(XMADDR)
|
|---|
| 145 | . D RTYPE^XMXADDR($P(XMADDR,":")) I $D(XMERROR) K XMADDR Q
|
|---|
| 146 | . D PREFIX^XMXADDR(.XMADDR,.XMPREFIX) I $D(XMERROR) K XMADDR Q
|
|---|
| 147 | I XMADDR'["@",".D.d.H.h.S.s."'[("."_$E(XMADDR,1,2)),'$D(XMPREFIX) K XMADDR Q
|
|---|
| 148 | D ADDRESS^XMXADDR(DUZ,XMADDR,.XMFULL,.XMERROR)
|
|---|
| 149 | I $D(XMERROR) K XMADDR Q
|
|---|
| 150 | I XMFULL'["@" D
|
|---|
| 151 | . I ".D.H.S."[("."_$E(XMFULL,1,2)) S XMFULL=XMFULL_"@"_^XMB("NETNAME") Q
|
|---|
| 152 | . ;I $G(XMPREFIX)'="" S XMFULL=XMFULL_"@"_^XMB("NETNAME") Q
|
|---|
| 153 | I XMFULL'["@" D Q
|
|---|
| 154 | . K XMADDR
|
|---|
| 155 | . D EN^DDIOL($$EZBLD^DIALOG(38028)) ;It can't be a local address, except for Device or Server.
|
|---|
| 156 | . I $E(XMFULL,1,2)="G." D EN^DDIOL($$EZBLD^DIALOG(38029)) ;Put the group in the MEMBER GROUP multiple.
|
|---|
| 157 | . E D EN^DDIOL($$EZBLD^DIALOG(38030)) ;Put the person in the MEMBER multiple.
|
|---|
| 158 | . I $G(XMPREFIX)'="" D EN^DDIOL($$EZBLD^DIALOG(38031,XMPREFIX)) ;Put '|1|' in the TYPE field.
|
|---|
| 159 | I $G(XMPREFIX)'="" S XMFULL=XMPREFIX_":"_XMFULL
|
|---|
| 160 | S XMADDR=XMFULL
|
|---|
| 161 | Q
|
|---|
| 162 | EDITMG ; Mail Group Edit
|
|---|
| 163 | ; See entry EDIT for info on XMIA & XMTRKNEW
|
|---|
| 164 | N DIC,XMABORT,DLAYGO,X,Y,XMIA,XMTRKNEW,XMREC
|
|---|
| 165 | S XMABORT=0,(XMIA,XMTRKNEW)=1,DLAYGO=3.8
|
|---|
| 166 | S DIC(0)="AEQLM",DIC="^XMB(3.8,"
|
|---|
| 167 | S DIC("S")=$$GRPSCR(0)
|
|---|
| 168 | F D Q:XMABORT
|
|---|
| 169 | . W !
|
|---|
| 170 | . D ^DIC I Y<0 S XMABORT=1 Q
|
|---|
| 171 | . N XMDR
|
|---|
| 172 | . S XMDR=".01T;2;3" ; name, members, description
|
|---|
| 173 | . ; type - if type is public, ask about self enrollment,
|
|---|
| 174 | . ; else ask about restrictions.
|
|---|
| 175 | . S XMDR=XMDR_";4;I X=""PU"" S Y=7;10;S Y=5;7"
|
|---|
| 176 | . S XMDR=XMDR_";5:6.9" ; organizer, coordinator, authorized senders
|
|---|
| 177 | . S XMDR=XMDR_";10.1:13.9" ; member groups, remote members, distr list
|
|---|
| 178 | . D EDIT(+Y,XMDR,$P(Y,U,3))
|
|---|
| 179 | Q
|
|---|
| 180 | GRPSCR(XMCOORD) ; Who may edit a mail group?
|
|---|
| 181 | N XMSCR,XMOK
|
|---|
| 182 | S XMOK=0
|
|---|
| 183 | I $T(ISA^USRLM)'="" S XMOK=$$ISA^USRLM(DUZ,"CLINICAL COORDINATOR")
|
|---|
| 184 | I $D(^XUSEC("XMMGR",DUZ))!$D(^XUSEC("XM GROUP EDIT MASTER",DUZ))!XMOK D
|
|---|
| 185 | . ; Screen whether group is public or (private and) unrestricted
|
|---|
| 186 | . S XMSCR="N XMREC S XMREC=^(0) I $P(XMREC,U,2)=""PU""!'$P(XMREC,U,6)!"
|
|---|
| 187 | E S XMSCR="I " ; Or, at the very minimum,
|
|---|
| 188 | ; Screen whether user is organizer or coordinator.
|
|---|
| 189 | 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:"")
|
|---|
| 190 | ;
|
|---|
| 191 | LCOORD ; Mail Group Coordinator edit w/o remote members
|
|---|
| 192 | D COORD(0)
|
|---|
| 193 | Q
|
|---|
| 194 | RCOORD ; Mail Group Coordinator edit w/remote members
|
|---|
| 195 | D COORD(1)
|
|---|
| 196 | Q
|
|---|
| 197 | COORD(XMREMOTE) ;
|
|---|
| 198 | ; See entry EDIT for info on XMIA & XMTRKNEW
|
|---|
| 199 | N DIC,XMABORT,DLAYGO,X,Y,XMIA,XMTRKNEW
|
|---|
| 200 | S XMABORT=0,(XMIA,XMTRKNEW)=1
|
|---|
| 201 | S DIC(0)="AEQM",DIC="^XMB(3.8,"
|
|---|
| 202 | S DIC("S")=$$GRPSCR(1)
|
|---|
| 203 | F D Q:XMABORT
|
|---|
| 204 | . W !
|
|---|
| 205 | . D ^DIC I Y<0 S XMABORT=1 Q
|
|---|
| 206 | . ; edit local members, member groups, & perhaps, remote members
|
|---|
| 207 | . D EDIT(+Y,"2;11"_$S(XMREMOTE:";12",1:""),0)
|
|---|
| 208 | Q
|
|---|
