- 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 Jan 18, 2025@03:12:09 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