XMAPHOST ;ISC-SF/GMB-Print to Message (P-MESSAGE) ;07/29/2003 14:36
;;8.0;MailMan;**2,17,21,28,33**;Jun 28, 2002
;Was (WASH ISC)/KMB/CAP before extensive rework.
;
;This routine handles printing to P-MESSAGE.
;
;To print reports to mail messages, we actually write to host files
;(DOS,VMS...) and then suck them into mail messages. MailMan works
;closely with TaskMan and the device handler to make it happen.
;
;If a user or application wants to write something to a mail message,
;the user should choose (or the application should set ZTIO=) a device
;whose name starts with "P-MESSAGE". The user or application can
;set the subject of the message, as well as the recipients. The user
;does this by responding to MailMan queries, and the application does
;this by setting input variables (see below).
;
;EN^XMAPHOST is called as a pre-open execute for the P-MESSAGE device,
;and READ^XMAPHOST is called as a close execute for the P-MESSAGE
;terminal type.
;
;The pre-open execute is there to capture the wishes (message subject,
;recipients, and whether to queue or not) of the user working in the
;foreground. The global ^TMP("XM-MESS",$J) is created, as a result.
;TaskMan looks for this global whenever $E(ZTIO,1,9)="P-MESSAGE", and
;includes it in the task, if the user chooses to task the print. This
;is a special arrangement that MailMan has with TaskMan.
;
;If the job printing to P-MESSAGE is running in the background, then
;the pre-open execute code does not get executed during the pre-open
;execute; instead, it is run as part of the close execute.
;
;If more than 250 consecutive null lines are encountered, MailMan
;assumes EOF has somehow been missed, and stops transferring lines from
;the host file to the message.
;
;This routine has one idiosyncracy. If the report contains one single
;line or two lines separated with only a $C(13) instead of a CR/LF that
;is more than 254 characters long, there will be unexpected results.
;
;Variables:
;input:
; XMDUZ (optional) Sender DUZ or string (default=DUZ)
; If XMDUZ is a string, then user will not be asked who the
; message should be from.
; XMSUB (optional) message subject. If not supplied, then default
; subject is "Queued mail report from "<user name>
; XMY(x)="" (optional) array of additional addressees to whom the
; message should be sent. See documentation for ^XMD for more
; info on XMY.
; The message will always be sent to XMDUZ (unless XMDUZ is a
; string), so it is not necessary to set XMY(XMDUZ)="".
; XMQUIET (optional) if $G(XMQUIET), then there is no user interaction
; and no information written to the screen.
; XMZBACK (optional) if $D(XMZBACK), then XMZ is set upon exit,
; and XMZBACK is killed.
;output:
; XMZ If $D(XMZBACK), then XMZ is set with the IEN of the message,
; and XMZBACK is killed; otherwise, XMZ is not set, and
; remains whatever it was (or wasn't) before the call.
; XMMG If error, may contain error message.
; XMV("ERROR") If error, may contain error message.
;
EN ; Entry from pre-open execute of P-MESSAGE entry in DEVICE file.
; If the user chooses to queue the print, we don't want this code
; (the pre-open execute of the DEVICE file entry) to execute when
; the task starts up.
K ^TMP("XM-MESS",$J)
N %H
Q:$D(ZTQUEUED)!$G(XMQUIET)!$D(DDS)
N XMAPHOST,XMABORT
D SETUP(.XMAPHOST,.XMABORT) I XMABORT S (POP,DUOUT,%ZISQUIT)=1 K IO("Q") Q
M ^TMP("XM-MESS",$J,"XMY")=^TMP("XMY",$J)
M ^TMP("XM-MESS",$J,"XMY0")=^TMP("XMY0",$J)
M ^TMP("XM-MESS",$J,"XMAPHOST")=XMAPHOST
D CLEANUP^XMXADDR
D KSETS
Q
SETUP(XMAPHOST,XMABORT) ; Entry during close-execute (called from READ^XMAPHOST)
N XMINSTR
S XMABORT=0
D INIT(.XMDUZ,.XMAPHOST,.XMINSTR,.XMABORT)
I 'XMABORT D GETSUBJ($S($D(XMAPSUBJ):XMAPSUBJ,$D(XMSUB):XMSUB,1:""),.XMAPHOST,.XMABORT)
I 'XMABORT D FROMWHOM(XMDUZ,.XMINSTR,.XMABORT)
I 'XMABORT D ADDRMSG(XMDUZ,.XMINSTR,.XMABORT)
I 'XMABORT M XMAPHOST("XMINSTR")=XMINSTR Q
D CLEANUP^XMXADDR
D KSETS
Q
INIT(XMDUZ,XMAPHOST,XMINSTR,XMABORT) ;
I '$D(XMDUZ) S XMDUZ=DUZ,XMAPHOST("SET XMDUZ")=1 K XMV
S XMAPHOST("CHG XMDUZ")=XMDUZ
D SETFROM^XMD(.XMDUZ,.XMINSTR) I $D(XMMG) S XMABORT=1 Q
I '$D(XMINSTR("FROM")) K XMAPHOST("CHG XMDUZ")
I '$D(XMV("NAME")) D Q:XMABORT
. S XMAPHOST("SET XMV")=1
. D INITAPI^XMVVITAE
. I $D(XMV("ERROR")) S XMABORT=1 D:'$D(ZTQUEUED) ERROR^XM(.XMV,"ERROR")
I $D(XMZBACK) S XMAPHOST("XMZBACK")="" K XMZBACK
S XMAPHOST("XMDUZ")=XMDUZ
M XMAPHOST("XMV")=XMV
Q
GETSUBJ(XMSUBJ,XMAPHOST,XMABORT) ;
D CHKSUBJ(.XMSUBJ)
I $D(ZTQUEUED)!$G(XMQUIET) D
. S XMSUBJ=$G(XMSUBJ,$E($$EZBLD^DIALOG(34233,XMV("NAME")),1,65)) ; queued mail report from |1|
E D SUBJ^XMJMS(.XMSUBJ,.XMABORT) Q:XMABORT
S XMAPHOST("XMSUB")=XMSUBJ
Q
CHKSUBJ(XMSUBJ) ;
I XMSUBJ="" K XMSUBJ Q
K XMERR,^TMP("XMERR",$J)
I $L(XMSUBJ)<3 S XMSUBJ=XMSUBJ_"..."
I $L(XMSUBJ)>65 S XMSUBJ=$E(XMSUBJ,1,65)
S XMSUBJ=$$XMSUBJ^XMXPARM("",XMSUBJ)
I $D(XMERR) K XMSUBJ,XMERR,^TMP("XMERR",$J)
Q
FROMWHOM(XMDUZ,XMINSTR,XMABORT) ;
I XMDUZ=.5!$D(XMINSTR("FROM")) Q
N XMFROM
S XMFROM=$P($G(^XMB(3.7,XMDUZ,16)),U,3)
I $D(ZTQUEUED)!$G(XMQUIET) D Q
. I XMFROM="P" S XMINSTR("FROM")="POSTMASTER"
N DIR,X,Y,XMME,XMPOST
S DIR("A")=$$EZBLD^DIALOG(34239) ; From whom
S XMME=$$EZBLD^DIALOG(34240) ; M:Me
S XMPOST=$$EZBLD^DIALOG(34241) ; P:Postmaster
S DIR(0)="S^"_XMME_";"_XMPOST
S DIR("B")=$S(XMFROM="P":$P(XMPOST,":",2,9),1:$P(XMME,":",2,9))
D BLD^DIALOG(34242,"","","DIR(""?"")") ; Answer 'Me' if the message should be from...
D ^DIR I $D(DIRUT) S XMABORT=1 Q
I Y=$P(XMPOST,":",1) S XMINSTR("FROM")="POSTMASTER"
Q
ADDRMSG(XMDUZ,XMINSTR,XMABORT) ;
;I '$D(ZTQUEUED),'$G(XMQUIET) K XMY,XMY0
D INIT^XMXADDR
K XMERR,^TMP("XMERR",$J)
I $D(ZTQUEUED)!$G(XMQUIET) D
. I '$D(XMAPHOST("CHG XMDUZ")) S XMY(XMDUZ)=""
. D CHKBSKT^XMD(.XMY,.XMINSTR)
. D CHKADDR^XMXADDR(XMDUZ,.XMY,.XMINSTR)
. K XMY
E D Q:XMABORT ; ask the user for recipients.
. D TOWHOM^XMJMT(XMDUZ,$$EZBLD^DIALOG(34110),.XMINSTR,"",.XMABORT) ; send
Q
READ ; Entry from close-execute of P-MESSAGE entry in TERMINAL TYPE file.
; Read the host file into a message, send it, erase it.
; Read record from file.
; Each time <CR> is found in record it ends a message line.
N X,XMNULCNT,XMLEN,XMZZ,XMREC,XMI,XMLIMIT,XMAPHOST,XMINSTR,XMABORT
I '$D(^TMP("XM-MESS",$J)) D Q:XMABORT
. D SETUP(.XMAPHOST,.XMABORT)
E D
. M ^TMP("XMY",$J)=^TMP("XM-MESS",$J,"XMY")
. M ^TMP("XMY0",$J)=^TMP("XM-MESS",$J,"XMY0")
. M XMAPHOST=^TMP("XM-MESS",$J,"XMAPHOST")
. K ^TMP("XM-MESS",$J)
S XMDUZ=XMAPHOST("XMDUZ")
M XMV=XMAPHOST("XMV")
M XMINSTR=XMAPHOST("XMINSTR")
S XMLIMIT=$P($G(^XMB(1,1,.16)),U) ; P-MESSAGE LINE LIMIT
S:'XMLIMIT XMLIMIT=999999999999999
D CRE8XMZ^XMXSEND(XMAPHOST("XMSUB"),.XMZZ)
I '$D(ZTQUEUED),'$G(XMQUIET) D
. U IO(0)
. W !,$$EZBLD^DIALOG(34234) ; Moving to MailMan message...
. W !,"."
U IO
S (XMNULCNT,XMI)=0,XMREC=""
N $ETRAP,$ESTACK S $ETRAP="D EOFERR^XMAPHOST"
F S XMREC=$$GET() Q:$G(XMAPHOST("EOF")) D Q:$G(XMAPHOST("EOF"))!(XMI>XMLIMIT)
. I XMREC="" D Q:$G(XMAPHOST("EOF"))
. . S XMNULCNT=XMNULCNT+1
. . Q:XMNULCNT'>250 ; If more than 250 consecutive null lines,
. . S XMAPHOST("EOF")=1 ; set EOF and get rid of those null lines.
. . F K ^XMB(3.9,XMZZ,2,XMI,0) S XMI=XMI-1 Q:'XMI Q:$G(^XMB(3.9,XMZZ,2,XMI,0))'=""
. E S XMNULCNT=0
. S XMLEN=$L(XMREC)
. F D Q:XMREC=""!$G(XMAPHOST("EOF"))
. . D PUT(XMZZ,$P(XMREC,$C(13)),.XMI)
. . S XMREC=$P(XMREC,$C(13),2,999)
. . Q:XMREC=""
. . S:XMLEN>254 XMREC=XMREC_$$GET(),XMLEN=0
D EOF
Q
GET() ; Read a record from the file
N Y,X
N $ETRAP,$ESTACK S $ETRAP="S $EC="""" S XMAPHOST(""EOF"")=1 Q """""
R Y#255:1
Q Y
PUT(XMZZ,XMREC,XMI) ; Put data into message.
S XMI=XMI+1,^XMB(3.9,XMZZ,2,XMI,0)=$S(XMREC'?.E1C.E:XMREC,1:$$CTRL^XMXUTIL1(XMREC))
I '$D(ZTQUEUED),'$G(XMQUIET),XMI#10=0 U IO(0) W "." U IO
Q
EOFERR ;
D EOF
D UNWIND^%ZTER
Q
EOF ;
S $ETRAP=""
I XMI>XMLIMIT D
. S XMI=XMI+1,^XMB(3.9,XMZZ,2,XMI,0)=""
. S XMI=XMI+1,^XMB(3.9,XMZZ,2,XMI,0)="*******************************************************************"
. S XMI=XMI+1,^XMB(3.9,XMZZ,2,XMI,0)=$$EZBLD^DIALOG(34235,XMLIMIT) ; P-MESSAGE line limit of |1| reached.
. S XMI=XMI+1,^XMB(3.9,XMZZ,2,XMI,0)="*******************************************************************"
. Q:$D(ZTQUEUED)!$G(XMQUIET)
. U IO(0) W !,$$EZBLD^DIALOG(34235,XMLIMIT),! ; P-MESSAGE line limit of |1| reached.
I '$D(ZTQUEUED),'$G(XMQUIET) U IO(0) W !,$$EZBLD^DIALOG(34236) ; Finished moving.
S ^XMB(3.9,XMZZ,2,0)="^3.92A^"_XMI_"^"_XMI
D SENDMSG(XMDUZ,XMZZ,.XMINSTR)
D CLEANUP
Q
SENDMSG(XMDUZ,XMZ,XMINSTR) ; Here, send the message to recipient.
I '$D(ZTQUEUED),'$G(XMQUIET) W !,$$EZBLD^DIALOG(34217,XMZ) ; Sending [_XMZ_]...
D MOVEPART^XMXSEND(XMDUZ,XMZ,.XMINSTR)
I $D(XMINSTR("FROM")),XMINSTR("FROM")="POSTMASTER"!(XMINSTR("FROM")?.N) S $P(^XMB(3.9,XMZ,0),U,4)=DUZ ; Retain 'sender'
I $D(XMINSTR("FROM")),$D(XMINSTR("SELF BSKT")),XMINSTR("SELF BSKT")'=1 D
. D FWD^XMKP(XMDUZ,XMZ,.XMINSTR)
E D
. D SEND^XMKP(XMDUZ,XMZ,.XMINSTR)
I '$D(ZTQUEUED),'$G(XMQUIET) W !,$$EZBLD^DIALOG(34213) ; Sent
D CHECK^XMKPL
Q
CLEANUP ;
S IONOFF=1 ; Prevent form feed during device close
D CLEANUP^XMXADDR
D KSETS
K XMERR,^TMP("XMERR",$J)
I $D(XMAPHOST("XMZBACK")) S XMZ=XMZZ
Q
KSETS ;
K:$G(XMAPHOST("SET XMDUZ")) XMDUZ
K:$G(XMAPHOST("SET XMV")) XMV,XMDUN,XMNOSEND,XMDISPI,XMPRIV
I $D(XMAPHOST("CHG XMDUZ")) S XMDUZ=XMAPHOST("CHG XMDUZ")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMAPHOST 9807 printed Dec 13, 2024@02:11:04 Page 2
XMAPHOST ;ISC-SF/GMB-Print to Message (P-MESSAGE) ;07/29/2003 14:36
+1 ;;8.0;MailMan;**2,17,21,28,33**;Jun 28, 2002
+2 ;Was (WASH ISC)/KMB/CAP before extensive rework.
+3 ;
+4 ;This routine handles printing to P-MESSAGE.
+5 ;
+6 ;To print reports to mail messages, we actually write to host files
+7 ;(DOS,VMS...) and then suck them into mail messages. MailMan works
+8 ;closely with TaskMan and the device handler to make it happen.
+9 ;
+10 ;If a user or application wants to write something to a mail message,
+11 ;the user should choose (or the application should set ZTIO=) a device
+12 ;whose name starts with "P-MESSAGE". The user or application can
+13 ;set the subject of the message, as well as the recipients. The user
+14 ;does this by responding to MailMan queries, and the application does
+15 ;this by setting input variables (see below).
+16 ;
+17 ;EN^XMAPHOST is called as a pre-open execute for the P-MESSAGE device,
+18 ;and READ^XMAPHOST is called as a close execute for the P-MESSAGE
+19 ;terminal type.
+20 ;
+21 ;The pre-open execute is there to capture the wishes (message subject,
+22 ;recipients, and whether to queue or not) of the user working in the
+23 ;foreground. The global ^TMP("XM-MESS",$J) is created, as a result.
+24 ;TaskMan looks for this global whenever $E(ZTIO,1,9)="P-MESSAGE", and
+25 ;includes it in the task, if the user chooses to task the print. This
+26 ;is a special arrangement that MailMan has with TaskMan.
+27 ;
+28 ;If the job printing to P-MESSAGE is running in the background, then
+29 ;the pre-open execute code does not get executed during the pre-open
+30 ;execute; instead, it is run as part of the close execute.
+31 ;
+32 ;If more than 250 consecutive null lines are encountered, MailMan
+33 ;assumes EOF has somehow been missed, and stops transferring lines from
+34 ;the host file to the message.
+35 ;
+36 ;This routine has one idiosyncracy. If the report contains one single
+37 ;line or two lines separated with only a $C(13) instead of a CR/LF that
+38 ;is more than 254 characters long, there will be unexpected results.
+39 ;
+40 ;Variables:
+41 ;input:
+42 ; XMDUZ (optional) Sender DUZ or string (default=DUZ)
+43 ; If XMDUZ is a string, then user will not be asked who the
+44 ; message should be from.
+45 ; XMSUB (optional) message subject. If not supplied, then default
+46 ; subject is "Queued mail report from "<user name>
+47 ; XMY(x)="" (optional) array of additional addressees to whom the
+48 ; message should be sent. See documentation for ^XMD for more
+49 ; info on XMY.
+50 ; The message will always be sent to XMDUZ (unless XMDUZ is a
+51 ; string), so it is not necessary to set XMY(XMDUZ)="".
+52 ; XMQUIET (optional) if $G(XMQUIET), then there is no user interaction
+53 ; and no information written to the screen.
+54 ; XMZBACK (optional) if $D(XMZBACK), then XMZ is set upon exit,
+55 ; and XMZBACK is killed.
+56 ;output:
+57 ; XMZ If $D(XMZBACK), then XMZ is set with the IEN of the message,
+58 ; and XMZBACK is killed; otherwise, XMZ is not set, and
+59 ; remains whatever it was (or wasn't) before the call.
+60 ; XMMG If error, may contain error message.
+61 ; XMV("ERROR") If error, may contain error message.
+62 ;
EN ; Entry from pre-open execute of P-MESSAGE entry in DEVICE file.
+1 ; If the user chooses to queue the print, we don't want this code
+2 ; (the pre-open execute of the DEVICE file entry) to execute when
+3 ; the task starts up.
+4 KILL ^TMP("XM-MESS",$JOB)
+5 NEW %H
+6 if $DATA(ZTQUEUED)!$GET(XMQUIET)!$DATA(DDS)
QUIT
+7 NEW XMAPHOST,XMABORT
+8 DO SETUP(.XMAPHOST,.XMABORT)
IF XMABORT
SET (POP,DUOUT,%ZISQUIT)=1
KILL IO("Q")
QUIT
+9 MERGE ^TMP("XM-MESS",$JOB,"XMY")=^TMP("XMY",$JOB)
+10 MERGE ^TMP("XM-MESS",$JOB,"XMY0")=^TMP("XMY0",$JOB)
+11 MERGE ^TMP("XM-MESS",$JOB,"XMAPHOST")=XMAPHOST
+12 DO CLEANUP^XMXADDR
+13 DO KSETS
+14 QUIT
SETUP(XMAPHOST,XMABORT) ; Entry during close-execute (called from READ^XMAPHOST)
+1 NEW XMINSTR
+2 SET XMABORT=0
+3 DO INIT(.XMDUZ,.XMAPHOST,.XMINSTR,.XMABORT)
+4 IF 'XMABORT
DO GETSUBJ($SELECT($DATA(XMAPSUBJ):XMAPSUBJ,$DATA(XMSUB):XMSUB,1:""),.XMAPHOST,.XMABORT)
+5 IF 'XMABORT
DO FROMWHOM(XMDUZ,.XMINSTR,.XMABORT)
+6 IF 'XMABORT
DO ADDRMSG(XMDUZ,.XMINSTR,.XMABORT)
+7 IF 'XMABORT
MERGE XMAPHOST("XMINSTR")=XMINSTR
QUIT
+8 DO CLEANUP^XMXADDR
+9 DO KSETS
+10 QUIT
INIT(XMDUZ,XMAPHOST,XMINSTR,XMABORT) ;
+1 IF '$DATA(XMDUZ)
SET XMDUZ=DUZ
SET XMAPHOST("SET XMDUZ")=1
KILL XMV
+2 SET XMAPHOST("CHG XMDUZ")=XMDUZ
+3 DO SETFROM^XMD(.XMDUZ,.XMINSTR)
IF $DATA(XMMG)
SET XMABORT=1
QUIT
+4 IF '$DATA(XMINSTR("FROM"))
KILL XMAPHOST("CHG XMDUZ")
+5 IF '$DATA(XMV("NAME"))
Begin DoDot:1
+6 SET XMAPHOST("SET XMV")=1
+7 DO INITAPI^XMVVITAE
+8 IF $DATA(XMV("ERROR"))
SET XMABORT=1
if '$DATA(ZTQUEUED)
DO ERROR^XM(.XMV,"ERROR")
End DoDot:1
if XMABORT
QUIT
+9 IF $DATA(XMZBACK)
SET XMAPHOST("XMZBACK")=""
KILL XMZBACK
+10 SET XMAPHOST("XMDUZ")=XMDUZ
+11 MERGE XMAPHOST("XMV")=XMV
+12 QUIT
GETSUBJ(XMSUBJ,XMAPHOST,XMABORT) ;
+1 DO CHKSUBJ(.XMSUBJ)
+2 IF $DATA(ZTQUEUED)!$GET(XMQUIET)
Begin DoDot:1
+3 ; queued mail report from |1|
SET XMSUBJ=$GET(XMSUBJ,$EXTRACT($$EZBLD^DIALOG(34233,XMV("NAME")),1,65))
End DoDot:1
+4 IF '$TEST
DO SUBJ^XMJMS(.XMSUBJ,.XMABORT)
if XMABORT
QUIT
+5 SET XMAPHOST("XMSUB")=XMSUBJ
+6 QUIT
CHKSUBJ(XMSUBJ) ;
+1 IF XMSUBJ=""
KILL XMSUBJ
QUIT
+2 KILL XMERR,^TMP("XMERR",$JOB)
+3 IF $LENGTH(XMSUBJ)<3
SET XMSUBJ=XMSUBJ_"..."
+4 IF $LENGTH(XMSUBJ)>65
SET XMSUBJ=$EXTRACT(XMSUBJ,1,65)
+5 SET XMSUBJ=$$XMSUBJ^XMXPARM("",XMSUBJ)
+6 IF $DATA(XMERR)
KILL XMSUBJ,XMERR,^TMP("XMERR",$JOB)
+7 QUIT
FROMWHOM(XMDUZ,XMINSTR,XMABORT) ;
+1 IF XMDUZ=.5!$DATA(XMINSTR("FROM"))
QUIT
+2 NEW XMFROM
+3 SET XMFROM=$PIECE($GET(^XMB(3.7,XMDUZ,16)),U,3)
+4 IF $DATA(ZTQUEUED)!$GET(XMQUIET)
Begin DoDot:1
+5 IF XMFROM="P"
SET XMINSTR("FROM")="POSTMASTER"
End DoDot:1
QUIT
+6 NEW DIR,X,Y,XMME,XMPOST
+7 ; From whom
SET DIR("A")=$$EZBLD^DIALOG(34239)
+8 ; M:Me
SET XMME=$$EZBLD^DIALOG(34240)
+9 ; P:Postmaster
SET XMPOST=$$EZBLD^DIALOG(34241)
+10 SET DIR(0)="S^"_XMME_";"_XMPOST
+11 SET DIR("B")=$SELECT(XMFROM="P":$PIECE(XMPOST,":",2,9),1:$PIECE(XMME,":",2,9))
+12 ; Answer 'Me' if the message should be from...
DO BLD^DIALOG(34242,"","","DIR(""?"")")
+13 DO ^DIR
IF $DATA(DIRUT)
SET XMABORT=1
QUIT
+14 IF Y=$PIECE(XMPOST,":",1)
SET XMINSTR("FROM")="POSTMASTER"
+15 QUIT
ADDRMSG(XMDUZ,XMINSTR,XMABORT) ;
+1 ;I '$D(ZTQUEUED),'$G(XMQUIET) K XMY,XMY0
+2 DO INIT^XMXADDR
+3 KILL XMERR,^TMP("XMERR",$JOB)
+4 IF $DATA(ZTQUEUED)!$GET(XMQUIET)
Begin DoDot:1
+5 IF '$DATA(XMAPHOST("CHG XMDUZ"))
SET XMY(XMDUZ)=""
+6 DO CHKBSKT^XMD(.XMY,.XMINSTR)
+7 DO CHKADDR^XMXADDR(XMDUZ,.XMY,.XMINSTR)
+8 KILL XMY
End DoDot:1
+9 ; ask the user for recipients.
IF '$TEST
Begin DoDot:1
+10 ; send
DO TOWHOM^XMJMT(XMDUZ,$$EZBLD^DIALOG(34110),.XMINSTR,"",.XMABORT)
End DoDot:1
if XMABORT
QUIT
+11 QUIT
READ ; Entry from close-execute of P-MESSAGE entry in TERMINAL TYPE file.
+1 ; Read the host file into a message, send it, erase it.
+2 ; Read record from file.
+3 ; Each time <CR> is found in record it ends a message line.
+4 NEW X,XMNULCNT,XMLEN,XMZZ,XMREC,XMI,XMLIMIT,XMAPHOST,XMINSTR,XMABORT
+5 IF '$DATA(^TMP("XM-MESS",$JOB))
Begin DoDot:1
+6 DO SETUP(.XMAPHOST,.XMABORT)
End DoDot:1
if XMABORT
QUIT
+7 IF '$TEST
Begin DoDot:1
+8 MERGE ^TMP("XMY",$JOB)=^TMP("XM-MESS",$JOB,"XMY")
+9 MERGE ^TMP("XMY0",$JOB)=^TMP("XM-MESS",$JOB,"XMY0")
+10 MERGE XMAPHOST=^TMP("XM-MESS",$JOB,"XMAPHOST")
+11 KILL ^TMP("XM-MESS",$JOB)
End DoDot:1
+12 SET XMDUZ=XMAPHOST("XMDUZ")
+13 MERGE XMV=XMAPHOST("XMV")
+14 MERGE XMINSTR=XMAPHOST("XMINSTR")
+15 ; P-MESSAGE LINE LIMIT
SET XMLIMIT=$PIECE($GET(^XMB(1,1,.16)),U)
+16 if 'XMLIMIT
SET XMLIMIT=999999999999999
+17 DO CRE8XMZ^XMXSEND(XMAPHOST("XMSUB"),.XMZZ)
+18 IF '$DATA(ZTQUEUED)
IF '$GET(XMQUIET)
Begin DoDot:1
+19 USE IO(0)
+20 ; Moving to MailMan message...
WRITE !,$$EZBLD^DIALOG(34234)
+21 WRITE !,"."
End DoDot:1
+22 USE IO
+23 SET (XMNULCNT,XMI)=0
SET XMREC=""
+24 NEW $ETRAP,$ESTACK
SET $ETRAP="D EOFERR^XMAPHOST"
+25 FOR
SET XMREC=$$GET()
if $GET(XMAPHOST("EOF"))
QUIT
Begin DoDot:1
+26 IF XMREC=""
Begin DoDot:2
+27 SET XMNULCNT=XMNULCNT+1
+28 ; If more than 250 consecutive null lines,
if XMNULCNT'>250
QUIT
+29 ; set EOF and get rid of those null lines.
SET XMAPHOST("EOF")=1
+30 FOR
KILL ^XMB(3.9,XMZZ,2,XMI,0)
SET XMI=XMI-1
if 'XMI
QUIT
if $GET(^XMB(3.9,XMZZ,2,XMI,0))'=""
QUIT
End DoDot:2
if $GET(XMAPHOST("EOF"))
QUIT
+31 IF '$TEST
SET XMNULCNT=0
+32 SET XMLEN=$LENGTH(XMREC)
+33 FOR
Begin DoDot:2
+34 DO PUT(XMZZ,$PIECE(XMREC,$CHAR(13)),.XMI)
+35 SET XMREC=$PIECE(XMREC,$CHAR(13),2,999)
+36 if XMREC=""
QUIT
+37 if XMLEN>254
SET XMREC=XMREC_$$GET()
SET XMLEN=0
End DoDot:2
if XMREC=""!$GET(XMAPHOST("EOF"))
QUIT
End DoDot:1
if $GET(XMAPHOST("EOF"))!(XMI>XMLIMIT)
QUIT
+38 DO EOF
+39 QUIT
GET() ; Read a record from the file
+1 NEW Y,X
+2 NEW $ETRAP,$ESTACK
SET $ETRAP="S $EC="""" S XMAPHOST(""EOF"")=1 Q """""
+3 READ Y#255:1
+4 QUIT Y
PUT(XMZZ,XMREC,XMI) ; Put data into message.
+1 SET XMI=XMI+1
SET ^XMB(3.9,XMZZ,2,XMI,0)=$SELECT(XMREC'?.E1C.E:XMREC,1:$$CTRL^XMXUTIL1(XMREC))
+2 IF '$DATA(ZTQUEUED)
IF '$GET(XMQUIET)
IF XMI#10=0
USE IO(0)
WRITE "."
USE IO
+3 QUIT
EOFERR ;
+1 DO EOF
+2 DO UNWIND^%ZTER
+3 QUIT
EOF ;
+1 SET $ETRAP=""
+2 IF XMI>XMLIMIT
Begin DoDot:1
+3 SET XMI=XMI+1
SET ^XMB(3.9,XMZZ,2,XMI,0)=""
+4 SET XMI=XMI+1
SET ^XMB(3.9,XMZZ,2,XMI,0)="*******************************************************************"
+5 ; P-MESSAGE line limit of |1| reached.
SET XMI=XMI+1
SET ^XMB(3.9,XMZZ,2,XMI,0)=$$EZBLD^DIALOG(34235,XMLIMIT)
+6 SET XMI=XMI+1
SET ^XMB(3.9,XMZZ,2,XMI,0)="*******************************************************************"
+7 if $DATA(ZTQUEUED)!$GET(XMQUIET)
QUIT
+8 ; P-MESSAGE line limit of |1| reached.
USE IO(0)
WRITE !,$$EZBLD^DIALOG(34235,XMLIMIT),!
End DoDot:1
+9 ; Finished moving.
IF '$DATA(ZTQUEUED)
IF '$GET(XMQUIET)
USE IO(0)
WRITE !,$$EZBLD^DIALOG(34236)
+10 SET ^XMB(3.9,XMZZ,2,0)="^3.92A^"_XMI_"^"_XMI
+11 DO SENDMSG(XMDUZ,XMZZ,.XMINSTR)
+12 DO CLEANUP
+13 QUIT
SENDMSG(XMDUZ,XMZ,XMINSTR) ; Here, send the message to recipient.
+1 ; Sending [_XMZ_]...
IF '$DATA(ZTQUEUED)
IF '$GET(XMQUIET)
WRITE !,$$EZBLD^DIALOG(34217,XMZ)
+2 DO MOVEPART^XMXSEND(XMDUZ,XMZ,.XMINSTR)
+3 ; Retain 'sender'
IF $DATA(XMINSTR("FROM"))
IF XMINSTR("FROM")="POSTMASTER"!(XMINSTR("FROM")?.N)
SET $PIECE(^XMB(3.9,XMZ,0),U,4)=DUZ
+4 IF $DATA(XMINSTR("FROM"))
IF $DATA(XMINSTR("SELF BSKT"))
IF XMINSTR("SELF BSKT")'=1
Begin DoDot:1
+5 DO FWD^XMKP(XMDUZ,XMZ,.XMINSTR)
End DoDot:1
+6 IF '$TEST
Begin DoDot:1
+7 DO SEND^XMKP(XMDUZ,XMZ,.XMINSTR)
End DoDot:1
+8 ; Sent
IF '$DATA(ZTQUEUED)
IF '$GET(XMQUIET)
WRITE !,$$EZBLD^DIALOG(34213)
+9 DO CHECK^XMKPL
+10 QUIT
CLEANUP ;
+1 ; Prevent form feed during device close
SET IONOFF=1
+2 DO CLEANUP^XMXADDR
+3 DO KSETS
+4 KILL XMERR,^TMP("XMERR",$JOB)
+5 IF $DATA(XMAPHOST("XMZBACK"))
SET XMZ=XMZZ
+6 QUIT
KSETS ;
+1 if $GET(XMAPHOST("SET XMDUZ"))
KILL XMDUZ
+2 if $GET(XMAPHOST("SET XMV"))
KILL XMV,XMDUN,XMNOSEND,XMDISPI,XMPRIV
+3 IF $DATA(XMAPHOST("CHG XMDUZ"))
SET XMDUZ=XMAPHOST("CHG XMDUZ")
+4 QUIT
