XMXSEND ;ISC-SF/GMB-Send a msg ;06/19/2002 07:01
;;8.0;MailMan;;Jun 28, 2002
; Entry points:
; SENDMSG Send a message
; CRE8XMZ Setup a message. (1st part of 3-part message sending process)
; In the second part, the programmer directly sets the message
; text into the global.
; ADDRNSND Send the message created by CRE8XMZ and 'texted' by the
; programmer. (3rd part of 3-part message sending process)
; Involves checking the addressees, loading the message,
; putting the addressees in the message,
; and sending the message.
; LATER TaskMan entry point to send a 'later'd message
SENDMSG(XMDUZ,XMSUBJ,XMBODY,XMTO,XMINSTR,XMZ,XMATTACH) ;
; XMDUZ DUZ of who the msg is from
; XMSUBJ Subject of the msg
; XMBODY Body of the msg
; Must be closed root, passed by value. See WP_ROOT
; definition for WP^DIE(), FM word processing filer.
; XMTO Addressees
; XMINSTR("SELF BSKT") Basket to deliver to if sender is recipient
; XMINSTR("SHARE DATE") Delete date if recipient is "SHARED,MAIL"
; XMINSTR("SHARE BSKT") Basket if recipient is "SHARED,MAIL"
; XMINSTR("RCPT BSKT") Basket name (only) to deliver to for other recipients
; XMINSTR("VAPOR") Date on which to vaporize (delete) this message
; from recipient baskets
; XMINSTR("LATER") Date on which to send this msg, if not now
; XMINSTR("FROM") String saying from whom (default is user)
; XMINSTR("FLAGS") Any or all of the following:
; P Priority
; I Information only (may not be replied to)
; X Closed msg (may not be forwarded)
; C Confidential (surrogates may not read)
; S Send to sender (make sender a recipient)
; R Confirm receipt
; XMINSTR("SCR KEY") Scramble key (implies that msg should be scrambled)
; XMINSTR("SCR HINT") Hint (to guess the scramble key)
; XMINSTR("STRIP") String containing characters to strip from the message text
; XMINSTR("TYPE") Msg type is one of the following:
; D Document (NOT IMPLEMENTED)
; S Spooled Document (NOT IMPLEMENTED)
; X DIFROM (NOT IMPLEMENTED)
; O ODIF (NOT IMPLEMENTED)
; B BLOB
; K KIDS (NOT IMPLEMENTED)
; XMINSTR("ADDR FLAGS") Any or all of the following:
; I Do not Initialize (kill) the ^TMP addressee global
; R Do not Restrict addressees
; XMZ (out) msg number in ^XMB(3.9 (BUT IF $D(XMINSTR("LATER")),
; then XMZ contains the task number)
; XMATTACH (in) Array of files to attach to message
; ("IMAGE",x) imaging (BLOB) files
; ("ROU",x) routines (NOT IMPLEMENTED)
K XMERR,^TMP("XMERR",$J)
Q:'$$SEND^XMXSEC(XMDUZ,.XMINSTR)
I $D(XMINSTR("LATER")) D Q
. N XMTASK
. D PSNDLATR(XMDUZ,XMSUBJ,XMBODY,.XMTO,.XMINSTR,.XMTASK,.XMATTACH)
. I $D(XMTASK) S XMZ=XMTASK
D CRE8XMZ(XMSUBJ,.XMZ) Q:$D(XMERR) ; Create a place for the msg in the msg file
D:$D(XMATTACH("IMAGE"))>9 ADDBLOB(XMZ,.XMATTACH) Q:$D(XMERR)
D MOVEBODY(XMZ,XMBODY) ; Put the msg body in place
D CHEKBODY(XMZ,$G(XMINSTR("STRIP")))
D ADDRNSND(XMDUZ,XMZ,.XMTO,.XMINSTR)
Q
ADDRNSND(XMDUZ,XMZ,XMTO,XMINSTR) ;
D CHEKADDR(XMDUZ,XMZ,.XMTO,.XMINSTR)
D BLDNSND(XMDUZ,XMZ,.XMINSTR)
D CLEANUP^XMXADDR
Q
CHEKADDR(XMDUZ,XMZ,XMTO,XMINSTR) ;
N XMRESTR
D:$G(XMINSTR("ADDR FLAGS"))'["I" INIT^XMXADDR
D:$G(XMINSTR("ADDR FLAGS"))'["R" CHKLINES^XMXSEC1(XMDUZ,XMZ,.XMRESTR)
D:$G(XMINSTR("FLAGS"))["S" CHKADDR^XMXADDR(XMDUZ,XMDUZ)
D CHKADDR^XMXADDR(XMDUZ,.XMTO,.XMINSTR,.XMRESTR) ; Address the msg
Q
BLDNSND(XMDUZ,XMZ,XMINSTR) ;
D MOVEPART(XMDUZ,XMZ,.XMINSTR) ; Put various parts of the msg in place
I '$$GOTADDR^XMXADDR D ERRSET^XMXUTIL(34100) Q ; No addressees. Message not sent.
D SEND^XMKP(XMDUZ,XMZ,.XMINSTR) ; Send the msg
D CHECK^XMKPL
Q
ADDBLOB(XMZ,XMATTACH) ;
N X,XMYBLOB,%X,%Y
S %X="XMATTACH(""IMAGE"",",%Y="XMYBLOB(" D %XY^%RCR
S X=$$MULTI^XMBBLOB(XMZ)
Q:'X
S XMERR=$G(XMERR)+1,^TMP("XMERR",$J,XMERR,"TEXT",1)="Error with $$MULTI^XMBBLOB"
D KILLMSG^XMXUTIL(XMZ)
Q
CRE8XMZ(XMSUBJ,XMZ,XMIA) ; Create a place for the msg in the msg file
N XMFDA,XMIEN,XMMAXDIG,XMRESET
I XMSUBJ[U S XMSUBJ=$$ENCODEUP^XMXUTIL1(XMSUBJ)
S XMMAXDIG=$P($G(^XMB(1,1,.17),8),U,1) I 'XMMAXDIG S XMMAXDIG=8
S XMRESET=0
TRYXMZ ;
S XMFDA(3.9,"+1,",.01)=XMSUBJ
S XMFDA(3.9,"+1,",31)=DT ; local create date
D UPDATE^DIE("","XMFDA","XMIEN")
I $D(DIERR) D Q
. S XMZ=-1
. ; Call to UPDATE^DIE failed. Can't get a message number.
. ; Here's the error returned by FileMan:
. D ERRSET^XMXUTIL(34107)
. N I,J,K
. S J=0
. S I=$O(^TMP("XMERR",$J,XMERR,"TEXT",":"),-1)
. F K=1:1:+DIERR D
. . F S J=$O(^TMP("DIERR",$J,K,"TEXT",J)) Q:'J D
. . . S I=I+1,^TMP("XMERR",$J,XMERR,"TEXT",I)=^TMP("DIERR",$J,K,"TEXT",J)
. Q:'$G(XMIA)!$D(ZTQUEUED)
. D SHOW^XMJERR
. D WAIT^XMXUTIL
S XMZ=XMIEN(1)
Q:$L(XMZ)'>XMMAXDIG
I XMRESET S $P(^XMB(1,1,.17),U,1)=$L(XMZ) Q
; Recycle message numbers, because this one's too big...
K XMIEN
S XMRESET=1
I '$D(^XMB(3.9,99999,0)) D
. ; We do this so that if message 100000 is created and then deleted,
. ; FM will set piece 3 of ^XMB(3.9,0) to 99999. We don't want any
. ; message number lower than 100000 to be created, so that message
. ; numbers can't be confused with message sequence numbers in baskets
. S ^XMB(3.9,99999,0)="place holder"
. S ^XMB(3.9,"B","place holder",99999)=""
L +^XMB(3.9,0):1
I $L($P(^XMB(3.9,0),U,3))>XMMAXDIG S $P(^XMB(3.9,0),U,3)=99999
N DIK,DA S DIK="^XMB(3.9,",DA=XMZ D ^DIK ; Delete the message stub.
L -^XMB(3.9,0)
G TRYXMZ ; Go get another
MOVEBODY(XMZ,XMBODY,XMFLAG) ;
D WP^DIE(3.9,XMZ_",",3,$G(XMFLAG),XMBODY)
Q
CHEKBODY(XMZ,XMSTRIP,XMI) ; Remove XMSTRIP, control characters from text
N XMLINE,I,XMLEN,XMALTRD
S XMI=+$G(XMI)
F S XMI=$O(^XMB(3.9,XMZ,2,XMI)) Q:'XMI S XMLINE=^(XMI,0) D
. S XMALTRD=0
. I $G(XMSTRIP)'="" S XMLEN=$L(XMLINE),XMLINE=$TR(XMLINE,XMSTRIP) I XMLEN>$L(XMLINE) S XMALTRD=1
. I XMLINE?.E1C.E D
. . S (I,XMALTRD)=1
. . F D Q:XMLINE'?.E1C.E
. . . I $E(XMLINE,I)?1C S XMLINE=$E(XMLINE,1,I-1)_$E(XMLINE,I+1,999) Q
. . . S I=I+1
. S:XMALTRD ^XMB(3.9,XMZ,2,XMI,0)=XMLINE
Q
MOVEPART(XMDUZ,XMZ,XMINSTR) ; Put various parts of the msg in place
N XMFDA,XMIENS
S XMIENS=XMZ_","
I $D(XMINSTR("FROM")) S XMFDA(3.9,XMIENS,1)=XMINSTR("FROM")
E D
. S XMFDA(3.9,XMIENS,1)=XMDUZ
. S:XMDUZ'=DUZ XMFDA(3.9,XMIENS,1.1)=DUZ
S XMFDA(3.9,XMIENS,1.4)=$$NOW^XLFDT()
I $D(XMINSTR) D
. S:$G(XMINSTR("FLAGS"))["R" XMFDA(3.9,XMIENS,1.3)="y"
. S:$D(XMINSTR("VAPOR")) XMFDA(3.9,XMIENS,1.6)=XMINSTR("VAPOR")
. S:$D(XMINSTR("TYPE")) XMFDA(3.9,XMIENS,1.7)=XMINSTR("TYPE")
. I $D(XMINSTR("SCR KEY")) D
. . N XMKEY,XMSECURE ; XMSECURE is new'd for scramble
. . S XMFDA(3.9,XMIENS,1.8)=$S($G(XMINSTR("SCR HINT"))="":" ",1:XMINSTR("SCR HINT"))
. . D LOADCODE^XMJMCODE
. . S XMKEY=XMINSTR("SCR KEY")
. . D ADJUST^XMJMCODE(.XMKEY)
. . S XMFDA(3.9,XMIENS,1.85)="1"_$$ENCSTR^XMJMCODE(XMKEY)
. . D ENCMSG^XMJMCODE(XMZ)
. S:$G(XMINSTR("FLAGS"))["X" XMFDA(3.9,XMIENS,1.95)="y"
. S:$G(XMINSTR("FLAGS"))["C" XMFDA(3.9,XMIENS,1.96)="y"
. S:$G(XMINSTR("FLAGS"))["I" XMFDA(3.9,XMIENS,1.97)="y"
. S:$G(XMINSTR("FLAGS"))["P" XMFDA(3.9,XMIENS,1.7)=$G(XMFDA(3.9,XMIENS,1.7))_"P"
. S:$D(XMINSTR("RCPT BSKT")) XMFDA(3.9,XMIENS,21)=XMINSTR("RCPT BSKT")
S:$$BRODCAST^XMKP XMFDA(3.9,XMIENS,1.97)="y"
D FILE^DIE("","XMFDA")
Q
LATER ; TaskMan entry point to send a user's latered message
N XMI,XMLATER,XMPREFIX,XMTO,XMV,XMPRIVAT,XMBCAST
S XMPRIVAT=$$EZBLD^DIALOG(39135) ; " [Private Mail Group]"
S XMBCAST=$$EZBLD^DIALOG(39006) ; "* (Broadcast to all local users)"
D INIT^XMVVITAE
S XMI=""
F S XMI=$O(^TMP("XMY0",$J,XMI)) Q:XMI="" D
. S XMPREFIX=$G(^TMP("XMY0",$J,XMI,1)) ; prefix (I:,C:)
. S XMLATER=$G(^TMP("XMY0",$J,XMI,"L"))
. S:XMLATER'="" XMPREFIX=XMPREFIX_"L@"_XMLATER
. S:XMPREFIX'="" XMPREFIX=XMPREFIX_":"
. S XMTO(XMPREFIX_$S(XMI[XMPRIVAT:$P(XMI,XMPRIVAT,1),XMI=XMBCAST:"*",1:XMI))="" ; (set in ^XMXADDRG)
D SENDMSG(XMDUZ,XMSUBJ,"^TMP(""XM"",$J,""BODY"")",.XMTO,.XMINSTR)
S ZTREQ="@"
Q
PSNDLATR(XMDUZ,XMSUBJ,XMBODY,XMTO,XMINSTR,ZTSK,XMATTACH) ; Set up a task for a program to send a message later
N ZTRTN,ZTDTH,ZTDESC,ZTIO,ZTSAVE
S ZTIO=""
S ZTRTN="PTSKLATR^XMXSEND"
S ZTDTH=$$FMTH^XLFDT(XMINSTR("LATER"))
S ZTDESC=$$EZBLD^DIALOG(39310) ; MailMan: Send Message Later
S ZTSAVE($$OREF^DILF(XMBODY))=""
F I="DUZ","XMDUZ","XMSUBJ","XMBODY","XMTO","XMTO(","XMINSTR(","XMATTACH(" S ZTSAVE(I)=""
D ^%ZTLOAD
;D HOME^%ZIS call this only if preceded by call to ^%ZIS
I '$D(ZTSK) D ERRSET^XMXUTIL(39311) ; Task creation not successful
Q
PTSKLATR ; TaskMan entry point to send a program's latered message
K XMINSTR("LATER")
D SENDMSG(XMDUZ,XMSUBJ,XMBODY,.XMTO,.XMINSTR,"",.XMATTACH)
S ZTREQ="@"
Q
STARTMSG(XMSUBJ,XMZ) ;
K XMERR,^TMP("XMERR",$J)
D CRE8XMZ(XMSUBJ,.XMZ) Q:$D(XMERR)
S XMLCNT=0
Q
BODYLINE(XMZ,XMLINE) ; Put the msg body in place, line by line
S XMLCNT=XMLCNT+1
S ^XMB(3.9,XMZ,2,XMLCNT,0)=XMLINE
Q
ENDMSG(XMDUZ,XMZ,XMTO,XMINSTR) ;
S ^XMB(3.9,XMZ,2,0)="^^"_XMLCNT_U_XMLCNT_U_DT
K XMLCNT
D ADDRNSND(XMDUZ,XMZ,.XMTO,.XMINSTR)
Q
POSTMAST(XMDUZ,XMINSTR) ;
S:'$D(XMDUZ) XMDUZ=DUZ
D:'$G(XMV("PRIV")) INIT^XMVVITAE
S XMINSTR("FROM")=.5
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMXSEND 9762 printed Dec 13, 2024@02:14:27 Page 2
XMXSEND ;ISC-SF/GMB-Send a msg ;06/19/2002 07:01
+1 ;;8.0;MailMan;;Jun 28, 2002
+2 ; Entry points:
+3 ; SENDMSG Send a message
+4 ; CRE8XMZ Setup a message. (1st part of 3-part message sending process)
+5 ; In the second part, the programmer directly sets the message
+6 ; text into the global.
+7 ; ADDRNSND Send the message created by CRE8XMZ and 'texted' by the
+8 ; programmer. (3rd part of 3-part message sending process)
+9 ; Involves checking the addressees, loading the message,
+10 ; putting the addressees in the message,
+11 ; and sending the message.
+12 ; LATER TaskMan entry point to send a 'later'd message
SENDMSG(XMDUZ,XMSUBJ,XMBODY,XMTO,XMINSTR,XMZ,XMATTACH) ;
+1 ; XMDUZ DUZ of who the msg is from
+2 ; XMSUBJ Subject of the msg
+3 ; XMBODY Body of the msg
+4 ; Must be closed root, passed by value. See WP_ROOT
+5 ; definition for WP^DIE(), FM word processing filer.
+6 ; XMTO Addressees
+7 ; XMINSTR("SELF BSKT") Basket to deliver to if sender is recipient
+8 ; XMINSTR("SHARE DATE") Delete date if recipient is "SHARED,MAIL"
+9 ; XMINSTR("SHARE BSKT") Basket if recipient is "SHARED,MAIL"
+10 ; XMINSTR("RCPT BSKT") Basket name (only) to deliver to for other recipients
+11 ; XMINSTR("VAPOR") Date on which to vaporize (delete) this message
+12 ; from recipient baskets
+13 ; XMINSTR("LATER") Date on which to send this msg, if not now
+14 ; XMINSTR("FROM") String saying from whom (default is user)
+15 ; XMINSTR("FLAGS") Any or all of the following:
+16 ; P Priority
+17 ; I Information only (may not be replied to)
+18 ; X Closed msg (may not be forwarded)
+19 ; C Confidential (surrogates may not read)
+20 ; S Send to sender (make sender a recipient)
+21 ; R Confirm receipt
+22 ; XMINSTR("SCR KEY") Scramble key (implies that msg should be scrambled)
+23 ; XMINSTR("SCR HINT") Hint (to guess the scramble key)
+24 ; XMINSTR("STRIP") String containing characters to strip from the message text
+25 ; XMINSTR("TYPE") Msg type is one of the following:
+26 ; D Document (NOT IMPLEMENTED)
+27 ; S Spooled Document (NOT IMPLEMENTED)
+28 ; X DIFROM (NOT IMPLEMENTED)
+29 ; O ODIF (NOT IMPLEMENTED)
+30 ; B BLOB
+31 ; K KIDS (NOT IMPLEMENTED)
+32 ; XMINSTR("ADDR FLAGS") Any or all of the following:
+33 ; I Do not Initialize (kill) the ^TMP addressee global
+34 ; R Do not Restrict addressees
+35 ; XMZ (out) msg number in ^XMB(3.9 (BUT IF $D(XMINSTR("LATER")),
+36 ; then XMZ contains the task number)
+37 ; XMATTACH (in) Array of files to attach to message
+38 ; ("IMAGE",x) imaging (BLOB) files
+39 ; ("ROU",x) routines (NOT IMPLEMENTED)
+40 KILL XMERR,^TMP("XMERR",$JOB)
+41 if '$$SEND^XMXSEC(XMDUZ,.XMINSTR)
QUIT
+42 IF $DATA(XMINSTR("LATER"))
Begin DoDot:1
+43 NEW XMTASK
+44 DO PSNDLATR(XMDUZ,XMSUBJ,XMBODY,.XMTO,.XMINSTR,.XMTASK,.XMATTACH)
+45 IF $DATA(XMTASK)
SET XMZ=XMTASK
End DoDot:1
QUIT
+46 ; Create a place for the msg in the msg file
DO CRE8XMZ(XMSUBJ,.XMZ)
if $DATA(XMERR)
QUIT
+47 if $DATA(XMATTACH("IMAGE"))>9
DO ADDBLOB(XMZ,.XMATTACH)
if $DATA(XMERR)
QUIT
+48 ; Put the msg body in place
DO MOVEBODY(XMZ,XMBODY)
+49 DO CHEKBODY(XMZ,$GET(XMINSTR("STRIP")))
+50 DO ADDRNSND(XMDUZ,XMZ,.XMTO,.XMINSTR)
+51 QUIT
ADDRNSND(XMDUZ,XMZ,XMTO,XMINSTR) ;
+1 DO CHEKADDR(XMDUZ,XMZ,.XMTO,.XMINSTR)
+2 DO BLDNSND(XMDUZ,XMZ,.XMINSTR)
+3 DO CLEANUP^XMXADDR
+4 QUIT
CHEKADDR(XMDUZ,XMZ,XMTO,XMINSTR) ;
+1 NEW XMRESTR
+2 if $GET(XMINSTR("ADDR FLAGS"))'["I"
DO INIT^XMXADDR
+3 if $GET(XMINSTR("ADDR FLAGS"))'["R"
DO CHKLINES^XMXSEC1(XMDUZ,XMZ,.XMRESTR)
+4 if $GET(XMINSTR("FLAGS"))["S"
DO CHKADDR^XMXADDR(XMDUZ,XMDUZ)
+5 ; Address the msg
DO CHKADDR^XMXADDR(XMDUZ,.XMTO,.XMINSTR,.XMRESTR)
+6 QUIT
BLDNSND(XMDUZ,XMZ,XMINSTR) ;
+1 ; Put various parts of the msg in place
DO MOVEPART(XMDUZ,XMZ,.XMINSTR)
+2 ; No addressees. Message not sent.
IF '$$GOTADDR^XMXADDR
DO ERRSET^XMXUTIL(34100)
QUIT
+3 ; Send the msg
DO SEND^XMKP(XMDUZ,XMZ,.XMINSTR)
+4 DO CHECK^XMKPL
+5 QUIT
ADDBLOB(XMZ,XMATTACH) ;
+1 NEW X,XMYBLOB,%X,%Y
+2 SET %X="XMATTACH(""IMAGE"","
SET %Y="XMYBLOB("
DO %XY^%RCR
+3 SET X=$$MULTI^XMBBLOB(XMZ)
+4 if 'X
QUIT
+5 SET XMERR=$GET(XMERR)+1
SET ^TMP("XMERR",$JOB,XMERR,"TEXT",1)="Error with $$MULTI^XMBBLOB"
+6 DO KILLMSG^XMXUTIL(XMZ)
+7 QUIT
CRE8XMZ(XMSUBJ,XMZ,XMIA) ; Create a place for the msg in the msg file
+1 NEW XMFDA,XMIEN,XMMAXDIG,XMRESET
+2 IF XMSUBJ[U
SET XMSUBJ=$$ENCODEUP^XMXUTIL1(XMSUBJ)
+3 SET XMMAXDIG=$PIECE($GET(^XMB(1,1,.17),8),U,1)
IF 'XMMAXDIG
SET XMMAXDIG=8
+4 SET XMRESET=0
TRYXMZ ;
+1 SET XMFDA(3.9,"+1,",.01)=XMSUBJ
+2 ; local create date
SET XMFDA(3.9,"+1,",31)=DT
+3 DO UPDATE^DIE("","XMFDA","XMIEN")
+4 IF $DATA(DIERR)
Begin DoDot:1
+5 SET XMZ=-1
+6 ; Call to UPDATE^DIE failed. Can't get a message number.
+7 ; Here's the error returned by FileMan:
+8 DO ERRSET^XMXUTIL(34107)
+9 NEW I,J,K
+10 SET J=0
+11 SET I=$ORDER(^TMP("XMERR",$JOB,XMERR,"TEXT",":"),-1)
+12 FOR K=1:1:+DIERR
Begin DoDot:2
+13 FOR
SET J=$ORDER(^TMP("DIERR",$JOB,K,"TEXT",J))
if 'J
QUIT
Begin DoDot:3
+14 SET I=I+1
SET ^TMP("XMERR",$JOB,XMERR,"TEXT",I)=^TMP("DIERR",$JOB,K,"TEXT",J)
End DoDot:3
End DoDot:2
+15 if '$GET(XMIA)!$DATA(ZTQUEUED)
QUIT
+16 DO SHOW^XMJERR
+17 DO WAIT^XMXUTIL
End DoDot:1
QUIT
+18 SET XMZ=XMIEN(1)
+19 if $LENGTH(XMZ)'>XMMAXDIG
QUIT
+20 IF XMRESET
SET $PIECE(^XMB(1,1,.17),U,1)=$LENGTH(XMZ)
QUIT
+21 ; Recycle message numbers, because this one's too big...
+22 KILL XMIEN
+23 SET XMRESET=1
+24 IF '$DATA(^XMB(3.9,99999,0))
Begin DoDot:1
+25 ; We do this so that if message 100000 is created and then deleted,
+26 ; FM will set piece 3 of ^XMB(3.9,0) to 99999. We don't want any
+27 ; message number lower than 100000 to be created, so that message
+28 ; numbers can't be confused with message sequence numbers in baskets
+29 SET ^XMB(3.9,99999,0)="place holder"
+30 SET ^XMB(3.9,"B","place holder",99999)=""
End DoDot:1
+31 LOCK +^XMB(3.9,0):1
+32 IF $LENGTH($PIECE(^XMB(3.9,0),U,3))>XMMAXDIG
SET $PIECE(^XMB(3.9,0),U,3)=99999
+33 ; Delete the message stub.
NEW DIK,DA
SET DIK="^XMB(3.9,"
SET DA=XMZ
DO ^DIK
+34 LOCK -^XMB(3.9,0)
+35 ; Go get another
GOTO TRYXMZ
MOVEBODY(XMZ,XMBODY,XMFLAG) ;
+1 DO WP^DIE(3.9,XMZ_",",3,$GET(XMFLAG),XMBODY)
+2 QUIT
CHEKBODY(XMZ,XMSTRIP,XMI) ; Remove XMSTRIP, control characters from text
+1 NEW XMLINE,I,XMLEN,XMALTRD
+2 SET XMI=+$GET(XMI)
+3 FOR
SET XMI=$ORDER(^XMB(3.9,XMZ,2,XMI))
if 'XMI
QUIT
SET XMLINE=^(XMI,0)
Begin DoDot:1
+4 SET XMALTRD=0
+5 IF $GET(XMSTRIP)'=""
SET XMLEN=$LENGTH(XMLINE)
SET XMLINE=$TRANSLATE(XMLINE,XMSTRIP)
IF XMLEN>$LENGTH(XMLINE)
SET XMALTRD=1
+6 IF XMLINE?.E1C.E
Begin DoDot:2
+7 SET (I,XMALTRD)=1
+8 FOR
Begin DoDot:3
+9 IF $EXTRACT(XMLINE,I)?1C
SET XMLINE=$EXTRACT(XMLINE,1,I-1)_$EXTRACT(XMLINE,I+1,999)
QUIT
+10 SET I=I+1
End DoDot:3
if XMLINE'?.E1C.E
QUIT
End DoDot:2
+11 if XMALTRD
SET ^XMB(3.9,XMZ,2,XMI,0)=XMLINE
End DoDot:1
+12 QUIT
MOVEPART(XMDUZ,XMZ,XMINSTR) ; Put various parts of the msg in place
+1 NEW XMFDA,XMIENS
+2 SET XMIENS=XMZ_","
+3 IF $DATA(XMINSTR("FROM"))
SET XMFDA(3.9,XMIENS,1)=XMINSTR("FROM")
+4 IF '$TEST
Begin DoDot:1
+5 SET XMFDA(3.9,XMIENS,1)=XMDUZ
+6 if XMDUZ'=DUZ
SET XMFDA(3.9,XMIENS,1.1)=DUZ
End DoDot:1
+7 SET XMFDA(3.9,XMIENS,1.4)=$$NOW^XLFDT()
+8 IF $DATA(XMINSTR)
Begin DoDot:1
+9 if $GET(XMINSTR("FLAGS"))["R"
SET XMFDA(3.9,XMIENS,1.3)="y"
+10 if $DATA(XMINSTR("VAPOR"))
SET XMFDA(3.9,XMIENS,1.6)=XMINSTR("VAPOR")
+11 if $DATA(XMINSTR("TYPE"))
SET XMFDA(3.9,XMIENS,1.7)=XMINSTR("TYPE")
+12 IF $DATA(XMINSTR("SCR KEY"))
Begin DoDot:2
+13 ; XMSECURE is new'd for scramble
NEW XMKEY,XMSECURE
+14 SET XMFDA(3.9,XMIENS,1.8)=$SELECT($GET(XMINSTR("SCR HINT"))="":" ",1:XMINSTR("SCR HINT"))
+15 DO LOADCODE^XMJMCODE
+16 SET XMKEY=XMINSTR("SCR KEY")
+17 DO ADJUST^XMJMCODE(.XMKEY)
+18 SET XMFDA(3.9,XMIENS,1.85)="1"_$$ENCSTR^XMJMCODE(XMKEY)
+19 DO ENCMSG^XMJMCODE(XMZ)
End DoDot:2
+20 if $GET(XMINSTR("FLAGS"))["X"
SET XMFDA(3.9,XMIENS,1.95)="y"
+21 if $GET(XMINSTR("FLAGS"))["C"
SET XMFDA(3.9,XMIENS,1.96)="y"
+22 if $GET(XMINSTR("FLAGS"))["I"
SET XMFDA(3.9,XMIENS,1.97)="y"
+23 if $GET(XMINSTR("FLAGS"))["P"
SET XMFDA(3.9,XMIENS,1.7)=$GET(XMFDA(3.9,XMIENS,1.7))_"P"
+24 if $DATA(XMINSTR("RCPT BSKT"))
SET XMFDA(3.9,XMIENS,21)=XMINSTR("RCPT BSKT")
End DoDot:1
+25 if $$BRODCAST^XMKP
SET XMFDA(3.9,XMIENS,1.97)="y"
+26 DO FILE^DIE("","XMFDA")
+27 QUIT
LATER ; TaskMan entry point to send a user's latered message
+1 NEW XMI,XMLATER,XMPREFIX,XMTO,XMV,XMPRIVAT,XMBCAST
+2 ; " [Private Mail Group]"
SET XMPRIVAT=$$EZBLD^DIALOG(39135)
+3 ; "* (Broadcast to all local users)"
SET XMBCAST=$$EZBLD^DIALOG(39006)
+4 DO INIT^XMVVITAE
+5 SET XMI=""
+6 FOR
SET XMI=$ORDER(^TMP("XMY0",$JOB,XMI))
if XMI=""
QUIT
Begin DoDot:1
+7 ; prefix (I:,C:)
SET XMPREFIX=$GET(^TMP("XMY0",$JOB,XMI,1))
+8 SET XMLATER=$GET(^TMP("XMY0",$JOB,XMI,"L"))
+9 if XMLATER'=""
SET XMPREFIX=XMPREFIX_"L@"_XMLATER
+10 if XMPREFIX'=""
SET XMPREFIX=XMPREFIX_":"
+11 ; (set in ^XMXADDRG)
SET XMTO(XMPREFIX_$SELECT(XMI[XMPRIVAT:$PIECE(XMI,XMPRIVAT,1),XMI=XMBCAST:"*",1:XMI))=""
End DoDot:1
+12 DO SENDMSG(XMDUZ,XMSUBJ,"^TMP(""XM"",$J,""BODY"")",.XMTO,.XMINSTR)
+13 SET ZTREQ="@"
+14 QUIT
PSNDLATR(XMDUZ,XMSUBJ,XMBODY,XMTO,XMINSTR,ZTSK,XMATTACH) ; Set up a task for a program to send a message later
+1 NEW ZTRTN,ZTDTH,ZTDESC,ZTIO,ZTSAVE
+2 SET ZTIO=""
+3 SET ZTRTN="PTSKLATR^XMXSEND"
+4 SET ZTDTH=$$FMTH^XLFDT(XMINSTR("LATER"))
+5 ; MailMan: Send Message Later
SET ZTDESC=$$EZBLD^DIALOG(39310)
+6 SET ZTSAVE($$OREF^DILF(XMBODY))=""
+7 FOR I="DUZ","XMDUZ","XMSUBJ","XMBODY","XMTO","XMTO(","XMINSTR(","XMATTACH("
SET ZTSAVE(I)=""
+8 DO ^%ZTLOAD
+9 ;D HOME^%ZIS call this only if preceded by call to ^%ZIS
+10 ; Task creation not successful
IF '$DATA(ZTSK)
DO ERRSET^XMXUTIL(39311)
+11 QUIT
PTSKLATR ; TaskMan entry point to send a program's latered message
+1 KILL XMINSTR("LATER")
+2 DO SENDMSG(XMDUZ,XMSUBJ,XMBODY,.XMTO,.XMINSTR,"",.XMATTACH)
+3 SET ZTREQ="@"
+4 QUIT
STARTMSG(XMSUBJ,XMZ) ;
+1 KILL XMERR,^TMP("XMERR",$JOB)
+2 DO CRE8XMZ(XMSUBJ,.XMZ)
if $DATA(XMERR)
QUIT
+3 SET XMLCNT=0
+4 QUIT
BODYLINE(XMZ,XMLINE) ; Put the msg body in place, line by line
+1 SET XMLCNT=XMLCNT+1
+2 SET ^XMB(3.9,XMZ,2,XMLCNT,0)=XMLINE
+3 QUIT
ENDMSG(XMDUZ,XMZ,XMTO,XMINSTR) ;
+1 SET ^XMB(3.9,XMZ,2,0)="^^"_XMLCNT_U_XMLCNT_U_DT
+2 KILL XMLCNT
+3 DO ADDRNSND(XMDUZ,XMZ,.XMTO,.XMINSTR)
+4 QUIT
POSTMAST(XMDUZ,XMINSTR) ;
+1 if '$DATA(XMDUZ)
SET XMDUZ=DUZ
+2 if '$GET(XMV("PRIV"))
DO INIT^XMVVITAE
+3 SET XMINSTR("FROM")=.5
+4 QUIT
