Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XMA2R

XMA2R.m

Go to the documentation of this file. 
  1. XMA2R ;ISC-SF/GMB- Reply to/Answer a message API ;04/19/2002  12:37
  1.  ;;8.0;MailMan;;Jun 28, 2002
  1.  ; Was (WASH ISC)/CAP
  1.  ;
  1.  ; Entry points (DBIA 1145):
  1.  ; ENT  function for non-interactive reply to a message.
  1.  ;      Reply is sent to all local recipients of the message.
  1.  ;      If message if from a remote sender, the reply is sent to
  1.  ;      the remote sender, too.
  1.  ; ENTA function for non-interactive answer to a message
  1. ENT(XMZ,XMSUBJ,XMTEXT,XMSTRIP,XMDUZ,XMNET) ; Send response to a message
  1.  ;Call as follows:
  1.  ; S var=$$ENT^XMA2R(XMZ,XMSUBJ,.XMTEXT,XMSTRIP,XMDUZ,XMNET)
  1.  ;Where:  XMZ     = Message being responded to
  1.  ;        XMSUBJ  = Subject of the response
  1.  ;                  (ignored, unless message is from a remote sender)
  1.  ;        .XMTEXT = Array containing text
  1.  ;        XMSTRIP = Characters to be stripped from text
  1.  ;        XMDUZ   = Sender of response (DUZ or free text)
  1.  ;        XMNET   = Send reply over the net? (0=no (DEFAULT); 1=yes)
  1.  ;                  (ignored, unless message is from a remote sender)
  1.  ;OUTPUT: If results okay = internal pointer to response in file 3.9
  1.  ;        If bad result, the letter "E" followed by a number,
  1.  ;        followed by a space, then a human readable explanation.
  1.  N XMV,XMZR,XMINSTR,XMMG,XMSECURE,XMZREC
  1.  K XMERR,^TMP("XMERR",$J)
  1.  I '$D(^XMB(3.9,XMZ,0)) Q "E5 Message "_XMZ_" does not exist."
  1.  I '$O(^XMB(3.9,XMZ,1,0)) Q "E6 Message "_XMZ_" has no recipients."
  1.  I $D(XMTEXT)<9 Q "E2 No message text !"
  1.  I '$O(XMTEXT(0)) Q "E4 No message text !"
  1.  S XMDUZ=$G(XMDUZ,DUZ)
  1.  I XMDUZ'?.N D  Q:$D(XMMG) "E10 "_$P(XMMG,"= ",2)
  1.  . D SETFROM^XMD(.XMDUZ,.XMINSTR)
  1.  D INITAPI^XMVVITAE
  1.  D CRE8XMZ^XMXSEND("R"_XMZ,.XMZR) Q:XMZR<1 $$ERR("E9")
  1.  D MOVETEXT(XMZR,.XMTEXT)
  1.  D CHEKBODY^XMXSEND(XMZR,$G(XMSTRIP))
  1.  D DOREPLY^XMXREPLY(XMDUZ,XMZ,XMZR,.XMINSTR)
  1.  S XMZREC=$G(^XMB(3.9,XMZ,0))
  1.  I $P(XMZREC,U,2)'["@"!'$G(XMNET) Q XMZR
  1.  I '$D(XMSUBJ) Q "E1 No subject !"
  1.  I $L(XMSUBJ)<3!($L(XMSUBJ)>65) Q "E3 Subject too long or short !"
  1.  S XMSUBJ=$$SCRUB^XMXUTIL1(XMSUBJ)
  1.  S:XMSUBJ[U XMSUBJ=$$ENCODEUP^XMXUTIL1(XMSUBJ)
  1.  N XMFROM,XMREPLTO
  1.  D REPLYTO^XMXREPLY(XMZ,.XMFROM,.XMREPLTO)
  1.  D INIT^XMXADDR
  1.  D CHKADDR^XMXADDR(XMDUZ,$$REMADDR^XMXADDR3($G(XMREPLTO,XMFROM)),.XMINSTR) Q:$D(XMERR) $$ERR("E12")
  1.  D NETREPLY^XMXREPLY(XMDUZ,XMZ,XMZR,XMSUBJ,.XMINSTR)
  1.  D CLEANUP^XMXADDR
  1.  Q XMZR
  1. MOVETEXT(XMZ,XMTEXT,XMAPPEND) ;
  1.  N I,XMLINE
  1.  S XMLINE=$S($G(XMAPPEND):$O(^XMB(3.9,XMZ,2,":"),-1),1:0)
  1.  S I=0
  1.  F  S I=$O(XMTEXT(I)) Q:'I  D
  1.  . S XMLINE=XMLINE+1
  1.  . S ^XMB(3.9,XMZ,2,XMLINE,0)=$S($D(XMTEXT(I,0)):XMTEXT(I,0),1:XMTEXT(I))
  1.  S ^XMB(3.9,XMZ,2,0)="^3.92A^"_XMLINE_U_XMLINE
  1.  Q
  1. ENTA(XMZ,XMSUBJ,XMTEXT,XMSTRIP,XMDUZ) ; Send Response Only to Sender of Original Message
  1.  ;Call as follows:
  1.  ; S var=$$ENT^XMA2R(XMZ,XMSUBJ,.XMTEXT,XMSTRIP,XMDUZ)
  1.  ;Where:  XMZ     = Message being responded to
  1.  ;        XMSUBJ  = Subject of the response
  1.  ;        .XMTEXT = Array containing text
  1.  ;        XMSTRIP = Characters to be stripped from text
  1.  ;        XMDUZ   = Sender of response (DUZ or free text)
  1.  ;
  1.  ;OUTPUT: If results okay = internal pointer to response in file 3.9
  1.  ;        If bad result, the letter "E" followed by a number,
  1.  ;        followed by a space, then a human readable explanation.
  1.  N XMV,XMZR,XMINSTR,XMMG,XMSECURE,XMZSENDR,XMZREC,XMTO
  1.  K XMERR,^TMP("XMERR",$J)
  1.  I '$D(^XMB(3.9,XMZ,0)) Q "E5 Message "_XMZ_" does not exist."
  1.  I '$D(XMSUBJ) Q "E1 No subject !"
  1.  I $D(XMTEXT)<9 Q "E2 No message text !"
  1.  I $L(XMSUBJ)<3!($L(XMSUBJ)>65) Q "E3 Subject too long or short !"
  1.  I '$O(XMTEXT(0)) Q "E4 No message text !"
  1.  S XMDUZ=$G(XMDUZ,DUZ)
  1.  I XMDUZ'?.N D  Q:$D(XMMG) "E10 "_$P(XMMG,"= ",2)
  1.  . D SETFROM^XMD(.XMDUZ,.XMINSTR)
  1.  D INITAPI^XMVVITAE
  1.  S XMZREC=^XMB(3.9,XMZ,0)
  1.  S XMZSENDR=$P(XMZREC,U,2)
  1.  S:XMZSENDR["@" XMZSENDR=$$REPLYTO1^XMXREPLY(XMZ)
  1.  D CRE8XMZ^XMXSEND(XMSUBJ,.XMZR) Q:XMZR<1 $$ERR("E9")
  1.  D COPY^XMXANSER(XMZ,$P(XMZREC,U,1),XMZSENDR,$P(XMZREC,U,3),XMZR)
  1.  D MOVETEXT(XMZR,.XMTEXT,1)
  1.  D NETSIG^XMXEDIT(XMDUZ,XMZR)
  1.  D CHEKBODY^XMXSEND(XMZR,$G(XMSTRIP))
  1.  S XMTO(XMZSENDR)=""
  1.  S XMTO(XMDUZ)=""
  1.  S XMINSTR("ADDR FLAGS")="R"  ; No addressing restrictions
  1.  D ADDRNSND^XMXSEND(XMDUZ,XMZR,.XMTO,.XMINSTR)
  1.  Q:$D(XMERR) $$ERR("E11")
  1.  Q XMZR
  1. ERR(XMER) ;
  1.  S XMER=XMER_" "_^TMP("XMERR",$J,1,"TEXT",1)
  1.  K XMERR,^TMP("XMERR",$J)
  1.  Q XMER