XMAPHOST ;(WASH ISC)/KMB/CAP-PRINT TO MESSAGE (P-MESSAGE) ;08/05/96 09:16 [ 12/04/96 3:56 PM ]
;;7.1;Mailman;**1003**;OCT 27, 1998
;;7.1;MailMan;**7,14,27**;Sep 12, 1994
;
;This routine is called as a close execute for the P-Message device
;to put reports written to host files (DOS,VMS...) into mail messages.
;
;It 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.
;
;
K ^TMP("XMY",$J),^TMP("XMY0",$J) I '$D(ZTQUEUED) K XMY,XMY0
S Y=0
N XMDUZ S XMDUZ=DUZ I '$G(XMDUZ) S XMDUZ=.5 I '$D(ZTQUEUED) U IO(0) W !!,*7,"No user identity. Using Postmaster as sender and receiver." U IO
S %=$G(XMSUB) N XMXUSEC,XMSUB,XMR S XMSUB=%
I '$D(^XMB(3.7,$S($D(XMDUZ):XMDUZ,1:DUZ))),'$D(ZTQUEUED) U IO(0) W !,*7,"You do not have a mail box. MailMan will not deliver messages to you." U IO
I '$D(ZTQUEUED) U IO(0) W !!,"Moving text to MailMan message... (Creating now) " U IO
N XMZ D DUN S XMSUB=$S($L($G(XMSUB))>3:XMSUB,$D(ZTQUEUED):"QUEUED MAIL REPORT FROM "_%,1:"")
I '$D(ZTQUEUED) D 0
D GET^XMA2
S XMAPHOST("XMZ")=XMZ,XMAPHOST("XMSUB")=XMSUB
Q
;
;Read the host file into a message, send it, erase it
READ ;Read record from file
;Each time <CR> is found in record it ends a message line
N %,XMA0,XMB0,XMR,XMZ,Y
I $$NEWERR^%ZTER N $ETRAP,$ESTACK S $ETRAP=""
S X="EOF^XMAPHOST",@^%ZOSF("TRAP")
S %=0,I=0,X="",XMZ=XMAPHOST("XMZ"),XMB0=^%ZOSF("OS")
O IO:("/m/XM"_DUZ_"."_$J:"R") ;IHS/MFD added line
U IO F D G EOF:$G(XMAPHOST("EOF"))
. S X=$$GET(),XMA0=$L(X) S:X="" %=%+1 Q:%>999!$G(XMAPHOST("EOF"))
. I X[""!(%<9) F D Q:X=""!$G(XMAPHOST("EOF"))
. . S I=$$PUT(XMZ,$P(X,$C(13)),I),X=$P(X,$C(13),2,999)
. . I $L(X),XMA0>254 S X=X_$$GET(),XMA0=0
. . Q
. Q
Q
PUT(XMZ,X,I) ;Put data into message.
S I=I+1,^XMB(3.9,XMZ,2,I,0)=$$STRIP(X),%=0
I '$D(ZTQUEUED),I#10=0 U IO(0) W "." U IO
Q I
GET() ;Read a record from the file
N Y,X
G:$D(XMAPHOST("EOF")) GETR
I $$NEWERR^%ZTER N $ETRAP,$ESTACK S $ETRAP=""
S X="GETQ^XMAPHOST",@^%ZOSF("TRAP")
GETR R Y#255:1
I XMB0["MSM" G GETQ:$ZC'=0 Q Y
Q Y
GETQ S XMAPHOST("EOF")=1
Q ""
EOF ;
I '$$NEWERR^%ZTER S X="ERR^ZU",@^%ZOSF("TRAP")
I '$D(ZTQUEUED) U IO(0) W !,"END OF FILE",!
S ^XMB(3.9,XMAPHOST("XMZ"),2,0)="^3.92A^"_I_"^"_I
;Here, send the message to recipient.
N XMZ S XMZ=XMAPHOST("XMZ") I $D(ZTQUEUED) S XMY($S($G(XMDUZ):XMDUZ,$G(DUZ):DUZ,1:.5))="" D REDO^XMA21 G FINAL
;Here, we ask the user for recipients.
I '$D(ZTQUEUED) U IO(0) D DUN N DIC,XMDUZ,XMDUN S XMDUZ=$S(DUZ:DUZ,1:.5),XMDUN=% D DESTXM^XMA21 G FINAL
FINAL I '$D(^TMP("XMY",$J)) S TMP("XMY",$J,.5)="",^TMP("XMY0",$J,.5)=""
D ENT^XMAD1
I '$D(ZTQUEUED) U IO(0) W !,"Message subject: ",XMAPHOST("XMSUB"),", Message number: ",XMZ,! H 3
Q1 S IONOFF=1 ;Prevent form feed during device close
K %,X,XMAPHOST,XMY,^TMP("XMY",$J),^TMP("XMY0",$J),Y,I Q
STRIP(X) ;Remove Control Characters
N % S %=0 I X'?.ANP N % F %=1:1:$L(X) I $E(X,%)?1C S X=$E(X,1,%-1)_$E(X,%+1,999) Q:X?.ANP S %=%-1
Q X
DUN ;GET NAME IN %
S %=$S($D(^VA(200,DUZ,0))#2:$P(^(0),U),'$D(^DIC(3,DUZ,0)):"POSTMASTER",1:$P(^DIC(3,DUZ,0),U))
Q
0 U IO(0) S XMAPHOST("XMSUB")=XMSUB D ENTS^XMA20
I X'["^" S XMSUB=$S($L(X):X,1:XMAPHOST("XMSUB")) U IO Q
W !!,"Sorry, I cannot stop the creation of this message at this point.",!,"You must enter a valid SUBJECT.",!
G 0
XMAPHOST ;(WASH ISC)/KMB/CAP-PRINT TO MESSAGE (P-MESSAGE) ;08/05/96 09:16 [ 12/04/96 3:56 PM ]
+1 ;;7.1;Mailman;**1003**;OCT 27, 1998
+2 ;;7.1;MailMan;**7,14,27**;Sep 12, 1994
+3 ;
+4 ;This routine is called as a close execute for the P-Message device
+5 ;to put reports written to host files (DOS,VMS...) into mail messages.
+6 ;
+7 ;It has one idiosyncracy. If the report contains one single line
+8 ;or two lines separated with only a $C(13) instead of a CR/LF that is
+9 ;more than 254 characters long, there will be unexpected results.
+10 ;
+11 ;
+12 KILL ^TMP("XMY",$JOB),^TMP("XMY0",$JOB)
IF '$DATA(ZTQUEUED)
KILL XMY,XMY0
+13 SET Y=0
+14 NEW XMDUZ
SET XMDUZ=DUZ
IF '$GET(XMDUZ)
SET XMDUZ=.5
IF '$DATA(ZTQUEUED)
USE IO(0)
WRITE !!,*7,"No user identity. Using Postmaster as sender and receiver."
USE IO
+15 SET %=$GET(XMSUB)
NEW XMXUSEC,XMSUB,XMR
SET XMSUB=%
+16 IF '$DATA(^XMB(3.7,$SELECT($DATA(XMDUZ):XMDUZ,1:DUZ)))
IF '$DATA(ZTQUEUED)
USE IO(0)
WRITE !,*7,"You do not have a mail box. MailMan will not deliver messages to you."
USE IO
+17 IF '$DATA(ZTQUEUED)
USE IO(0)
WRITE !!,"Moving text to MailMan message... (Creating now) "
USE IO
+18 NEW XMZ
DO DUN
SET XMSUB=$SELECT($LENGTH($GET(XMSUB))>3:XMSUB,$DATA(ZTQUEUED):"QUEUED MAIL REPORT FROM "_%,1:"")
+19 IF '$DATA(ZTQUEUED)
DO 0
+20 DO GET^XMA2
+21 SET XMAPHOST("XMZ")=XMZ
SET XMAPHOST("XMSUB")=XMSUB
+22 QUIT
+23 ;
+24 ;Read the host file into a message, send it, erase it
READ ;Read record from file
+1 ;Each time <CR> is found in record it ends a message line
+2 NEW %,XMA0,XMB0,XMR,XMZ,Y
+3 IF $$NEWERR^%ZTER
NEW $ETRAP,$ESTACK
SET $ETRAP=""
+4 SET X="EOF^XMAPHOST"
SET @^%ZOSF("TRAP")
+5 SET %=0
SET I=0
SET X=""
SET XMZ=XMAPHOST("XMZ")
SET XMB0=^%ZOSF("OS")
+6 ;IHS/MFD added line
OPEN IO:("/m/XM"_DUZ_"."_$JOB:"R")
+7 USE IO
FOR
Begin DoDot:1
+8 SET X=$$GET()
SET XMA0=$LENGTH(X)
IF X=""
SET %=%+1
IF %>999!$GET(XMAPHOST("EOF"))
QUIT
+9 IF X[""!(%<9)
FOR
Begin DoDot:2
+10 SET I=$$PUT(XMZ,$PIECE(X,$CHAR(13)),I)
SET X=$PIECE(X,$CHAR(13),2,999)
+11 IF $LENGTH(X)
IF XMA0>254
SET X=X_$$GET()
SET XMA0=0
+12 QUIT
End DoDot:2
IF X=""!$GET(XMAPHOST("EOF"))
QUIT
+13 QUIT
End DoDot:1
IF $GET(XMAPHOST("EOF"))
GOTO EOF
+14 QUIT
PUT(XMZ,X,I) ;Put data into message.
+1 SET I=I+1
SET ^XMB(3.9,XMZ,2,I,0)=$$STRIP(X)
SET %=0
+2 IF '$DATA(ZTQUEUED)
IF I#10=0
USE IO(0)
WRITE "."
USE IO
+3 QUIT I
GET() ;Read a record from the file
+1 NEW Y,X
+2 IF $DATA(XMAPHOST("EOF"))
GOTO GETR
+3 IF $$NEWERR^%ZTER
NEW $ETRAP,$ESTACK
SET $ETRAP=""
+4 SET X="GETQ^XMAPHOST"
SET @^%ZOSF("TRAP")
GETR READ Y#255:1
+1 IF XMB0["MSM"
IF $ZC'=0
GOTO GETQ
QUIT Y
+2 QUIT Y
GETQ SET XMAPHOST("EOF")=1
+1 QUIT ""
EOF ;
+1 IF '$$NEWERR^%ZTER
SET X="ERR^ZU"
SET @^%ZOSF("TRAP")
+2 IF '$DATA(ZTQUEUED)
USE IO(0)
WRITE !,"END OF FILE",!
+3 SET ^XMB(3.9,XMAPHOST("XMZ"),2,0)="^3.92A^"_I_"^"_I
+4 ;Here, send the message to recipient.
+5 NEW XMZ
SET XMZ=XMAPHOST("XMZ")
IF $DATA(ZTQUEUED)
SET XMY($SELECT($GET(XMDUZ):XMDUZ,$GET(DUZ):DUZ,1:.5))=""
DO REDO^XMA21
GOTO FINAL
+6 ;Here, we ask the user for recipients.
+7 IF '$DATA(ZTQUEUED)
USE IO(0)
DO DUN
NEW DIC,XMDUZ,XMDUN
SET XMDUZ=$SELECT(DUZ:DUZ,1:.5)
SET XMDUN=%
DO DESTXM^XMA21
GOTO FINAL
FINAL IF '$DATA(^TMP("XMY",$JOB))
SET TMP("XMY",$JOB,.5)=""
SET ^TMP("XMY0",$JOB,.5)=""
+1 DO ENT^XMAD1
+2 IF '$DATA(ZTQUEUED)
USE IO(0)
WRITE !,"Message subject: ",XMAPHOST("XMSUB"),", Message number: ",XMZ,!
HANG 3
Q1 ;Prevent form feed during device close
SET IONOFF=1
+1 KILL %,X,XMAPHOST,XMY,^TMP("XMY",$JOB),^TMP("XMY0",$JOB),Y,I
QUIT
STRIP(X) ;Remove Control Characters
+1 NEW %
SET %=0
IF X'?.ANP
NEW %
FOR %=1:1:$LENGTH(X)
IF $EXTRACT(X,%)?1C
SET X=$EXTRACT(X,1,%-1)_$EXTRACT(X,%+1,999)
IF X?.ANP
QUIT
SET %=%-1
+2 QUIT X
DUN ;GET NAME IN %
+1 SET %=$SELECT($DATA(^VA(200,DUZ,0))#2:$PIECE(^(0),U),'$DATA(^DIC(3,DUZ,0)):"POSTMASTER",1:$PIECE(^DIC(3,DUZ,0),U))
+2 QUIT
0 USE IO(0)
SET XMAPHOST("XMSUB")=XMSUB
DO ENTS^XMA20
+1 IF X'["^"
SET XMSUB=$SELECT($LENGTH(X):X,1:XMAPHOST("XMSUB"))
USE IO
QUIT
+2 WRITE !!,"Sorry, I cannot stop the creation of this message at this point.",!,"You must enter a valid SUBJECT.",!
+3 GOTO 0
