source: WorldVistAEHR/trunk/r/MAILMAN-XM/XMD.m@ 1710

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

initial load of WorldVistAEHR
File size: 9.2 KB
RevLine 
[613]1XMD ;ISC-SF/GMB-Send/Forward/Add text to a message APIs ;08/27/2003 11:01
2 ;;8.0;MailMan;**21**;Jun 28, 2002
3 ; Was (WASH ISC)/THM/CAP
4 ;
5 ; Entry points (DBIA 10070) are:
6 ; ^XMD Send a message.
7 ; If no recipients defined, prompt for them.
8 ; EN1^XMD Put text in a message.
9 ; If no recipients defined, prompt for them.
10 ; Send the message.
11 ; ENL^XMD Add text to an existing message.
12 ; ENT^XMD Interactive 'send a message'. (Same as menu)
13 ; ENT1^XMD Forward a message.
14 ; ENT2^XMD Forward a message.
15 ; Prompt for recipients, whether or not any are already
16 ; defined.
17 ;
18 ; I/O Variables to the various APIs:
19 ; XMDUZ (in, optional) Sender DUZ or string (default=DUZ)
20 ; For new messages, XMDUZ may be a string, which will be
21 ; put in the 'message from' field.
22 ; For forwarded messages, XMDUZ may be a string, which
23 ; will be put in the 'forwarded by' field.
24 ; XMSUB (in) Message subject
25 ; XMTEXT (in) @location of message. For example, the following are
26 ; among the acceptable:
27 ; XMTEXT="array("
28 ; XMTEXT="array(""node"","
29 ; XMTEXT="^TMP(""namespace"",$J,""array"","
30 ; The array must be in the acceptable FM word processing
31 ; format.
32 ; XMSTRIP (in, optional) Characters that user wants stripped from text
33 ; of message (default=none)
34 ; XMY (in, optional) Array of recipients, XMY(x)="", where
35 ; x is a valid local or internet address.
36 ; XMY(x,0)=basket to deliver to, if x=sender's DUZ or .6
37 ; (Basket may be its number or name. If name, and it
38 ; doesn't exist, it will be created.)
39 ; XMY(x,1)=recipient type, either "I" (info only) or
40 ; "C" (carbon copy)
41 ; XMY(x,"D")=delete date, if x=.6 ("SHARED,MAIL")
42 ; A local address may be a user's name or DUZ, a G.group
43 ; name or S.server name.
44 ; If not supplied and the process is not queued,
45 ; you will be prompted.
46 ; XMMG (in, optional) If XMY is not supplied and the process is not
47 ; queued, XMMG is used as the default for the first
48 ; 'send to:' prompt. It is ignored otherwise.
49 ; (out) Contains error message if error occurs.
50 ; Undefined if no error.
51 ; DIFROM (in, optional) ?
52 ; XMROU (in, optional) Array of routines to be loaded in a PackMan
53 ; message. XMROU(x)="", where x=routine name.
54 ; XMYBLOB (in, optional) Array of images from the imaging system to be
55 ; loaded. XMYBLOB(y)=x, where y and x are ?
56 ;
57 ; Local Variables:
58 ; XMDF Flag that programmer interface is in use.
59 ; Therefore do not check for Security Keys on domains.
60 ;
61 ; Entry point ^XMD
62 ; Needs: DUZ,XMSUB,XMTEXT
63 ; Accepts: XMDUZ,XMY,XMMG,XMSTRIP,XMROU,DIFROM,XMYBLOB,
64 ; and, if $D(DIFROM), XMDF
65 ; Ignores: N/A
66 ; Returns: XMZ(if no error),XMMG(if error)
67 ; Kills: XMSUB,XMTEXT,XMY,XMSTRIP,XMMG(if no error),XMYBLOB
68 N XMV,XMINSTR,XMBLOBER,XMABORT
69 I '$D(DIFROM) N XMDF S XMDF=1
70 I '$G(DUZ) N DUZ D DUZ^XUP(.5)
71 I $G(XMDUZ)=""!($G(XMDUZ)=0) S XMDUZ=DUZ
72 I XMDUZ'?.N S %=XMDUZ N XMDUZ S XMDUZ=% K %
73 K XMERR,^TMP("XMERR",$J)
74 S XMABORT=0
75 I '$D(XMTEXT) S XMMG="Error = No message text" Q
76 I '$O(@(XMTEXT_"0)")) S XMMG="Error = No message text" Q
77 I '$D(XMSUB) S XMMG="Error = No message subject" Q
78 ;I $L(XMSUB)<3!($L(XMSUB)>65) S XMMG="Error = Message subject too long or too short" Q
79 I $L(XMSUB)<3 S XMSUB=XMSUB_"..."
80 I $L(XMSUB)>65 S XMSUB=$E(XMSUB,1,65)
81 I $D(XMY)'<10 K XMMG
82 I XMDUZ'?.N D SETFROM(.XMDUZ,.XMINSTR) Q:$G(XMMG)["Error =" ; If XMDUZ=.5, becomes POSTMASTER
83 D INITAPI^XMVVITAE
84 D INITLATR^XMXADDR
85 I '$D(XMROU),'$D(DIFROM),'$D(XMYBLOB),$D(XMY) D Q
86 . D SEND(XMDUZ,XMSUB,XMTEXT,.XMSTRIP,.XMY,.XMINSTR,.XMMG,.XMZ)
87 . D QUIT
88 D CLEANUP^XMXADDR
89 S XMSUB=$$ENCODEUP^XMXUTIL1(XMSUB)
90 F D CRE8XMZ^XMXSEND(XMSUB,.XMZ) Q:XMZ>0 D
91 . K XMERR,^TMP("XMERR",$J)
92 . I $D(ZTQUEUED) H 1 Q
93 . W !,$C(7),$$EZBLD^DIALOG(34101),! ;Waiting for access to the Message File
94 . N I F I=1:1:10 H 1 W "."
95 I $D(XMYBLOB)>9 D Q:XMBLOBER
96 . ; Add BLOBS to message
97 . S XMBLOBER=$$MULTI^XMBBLOB(XMZ)
98 . K XMYBLOB
99 . Q:'XMBLOBER
100 . D KILLMSG^XMXUTIL(XMZ)
101 . K XMZ
102 D EN1A
103 Q
104SEND(XMDUZ,XMSUBJ,XMBODY,XMSTRIP,XMTO,XMINSTR,XMMG,XMZ) ;
105 S XMBODY=$$CREF^DILF(XMBODY)
106 S:$D(XMSTRIP) XMINSTR("STRIP")=XMSTRIP
107 D CHKBSKT(.XMTO,.XMINSTR)
108 D SENDMSG^XMXPARM(.XMDUZ,.XMSUBJ,.XMBODY,.XMTO,.XMINSTR)
109 I $D(XMERR) D ERR1 Q
110 S:$D(XMDF) XMINSTR("ADDR FLAGS")="R" ; Ignore addressee restrictions
111 D SENDMSG^XMXSEND(XMDUZ,XMSUBJ,XMBODY,.XMTO,.XMINSTR,.XMZ)
112 D:$D(XMERR) ERR1
113 Q
114ERR1 ;
115 S XMMG="Error = "_^TMP("XMERR",$J,1,"TEXT",1)
116 K XMERR,^TMP("XMERR",$J)
117 Q
118EN1 ; Enter text in the msg, ask for recipients if there aren't any,
119 ; and send the msg.
120 ; Needs: DUZ,XMZ,XMTEXT
121 ; Accepts: XMDF,XMY,XMMG,XMSTRIP,XMROU,DIFROM
122 ; Ignores: XMDUZ,XMSUB
123 ; Returns: N/A
124 ; Kills: XMTEXT,XMY,XMSTRIP,XMMG
125 N XMV,XMABORT,XMDUZ,XMFROM,XMINSTR,XMSUB ; (XMSUB is newed so it isn't killed in QUIT)
126 S XMABORT=0
127 S XMDUZ=DUZ
128 D INITAPI^XMVVITAE
129 D INITLATR^XMXADDR
130 K XMERR,^TMP("XMERR",$J)
131 I $D(XMY)'<10 K XMMG
132 S XMFROM=$P($G(^XMB(3.9,XMZ,0)),U,2)
133 I XMFROM'="",XMFROM'=XMDUZ S XMINSTR("FROM")=XMFROM
134 D EN1A
135 Q
136EN1A ;
137 D EN2A
138 Q:$D(DIFROM)
139 D EN3A
140 D QUIT
141 Q
142EN2A ;
143 N XMI,XMBODY
144 S XMI=0
145 I $D(XMROU)>9,'$O(^XMB(3.9,XMZ,2,0)) D NEW^XMP S XMI=1,^XMB(3.9,XMZ,2,0)="^^1^1"
146 S XMBODY=$$CREF^DILF(XMTEXT)
147 D MOVEBODY^XMXSEND(XMZ,XMBODY,"A")
148 D CHEKBODY^XMXSEND(XMZ,.XMSTRIP,XMI)
149 S XCNP=+$P($G(^XMB(3.9,XMZ,2,0)),U,3)
150 Q:$D(DIFROM)
151 Q:$D(XMROU)'>9
152 D XMROU^XMPH
153 K XMROU
154 D PSECURE^XMPSEC(XMZ,.XMABORT)
155 Q
156EN3 ; called from XPDTP (KIDS)
157 ; XMDUZ must be valid DUZ, if provided. It may not be a string.
158 N XMV,XMINSTR
159 I '$G(DUZ) N DUZ D DUZ^XUP(.5)
160 I '$D(XMDUZ) S XMDUZ=DUZ
161 D INITAPI^XMVVITAE
162 D INITLATR^XMXADDR
163 D EN3A
164 D QUIT
165 Q
166EN3A ;
167 N XMABORT
168 S XMABORT=0
169 S:$D(XMDF) XMINSTR("ADDR FLAGS")="R" ; Ignore addressee restrictions
170 I $D(XMY)<10,'$$GOTADDR^XMXADDR,'$D(ZTQUEUED) D
171 . I $D(XMMG) S XMINSTR("TO PROMPT")=XMMG K XMMG
172 . D TOWHOM^XMJMT($G(XMDUZ,DUZ),$$EZBLD^DIALOG(34110),.XMINSTR,"",.XMABORT) ;Send
173 E D
174 . D CHKBSKT(.XMY,.XMINSTR)
175 . D CHKADDR^XMXADDR(XMDUZ,.XMY,.XMINSTR) K:$D(XMERR) XMERR,^TMP("XMERR",$J)
176 Q:XMABORT
177 I '$$GOTADDR^XMXADDR S:'$D(XMMG) XMMG="Error = No recipients." Q
178 D BLDNSND^XMXSEND(XMDUZ,XMZ,.XMINSTR)
179 Q
180QUIT ;
181 K XMSUB,XMTEXT,XMY,XMSTRIP
182 D CLEANUP^XMXADDR
183 Q
184ENT ; Entry for outside users
185 ; All input variables ignored
186 I '$G(DUZ) W " User ID needed (DUZ) !!" Q
187 D EN^XM,SEND^XMJMS
188 Q
189INIT ; From DIFROM
190 D XMZ^XMA2 Q:XMZ<1 S $P(^XMB(3.9,XMZ,0),U,7)="X" D NEW^XMP
191 Q
192ENT1 ; Forward a msg, do not ask for recipients
193 ; Needs: DUZ,XMZ,XMY
194 ; Accepts: XMDUZ
195 ; Ignores: XMSUB,XMTEXT,XMMG,XMSTRIP,XMROU,DIFROM,XMYBLOB
196 ; Returns: N/A
197 ; Kills: XMDUZ,XMY
198 N XMDF
199 S XMDF=1
200 D ENT1A(0)
201 Q
202ENT1A(XMASK) ;
203 N XMV,XMINSTR,XMABORT
204 K XMERR,^TMP("XMERR",$J)
205 I '$G(DUZ) N DUZ D DUZ^XUP(.5)
206 I $G(XMDUZ)=""!($G(XMDUZ)=0) S XMDUZ=DUZ
207 S XMABORT=0
208 D:XMDUZ'?.N SETFWD(.XMDUZ,.XMINSTR)
209 D INITAPI^XMVVITAE
210 D INIT^XMXADDR
211 S:$D(XMDF) XMINSTR("ADDR FLAGS")="R" ; Ignore addressee restrictions
212 I XMASK D TOWHOM^XMJMT(XMDUZ,$$EZBLD^DIALOG(34111),.XMINSTR,"",.XMABORT) Q:XMABORT ;Forward
213 D CHKBSKT(.XMY,.XMINSTR)
214 D CHKADDR^XMXADDR(XMDUZ,.XMY,.XMINSTR) K:$D(XMERR) XMERR,^TMP("XMERR",$J)
215 I $$GOTADDR^XMXADDR D
216 . D FWD^XMKP(XMDUZ,XMZ,.XMINSTR)
217 . D CHECK^XMKPL
218 E S:'$D(XMMG) XMMG="Error = No recipients."
219 K XMDUZ,XMY
220 D CLEANUP^XMXADDR
221 Q
222ENT2 ; Forward a msg, ask for (more) recipients
223 ; Needs: DUZ,XMZ
224 ; Accepts: XMDUZ,XMY,XMDF
225 ; Ignores: XMSUB,XMTEXT,XMMG,XMSTRIP,XMROU,DIFROM,XMYBLOB
226 ; Returns: N/A
227 ; Kills: XMDUZ,XMY
228 D ENT1A($S($D(ZTQUEUED):0,1:1))
229 Q
230ENX ;FROM MAILMAN
231 S %=XMDUZ N XMDUZ,XMK S XMDUZ=% D XMD K %
232 Q
233ENL ; Add text to an existing message
234 ; Needs: XMZ,XMTEXT
235 ; Accepts: XMSTRIP
236 ; Ignores: DUZ,XMDUZ,XMSUB,XMMG,XMY,XMROU,DIFROM,XMYBLOB
237 ; Returns: N/A
238 ; Kills: XMSTRIP
239 N XMI,XMBODY
240 K XMERR,^TMP("XMERR",$J)
241 S XMBODY=$$CREF^DILF(XMTEXT)
242 S XMI=+$P($G(^XMB(3.9,XMZ,2,0)),U,3)
243 D MOVEBODY^XMXSEND(XMZ,XMBODY,"A")
244 D CHEKBODY^XMXSEND(XMZ,.XMSTRIP,XMI)
245 K XMSTRIP
246 Q
247CHKBSKT(XMTO,XMINSTR) ;
248 I $D(XMTO(XMDUZ,0)) S XMINSTR("SELF BSKT")=XMTO(XMDUZ,0)
249 I $D(XMTO(.6,0)) S XMINSTR("SHARE BSKT")=XMTO(.6,0)
250 I $D(XMTO(.6,"D")) S XMINSTR("SHARE DATE")=XMTO(.6,"D")
251 N XMADDR
252 S XMADDR=""
253 F S XMADDR=$O(XMTO(XMADDR)) Q:XMADDR="" I $D(XMTO(XMADDR,1)) D
254 . S XMTO(XMTO(XMADDR,1)_":"_XMADDR)=""
255 . K XMTO(XMADDR)
256 Q
257SETFROM(XMDUZ,XMINSTR) ;
258 Q:XMDUZ=DUZ
259 N XMPOSTPR
260 I XMDUZ=.5 D Q:XMPOSTPR
261 . S XMPOSTPR=+$O(^XMB(3.7,"AB",DUZ,.5,0))
262 . Q:'XMPOSTPR
263 . I $P($G(^XMB(3.7,.5,9,XMPOSTPR,0)),U,3)'="y" S XMPOSTPR=0
264 I XMDUZ'="POSTMASTER",XMDUZ'=.5 D CHKUSER(.XMDUZ) Q:+XMDUZ=XMDUZ
265 S XMINSTR("FROM")=$$XMFROM^XMXPARM("XMDUZ",XMDUZ)
266 I $D(XMERR) D ERR1 Q
267 S XMDUZ=DUZ
268 Q
269SETFWD(XMDUZ,XMINSTR) ;
270 Q:XMDUZ=DUZ
271 I XMDUZ=.5,$D(^XMB(3.7,"AB",DUZ,.5)) Q
272 I XMDUZ=.5,'$D(^XMB(3.7,"AB",DUZ,.5)) S XMDUZ="POSTMASTER"
273 E D CHKUSER(.XMDUZ) Q:+XMDUZ=XMDUZ
274 S XMINSTR("FWD BY")=$$XMFROM^XMXPARM("XMDUZ",XMDUZ)
275 I $D(XMERR) D ERR1 Q
276 S XMDUZ=DUZ
277 Q
278CHKUSER(XMDUZ) ;
279 N XMERR
280 D CHKUSER^XMXPARM1(.XMDUZ)
281 I $D(XMERR) K ^TMP("XMERR",$J),DIERR,^TMP("DIERR",$J)
282 Q
Note: See TracBrowser for help on using the repository browser.