XMXANSER ;ISC-SF/GMB-Answer a msg ;04/24/2002 10:08
;;8.0;MailMan;;Jun 28, 2002
; Replaces ^XMA11A (ISC-WASH/CAP/THM)
; XMDUZ DUZ of who the msg is from
; XMSUBJ Subject of the msg (defaults to 'Re:' original subject)
; XMBODY Closed root of Body of the msg
; Must be closed root, passed by value. See WP_ROOT
; definition for WP^DIE(), FM word processing filer.
; XMTO Additional addressees, besides msg originator
; XMINSTR("FROM") String saying from whom (default is user)
; XMINSTR("SELF BSKT") Basket to deliver to if sender is recipient
; XMINSTR("SHARE BSKT") Basket to deliver to if recipient is "SHARED,MAIL"
; XMINSTR("SHARE DATE") Delete date 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("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("KEYS") List of keys needed by recipient to read msg (NOT IMPLEMENTED)
; XMINSTR("TYPE") Msg type is one of the following:
; D Document
; S Spooled Document
; X DIFROM
; O ODIF
; B BLOB
; K KIDS
;
; Output:
; XMZR The number of the message containing the answer.
ANSRMSG(XMDUZ,XMK,XMKZ,XMSUBJ,XMBODY,XMTO,XMINSTR,XMZR) ;
N XMZ,XMZREC,XMZSENDR
K XMERR,^TMP("XMERR",$J)
D CHKMSG^XMXSEC1(XMDUZ,.XMK,.XMKZ,.XMZ,.XMZREC) Q:$D(XMERR)
Q:'$$ANSWER^XMXSEC(XMDUZ,XMZ,XMZREC)
S:$G(XMSUBJ)="" XMSUBJ=$E($$EZBLD^DIALOG(37006)_$P(XMZREC,U,1),1,65) ; Re:
D CRE8XMZ^XMXSEND(XMSUBJ,.XMZR) Q:$D(XMERR)
S XMZSENDR=$P(XMZREC,U,2)
S:XMZSENDR["@" XMZSENDR=$$REPLYTO1^XMXREPLY(XMZ)
D COMPOSE(XMDUZ,XMZ,$P(XMZREC,U,1),XMZSENDR,$P(XMZREC,U,3),XMZR,XMBODY)
S XMTO(XMZSENDR)=""
S XMINSTR("EXACT")=1 ; Match on exact domain name
D ADDRNSND^XMXSEND(XMDUZ,XMZR,.XMTO,.XMINSTR)
K XMINSTR("EXACT")
Q
COMPOSE(XMDUZ,XMZ,XMZSUBJ,XMZSENDR,XMZDATE,XMZR,XMBODY) ;
D COPY(XMZ,XMZSUBJ,XMZSENDR,XMZDATE,XMZR)
; File XMBODY, with the "append" option
D MOVEBODY^XMXSEND(XMZR,XMBODY,"A") ; Put the msg body in place
D NETSIG^XMXEDIT(XMDUZ,XMZR)
Q
COPY(XMZO,XMZOSUBJ,XMZOFROM,XMZODATE,XMZ) ; Copy the original msg, putting ">" in front of each line.
N I,J
D COPYHEAD^XMJMC(XMZO,XMZOSUBJ,XMZOFROM,XMZODATE,XMZ,"A",.J)
S J=J+1,^XMB(3.9,XMZ,2,J,0)=">"
S I=.999999
F S I=$O(^XMB(3.9,XMZO,2,I)) Q:I="" S J=J+1,^XMB(3.9,XMZ,2,J,0)=$E(">"_^(I,0),1,254)
S J=J+1,^XMB(3.9,XMZ,2,J,0)=""
S J=J+1,^XMB(3.9,XMZ,2,J,0)=""
S ^XMB(3.9,XMZ,2,0)="^3.92A^"_J_U_J_U_DT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMXANSER 3289 printed Dec 13, 2024@02:14:01 Page 2
XMXANSER ;ISC-SF/GMB-Answer a msg ;04/24/2002 10:08
+1 ;;8.0;MailMan;;Jun 28, 2002
+2 ; Replaces ^XMA11A (ISC-WASH/CAP/THM)
+3 ; XMDUZ DUZ of who the msg is from
+4 ; XMSUBJ Subject of the msg (defaults to 'Re:' original subject)
+5 ; XMBODY Closed root of Body of the msg
+6 ; Must be closed root, passed by value. See WP_ROOT
+7 ; definition for WP^DIE(), FM word processing filer.
+8 ; XMTO Additional addressees, besides msg originator
+9 ; XMINSTR("FROM") String saying from whom (default is user)
+10 ; XMINSTR("SELF BSKT") Basket to deliver to if sender is recipient
+11 ; XMINSTR("SHARE BSKT") Basket to deliver to if recipient is "SHARED,MAIL"
+12 ; XMINSTR("SHARE DATE") Delete date if recipient is "SHARED,MAIL"
+13 ; XMINSTR("RCPT BSKT") Basket name (only) to deliver to for other recipients
+14 ; XMINSTR("VAPOR") Date on which to vaporize (delete) this message
+15 ; from recipient baskets
+16 ; XMINSTR("LATER") Date on which to send this msg, if not now
+17 ; XMINSTR("FLAGS") Any or all of the following:
+18 ; P Priority
+19 ; I Information only (may not be replied to)
+20 ; X Closed msg (may not be forwarded)
+21 ; C Confidential (surrogates may not read)
+22 ; S Send to sender (make sender a recipient)
+23 ; R Confirm receipt
+24 ; XMINSTR("SCR KEY") Scramble key (implies that msg should be scrambled)
+25 ; XMINSTR("SCR HINT") Hint (to guess the scramble key)
+26 ; XMINSTR("KEYS") List of keys needed by recipient to read msg (NOT IMPLEMENTED)
+27 ; XMINSTR("TYPE") Msg type is one of the following:
+28 ; D Document
+29 ; S Spooled Document
+30 ; X DIFROM
+31 ; O ODIF
+32 ; B BLOB
+33 ; K KIDS
+34 ;
+35 ; Output:
+36 ; XMZR The number of the message containing the answer.
ANSRMSG(XMDUZ,XMK,XMKZ,XMSUBJ,XMBODY,XMTO,XMINSTR,XMZR) ;
+1 NEW XMZ,XMZREC,XMZSENDR
+2 KILL XMERR,^TMP("XMERR",$JOB)
+3 DO CHKMSG^XMXSEC1(XMDUZ,.XMK,.XMKZ,.XMZ,.XMZREC)
if $DATA(XMERR)
QUIT
+4 if '$$ANSWER^XMXSEC(XMDUZ,XMZ,XMZREC)
QUIT
+5 ; Re:
if $GET(XMSUBJ)=""
SET XMSUBJ=$EXTRACT($$EZBLD^DIALOG(37006)_$PIECE(XMZREC,U,1),1,65)
+6 DO CRE8XMZ^XMXSEND(XMSUBJ,.XMZR)
if $DATA(XMERR)
QUIT
+7 SET XMZSENDR=$PIECE(XMZREC,U,2)
+8 if XMZSENDR["@"
SET XMZSENDR=$$REPLYTO1^XMXREPLY(XMZ)
+9 DO COMPOSE(XMDUZ,XMZ,$PIECE(XMZREC,U,1),XMZSENDR,$PIECE(XMZREC,U,3),XMZR,XMBODY)
+10 SET XMTO(XMZSENDR)=""
+11 ; Match on exact domain name
SET XMINSTR("EXACT")=1
+12 DO ADDRNSND^XMXSEND(XMDUZ,XMZR,.XMTO,.XMINSTR)
+13 KILL XMINSTR("EXACT")
+14 QUIT
COMPOSE(XMDUZ,XMZ,XMZSUBJ,XMZSENDR,XMZDATE,XMZR,XMBODY) ;
+1 DO COPY(XMZ,XMZSUBJ,XMZSENDR,XMZDATE,XMZR)
+2 ; File XMBODY, with the "append" option
+3 ; Put the msg body in place
DO MOVEBODY^XMXSEND(XMZR,XMBODY,"A")
+4 DO NETSIG^XMXEDIT(XMDUZ,XMZR)
+5 QUIT
COPY(XMZO,XMZOSUBJ,XMZOFROM,XMZODATE,XMZ) ; Copy the original msg, putting ">" in front of each line.
+1 NEW I,J
+2 DO COPYHEAD^XMJMC(XMZO,XMZOSUBJ,XMZOFROM,XMZODATE,XMZ,"A",.J)
+3 SET J=J+1
SET ^XMB(3.9,XMZ,2,J,0)=">"
+4 SET I=.999999
+5 FOR
SET I=$ORDER(^XMB(3.9,XMZO,2,I))
if I=""
QUIT
SET J=J+1
SET ^XMB(3.9,XMZ,2,J,0)=$EXTRACT(">"_^(I,0),1,254)
+6 SET J=J+1
SET ^XMB(3.9,XMZ,2,J,0)=""
+7 SET J=J+1
SET ^XMB(3.9,XMZ,2,J,0)=""
+8 SET ^XMB(3.9,XMZ,2,0)="^3.92A^"_J_U_J_U_DT
+9 QUIT
