source: WorldVistAEHR/trunk/r/MAILMAN-XM/XMAPHOST.m@ 1166

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

initial load of WorldVistAEHR
File size: 9.3 KB
RevLine 
[613]1XMAPHOST ;ISC-SF/GMB-Print to Message (P-MESSAGE) ;07/29/2003 14:36
2 ;;8.0;MailMan;**2,17,21,28,33**;Jun 28, 2002
3 ;Was (WASH ISC)/KMB/CAP before extensive rework.
4 ;
5 ;This routine handles printing to P-MESSAGE.
6 ;
7 ;To print reports to mail messages, we actually write to host files
8 ;(DOS,VMS...) and then suck them into mail messages. MailMan works
9 ;closely with TaskMan and the device handler to make it happen.
10 ;
11 ;If a user or application wants to write something to a mail message,
12 ;the user should choose (or the application should set ZTIO=) a device
13 ;whose name starts with "P-MESSAGE". The user or application can
14 ;set the subject of the message, as well as the recipients. The user
15 ;does this by responding to MailMan queries, and the application does
16 ;this by setting input variables (see below).
17 ;
18 ;EN^XMAPHOST is called as a pre-open execute for the P-MESSAGE device,
19 ;and READ^XMAPHOST is called as a close execute for the P-MESSAGE
20 ;terminal type.
21 ;
22 ;The pre-open execute is there to capture the wishes (message subject,
23 ;recipients, and whether to queue or not) of the user working in the
24 ;foreground. The global ^TMP("XM-MESS",$J) is created, as a result.
25 ;TaskMan looks for this global whenever $E(ZTIO,1,9)="P-MESSAGE", and
26 ;includes it in the task, if the user chooses to task the print. This
27 ;is a special arrangement that MailMan has with TaskMan.
28 ;
29 ;If the job printing to P-MESSAGE is running in the background, then
30 ;the pre-open execute code does not get executed during the pre-open
31 ;execute; instead, it is run as part of the close execute.
32 ;
33 ;If more than 250 consecutive null lines are encountered, MailMan
34 ;assumes EOF has somehow been missed, and stops transferring lines from
35 ;the host file to the message.
36 ;
37 ;This routine has one idiosyncracy. If the report contains one single
38 ;line or two lines separated with only a $C(13) instead of a CR/LF that
39 ;is more than 254 characters long, there will be unexpected results.
40 ;
41 ;Variables:
42 ;input:
43 ; XMDUZ (optional) Sender DUZ or string (default=DUZ)
44 ; If XMDUZ is a string, then user will not be asked who the
45 ; message should be from.
46 ; XMSUB (optional) message subject. If not supplied, then default
47 ; subject is "Queued mail report from "<user name>
48 ; XMY(x)="" (optional) array of additional addressees to whom the
49 ; message should be sent. See documentation for ^XMD for more
50 ; info on XMY.
51 ; The message will always be sent to XMDUZ (unless XMDUZ is a
52 ; string), so it is not necessary to set XMY(XMDUZ)="".
53 ; XMQUIET (optional) if $G(XMQUIET), then there is no user interaction
54 ; and no information written to the screen.
55 ; XMZBACK (optional) if $D(XMZBACK), then XMZ is set upon exit,
56 ; and XMZBACK is killed.
57 ;output:
58 ; XMZ If $D(XMZBACK), then XMZ is set with the IEN of the message,
59 ; and XMZBACK is killed; otherwise, XMZ is not set, and
60 ; remains whatever it was (or wasn't) before the call.
61 ; XMMG If error, may contain error message.
62 ; XMV("ERROR") If error, may contain error message.
63 ;
64EN ; Entry from pre-open execute of P-MESSAGE entry in DEVICE file.
65 ; If the user chooses to queue the print, we don't want this code
66 ; (the pre-open execute of the DEVICE file entry) to execute when
67 ; the task starts up.
68 K ^TMP("XM-MESS",$J)
69 N %H
70 Q:$D(ZTQUEUED)!$G(XMQUIET)!$D(DDS)
71 N XMAPHOST,XMABORT
72 D SETUP(.XMAPHOST,.XMABORT) I XMABORT S (POP,DUOUT,%ZISQUIT)=1 K IO("Q") Q
73 M ^TMP("XM-MESS",$J,"XMY")=^TMP("XMY",$J)
74 M ^TMP("XM-MESS",$J,"XMY0")=^TMP("XMY0",$J)
75 M ^TMP("XM-MESS",$J,"XMAPHOST")=XMAPHOST
76 D CLEANUP^XMXADDR
77 D KSETS
78 Q
79SETUP(XMAPHOST,XMABORT) ; Entry during close-execute (called from READ^XMAPHOST)
80 N XMINSTR
81 S XMABORT=0
82 D INIT(.XMDUZ,.XMAPHOST,.XMINSTR,.XMABORT)
83 I 'XMABORT D GETSUBJ($S($D(XMAPSUBJ):XMAPSUBJ,$D(XMSUB):XMSUB,1:""),.XMAPHOST,.XMABORT)
84 I 'XMABORT D FROMWHOM(XMDUZ,.XMINSTR,.XMABORT)
85 I 'XMABORT D ADDRMSG(XMDUZ,.XMINSTR,.XMABORT)
86 I 'XMABORT M XMAPHOST("XMINSTR")=XMINSTR Q
87 D CLEANUP^XMXADDR
88 D KSETS
89 Q
90INIT(XMDUZ,XMAPHOST,XMINSTR,XMABORT) ;
91 I '$D(XMDUZ) S XMDUZ=DUZ,XMAPHOST("SET XMDUZ")=1 K XMV
92 S XMAPHOST("CHG XMDUZ")=XMDUZ
93 D SETFROM^XMD(.XMDUZ,.XMINSTR) I $D(XMMG) S XMABORT=1 Q
94 I '$D(XMINSTR("FROM")) K XMAPHOST("CHG XMDUZ")
95 I '$D(XMV("NAME")) D Q:XMABORT
96 . S XMAPHOST("SET XMV")=1
97 . D INITAPI^XMVVITAE
98 . I $D(XMV("ERROR")) S XMABORT=1 D:'$D(ZTQUEUED) ERROR^XM(.XMV,"ERROR")
99 I $D(XMZBACK) S XMAPHOST("XMZBACK")="" K XMZBACK
100 S XMAPHOST("XMDUZ")=XMDUZ
101 M XMAPHOST("XMV")=XMV
102 Q
103GETSUBJ(XMSUBJ,XMAPHOST,XMABORT) ;
104 D CHKSUBJ(.XMSUBJ)
105 I $D(ZTQUEUED)!$G(XMQUIET) D
106 . S XMSUBJ=$G(XMSUBJ,$E($$EZBLD^DIALOG(34233,XMV("NAME")),1,65)) ; queued mail report from |1|
107 E D SUBJ^XMJMS(.XMSUBJ,.XMABORT) Q:XMABORT
108 S XMAPHOST("XMSUB")=XMSUBJ
109 Q
110CHKSUBJ(XMSUBJ) ;
111 I XMSUBJ="" K XMSUBJ Q
112 K XMERR,^TMP("XMERR",$J)
113 I $L(XMSUBJ)<3 S XMSUBJ=XMSUBJ_"..."
114 I $L(XMSUBJ)>65 S XMSUBJ=$E(XMSUBJ,1,65)
115 S XMSUBJ=$$XMSUBJ^XMXPARM("",XMSUBJ)
116 I $D(XMERR) K XMSUBJ,XMERR,^TMP("XMERR",$J)
117 Q
118FROMWHOM(XMDUZ,XMINSTR,XMABORT) ;
119 I XMDUZ=.5!$D(XMINSTR("FROM")) Q
120 N XMFROM
121 S XMFROM=$P($G(^XMB(3.7,XMDUZ,16)),U,3)
122 I $D(ZTQUEUED)!$G(XMQUIET) D Q
123 . I XMFROM="P" S XMINSTR("FROM")="POSTMASTER"
124 N DIR,X,Y,XMME,XMPOST
125 S DIR("A")=$$EZBLD^DIALOG(34239) ; From whom
126 S XMME=$$EZBLD^DIALOG(34240) ; M:Me
127 S XMPOST=$$EZBLD^DIALOG(34241) ; P:Postmaster
128 S DIR(0)="S^"_XMME_";"_XMPOST
129 S DIR("B")=$S(XMFROM="P":$P(XMPOST,":",2,9),1:$P(XMME,":",2,9))
130 D BLD^DIALOG(34242,"","","DIR(""?"")") ; Answer 'Me' if the message should be from...
131 D ^DIR I $D(DIRUT) S XMABORT=1 Q
132 I Y=$P(XMPOST,":",1) S XMINSTR("FROM")="POSTMASTER"
133 Q
134ADDRMSG(XMDUZ,XMINSTR,XMABORT) ;
135 ;I '$D(ZTQUEUED),'$G(XMQUIET) K XMY,XMY0
136 D INIT^XMXADDR
137 K XMERR,^TMP("XMERR",$J)
138 I $D(ZTQUEUED)!$G(XMQUIET) D
139 . I '$D(XMAPHOST("CHG XMDUZ")) S XMY(XMDUZ)=""
140 . D CHKBSKT^XMD(.XMY,.XMINSTR)
141 . D CHKADDR^XMXADDR(XMDUZ,.XMY,.XMINSTR)
142 . K XMY
143 E D Q:XMABORT ; ask the user for recipients.
144 . D TOWHOM^XMJMT(XMDUZ,$$EZBLD^DIALOG(34110),.XMINSTR,"",.XMABORT) ; send
145 Q
146READ ; Entry from close-execute of P-MESSAGE entry in TERMINAL TYPE file.
147 ; Read the host file into a message, send it, erase it.
148 ; Read record from file.
149 ; Each time <CR> is found in record it ends a message line.
150 N X,XMNULCNT,XMLEN,XMZZ,XMREC,XMI,XMLIMIT,XMAPHOST,XMINSTR,XMABORT
151 I '$D(^TMP("XM-MESS",$J)) D Q:XMABORT
152 . D SETUP(.XMAPHOST,.XMABORT)
153 E D
154 . M ^TMP("XMY",$J)=^TMP("XM-MESS",$J,"XMY")
155 . M ^TMP("XMY0",$J)=^TMP("XM-MESS",$J,"XMY0")
156 . M XMAPHOST=^TMP("XM-MESS",$J,"XMAPHOST")
157 . K ^TMP("XM-MESS",$J)
158 S XMDUZ=XMAPHOST("XMDUZ")
159 M XMV=XMAPHOST("XMV")
160 M XMINSTR=XMAPHOST("XMINSTR")
161 S XMLIMIT=$P($G(^XMB(1,1,.16)),U) ; P-MESSAGE LINE LIMIT
162 S:'XMLIMIT XMLIMIT=999999999999999
163 D CRE8XMZ^XMXSEND(XMAPHOST("XMSUB"),.XMZZ)
164 I '$D(ZTQUEUED),'$G(XMQUIET) D
165 . U IO(0)
166 . W !,$$EZBLD^DIALOG(34234) ; Moving to MailMan message...
167 . W !,"."
168 U IO
169 S (XMNULCNT,XMI)=0,XMREC=""
170 N $ETRAP,$ESTACK S $ETRAP="D EOFERR^XMAPHOST"
171 F S XMREC=$$GET() Q:$G(XMAPHOST("EOF")) D Q:$G(XMAPHOST("EOF"))!(XMI>XMLIMIT)
172 . I XMREC="" D Q:$G(XMAPHOST("EOF"))
173 . . S XMNULCNT=XMNULCNT+1
174 . . Q:XMNULCNT'>250 ; If more than 250 consecutive null lines,
175 . . S XMAPHOST("EOF")=1 ; set EOF and get rid of those null lines.
176 . . F K ^XMB(3.9,XMZZ,2,XMI,0) S XMI=XMI-1 Q:'XMI Q:$G(^XMB(3.9,XMZZ,2,XMI,0))'=""
177 . E S XMNULCNT=0
178 . S XMLEN=$L(XMREC)
179 . F D Q:XMREC=""!$G(XMAPHOST("EOF"))
180 . . D PUT(XMZZ,$P(XMREC,$C(13)),.XMI)
181 . . S XMREC=$P(XMREC,$C(13),2,999)
182 . . Q:XMREC=""
183 . . S:XMLEN>254 XMREC=XMREC_$$GET(),XMLEN=0
184 D EOF
185 Q
186GET() ; Read a record from the file
187 N Y,X
188 N $ETRAP,$ESTACK S $ETRAP="S $EC="""" S XMAPHOST(""EOF"")=1 Q """""
189 R Y#255:1
190 Q Y
191PUT(XMZZ,XMREC,XMI) ; Put data into message.
192 S XMI=XMI+1,^XMB(3.9,XMZZ,2,XMI,0)=$S(XMREC'?.E1C.E:XMREC,1:$$CTRL^XMXUTIL1(XMREC))
193 I '$D(ZTQUEUED),'$G(XMQUIET),XMI#10=0 U IO(0) W "." U IO
194 Q
195EOFERR ;
196 D EOF
197 D UNWIND^%ZTER
198 Q
199EOF ;
200 S $ETRAP=""
201 I XMI>XMLIMIT D
202 . S XMI=XMI+1,^XMB(3.9,XMZZ,2,XMI,0)=""
203 . S XMI=XMI+1,^XMB(3.9,XMZZ,2,XMI,0)="*******************************************************************"
204 . S XMI=XMI+1,^XMB(3.9,XMZZ,2,XMI,0)=$$EZBLD^DIALOG(34235,XMLIMIT) ; P-MESSAGE line limit of |1| reached.
205 . S XMI=XMI+1,^XMB(3.9,XMZZ,2,XMI,0)="*******************************************************************"
206 . Q:$D(ZTQUEUED)!$G(XMQUIET)
207 . U IO(0) W !,$$EZBLD^DIALOG(34235,XMLIMIT),! ; P-MESSAGE line limit of |1| reached.
208 I '$D(ZTQUEUED),'$G(XMQUIET) U IO(0) W !,$$EZBLD^DIALOG(34236) ; Finished moving.
209 S ^XMB(3.9,XMZZ,2,0)="^3.92A^"_XMI_"^"_XMI
210 D SENDMSG(XMDUZ,XMZZ,.XMINSTR)
211 D CLEANUP
212 Q
213SENDMSG(XMDUZ,XMZ,XMINSTR) ; Here, send the message to recipient.
214 I '$D(ZTQUEUED),'$G(XMQUIET) W !,$$EZBLD^DIALOG(34217,XMZ) ; Sending [_XMZ_]...
215 D MOVEPART^XMXSEND(XMDUZ,XMZ,.XMINSTR)
216 I $D(XMINSTR("FROM")),XMINSTR("FROM")="POSTMASTER"!(XMINSTR("FROM")?.N) S $P(^XMB(3.9,XMZ,0),U,4)=DUZ ; Retain 'sender'
217 I $D(XMINSTR("FROM")),$D(XMINSTR("SELF BSKT")),XMINSTR("SELF BSKT")'=1 D
218 . D FWD^XMKP(XMDUZ,XMZ,.XMINSTR)
219 E D
220 . D SEND^XMKP(XMDUZ,XMZ,.XMINSTR)
221 I '$D(ZTQUEUED),'$G(XMQUIET) W !,$$EZBLD^DIALOG(34213) ; Sent
222 D CHECK^XMKPL
223 Q
224CLEANUP ;
225 S IONOFF=1 ; Prevent form feed during device close
226 D CLEANUP^XMXADDR
227 D KSETS
228 K XMERR,^TMP("XMERR",$J)
229 I $D(XMAPHOST("XMZBACK")) S XMZ=XMZZ
230 Q
231KSETS ;
232 K:$G(XMAPHOST("SET XMDUZ")) XMDUZ
233 K:$G(XMAPHOST("SET XMV")) XMV,XMDUN,XMNOSEND,XMDISPI,XMPRIV
234 I $D(XMAPHOST("CHG XMDUZ")) S XMDUZ=XMAPHOST("CHG XMDUZ")
235 Q
Note: See TracBrowser for help on using the repository browser.