- 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 Jan 18, 2025@03:15:28 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