| 1 | XMA2R ;ISC-SF/GMB- Reply to/Answer a message API ;04/19/2002 12:37
|
|---|
| 2 | ;;8.0;MailMan;;Jun 28, 2002
|
|---|
| 3 | ; Was (WASH ISC)/CAP
|
|---|
| 4 | ;
|
|---|
| 5 | ; Entry points (DBIA 1145):
|
|---|
| 6 | ; ENT function for non-interactive reply to a message.
|
|---|
| 7 | ; Reply is sent to all local recipients of the message.
|
|---|
| 8 | ; If message if from a remote sender, the reply is sent to
|
|---|
| 9 | ; the remote sender, too.
|
|---|
| 10 | ; ENTA function for non-interactive answer to a message
|
|---|
| 11 | ENT(XMZ,XMSUBJ,XMTEXT,XMSTRIP,XMDUZ,XMNET) ; Send response to a message
|
|---|
| 12 | ;Call as follows:
|
|---|
| 13 | ; S var=$$ENT^XMA2R(XMZ,XMSUBJ,.XMTEXT,XMSTRIP,XMDUZ,XMNET)
|
|---|
| 14 | ;Where: XMZ = Message being responded to
|
|---|
| 15 | ; XMSUBJ = Subject of the response
|
|---|
| 16 | ; (ignored, unless message is from a remote sender)
|
|---|
| 17 | ; .XMTEXT = Array containing text
|
|---|
| 18 | ; XMSTRIP = Characters to be stripped from text
|
|---|
| 19 | ; XMDUZ = Sender of response (DUZ or free text)
|
|---|
| 20 | ; XMNET = Send reply over the net? (0=no (DEFAULT); 1=yes)
|
|---|
| 21 | ; (ignored, unless message is from a remote sender)
|
|---|
| 22 | ;OUTPUT: If results okay = internal pointer to response in file 3.9
|
|---|
| 23 | ; If bad result, the letter "E" followed by a number,
|
|---|
| 24 | ; followed by a space, then a human readable explanation.
|
|---|
| 25 | N XMV,XMZR,XMINSTR,XMMG,XMSECURE,XMZREC
|
|---|
| 26 | K XMERR,^TMP("XMERR",$J)
|
|---|
| 27 | I '$D(^XMB(3.9,XMZ,0)) Q "E5 Message "_XMZ_" does not exist."
|
|---|
| 28 | I '$O(^XMB(3.9,XMZ,1,0)) Q "E6 Message "_XMZ_" has no recipients."
|
|---|
| 29 | I $D(XMTEXT)<9 Q "E2 No message text !"
|
|---|
| 30 | I '$O(XMTEXT(0)) Q "E4 No message text !"
|
|---|
| 31 | S XMDUZ=$G(XMDUZ,DUZ)
|
|---|
| 32 | I XMDUZ'?.N D Q:$D(XMMG) "E10 "_$P(XMMG,"= ",2)
|
|---|
| 33 | . D SETFROM^XMD(.XMDUZ,.XMINSTR)
|
|---|
| 34 | D INITAPI^XMVVITAE
|
|---|
| 35 | D CRE8XMZ^XMXSEND("R"_XMZ,.XMZR) Q:XMZR<1 $$ERR("E9")
|
|---|
| 36 | D MOVETEXT(XMZR,.XMTEXT)
|
|---|
| 37 | D CHEKBODY^XMXSEND(XMZR,$G(XMSTRIP))
|
|---|
| 38 | D DOREPLY^XMXREPLY(XMDUZ,XMZ,XMZR,.XMINSTR)
|
|---|
| 39 | S XMZREC=$G(^XMB(3.9,XMZ,0))
|
|---|
| 40 | I $P(XMZREC,U,2)'["@"!'$G(XMNET) Q XMZR
|
|---|
| 41 | I '$D(XMSUBJ) Q "E1 No subject !"
|
|---|
| 42 | I $L(XMSUBJ)<3!($L(XMSUBJ)>65) Q "E3 Subject too long or short !"
|
|---|
| 43 | S XMSUBJ=$$SCRUB^XMXUTIL1(XMSUBJ)
|
|---|
| 44 | S:XMSUBJ[U XMSUBJ=$$ENCODEUP^XMXUTIL1(XMSUBJ)
|
|---|
| 45 | N XMFROM,XMREPLTO
|
|---|
| 46 | D REPLYTO^XMXREPLY(XMZ,.XMFROM,.XMREPLTO)
|
|---|
| 47 | D INIT^XMXADDR
|
|---|
| 48 | D CHKADDR^XMXADDR(XMDUZ,$$REMADDR^XMXADDR3($G(XMREPLTO,XMFROM)),.XMINSTR) Q:$D(XMERR) $$ERR("E12")
|
|---|
| 49 | D NETREPLY^XMXREPLY(XMDUZ,XMZ,XMZR,XMSUBJ,.XMINSTR)
|
|---|
| 50 | D CLEANUP^XMXADDR
|
|---|
| 51 | Q XMZR
|
|---|
| 52 | MOVETEXT(XMZ,XMTEXT,XMAPPEND) ;
|
|---|
| 53 | N I,XMLINE
|
|---|
| 54 | S XMLINE=$S($G(XMAPPEND):$O(^XMB(3.9,XMZ,2,":"),-1),1:0)
|
|---|
| 55 | S I=0
|
|---|
| 56 | F S I=$O(XMTEXT(I)) Q:'I D
|
|---|
| 57 | . S XMLINE=XMLINE+1
|
|---|
| 58 | . S ^XMB(3.9,XMZ,2,XMLINE,0)=$S($D(XMTEXT(I,0)):XMTEXT(I,0),1:XMTEXT(I))
|
|---|
| 59 | S ^XMB(3.9,XMZ,2,0)="^3.92A^"_XMLINE_U_XMLINE
|
|---|
| 60 | Q
|
|---|
| 61 | ENTA(XMZ,XMSUBJ,XMTEXT,XMSTRIP,XMDUZ) ; Send Response Only to Sender of Original Message
|
|---|
| 62 | ;Call as follows:
|
|---|
| 63 | ; S var=$$ENT^XMA2R(XMZ,XMSUBJ,.XMTEXT,XMSTRIP,XMDUZ)
|
|---|
| 64 | ;Where: XMZ = Message being responded to
|
|---|
| 65 | ; XMSUBJ = Subject of the response
|
|---|
| 66 | ; .XMTEXT = Array containing text
|
|---|
| 67 | ; XMSTRIP = Characters to be stripped from text
|
|---|
| 68 | ; XMDUZ = Sender of response (DUZ or free text)
|
|---|
| 69 | ;
|
|---|
| 70 | ;OUTPUT: If results okay = internal pointer to response in file 3.9
|
|---|
| 71 | ; If bad result, the letter "E" followed by a number,
|
|---|
| 72 | ; followed by a space, then a human readable explanation.
|
|---|
| 73 | N XMV,XMZR,XMINSTR,XMMG,XMSECURE,XMZSENDR,XMZREC,XMTO
|
|---|
| 74 | K XMERR,^TMP("XMERR",$J)
|
|---|
| 75 | I '$D(^XMB(3.9,XMZ,0)) Q "E5 Message "_XMZ_" does not exist."
|
|---|
| 76 | I '$D(XMSUBJ) Q "E1 No subject !"
|
|---|
| 77 | I $D(XMTEXT)<9 Q "E2 No message text !"
|
|---|
| 78 | I $L(XMSUBJ)<3!($L(XMSUBJ)>65) Q "E3 Subject too long or short !"
|
|---|
| 79 | I '$O(XMTEXT(0)) Q "E4 No message text !"
|
|---|
| 80 | S XMDUZ=$G(XMDUZ,DUZ)
|
|---|
| 81 | I XMDUZ'?.N D Q:$D(XMMG) "E10 "_$P(XMMG,"= ",2)
|
|---|
| 82 | . D SETFROM^XMD(.XMDUZ,.XMINSTR)
|
|---|
| 83 | D INITAPI^XMVVITAE
|
|---|
| 84 | S XMZREC=^XMB(3.9,XMZ,0)
|
|---|
| 85 | S XMZSENDR=$P(XMZREC,U,2)
|
|---|
| 86 | S:XMZSENDR["@" XMZSENDR=$$REPLYTO1^XMXREPLY(XMZ)
|
|---|
| 87 | D CRE8XMZ^XMXSEND(XMSUBJ,.XMZR) Q:XMZR<1 $$ERR("E9")
|
|---|
| 88 | D COPY^XMXANSER(XMZ,$P(XMZREC,U,1),XMZSENDR,$P(XMZREC,U,3),XMZR)
|
|---|
| 89 | D MOVETEXT(XMZR,.XMTEXT,1)
|
|---|
| 90 | D NETSIG^XMXEDIT(XMDUZ,XMZR)
|
|---|
| 91 | D CHEKBODY^XMXSEND(XMZR,$G(XMSTRIP))
|
|---|
| 92 | S XMTO(XMZSENDR)=""
|
|---|
| 93 | S XMTO(XMDUZ)=""
|
|---|
| 94 | S XMINSTR("ADDR FLAGS")="R" ; No addressing restrictions
|
|---|
| 95 | D ADDRNSND^XMXSEND(XMDUZ,XMZR,.XMTO,.XMINSTR)
|
|---|
| 96 | Q:$D(XMERR) $$ERR("E11")
|
|---|
| 97 | Q XMZR
|
|---|
| 98 | ERR(XMER) ;
|
|---|
| 99 | S XMER=XMER_" "_^TMP("XMERR",$J,1,"TEXT",1)
|
|---|
| 100 | K XMERR,^TMP("XMERR",$J)
|
|---|
| 101 | Q XMER
|
|---|
