source: FOIAVistA/tag/r/MAILMAN-XM/XMBGRP.m@ 812

Last change on this file since 812 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 5.6 KB
Line 
1XMBGRP ;ISC-SF/GMB-Mail Group APIs ;04/17/2002 07:44
2 ;;8.0;MailMan;;Jun 28, 2002
3 ; Was (WASH ISC)/JL,CAP
4 ;
5 ; Entry points (DBIA 1146):
6 ; $$DM Delete local members from a mail group.
7 ; $$MG Create a mail group or add members to an existing mail group.
8MG(XMGROUP,XMTYPE,XMORG,XMSELF,XMY,XMDESC,XMQUIET) ; Create group or add members to existing group
9 ;Example:
10 ;S X=$$MG^XMBGRP(XMGROUP,XMTYPE,XMORG,XMSELF,.XMY,.XMDESC,XMQUIET)
11 ;
12 ;XMGROUP =group name if creating a new group;
13 ; =group name or pointer to ^XMB(3.8,
14 ; if adding members to an existing group.
15 ;XMTYPE type of group - used only for creation
16 ; 0=public (default)
17 ; 1=private
18 ;XMORG group organizer - used only for creation
19 ; pointer to ^VA(200, (default=DUZ)
20 ;XMSELF allow self enrollment - used only for creation
21 ; 0=no
22 ; 1=yes (default)
23 ;XMY local group members (Array - Pass by reference)
24 ; XMY(member DUZ)=""
25 ;XMDESC description (Array - Pass by reference)
26 ; - used only for creation
27 ; Must be appropriate for FM word processing field.
28 ;XMQUIET silent flag
29 ; 0=interactive
30 ; 1=silent (default)
31 N XMABORT,XMGIEN,XMGNAME
32 S XMABORT=0
33 D MGINIT(XMGROUP,.XMGIEN,.XMGNAME,.XMTYPE,.XMORG,.XMSELF,.XMY,.XMDESC,.XMQUIET,.XMABORT)
34 I XMABORT K XMY Q 0
35 I '$D(XMGIEN) D
36 . D CREATE(XMGNAME,.XMGIEN,XMTYPE,XMORG,XMSELF,.XMDESC,XMQUIET,.XMABORT) Q:XMABORT
37 . Q:'$O(XMY(""))
38 . D ADD(XMGIEN,.XMY,.XMABORT) Q:XMABORT
39 . D NOTIFY("Members have been added to the "_XMGNAME_" Mail Group.",XMQUIET)
40 E D
41 . D ADD(XMGIEN,.XMY,.XMABORT)
42 K XMY
43 Q $S(XMABORT:0,1:XMGIEN)
44MGINIT(XMGROUP,XMGIEN,XMGNAME,XMTYPE,XMORG,XMSELF,XMY,XMDESC,XMQUIET,XMABORT) ;
45 D CHKGROUP(XMGROUP,.XMGIEN,.XMGNAME,.XMABORT) Q:XMABORT
46 I $D(XMGIEN),'$O(XMY("")) D Q
47 . D NOTIFY("E907 No members specified to add to Mail Group "_XMGNAME,XMQUIET)
48 . S XMABORT=1
49 D CHKVAL(.XMTYPE,"XMTYPE",2,0,.XMABORT) Q:XMABORT
50 S:$G(XMORG)="" XMORG=DUZ
51 S:XMORG<1 XMORG=.5
52 I '$D(^VA(200,XMORG,0)) D Q
53 . D NOTIFY("E904 "_XMORG_" is not a user to use as an organizer of a mail group.",XMQUIET)
54 . S XMABORT=1
55 D CHKVAL(.XMSELF,"XMSELF",4,1,.XMABORT) Q:XMABORT
56 D CHKVAL(.XMQUIET,"XMQUIET",7,1,.XMABORT) Q:XMABORT
57 S:$D(ZTQUEUED) XMQUIET=1
58 Q
59CHKGROUP(XMGROUP,XMGIEN,XMGNAME,XMABORT) ;
60 I +XMGROUP=XMGROUP D Q
61 . S XMGIEN=XMGROUP
62 . S XMGNAME=$P($G(^XMB(3.8,XMGIEN,0)),U,1)
63 . I XMGNAME="" D
64 . . D NOTIFY("E910 Mail Group "_XMGROUP_" could not be found !",XMQUIET)
65 . . S XMABORT=1
66 S XMGNAME=XMGROUP
67 I $L(XMGNAME)<3 D Q
68 . D NOTIFY("E901 "_XMGNAME_" is not valid -- it is shorter than 3 characters",XMQUIET)
69 . S XMABORT=1
70 I $L(XMGNAME)>30 D Q
71 . D NOTIFY("E902 "_XMGNAME_" is not valid -- it is longer than 30 characters",XMQUIET)
72 . S XMABORT=1
73 I $D(^XMB(3.8,"B",XMGNAME)) S XMGIEN=$O(^(XMGNAME,0))
74 Q
75CHKVAL(XMVAL,XMVNAME,XMPOSN,XMDEFALT,XMABORT) ;
76 S:$G(XMVAL)="" XMVAL=XMDEFALT
77 I XMVAL=0!(XMVAL=1) Q
78 D NOTIFY("E903 Parameter "_XMPOSN_"="_XMVAL_" (not valid, must be 0 or 1).",XMQUIET)
79 S XMABORT=1
80 Q
81CREATE(XMGNAME,XMGIEN,XMTYPE,XMORG,XMSELF,XMDESC,XMQUIET,XMABORT) ;
82 N DIC,Y,DA,DO,DD,X
83 S X=XMGNAME
84 S DIC="^XMB(3.8,",DIC(0)="FZMN"_$S(XMQUIET:"",1:"E")
85 S DIC("DR")="4///"_$S(XMTYPE=0:"PU",1:"PR")_";5///"_XMORG_";10///0;7///"_$S(XMSELF:"y",1:"n")
86 D FILE^DICN
87 I Y<0 D Q
88 . D NOTIFY("Mail Group ("_XMGNAME_") creation failed!",XMQUIET)
89 . S XMABORT=1
90 S XMGIEN=+Y
91 ;Add descriptive text
92 I $O(XMDESC(""))'="" D
93 . D WP^DIE(3.8,XMGIEN_",",3,"","XMDESC")
94 . K XMDESC
95 D NOTIFY("Mail Group "_XMGROUP_" created.",XMQUIET)
96 Q
97ADD(XMGIEN,XMY,XMABORT) ; Add local members
98 L +^XMB(3.8,XMGIEN):9 E D Q
99 . D NOTIFY("E906 "_XMGROUP_" File could not be locked - Did not add members.",XMQUIET)
100 . S XMABORT=1
101 N XMUSER,XMFDA,XMADDCNT
102 S XMUSER="",XMADDCNT=0
103 F S XMUSER=$O(XMY(XMUSER)) Q:XMUSER="" D
104 . I '$D(^VA(200,XMUSER,0))!'$D(^XMB(3.7,XMUSER,0)) D Q
105 . . D NOTIFY("E908 Invalid member ("_XMUSER_") - NOT pointer to ^VA(200",XMQUIET)
106 . Q:$D(^XMB(3.8,XMGIEN,1,"B",XMUSER)) ; already a member
107 . S XMFDA(3.81,"+1,"_XMGIEN_",",.01)=XMUSER
108 . D UPDATE^DIE("","XMFDA")
109 . S XMADDCNT=XMADDCNT+1
110 L -^XMB(3.8,XMGIEN)
111 K XMY
112 S:'XMADDCNT XMABORT=1 ; No members added
113 Q
114DM(XMGROUP,XMY,XMQUIET) ; Delete members
115 ;XMGROUP Mail Group Name or entry number
116 ;XMY Array of members to remove
117 ; XMY(local member DUZ)=""
118 ;XMQUIET Silent Flag
119 N XMGIEN,XMUSER,DIK,DA,XMABORT
120 S XMABORT=0
121 D DMINIT(XMGROUP,.XMGIEN,.XMY,.XMQUIET,.XMABORT)
122 I XMABORT K XMY Q 0
123 L +^XMB(3.8,XMGIEN):9 E D Q 0
124 . D NOTIFY("E906 "_XMGROUP_" File could not be locked - Did not delete members.",XMQUIET)
125 . S XMABORT=1
126 S DA(1)=XMGIEN,DIK="^XMB(3.8,"_XMGIEN_",1,"
127 S XMUSER=""
128 F S XMUSER=$O(XMY(XMUSER)) Q:XMUSER="" D
129 . S DA=$O(^XMB(3.8,XMGIEN,1,"B",XMUSER,0)) Q:'DA
130 . D ^DIK
131 K XMY
132 L -^XMB(3.8,XMGIEN)
133 Q 1
134DMINIT(XMGROUP,XMGIEN,XMY,XMQUIET,XMABORT) ;
135 N XMGNAME
136 D CHKGROUP(XMGROUP,.XMGIEN,.XMGNAME,.XMABORT) Q:XMABORT
137 I '$D(XMGIEN) D Q
138 . D NOTIFY("E910 Mail Group "_XMGROUP_" could not be found !",XMQUIET)
139 . S XMABORT=1
140 D CHKVAL(.XMQUIET,"XMQUIET",3,1,.XMABORT) Q:XMABORT
141 S:$D(ZTQUEUED) XMQUIET=1
142 I '$O(XMY("")) D Q
143 . D NOTIFY("E909 Member delete attempted with no members specified.",XMQUIET)
144 . S XMABORT=1
145 Q
146NOTIFY(XMMSG,XMQUIET) ; Notification
147 N I,XMTEXT
148 S XMTEXT(1)="There was a call to the Mail Group Applications Programmer"
149 S XMTEXT(2)="Interface (API) that required notification to the user:"
150 S XMTEXT(3)=""
151 S XMTEXT(4)=XMMSG
152 I XMQUIET D SENDMSG(.XMTEXT) Q
153 F I=1:1:4 W !,XMTEXT(I)
154 W !,$C(7)
155 Q
156SENDMSG(XMTEXT) ;
157 N XMY,XMDUZ,XMSUB
158 S XMY(.5)="",XMY(DUZ)="",XMTEXT="XMTEXT("
159 S XMDUZ=.5,XMSUB="MAIL GROUP API"
160 D ^XMD
161 Q
Note: See TracBrowser for help on using the repository browser.