XMA2R ;ISC-SF/GMB- Reply to/Answer a message API ;04/19/2002 12:37
;;8.0;MailMan;;Jun 28, 2002
; Was (WASH ISC)/CAP
;
; Entry points (DBIA 1145):
; ENT function for non-interactive reply to a message.
; Reply is sent to all local recipients of the message.
; If message if from a remote sender, the reply is sent to
; the remote sender, too.
; ENTA function for non-interactive answer to a message
ENT(XMZ,XMSUBJ,XMTEXT,XMSTRIP,XMDUZ,XMNET) ; Send response to a message
;Call as follows:
; S var=$$ENT^XMA2R(XMZ,XMSUBJ,.XMTEXT,XMSTRIP,XMDUZ,XMNET)
;Where: XMZ = Message being responded to
; XMSUBJ = Subject of the response
; (ignored, unless message is from a remote sender)
; .XMTEXT = Array containing text
; XMSTRIP = Characters to be stripped from text
; XMDUZ = Sender of response (DUZ or free text)
; XMNET = Send reply over the net? (0=no (DEFAULT); 1=yes)
; (ignored, unless message is from a remote sender)
;OUTPUT: If results okay = internal pointer to response in file 3.9
; If bad result, the letter "E" followed by a number,
; followed by a space, then a human readable explanation.
N XMV,XMZR,XMINSTR,XMMG,XMSECURE,XMZREC
K XMERR,^TMP("XMERR",$J)
I '$D(^XMB(3.9,XMZ,0)) Q "E5 Message "_XMZ_" does not exist."
I '$O(^XMB(3.9,XMZ,1,0)) Q "E6 Message "_XMZ_" has no recipients."
I $D(XMTEXT)<9 Q "E2 No message text !"
I '$O(XMTEXT(0)) Q "E4 No message text !"
S XMDUZ=$G(XMDUZ,DUZ)
I XMDUZ'?.N D Q:$D(XMMG) "E10 "_$P(XMMG,"= ",2)
. D SETFROM^XMD(.XMDUZ,.XMINSTR)
D INITAPI^XMVVITAE
D CRE8XMZ^XMXSEND("R"_XMZ,.XMZR) Q:XMZR<1 $$ERR("E9")
D MOVETEXT(XMZR,.XMTEXT)
D CHEKBODY^XMXSEND(XMZR,$G(XMSTRIP))
D DOREPLY^XMXREPLY(XMDUZ,XMZ,XMZR,.XMINSTR)
S XMZREC=$G(^XMB(3.9,XMZ,0))
I $P(XMZREC,U,2)'["@"!'$G(XMNET) Q XMZR
I '$D(XMSUBJ) Q "E1 No subject !"
I $L(XMSUBJ)<3!($L(XMSUBJ)>65) Q "E3 Subject too long or short !"
S XMSUBJ=$$SCRUB^XMXUTIL1(XMSUBJ)
S:XMSUBJ[U XMSUBJ=$$ENCODEUP^XMXUTIL1(XMSUBJ)
N XMFROM,XMREPLTO
D REPLYTO^XMXREPLY(XMZ,.XMFROM,.XMREPLTO)
D INIT^XMXADDR
D CHKADDR^XMXADDR(XMDUZ,$$REMADDR^XMXADDR3($G(XMREPLTO,XMFROM)),.XMINSTR) Q:$D(XMERR) $$ERR("E12")
D NETREPLY^XMXREPLY(XMDUZ,XMZ,XMZR,XMSUBJ,.XMINSTR)
D CLEANUP^XMXADDR
Q XMZR
MOVETEXT(XMZ,XMTEXT,XMAPPEND) ;
N I,XMLINE
S XMLINE=$S($G(XMAPPEND):$O(^XMB(3.9,XMZ,2,":"),-1),1:0)
S I=0
F S I=$O(XMTEXT(I)) Q:'I D
. S XMLINE=XMLINE+1
. S ^XMB(3.9,XMZ,2,XMLINE,0)=$S($D(XMTEXT(I,0)):XMTEXT(I,0),1:XMTEXT(I))
S ^XMB(3.9,XMZ,2,0)="^3.92A^"_XMLINE_U_XMLINE
Q
ENTA(XMZ,XMSUBJ,XMTEXT,XMSTRIP,XMDUZ) ; Send Response Only to Sender of Original Message
;Call as follows:
; S var=$$ENT^XMA2R(XMZ,XMSUBJ,.XMTEXT,XMSTRIP,XMDUZ)
;Where: XMZ = Message being responded to
; XMSUBJ = Subject of the response
; .XMTEXT = Array containing text
; XMSTRIP = Characters to be stripped from text
; XMDUZ = Sender of response (DUZ or free text)
;
;OUTPUT: If results okay = internal pointer to response in file 3.9
; If bad result, the letter "E" followed by a number,
; followed by a space, then a human readable explanation.
N XMV,XMZR,XMINSTR,XMMG,XMSECURE,XMZSENDR,XMZREC,XMTO
K XMERR,^TMP("XMERR",$J)
I '$D(^XMB(3.9,XMZ,0)) Q "E5 Message "_XMZ_" does not exist."
I '$D(XMSUBJ) Q "E1 No subject !"
I $D(XMTEXT)<9 Q "E2 No message text !"
I $L(XMSUBJ)<3!($L(XMSUBJ)>65) Q "E3 Subject too long or short !"
I '$O(XMTEXT(0)) Q "E4 No message text !"
S XMDUZ=$G(XMDUZ,DUZ)
I XMDUZ'?.N D Q:$D(XMMG) "E10 "_$P(XMMG,"= ",2)
. D SETFROM^XMD(.XMDUZ,.XMINSTR)
D INITAPI^XMVVITAE
S XMZREC=^XMB(3.9,XMZ,0)
S XMZSENDR=$P(XMZREC,U,2)
S:XMZSENDR["@" XMZSENDR=$$REPLYTO1^XMXREPLY(XMZ)
D CRE8XMZ^XMXSEND(XMSUBJ,.XMZR) Q:XMZR<1 $$ERR("E9")
D COPY^XMXANSER(XMZ,$P(XMZREC,U,1),XMZSENDR,$P(XMZREC,U,3),XMZR)
D MOVETEXT(XMZR,.XMTEXT,1)
D NETSIG^XMXEDIT(XMDUZ,XMZR)
D CHEKBODY^XMXSEND(XMZR,$G(XMSTRIP))
S XMTO(XMZSENDR)=""
S XMTO(XMDUZ)=""
S XMINSTR("ADDR FLAGS")="R" ; No addressing restrictions
D ADDRNSND^XMXSEND(XMDUZ,XMZR,.XMTO,.XMINSTR)
Q:$D(XMERR) $$ERR("E11")
Q XMZR
ERR(XMER) ;
S XMER=XMER_" "_^TMP("XMERR",$J,1,"TEXT",1)
K XMERR,^TMP("XMERR",$J)
Q XMER
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMA2R 4356 printed Apr 09, 2024@21:13:18 Page 2
XMA2R ;ISC-SF/GMB- Reply to/Answer a message API ;04/19/2002 12:37
+1 ;;8.0;MailMan;;Jun 28, 2002
+2 ; Was (WASH ISC)/CAP
+3 ;
+4 ; Entry points (DBIA 1145):
+5 ; ENT function for non-interactive reply to a message.
+6 ; Reply is sent to all local recipients of the message.
+7 ; If message if from a remote sender, the reply is sent to
+8 ; the remote sender, too.
+9 ; ENTA function for non-interactive answer to a message
ENT(XMZ,XMSUBJ,XMTEXT,XMSTRIP,XMDUZ,XMNET) ; Send response to a message
+1 ;Call as follows:
+2 ; S var=$$ENT^XMA2R(XMZ,XMSUBJ,.XMTEXT,XMSTRIP,XMDUZ,XMNET)
+3 ;Where: XMZ = Message being responded to
+4 ; XMSUBJ = Subject of the response
+5 ; (ignored, unless message is from a remote sender)
+6 ; .XMTEXT = Array containing text
+7 ; XMSTRIP = Characters to be stripped from text
+8 ; XMDUZ = Sender of response (DUZ or free text)
+9 ; XMNET = Send reply over the net? (0=no (DEFAULT); 1=yes)
+10 ; (ignored, unless message is from a remote sender)
+11 ;OUTPUT: If results okay = internal pointer to response in file 3.9
+12 ; If bad result, the letter "E" followed by a number,
+13 ; followed by a space, then a human readable explanation.
+14 NEW XMV,XMZR,XMINSTR,XMMG,XMSECURE,XMZREC
+15 KILL XMERR,^TMP("XMERR",$JOB)
+16 IF '$DATA(^XMB(3.9,XMZ,0))
QUIT "E5 Message "_XMZ_" does not exist."
+17 IF '$ORDER(^XMB(3.9,XMZ,1,0))
QUIT "E6 Message "_XMZ_" has no recipients."
+18 IF $DATA(XMTEXT)<9
QUIT "E2 No message text !"
+19 IF '$ORDER(XMTEXT(0))
QUIT "E4 No message text !"
+20 SET XMDUZ=$GET(XMDUZ,DUZ)
+21 IF XMDUZ'?.N
Begin DoDot:1
+22 DO SETFROM^XMD(.XMDUZ,.XMINSTR)
End DoDot:1
if $DATA(XMMG)
QUIT "E10 "_$PIECE(XMMG,"= ",2)
+23 DO INITAPI^XMVVITAE
+24 DO CRE8XMZ^XMXSEND("R"_XMZ,.XMZR)
if XMZR<1
QUIT $$ERR("E9")
+25 DO MOVETEXT(XMZR,.XMTEXT)
+26 DO CHEKBODY^XMXSEND(XMZR,$GET(XMSTRIP))
+27 DO DOREPLY^XMXREPLY(XMDUZ,XMZ,XMZR,.XMINSTR)
+28 SET XMZREC=$GET(^XMB(3.9,XMZ,0))
+29 IF $PIECE(XMZREC,U,2)'["@"!'$GET(XMNET)
QUIT XMZR
+30 IF '$DATA(XMSUBJ)
QUIT "E1 No subject !"
+31 IF $LENGTH(XMSUBJ)<3!($LENGTH(XMSUBJ)>65)
QUIT "E3 Subject too long or short !"
+32 SET XMSUBJ=$$SCRUB^XMXUTIL1(XMSUBJ)
+33 if XMSUBJ[U
SET XMSUBJ=$$ENCODEUP^XMXUTIL1(XMSUBJ)
+34 NEW XMFROM,XMREPLTO
+35 DO REPLYTO^XMXREPLY(XMZ,.XMFROM,.XMREPLTO)
+36 DO INIT^XMXADDR
+37 DO CHKADDR^XMXADDR(XMDUZ,$$REMADDR^XMXADDR3($GET(XMREPLTO,XMFROM)),.XMINSTR)
if $DATA(XMERR)
QUIT $$ERR("E12")
+38 DO NETREPLY^XMXREPLY(XMDUZ,XMZ,XMZR,XMSUBJ,.XMINSTR)
+39 DO CLEANUP^XMXADDR
+40 QUIT XMZR
MOVETEXT(XMZ,XMTEXT,XMAPPEND) ;
+1 NEW I,XMLINE
+2 SET XMLINE=$SELECT($GET(XMAPPEND):$ORDER(^XMB(3.9,XMZ,2,":"),-1),1:0)
+3 SET I=0
+4 FOR
SET I=$ORDER(XMTEXT(I))
if 'I
QUIT
Begin DoDot:1
+5 SET XMLINE=XMLINE+1
+6 SET ^XMB(3.9,XMZ,2,XMLINE,0)=$SELECT($DATA(XMTEXT(I,0)):XMTEXT(I,0),1:XMTEXT(I))
End DoDot:1
+7 SET ^XMB(3.9,XMZ,2,0)="^3.92A^"_XMLINE_U_XMLINE
+8 QUIT
ENTA(XMZ,XMSUBJ,XMTEXT,XMSTRIP,XMDUZ) ; Send Response Only to Sender of Original Message
+1 ;Call as follows:
+2 ; S var=$$ENT^XMA2R(XMZ,XMSUBJ,.XMTEXT,XMSTRIP,XMDUZ)
+3 ;Where: XMZ = Message being responded to
+4 ; XMSUBJ = Subject of the response
+5 ; .XMTEXT = Array containing text
+6 ; XMSTRIP = Characters to be stripped from text
+7 ; XMDUZ = Sender of response (DUZ or free text)
+8 ;
+9 ;OUTPUT: If results okay = internal pointer to response in file 3.9
+10 ; If bad result, the letter "E" followed by a number,
+11 ; followed by a space, then a human readable explanation.
+12 NEW XMV,XMZR,XMINSTR,XMMG,XMSECURE,XMZSENDR,XMZREC,XMTO
+13 KILL XMERR,^TMP("XMERR",$JOB)
+14 IF '$DATA(^XMB(3.9,XMZ,0))
QUIT "E5 Message "_XMZ_" does not exist."
+15 IF '$DATA(XMSUBJ)
QUIT "E1 No subject !"
+16 IF $DATA(XMTEXT)<9
QUIT "E2 No message text !"
+17 IF $LENGTH(XMSUBJ)<3!($LENGTH(XMSUBJ)>65)
QUIT "E3 Subject too long or short !"
+18 IF '$ORDER(XMTEXT(0))
QUIT "E4 No message text !"
+19 SET XMDUZ=$GET(XMDUZ,DUZ)
+20 IF XMDUZ'?.N
Begin DoDot:1
+21 DO SETFROM^XMD(.XMDUZ,.XMINSTR)
End DoDot:1
if $DATA(XMMG)
QUIT "E10 "_$PIECE(XMMG,"= ",2)
+22 DO INITAPI^XMVVITAE
+23 SET XMZREC=^XMB(3.9,XMZ,0)
+24 SET XMZSENDR=$PIECE(XMZREC,U,2)
+25 if XMZSENDR["@"
SET XMZSENDR=$$REPLYTO1^XMXREPLY(XMZ)
+26 DO CRE8XMZ^XMXSEND(XMSUBJ,.XMZR)
if XMZR<1
QUIT $$ERR("E9")
+27 DO COPY^XMXANSER(XMZ,$PIECE(XMZREC,U,1),XMZSENDR,$PIECE(XMZREC,U,3),XMZR)
+28 DO MOVETEXT(XMZR,.XMTEXT,1)
+29 DO NETSIG^XMXEDIT(XMDUZ,XMZR)
+30 DO CHEKBODY^XMXSEND(XMZR,$GET(XMSTRIP))
+31 SET XMTO(XMZSENDR)=""
+32 SET XMTO(XMDUZ)=""
+33 ; No addressing restrictions
SET XMINSTR("ADDR FLAGS")="R"
+34 DO ADDRNSND^XMXSEND(XMDUZ,XMZR,.XMTO,.XMINSTR)
+35 if $DATA(XMERR)
QUIT $$ERR("E11")
+36 QUIT XMZR
ERR(XMER) ;
+1 SET XMER=XMER_" "_^TMP("XMERR",$JOB,1,"TEXT",1)
+2 KILL XMERR,^TMP("XMERR",$JOB)
+3 QUIT XMER
