XMBGRP ;ISC-SF/GMB - Mail Group APIs ;04/17/2002 07:44
;;8.0;MailMan;**47**;Jun 28, 2002;Build 6
; Was (WASH ISC)/JL,CAP
;
; Entry points (DBIA 1146):
; $$DM Delete local members from a mail group.
; $$MG Create a mail group or add members to an existing mail group.
MG(XMGROUP,XMTYPE,XMORG,XMSELF,XMY,XMDESC,XMQUIET) ; Create group or add members to existing group
;Example:
;S X=$$MG^XMBGRP(XMGROUP,XMTYPE,XMORG,XMSELF,.XMY,.XMDESC,XMQUIET)
;
;XMGROUP =group name if creating a new group;
; =group name or pointer to ^XMB(3.8,
; if adding members to an existing group.
;XMTYPE type of group - used only for creation
; 0=public (default)
; 1=private
;XMORG group organizer - used only for creation
; pointer to ^VA(200, (default=DUZ)
;XMSELF allow self enrollment - used only for creation
; 0=no
; 1=yes (default)
;XMY local group members (Array - Pass by reference)
; XMY(member DUZ)=""
;XMDESC description (Array - Pass by reference)
; - used only for creation
; Must be appropriate for FM word processing field.
;XMQUIET silent flag
; 0=interactive
; 1=silent (default)
N XMABORT,XMGIEN,XMGNAME
S XMABORT=0
D MGINIT(XMGROUP,.XMGIEN,.XMGNAME,.XMTYPE,.XMORG,.XMSELF,.XMY,.XMDESC,.XMQUIET,.XMABORT)
I XMABORT K XMY Q 0
I '$D(XMGIEN) D
. D CREATE(XMGNAME,.XMGIEN,XMTYPE,XMORG,XMSELF,.XMDESC,XMQUIET,.XMABORT) Q:XMABORT
. Q:'$O(XMY(""))
. D ADD(XMGIEN,.XMY,.XMABORT) Q:XMABORT
. D NOTIFY("Members have been added to the "_XMGNAME_" Mail Group.",XMQUIET)
E D
. D ADD(XMGIEN,.XMY,.XMABORT)
K XMY
Q $S(XMABORT:0,1:XMGIEN)
MGINIT(XMGROUP,XMGIEN,XMGNAME,XMTYPE,XMORG,XMSELF,XMY,XMDESC,XMQUIET,XMABORT) ;
D CHKGROUP(XMGROUP,.XMGIEN,.XMGNAME,.XMABORT) Q:XMABORT
I $D(XMGIEN),'$O(XMY("")) D Q
. D NOTIFY("E907 No members specified to add to Mail Group "_XMGNAME,XMQUIET)
. S XMABORT=1
D CHKVAL(.XMTYPE,"XMTYPE",2,0,.XMABORT) Q:XMABORT
S:$G(XMORG)="" XMORG=DUZ
S:XMORG<1 XMORG=.5
I '$D(^VA(200,XMORG,0)) D Q
. D NOTIFY("E904 "_XMORG_" is not a user to use as an organizer of a mail group.",XMQUIET)
. S XMABORT=1
D CHKVAL(.XMSELF,"XMSELF",4,1,.XMABORT) Q:XMABORT
D CHKVAL(.XMQUIET,"XMQUIET",7,1,.XMABORT) Q:XMABORT
S:$D(ZTQUEUED) XMQUIET=1
Q
CHKGROUP(XMGROUP,XMGIEN,XMGNAME,XMABORT) ;
I +XMGROUP=XMGROUP D Q
. S XMGIEN=XMGROUP
. S XMGNAME=$P($G(^XMB(3.8,XMGIEN,0)),U,1)
. I XMGNAME="" D
. . D NOTIFY("E910 Mail Group "_XMGROUP_" could not be found !",XMQUIET)
. . S XMABORT=1
S XMGNAME=XMGROUP
I $L(XMGNAME)<3 D Q
. D NOTIFY("E901 "_XMGNAME_" is not valid -- it is shorter than 3 characters",XMQUIET)
. S XMABORT=1
I $L(XMGNAME)>30 D Q
. D NOTIFY("E902 "_XMGNAME_" is not valid -- it is longer than 30 characters",XMQUIET)
. S XMABORT=1
I $D(^XMB(3.8,"B",XMGNAME)) S XMGIEN=$O(^(XMGNAME,0))
Q
CHKVAL(XMVAL,XMVNAME,XMPOSN,XMDEFALT,XMABORT) ;
S:$G(XMVAL)="" XMVAL=XMDEFALT
I XMVAL=0!(XMVAL=1) Q
D NOTIFY("E903 Parameter "_XMPOSN_"="_XMVAL_" (not valid, must be 0 or 1).",XMQUIET)
S XMABORT=1
Q
CREATE(XMGNAME,XMGIEN,XMTYPE,XMORG,XMSELF,XMDESC,XMQUIET,XMABORT) ;
N DIC,Y,DA,DO,DD,X
S X=XMGNAME
S DIC="^XMB(3.8,",DIC(0)="FZMN"_$S(XMQUIET:"",1:"E")
;** XM*8.0*47 Modified the DIR("DR") array to use a four slash stuff for the organizer field to prevent Fileman from reading four digit DUZ's as last four of SSN **
S DIC("DR")="4///"_$S(XMTYPE=0:"PU",1:"PR")_";5////"_XMORG_";10///0;7///"_$S(XMSELF:"y",1:"n")
D FILE^DICN
I Y<0 D Q
. D NOTIFY("Mail Group ("_XMGNAME_") creation failed!",XMQUIET)
. S XMABORT=1
S XMGIEN=+Y
;Add descriptive text
I $O(XMDESC(""))'="" D
. D WP^DIE(3.8,XMGIEN_",",3,"","XMDESC")
. K XMDESC
D NOTIFY("Mail Group "_XMGROUP_" created.",XMQUIET)
Q
ADD(XMGIEN,XMY,XMABORT) ; Add local members
L +^XMB(3.8,XMGIEN):9 E D Q
. D NOTIFY("E906 "_XMGROUP_" File could not be locked - Did not add members.",XMQUIET)
. S XMABORT=1
N XMUSER,XMFDA,XMADDCNT
S XMUSER="",XMADDCNT=0
F S XMUSER=$O(XMY(XMUSER)) Q:XMUSER="" D
. I '$D(^VA(200,XMUSER,0))!'$D(^XMB(3.7,XMUSER,0)) D Q
. . D NOTIFY("E908 Invalid member ("_XMUSER_") - NOT pointer to ^VA(200",XMQUIET)
. Q:$D(^XMB(3.8,XMGIEN,1,"B",XMUSER)) ; already a member
. S XMFDA(3.81,"+1,"_XMGIEN_",",.01)=XMUSER
. D UPDATE^DIE("","XMFDA")
. S XMADDCNT=XMADDCNT+1
L -^XMB(3.8,XMGIEN)
K XMY
S:'XMADDCNT XMABORT=1 ; No members added
Q
DM(XMGROUP,XMY,XMQUIET) ; Delete members
;XMGROUP Mail Group Name or entry number
;XMY Array of members to remove
; XMY(local member DUZ)=""
;XMQUIET Silent Flag
N XMGIEN,XMUSER,DIK,DA,XMABORT
S XMABORT=0
D DMINIT(XMGROUP,.XMGIEN,.XMY,.XMQUIET,.XMABORT)
I XMABORT K XMY Q 0
L +^XMB(3.8,XMGIEN):9 E D Q 0
. D NOTIFY("E906 "_XMGROUP_" File could not be locked - Did not delete members.",XMQUIET)
. S XMABORT=1
S DA(1)=XMGIEN,DIK="^XMB(3.8,"_XMGIEN_",1,"
S XMUSER=""
F S XMUSER=$O(XMY(XMUSER)) Q:XMUSER="" D
. S DA=$O(^XMB(3.8,XMGIEN,1,"B",XMUSER,0)) Q:'DA
. D ^DIK
K XMY
L -^XMB(3.8,XMGIEN)
Q 1
DMINIT(XMGROUP,XMGIEN,XMY,XMQUIET,XMABORT) ;
N XMGNAME
D CHKGROUP(XMGROUP,.XMGIEN,.XMGNAME,.XMABORT) Q:XMABORT
I '$D(XMGIEN) D Q
. D NOTIFY("E910 Mail Group "_XMGROUP_" could not be found !",XMQUIET)
. S XMABORT=1
D CHKVAL(.XMQUIET,"XMQUIET",3,1,.XMABORT) Q:XMABORT
S:$D(ZTQUEUED) XMQUIET=1
I '$O(XMY("")) D Q
. D NOTIFY("E909 Member delete attempted with no members specified.",XMQUIET)
. S XMABORT=1
Q
NOTIFY(XMMSG,XMQUIET) ; Notification
N I,XMTEXT
S XMTEXT(1)="There was a call to the Mail Group Applications Programmer"
S XMTEXT(2)="Interface (API) that required notification to the user:"
S XMTEXT(3)=""
S XMTEXT(4)=XMMSG
I XMQUIET D SENDMSG(.XMTEXT) Q
F I=1:1:4 W !,XMTEXT(I)
W !,$C(7)
Q
SENDMSG(XMTEXT) ;
N XMY,XMDUZ,XMSUB
S XMY(.5)="",XMY(DUZ)="",XMTEXT="XMTEXT("
S XMDUZ=.5,XMSUB="MAIL GROUP API"
D ^XMD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMBGRP 6049 printed Oct 16, 2024@18:11:51 Page 2
XMBGRP ;ISC-SF/GMB - Mail Group APIs ;04/17/2002 07:44
+1 ;;8.0;MailMan;**47**;Jun 28, 2002;Build 6
+2 ; Was (WASH ISC)/JL,CAP
+3 ;
+4 ; Entry points (DBIA 1146):
+5 ; $$DM Delete local members from a mail group.
+6 ; $$MG Create a mail group or add members to an existing mail group.
MG(XMGROUP,XMTYPE,XMORG,XMSELF,XMY,XMDESC,XMQUIET) ; Create group or add members to existing group
+1 ;Example:
+2 ;S X=$$MG^XMBGRP(XMGROUP,XMTYPE,XMORG,XMSELF,.XMY,.XMDESC,XMQUIET)
+3 ;
+4 ;XMGROUP =group name if creating a new group;
+5 ; =group name or pointer to ^XMB(3.8,
+6 ; if adding members to an existing group.
+7 ;XMTYPE type of group - used only for creation
+8 ; 0=public (default)
+9 ; 1=private
+10 ;XMORG group organizer - used only for creation
+11 ; pointer to ^VA(200, (default=DUZ)
+12 ;XMSELF allow self enrollment - used only for creation
+13 ; 0=no
+14 ; 1=yes (default)
+15 ;XMY local group members (Array - Pass by reference)
+16 ; XMY(member DUZ)=""
+17 ;XMDESC description (Array - Pass by reference)
+18 ; - used only for creation
+19 ; Must be appropriate for FM word processing field.
+20 ;XMQUIET silent flag
+21 ; 0=interactive
+22 ; 1=silent (default)
+23 NEW XMABORT,XMGIEN,XMGNAME
+24 SET XMABORT=0
+25 DO MGINIT(XMGROUP,.XMGIEN,.XMGNAME,.XMTYPE,.XMORG,.XMSELF,.XMY,.XMDESC,.XMQUIET,.XMABORT)
+26 IF XMABORT
KILL XMY
QUIT 0
+27 IF '$DATA(XMGIEN)
Begin DoDot:1
+28 DO CREATE(XMGNAME,.XMGIEN,XMTYPE,XMORG,XMSELF,.XMDESC,XMQUIET,.XMABORT)
if XMABORT
QUIT
+29 if '$ORDER(XMY(""))
QUIT
+30 DO ADD(XMGIEN,.XMY,.XMABORT)
if XMABORT
QUIT
+31 DO NOTIFY("Members have been added to the "_XMGNAME_" Mail Group.",XMQUIET)
End DoDot:1
+32 IF '$TEST
Begin DoDot:1
+33 DO ADD(XMGIEN,.XMY,.XMABORT)
End DoDot:1
+34 KILL XMY
+35 QUIT $SELECT(XMABORT:0,1:XMGIEN)
MGINIT(XMGROUP,XMGIEN,XMGNAME,XMTYPE,XMORG,XMSELF,XMY,XMDESC,XMQUIET,XMABORT) ;
+1 DO CHKGROUP(XMGROUP,.XMGIEN,.XMGNAME,.XMABORT)
if XMABORT
QUIT
+2 IF $DATA(XMGIEN)
IF '$ORDER(XMY(""))
Begin DoDot:1
+3 DO NOTIFY("E907 No members specified to add to Mail Group "_XMGNAME,XMQUIET)
+4 SET XMABORT=1
End DoDot:1
QUIT
+5 DO CHKVAL(.XMTYPE,"XMTYPE",2,0,.XMABORT)
if XMABORT
QUIT
+6 if $GET(XMORG)=""
SET XMORG=DUZ
+7 if XMORG<1
SET XMORG=.5
+8 IF '$DATA(^VA(200,XMORG,0))
Begin DoDot:1
+9 DO NOTIFY("E904 "_XMORG_" is not a user to use as an organizer of a mail group.",XMQUIET)
+10 SET XMABORT=1
End DoDot:1
QUIT
+11 DO CHKVAL(.XMSELF,"XMSELF",4,1,.XMABORT)
if XMABORT
QUIT
+12 DO CHKVAL(.XMQUIET,"XMQUIET",7,1,.XMABORT)
if XMABORT
QUIT
+13 if $DATA(ZTQUEUED)
SET XMQUIET=1
+14 QUIT
CHKGROUP(XMGROUP,XMGIEN,XMGNAME,XMABORT) ;
+1 IF +XMGROUP=XMGROUP
Begin DoDot:1
+2 SET XMGIEN=XMGROUP
+3 SET XMGNAME=$PIECE($GET(^XMB(3.8,XMGIEN,0)),U,1)
+4 IF XMGNAME=""
Begin DoDot:2
+5 DO NOTIFY("E910 Mail Group "_XMGROUP_" could not be found !",XMQUIET)
+6 SET XMABORT=1
End DoDot:2
End DoDot:1
QUIT
+7 SET XMGNAME=XMGROUP
+8 IF $LENGTH(XMGNAME)<3
Begin DoDot:1
+9 DO NOTIFY("E901 "_XMGNAME_" is not valid -- it is shorter than 3 characters",XMQUIET)
+10 SET XMABORT=1
End DoDot:1
QUIT
+11 IF $LENGTH(XMGNAME)>30
Begin DoDot:1
+12 DO NOTIFY("E902 "_XMGNAME_" is not valid -- it is longer than 30 characters",XMQUIET)
+13 SET XMABORT=1
End DoDot:1
QUIT
+14 IF $DATA(^XMB(3.8,"B",XMGNAME))
SET XMGIEN=$ORDER(^(XMGNAME,0))
+15 QUIT
CHKVAL(XMVAL,XMVNAME,XMPOSN,XMDEFALT,XMABORT) ;
+1 if $GET(XMVAL)=""
SET XMVAL=XMDEFALT
+2 IF XMVAL=0!(XMVAL=1)
QUIT
+3 DO NOTIFY("E903 Parameter "_XMPOSN_"="_XMVAL_" (not valid, must be 0 or 1).",XMQUIET)
+4 SET XMABORT=1
+5 QUIT
CREATE(XMGNAME,XMGIEN,XMTYPE,XMORG,XMSELF,XMDESC,XMQUIET,XMABORT) ;
+1 NEW DIC,Y,DA,DO,DD,X
+2 SET X=XMGNAME
+3 SET DIC="^XMB(3.8,"
SET DIC(0)="FZMN"_$SELECT(XMQUIET:"",1:"E")
+4 ;** XM*8.0*47 Modified the DIR("DR") array to use a four slash stuff for the organizer field to prevent Fileman from reading four digit DUZ's as last four of SSN **
+5 SET DIC("DR")="4///"_$SELECT(XMTYPE=0:"PU",1:"PR")_";5////"_XMORG_";10///0;7///"_$SELECT(XMSELF:"y",1:"n")
+6 DO FILE^DICN
+7 IF Y<0
Begin DoDot:1
+8 DO NOTIFY("Mail Group ("_XMGNAME_") creation failed!",XMQUIET)
+9 SET XMABORT=1
End DoDot:1
QUIT
+10 SET XMGIEN=+Y
+11 ;Add descriptive text
+12 IF $ORDER(XMDESC(""))'=""
Begin DoDot:1
+13 DO WP^DIE(3.8,XMGIEN_",",3,"","XMDESC")
+14 KILL XMDESC
End DoDot:1
+15 DO NOTIFY("Mail Group "_XMGROUP_" created.",XMQUIET)
+16 QUIT
ADD(XMGIEN,XMY,XMABORT) ; Add local members
+1 LOCK +^XMB(3.8,XMGIEN):9
IF '$TEST
Begin DoDot:1
+2 DO NOTIFY("E906 "_XMGROUP_" File could not be locked - Did not add members.",XMQUIET)
+3 SET XMABORT=1
End DoDot:1
QUIT
+4 NEW XMUSER,XMFDA,XMADDCNT
+5 SET XMUSER=""
SET XMADDCNT=0
+6 FOR
SET XMUSER=$ORDER(XMY(XMUSER))
if XMUSER=""
QUIT
Begin DoDot:1
+7 IF '$DATA(^VA(200,XMUSER,0))!'$DATA(^XMB(3.7,XMUSER,0))
Begin DoDot:2
+8 DO NOTIFY("E908 Invalid member ("_XMUSER_") - NOT pointer to ^VA(200",XMQUIET)
End DoDot:2
QUIT
+9 ; already a member
if $DATA(^XMB(3.8,XMGIEN,1,"B",XMUSER))
QUIT
+10 SET XMFDA(3.81,"+1,"_XMGIEN_",",.01)=XMUSER
+11 DO UPDATE^DIE("","XMFDA")
+12 SET XMADDCNT=XMADDCNT+1
End DoDot:1
+13 LOCK -^XMB(3.8,XMGIEN)
+14 KILL XMY
+15 ; No members added
if 'XMADDCNT
SET XMABORT=1
+16 QUIT
DM(XMGROUP,XMY,XMQUIET) ; Delete members
+1 ;XMGROUP Mail Group Name or entry number
+2 ;XMY Array of members to remove
+3 ; XMY(local member DUZ)=""
+4 ;XMQUIET Silent Flag
+5 NEW XMGIEN,XMUSER,DIK,DA,XMABORT
+6 SET XMABORT=0
+7 DO DMINIT(XMGROUP,.XMGIEN,.XMY,.XMQUIET,.XMABORT)
+8 IF XMABORT
KILL XMY
QUIT 0
+9 LOCK +^XMB(3.8,XMGIEN):9
IF '$TEST
Begin DoDot:1
+10 DO NOTIFY("E906 "_XMGROUP_" File could not be locked - Did not delete members.",XMQUIET)
+11 SET XMABORT=1
End DoDot:1
QUIT 0
+12 SET DA(1)=XMGIEN
SET DIK="^XMB(3.8,"_XMGIEN_",1,"
+13 SET XMUSER=""
+14 FOR
SET XMUSER=$ORDER(XMY(XMUSER))
if XMUSER=""
QUIT
Begin DoDot:1
+15 SET DA=$ORDER(^XMB(3.8,XMGIEN,1,"B",XMUSER,0))
if 'DA
QUIT
+16 DO ^DIK
End DoDot:1
+17 KILL XMY
+18 LOCK -^XMB(3.8,XMGIEN)
+19 QUIT 1
DMINIT(XMGROUP,XMGIEN,XMY,XMQUIET,XMABORT) ;
+1 NEW XMGNAME
+2 DO CHKGROUP(XMGROUP,.XMGIEN,.XMGNAME,.XMABORT)
if XMABORT
QUIT
+3 IF '$DATA(XMGIEN)
Begin DoDot:1
+4 DO NOTIFY("E910 Mail Group "_XMGROUP_" could not be found !",XMQUIET)
+5 SET XMABORT=1
End DoDot:1
QUIT
+6 DO CHKVAL(.XMQUIET,"XMQUIET",3,1,.XMABORT)
if XMABORT
QUIT
+7 if $DATA(ZTQUEUED)
SET XMQUIET=1
+8 IF '$ORDER(XMY(""))
Begin DoDot:1
+9 DO NOTIFY("E909 Member delete attempted with no members specified.",XMQUIET)
+10 SET XMABORT=1
End DoDot:1
QUIT
+11 QUIT
NOTIFY(XMMSG,XMQUIET) ; Notification
+1 NEW I,XMTEXT
+2 SET XMTEXT(1)="There was a call to the Mail Group Applications Programmer"
+3 SET XMTEXT(2)="Interface (API) that required notification to the user:"
+4 SET XMTEXT(3)=""
+5 SET XMTEXT(4)=XMMSG
+6 IF XMQUIET
DO SENDMSG(.XMTEXT)
QUIT
+7 FOR I=1:1:4
WRITE !,XMTEXT(I)
+8 WRITE !,$CHAR(7)
+9 QUIT
SENDMSG(XMTEXT) ;
+1 NEW XMY,XMDUZ,XMSUB
+2 SET XMY(.5)=""
SET XMY(DUZ)=""
SET XMTEXT="XMTEXT("
+3 SET XMDUZ=.5
SET XMSUB="MAIL GROUP API"
+4 DO ^XMD
+5 QUIT
