source: WorldVistAEHR/trunk/r/MAILMAN-XM/XMXSEND.m@ 648

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

initial load of WorldVistAEHR
File size: 9.3 KB
RevLine 
[613]1XMXSEND ;ISC-SF/GMB-Send a msg ;06/19/2002 07:01
2 ;;8.0;MailMan;;Jun 28, 2002
3 ; Entry points:
4 ; SENDMSG Send a message
5 ; CRE8XMZ Setup a message. (1st part of 3-part message sending process)
6 ; In the second part, the programmer directly sets the message
7 ; text into the global.
8 ; ADDRNSND Send the message created by CRE8XMZ and 'texted' by the
9 ; programmer. (3rd part of 3-part message sending process)
10 ; Involves checking the addressees, loading the message,
11 ; putting the addressees in the message,
12 ; and sending the message.
13 ; LATER TaskMan entry point to send a 'later'd message
14SENDMSG(XMDUZ,XMSUBJ,XMBODY,XMTO,XMINSTR,XMZ,XMATTACH) ;
15 ; XMDUZ DUZ of who the msg is from
16 ; XMSUBJ Subject of the msg
17 ; XMBODY Body of the msg
18 ; Must be closed root, passed by value. See WP_ROOT
19 ; definition for WP^DIE(), FM word processing filer.
20 ; XMTO Addressees
21 ; XMINSTR("SELF BSKT") Basket to deliver to if sender is recipient
22 ; XMINSTR("SHARE DATE") Delete date if recipient is "SHARED,MAIL"
23 ; XMINSTR("SHARE BSKT") Basket if recipient is "SHARED,MAIL"
24 ; XMINSTR("RCPT BSKT") Basket name (only) to deliver to for other recipients
25 ; XMINSTR("VAPOR") Date on which to vaporize (delete) this message
26 ; from recipient baskets
27 ; XMINSTR("LATER") Date on which to send this msg, if not now
28 ; XMINSTR("FROM") String saying from whom (default is user)
29 ; XMINSTR("FLAGS") Any or all of the following:
30 ; P Priority
31 ; I Information only (may not be replied to)
32 ; X Closed msg (may not be forwarded)
33 ; C Confidential (surrogates may not read)
34 ; S Send to sender (make sender a recipient)
35 ; R Confirm receipt
36 ; XMINSTR("SCR KEY") Scramble key (implies that msg should be scrambled)
37 ; XMINSTR("SCR HINT") Hint (to guess the scramble key)
38 ; XMINSTR("STRIP") String containing characters to strip from the message text
39 ; XMINSTR("TYPE") Msg type is one of the following:
40 ; D Document (NOT IMPLEMENTED)
41 ; S Spooled Document (NOT IMPLEMENTED)
42 ; X DIFROM (NOT IMPLEMENTED)
43 ; O ODIF (NOT IMPLEMENTED)
44 ; B BLOB
45 ; K KIDS (NOT IMPLEMENTED)
46 ; XMINSTR("ADDR FLAGS") Any or all of the following:
47 ; I Do not Initialize (kill) the ^TMP addressee global
48 ; R Do not Restrict addressees
49 ; XMZ (out) msg number in ^XMB(3.9 (BUT IF $D(XMINSTR("LATER")),
50 ; then XMZ contains the task number)
51 ; XMATTACH (in) Array of files to attach to message
52 ; ("IMAGE",x) imaging (BLOB) files
53 ; ("ROU",x) routines (NOT IMPLEMENTED)
54 K XMERR,^TMP("XMERR",$J)
55 Q:'$$SEND^XMXSEC(XMDUZ,.XMINSTR)
56 I $D(XMINSTR("LATER")) D Q
57 . N XMTASK
58 . D PSNDLATR(XMDUZ,XMSUBJ,XMBODY,.XMTO,.XMINSTR,.XMTASK,.XMATTACH)
59 . I $D(XMTASK) S XMZ=XMTASK
60 D CRE8XMZ(XMSUBJ,.XMZ) Q:$D(XMERR) ; Create a place for the msg in the msg file
61 D:$D(XMATTACH("IMAGE"))>9 ADDBLOB(XMZ,.XMATTACH) Q:$D(XMERR)
62 D MOVEBODY(XMZ,XMBODY) ; Put the msg body in place
63 D CHEKBODY(XMZ,$G(XMINSTR("STRIP")))
64 D ADDRNSND(XMDUZ,XMZ,.XMTO,.XMINSTR)
65 Q
66ADDRNSND(XMDUZ,XMZ,XMTO,XMINSTR) ;
67 D CHEKADDR(XMDUZ,XMZ,.XMTO,.XMINSTR)
68 D BLDNSND(XMDUZ,XMZ,.XMINSTR)
69 D CLEANUP^XMXADDR
70 Q
71CHEKADDR(XMDUZ,XMZ,XMTO,XMINSTR) ;
72 N XMRESTR
73 D:$G(XMINSTR("ADDR FLAGS"))'["I" INIT^XMXADDR
74 D:$G(XMINSTR("ADDR FLAGS"))'["R" CHKLINES^XMXSEC1(XMDUZ,XMZ,.XMRESTR)
75 D:$G(XMINSTR("FLAGS"))["S" CHKADDR^XMXADDR(XMDUZ,XMDUZ)
76 D CHKADDR^XMXADDR(XMDUZ,.XMTO,.XMINSTR,.XMRESTR) ; Address the msg
77 Q
78BLDNSND(XMDUZ,XMZ,XMINSTR) ;
79 D MOVEPART(XMDUZ,XMZ,.XMINSTR) ; Put various parts of the msg in place
80 I '$$GOTADDR^XMXADDR D ERRSET^XMXUTIL(34100) Q ; No addressees. Message not sent.
81 D SEND^XMKP(XMDUZ,XMZ,.XMINSTR) ; Send the msg
82 D CHECK^XMKPL
83 Q
84ADDBLOB(XMZ,XMATTACH) ;
85 N X,XMYBLOB,%X,%Y
86 S %X="XMATTACH(""IMAGE"",",%Y="XMYBLOB(" D %XY^%RCR
87 S X=$$MULTI^XMBBLOB(XMZ)
88 Q:'X
89 S XMERR=$G(XMERR)+1,^TMP("XMERR",$J,XMERR,"TEXT",1)="Error with $$MULTI^XMBBLOB"
90 D KILLMSG^XMXUTIL(XMZ)
91 Q
92CRE8XMZ(XMSUBJ,XMZ,XMIA) ; Create a place for the msg in the msg file
93 N XMFDA,XMIEN,XMMAXDIG,XMRESET
94 I XMSUBJ[U S XMSUBJ=$$ENCODEUP^XMXUTIL1(XMSUBJ)
95 S XMMAXDIG=$P($G(^XMB(1,1,.17),8),U,1) I 'XMMAXDIG S XMMAXDIG=8
96 S XMRESET=0
97TRYXMZ ;
98 S XMFDA(3.9,"+1,",.01)=XMSUBJ
99 S XMFDA(3.9,"+1,",31)=DT ; local create date
100 D UPDATE^DIE("","XMFDA","XMIEN")
101 I $D(DIERR) D Q
102 . S XMZ=-1
103 . ; Call to UPDATE^DIE failed. Can't get a message number.
104 . ; Here's the error returned by FileMan:
105 . D ERRSET^XMXUTIL(34107)
106 . N I,J,K
107 . S J=0
108 . S I=$O(^TMP("XMERR",$J,XMERR,"TEXT",":"),-1)
109 . F K=1:1:+DIERR D
110 . . F S J=$O(^TMP("DIERR",$J,K,"TEXT",J)) Q:'J D
111 . . . S I=I+1,^TMP("XMERR",$J,XMERR,"TEXT",I)=^TMP("DIERR",$J,K,"TEXT",J)
112 . Q:'$G(XMIA)!$D(ZTQUEUED)
113 . D SHOW^XMJERR
114 . D WAIT^XMXUTIL
115 S XMZ=XMIEN(1)
116 Q:$L(XMZ)'>XMMAXDIG
117 I XMRESET S $P(^XMB(1,1,.17),U,1)=$L(XMZ) Q
118 ; Recycle message numbers, because this one's too big...
119 K XMIEN
120 S XMRESET=1
121 I '$D(^XMB(3.9,99999,0)) D
122 . ; We do this so that if message 100000 is created and then deleted,
123 . ; FM will set piece 3 of ^XMB(3.9,0) to 99999. We don't want any
124 . ; message number lower than 100000 to be created, so that message
125 . ; numbers can't be confused with message sequence numbers in baskets
126 . S ^XMB(3.9,99999,0)="place holder"
127 . S ^XMB(3.9,"B","place holder",99999)=""
128 L +^XMB(3.9,0):1
129 I $L($P(^XMB(3.9,0),U,3))>XMMAXDIG S $P(^XMB(3.9,0),U,3)=99999
130 N DIK,DA S DIK="^XMB(3.9,",DA=XMZ D ^DIK ; Delete the message stub.
131 L -^XMB(3.9,0)
132 G TRYXMZ ; Go get another
133MOVEBODY(XMZ,XMBODY,XMFLAG) ;
134 D WP^DIE(3.9,XMZ_",",3,$G(XMFLAG),XMBODY)
135 Q
136CHEKBODY(XMZ,XMSTRIP,XMI) ; Remove XMSTRIP, control characters from text
137 N XMLINE,I,XMLEN,XMALTRD
138 S XMI=+$G(XMI)
139 F S XMI=$O(^XMB(3.9,XMZ,2,XMI)) Q:'XMI S XMLINE=^(XMI,0) D
140 . S XMALTRD=0
141 . I $G(XMSTRIP)'="" S XMLEN=$L(XMLINE),XMLINE=$TR(XMLINE,XMSTRIP) I XMLEN>$L(XMLINE) S XMALTRD=1
142 . I XMLINE?.E1C.E D
143 . . S (I,XMALTRD)=1
144 . . F D Q:XMLINE'?.E1C.E
145 . . . I $E(XMLINE,I)?1C S XMLINE=$E(XMLINE,1,I-1)_$E(XMLINE,I+1,999) Q
146 . . . S I=I+1
147 . S:XMALTRD ^XMB(3.9,XMZ,2,XMI,0)=XMLINE
148 Q
149MOVEPART(XMDUZ,XMZ,XMINSTR) ; Put various parts of the msg in place
150 N XMFDA,XMIENS
151 S XMIENS=XMZ_","
152 I $D(XMINSTR("FROM")) S XMFDA(3.9,XMIENS,1)=XMINSTR("FROM")
153 E D
154 . S XMFDA(3.9,XMIENS,1)=XMDUZ
155 . S:XMDUZ'=DUZ XMFDA(3.9,XMIENS,1.1)=DUZ
156 S XMFDA(3.9,XMIENS,1.4)=$$NOW^XLFDT()
157 I $D(XMINSTR) D
158 . S:$G(XMINSTR("FLAGS"))["R" XMFDA(3.9,XMIENS,1.3)="y"
159 . S:$D(XMINSTR("VAPOR")) XMFDA(3.9,XMIENS,1.6)=XMINSTR("VAPOR")
160 . S:$D(XMINSTR("TYPE")) XMFDA(3.9,XMIENS,1.7)=XMINSTR("TYPE")
161 . I $D(XMINSTR("SCR KEY")) D
162 . . N XMKEY,XMSECURE ; XMSECURE is new'd for scramble
163 . . S XMFDA(3.9,XMIENS,1.8)=$S($G(XMINSTR("SCR HINT"))="":" ",1:XMINSTR("SCR HINT"))
164 . . D LOADCODE^XMJMCODE
165 . . S XMKEY=XMINSTR("SCR KEY")
166 . . D ADJUST^XMJMCODE(.XMKEY)
167 . . S XMFDA(3.9,XMIENS,1.85)="1"_$$ENCSTR^XMJMCODE(XMKEY)
168 . . D ENCMSG^XMJMCODE(XMZ)
169 . S:$G(XMINSTR("FLAGS"))["X" XMFDA(3.9,XMIENS,1.95)="y"
170 . S:$G(XMINSTR("FLAGS"))["C" XMFDA(3.9,XMIENS,1.96)="y"
171 . S:$G(XMINSTR("FLAGS"))["I" XMFDA(3.9,XMIENS,1.97)="y"
172 . S:$G(XMINSTR("FLAGS"))["P" XMFDA(3.9,XMIENS,1.7)=$G(XMFDA(3.9,XMIENS,1.7))_"P"
173 . S:$D(XMINSTR("RCPT BSKT")) XMFDA(3.9,XMIENS,21)=XMINSTR("RCPT BSKT")
174 S:$$BRODCAST^XMKP XMFDA(3.9,XMIENS,1.97)="y"
175 D FILE^DIE("","XMFDA")
176 Q
177LATER ; TaskMan entry point to send a user's latered message
178 N XMI,XMLATER,XMPREFIX,XMTO,XMV,XMPRIVAT,XMBCAST
179 S XMPRIVAT=$$EZBLD^DIALOG(39135) ; " [Private Mail Group]"
180 S XMBCAST=$$EZBLD^DIALOG(39006) ; "* (Broadcast to all local users)"
181 D INIT^XMVVITAE
182 S XMI=""
183 F S XMI=$O(^TMP("XMY0",$J,XMI)) Q:XMI="" D
184 . S XMPREFIX=$G(^TMP("XMY0",$J,XMI,1)) ; prefix (I:,C:)
185 . S XMLATER=$G(^TMP("XMY0",$J,XMI,"L"))
186 . S:XMLATER'="" XMPREFIX=XMPREFIX_"L@"_XMLATER
187 . S:XMPREFIX'="" XMPREFIX=XMPREFIX_":"
188 . S XMTO(XMPREFIX_$S(XMI[XMPRIVAT:$P(XMI,XMPRIVAT,1),XMI=XMBCAST:"*",1:XMI))="" ; (set in ^XMXADDRG)
189 D SENDMSG(XMDUZ,XMSUBJ,"^TMP(""XM"",$J,""BODY"")",.XMTO,.XMINSTR)
190 S ZTREQ="@"
191 Q
192PSNDLATR(XMDUZ,XMSUBJ,XMBODY,XMTO,XMINSTR,ZTSK,XMATTACH) ; Set up a task for a program to send a message later
193 N ZTRTN,ZTDTH,ZTDESC,ZTIO,ZTSAVE
194 S ZTIO=""
195 S ZTRTN="PTSKLATR^XMXSEND"
196 S ZTDTH=$$FMTH^XLFDT(XMINSTR("LATER"))
197 S ZTDESC=$$EZBLD^DIALOG(39310) ; MailMan: Send Message Later
198 S ZTSAVE($$OREF^DILF(XMBODY))=""
199 F I="DUZ","XMDUZ","XMSUBJ","XMBODY","XMTO","XMTO(","XMINSTR(","XMATTACH(" S ZTSAVE(I)=""
200 D ^%ZTLOAD
201 ;D HOME^%ZIS call this only if preceded by call to ^%ZIS
202 I '$D(ZTSK) D ERRSET^XMXUTIL(39311) ; Task creation not successful
203 Q
204PTSKLATR ; TaskMan entry point to send a program's latered message
205 K XMINSTR("LATER")
206 D SENDMSG(XMDUZ,XMSUBJ,XMBODY,.XMTO,.XMINSTR,"",.XMATTACH)
207 S ZTREQ="@"
208 Q
209STARTMSG(XMSUBJ,XMZ) ;
210 K XMERR,^TMP("XMERR",$J)
211 D CRE8XMZ(XMSUBJ,.XMZ) Q:$D(XMERR)
212 S XMLCNT=0
213 Q
214BODYLINE(XMZ,XMLINE) ; Put the msg body in place, line by line
215 S XMLCNT=XMLCNT+1
216 S ^XMB(3.9,XMZ,2,XMLCNT,0)=XMLINE
217 Q
218ENDMSG(XMDUZ,XMZ,XMTO,XMINSTR) ;
219 S ^XMB(3.9,XMZ,2,0)="^^"_XMLCNT_U_XMLCNT_U_DT
220 K XMLCNT
221 D ADDRNSND(XMDUZ,XMZ,.XMTO,.XMINSTR)
222 Q
223POSTMAST(XMDUZ,XMINSTR) ;
224 S:'$D(XMDUZ) XMDUZ=DUZ
225 D:'$G(XMV("PRIV")) INIT^XMVVITAE
226 S XMINSTR("FROM")=.5
227 Q
Note: See TracBrowser for help on using the repository browser.