XMJMR ;ISC-SF/GMB-Interactive Reply ;04/24/2002 10:28
;;8.0;MailMan;;Jun 28, 2002
; Replaces REPLY^XMA11,^XMA2,^XMA20,^XMAH1 (ISC-WASH/CAP/THM)
REPLY(XMDUZ,XMK,XMKN,XMZO,XMZOSUBJ,XMZOFROM,XMINSTR,XMPTR,XMRESPSO,XMINCL,XMRESP) ;
N XMABORT,XMZ,XMID,XMWHICH,XMZI
S XMABORT=0
D INIT^XMJMR1(XMDUZ,.XMK,.XMKN,XMZO,XMZOSUBJ,XMZOFROM,.XMINSTR,XMINCL,.XMZI,.XMWHICH,.XMABORT) Q:XMABORT
D CRE8XMZ^XMXSEND("R"_XMZO,.XMZ,1) I XMZ<1 S XMABORT=1 Q
S XMID=$S(XMDUZ=.6:DUZ,1:XMDUZ)
D EDITON^XMJMS(XMID,XMZ,XMZO)
D PROCESS(XMID,XMK,XMKN,XMZO,XMZOSUBJ,XMZOFROM,XMZ,.XMINSTR,XMPTR,XMRESPSO,.XMRESP,.XMZI,.XMWHICH,.XMABORT)
I XMABORT=DTIME D HALT^XMJMS($$EZBLD^DIALOG(34220)) ; replying to
D EDITOFF^XMJMS(XMID)
D:XMABORT KILLMSG^XMXUTIL(XMZ)
Q
PROCESS(XMDUZ,XMK,XMKN,XMZO,XMZOSUBJ,XMZOFROM,XMZ,XMINSTR,XMPTR,XMRESPSO,XMRESP,XMZI,XMWHICH,XMABORT) ;
N XMRESTR
S XMRESTR("REPLYTO")=XMZO
D:$D(XMWHICH) COPYTEXT^XMJMR1(XMZI,XMZ,XMWHICH,(XMZI'=XMZO))
D BODY^XMJMS(XMDUZ,XMZ,XMZOSUBJ,.XMRESTR,.XMABORT) Q:XMABORT
D REPLYMSG^XMJMRO(XMDUZ,XMK,XMKN,XMZO,XMZ,XMZOSUBJ,.XMRESTR,XMPTR,XMRESPSO,.XMRESP,.XMABORT) Q:XMABORT
I XMZOFROM["@",$$UP^XLFSTR(XMZOFROM)'["POSTMASTER" D REMOTE(XMDUZ,XMZO,XMZOSUBJ,XMZ,.XMINSTR)
Q
REMOTE(XMDUZ,XMZO,XMZOSUBJ,XMZ,XMINSTR) ;
N DIR,Y,XMSUBJ,XMTO,XMABORT
S XMABORT=0
S DIR("A")=$$EZBLD^DIALOG(34206) ; Do you wish to send this reply across the network?
S DIR(0)="Y",DIR("B")=$$EZBLD^DIALOG(39053) ; No
D BLD^DIALOG(34207,"","","DIR(""?"")") ; Enter YES if you wish your response ...
S DIR("??")="^D RHELP^XMJMR"
D ^DIR Q:'Y!$D(DIRUT)
S XMRE=$$EZBLD^DIALOG(37006) ; Re:
S XMSUBJ=$S($$UP^XLFSTR($E(XMZOSUBJ,1,$L(XMRE)))=$$UP^XLFSTR(XMRE):XMZOSUBJ,1:$E(XMRE_XMZOSUBJ,1,65))
D SUBJ^XMJMS(.XMSUBJ,.XMABORT) Q:XMABORT
D REPLYTO(XMZO,.XMTO,.XMABORT) Q:XMABORT
W !,$$EZBLD^DIALOG(34211,XMTO) ; Addressing the reply to: |1|
D INIT^XMXADDR
S XMINSTR("EXACT")=1 ; Match on exact domain name
D ADDR^XMXADDR(XMDUZ,XMTO,.XMINSTR)
K XMINSTR("EXACT")
;S:XMTO[".DOMAIN.EXT" XMTO=$TR($P(XMTO,"@"),"._+",", .")_"@"_$P(XMTO,"@",2)
I $$GOTADDR^XMXADDR D
. W !,$$EZBLD^DIALOG(34212) ; Sending network reply...
. D NETREPLY^XMXREPLY(XMDUZ,XMZO,XMZ,XMSUBJ,.XMINSTR)
. W $$EZBLD^DIALOG(34213) ; Sent
D CLEANUP^XMXADDR
Q
RHELP ;
N XMTEXT
D BLD^DIALOG(34208,"","","XMTEXT","F") ; A network response will go to all message ... (explains network reply)
D MSG^DIALOG("WH","","","","XMTEXT")
Q
REPLYTO(XMZ,XMFROM,XMABORT) ;
N XMREPLTO,XMF,XMR
D REPLYTO^XMXREPLY(XMZ,.XMFROM,.XMREPLTO)
S XMF=XMFROM
S XMFROM=$$REMADDR^XMXADDR3(XMFROM)
Q:$G(XMREPLTO)=""
S XMR=XMREPLTO
S XMREPLTO=$$REMADDR^XMXADDR3(XMREPLTO)
Q:$$UP^XLFSTR(XMREPLTO)=$$UP^XLFSTR(XMFROM)
N DIR,Y
S DIR(0)="S^"
S DIR(0)=DIR(0)_"F:'FROM' "_XMF
S DIR(0)=DIR(0)_";R:'REPLY-TO' "_XMR
S DIR("B")="R"
D BLD^DIALOG(34214,"","","DIR(""A"")") ; This message has a 'reply-to' address ... (use which address?)
D BLD^DIALOG(34215,"","","DIR(""?"")") ; Generally, we recommend that you use ...
D ^DIR I $D(DIRUT) S XMABORT=1 Q
S:Y="R" XMFROM=XMREPLTO
Q
RECOVER(XMDUZ,XMZ,XMZO) ;
I XMDUZ'=DUZ,$$ZCONFID^XMXSEC(XMZO) D Q
. ; If user is surrogate & msg is confidential, delete unsent reply.
. D EDITOFF^XMJMS(XMDUZ)
. D KILLMSG^XMXUTIL(XMZ)
N XMSUBJ,DIR,Y,XMTEXT
S XMSUBJ=$P(^XMB(3.9,XMZO,0),U,1)
S:XMSUBJ["~U~" XMSUBJ=$$DECODEUP^XMXUTIL1(XMSUBJ)
W $C(7),!
;You have / |1| has an unsent response in your buffer.
D BLD^DIALOG($S(XMDUZ=DUZ:34222,1:34222.1),XMV("NAME"),"","XMTEXT","F")
;Subj: _XMSUBJ
D BLD^DIALOG(34536,XMSUBJ,"","XMTEXT","FS")
D MSG^DIALOG("WM","",79,"","XMTEXT")
W !
;You may continue to reply, or delete the remaining text.
;Shall we delete the unsent response?
D BLD^DIALOG(34222.3,"","","DIR(""A"")")
S DIR(0)="Y"
S DIR("B")=$$EZBLD^DIALOG(39053) ; No
D BLD^DIALOG(34223,"","","DIR(""?"")") ; Enter YES to delete the unsent response...
D ^DIR
I $D(DTOUT) D HALT^XMJMS($$EZBLD^DIALOG(34221)) ; recovering
I Y=1!$D(DUOUT) D Q
. D EDITOFF^XMJMS(XMDUZ)
. D KILLMSG^XMXUTIL(XMZ)
N XMK,XMKN,XMZOSUBJ,XMZOFROM,XMINSTR,XMABORT,XMSECURE,XMPAKMAN,XMWHICH,XMPTR,XMRESPSO,XMRESP
S XMABORT=0
D RECINIT(XMDUZ,XMZO,.XMK,.XMKN,.XMZOSUBJ,.XMZOFROM,.XMINSTR,.XMPTR,.XMRESPSO,.XMRESP)
D WAIT^XMXUTIL
D INIT^XMJMR1(XMDUZ,.XMK,.XMKN,XMZO,XMZOSUBJ,XMZOFROM,.XMINSTR,0,"",.XMWHICH,.XMABORT) Q:XMV("NOSEND")
I XMABORT D HALT^XMJMS($$EZBLD^DIALOG(34221)) ; recovering
D PROCESS(XMDUZ,XMK,XMKN,XMZO,XMZOSUBJ,XMZOFROM,XMZ,.XMINSTR,XMPTR,XMRESPSO,.XMRESP,"",.XMWHICH,.XMABORT)
I XMABORT=DTIME D HALT^XMJMS($$EZBLD^DIALOG(34220)) ; replying to
D EDITOFF^XMJMS(XMDUZ)
D:XMABORT KILLMSG^XMXUTIL(XMZ)
Q
RECINIT(XMDUZ,XMZO,XMK,XMKN,XMZOSUBJ,XMZOFROM,XMINSTR,XMPTR,XMRESPSO,XMRESP) ;
N XMSECBAD,XMIM,XMIU
S XMK=+$O(^XMB(3.7,"M",XMZO,XMDUZ,""))
S XMKN=$P($G(^XMB(3.7,XMDUZ,2,XMK,0)),U,1)
D DISPMSG^XMJMP(XMDUZ,XMK,XMKN,XMZO,.XMSECBAD,1)
I $G(XMSECBAD) D HALT^XMJMS($$EZBLD^DIALOG(34221)) ; recovering
D INMSG^XMXUTIL2(XMDUZ,0,XMZO,"","I",.XMIM,.XMINSTR,.XMIU)
S XMZOSUBJ=XMIM("SUBJ")
S XMZOFROM=XMIM("FROM")
S XMRESPSO=XMIM("RESPS")
S XMPTR=XMIU("IEN")
S XMRESP=XMIU("RESP")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMJMR 5219 printed Apr 09, 2024@21:15:38 Page 2
XMJMR ;ISC-SF/GMB-Interactive Reply ;04/24/2002 10:28
+1 ;;8.0;MailMan;;Jun 28, 2002
+2 ; Replaces REPLY^XMA11,^XMA2,^XMA20,^XMAH1 (ISC-WASH/CAP/THM)
REPLY(XMDUZ,XMK,XMKN,XMZO,XMZOSUBJ,XMZOFROM,XMINSTR,XMPTR,XMRESPSO,XMINCL,XMRESP) ;
+1 NEW XMABORT,XMZ,XMID,XMWHICH,XMZI
+2 SET XMABORT=0
+3 DO INIT^XMJMR1(XMDUZ,.XMK,.XMKN,XMZO,XMZOSUBJ,XMZOFROM,.XMINSTR,XMINCL,.XMZI,.XMWHICH,.XMABORT)
if XMABORT
QUIT
+4 DO CRE8XMZ^XMXSEND("R"_XMZO,.XMZ,1)
IF XMZ<1
SET XMABORT=1
QUIT
+5 SET XMID=$SELECT(XMDUZ=.6:DUZ,1:XMDUZ)
+6 DO EDITON^XMJMS(XMID,XMZ,XMZO)
+7 DO PROCESS(XMID,XMK,XMKN,XMZO,XMZOSUBJ,XMZOFROM,XMZ,.XMINSTR,XMPTR,XMRESPSO,.XMRESP,.XMZI,.XMWHICH,.XMABORT)
+8 ; replying to
IF XMABORT=DTIME
DO HALT^XMJMS($$EZBLD^DIALOG(34220))
+9 DO EDITOFF^XMJMS(XMID)
+10 if XMABORT
DO KILLMSG^XMXUTIL(XMZ)
+11 QUIT
PROCESS(XMDUZ,XMK,XMKN,XMZO,XMZOSUBJ,XMZOFROM,XMZ,XMINSTR,XMPTR,XMRESPSO,XMRESP,XMZI,XMWHICH,XMABORT) ;
+1 NEW XMRESTR
+2 SET XMRESTR("REPLYTO")=XMZO
+3 if $DATA(XMWHICH)
DO COPYTEXT^XMJMR1(XMZI,XMZ,XMWHICH,(XMZI'=XMZO))
+4 DO BODY^XMJMS(XMDUZ,XMZ,XMZOSUBJ,.XMRESTR,.XMABORT)
if XMABORT
QUIT
+5 DO REPLYMSG^XMJMRO(XMDUZ,XMK,XMKN,XMZO,XMZ,XMZOSUBJ,.XMRESTR,XMPTR,XMRESPSO,.XMRESP,.XMABORT)
if XMABORT
QUIT
+6 IF XMZOFROM["@"
IF $$UP^XLFSTR(XMZOFROM)'["POSTMASTER"
DO REMOTE(XMDUZ,XMZO,XMZOSUBJ,XMZ,.XMINSTR)
+7 QUIT
REMOTE(XMDUZ,XMZO,XMZOSUBJ,XMZ,XMINSTR) ;
+1 NEW DIR,Y,XMSUBJ,XMTO,XMABORT
+2 SET XMABORT=0
+3 ; Do you wish to send this reply across the network?
SET DIR("A")=$$EZBLD^DIALOG(34206)
+4 ; No
SET DIR(0)="Y"
SET DIR("B")=$$EZBLD^DIALOG(39053)
+5 ; Enter YES if you wish your response ...
DO BLD^DIALOG(34207,"","","DIR(""?"")")
+6 SET DIR("??")="^D RHELP^XMJMR"
+7 DO ^DIR
if 'Y!$DATA(DIRUT)
QUIT
+8 ; Re:
SET XMRE=$$EZBLD^DIALOG(37006)
+9 SET XMSUBJ=$SELECT($$UP^XLFSTR($EXTRACT(XMZOSUBJ,1,$LENGTH(XMRE)))=$$UP^XLFSTR(XMRE):XMZOSUBJ,1:$EXTRACT(XMRE_XMZOSUBJ,1,65))
+10 DO SUBJ^XMJMS(.XMSUBJ,.XMABORT)
if XMABORT
QUIT
+11 DO REPLYTO(XMZO,.XMTO,.XMABORT)
if XMABORT
QUIT
+12 ; Addressing the reply to: |1|
WRITE !,$$EZBLD^DIALOG(34211,XMTO)
+13 DO INIT^XMXADDR
+14 ; Match on exact domain name
SET XMINSTR("EXACT")=1
+15 DO ADDR^XMXADDR(XMDUZ,XMTO,.XMINSTR)
+16 KILL XMINSTR("EXACT")
+17 ;S:XMTO[".DOMAIN.EXT" XMTO=$TR($P(XMTO,"@"),"._+",", .")_"@"_$P(XMTO,"@",2)
+18 IF $$GOTADDR^XMXADDR
Begin DoDot:1
+19 ; Sending network reply...
WRITE !,$$EZBLD^DIALOG(34212)
+20 DO NETREPLY^XMXREPLY(XMDUZ,XMZO,XMZ,XMSUBJ,.XMINSTR)
+21 ; Sent
WRITE $$EZBLD^DIALOG(34213)
End DoDot:1
+22 DO CLEANUP^XMXADDR
+23 QUIT
RHELP ;
+1 NEW XMTEXT
+2 ; A network response will go to all message ... (explains network reply)
DO BLD^DIALOG(34208,"","","XMTEXT","F")
+3 DO MSG^DIALOG("WH","","","","XMTEXT")
+4 QUIT
REPLYTO(XMZ,XMFROM,XMABORT) ;
+1 NEW XMREPLTO,XMF,XMR
+2 DO REPLYTO^XMXREPLY(XMZ,.XMFROM,.XMREPLTO)
+3 SET XMF=XMFROM
+4 SET XMFROM=$$REMADDR^XMXADDR3(XMFROM)
+5 if $GET(XMREPLTO)=""
QUIT
+6 SET XMR=XMREPLTO
+7 SET XMREPLTO=$$REMADDR^XMXADDR3(XMREPLTO)
+8 if $$UP^XLFSTR(XMREPLTO)=$$UP^XLFSTR(XMFROM)
QUIT
+9 NEW DIR,Y
+10 SET DIR(0)="S^"
+11 SET DIR(0)=DIR(0)_"F:'FROM' "_XMF
+12 SET DIR(0)=DIR(0)_";R:'REPLY-TO' "_XMR
+13 SET DIR("B")="R"
+14 ; This message has a 'reply-to' address ... (use which address?)
DO BLD^DIALOG(34214,"","","DIR(""A"")")
+15 ; Generally, we recommend that you use ...
DO BLD^DIALOG(34215,"","","DIR(""?"")")
+16 DO ^DIR
IF $DATA(DIRUT)
SET XMABORT=1
QUIT
+17 if Y="R"
SET XMFROM=XMREPLTO
+18 QUIT
RECOVER(XMDUZ,XMZ,XMZO) ;
+1 IF XMDUZ'=DUZ
IF $$ZCONFID^XMXSEC(XMZO)
Begin DoDot:1
+2 ; If user is surrogate & msg is confidential, delete unsent reply.
+3 DO EDITOFF^XMJMS(XMDUZ)
+4 DO KILLMSG^XMXUTIL(XMZ)
End DoDot:1
QUIT
+5 NEW XMSUBJ,DIR,Y,XMTEXT
+6 SET XMSUBJ=$PIECE(^XMB(3.9,XMZO,0),U,1)
+7 if XMSUBJ["~U~"
SET XMSUBJ=$$DECODEUP^XMXUTIL1(XMSUBJ)
+8 WRITE $CHAR(7),!
+9 ;You have / |1| has an unsent response in your buffer.
+10 DO BLD^DIALOG($SELECT(XMDUZ=DUZ:34222,1:34222.1),XMV("NAME"),"","XMTEXT","F")
+11 ;Subj: _XMSUBJ
+12 DO BLD^DIALOG(34536,XMSUBJ,"","XMTEXT","FS")
+13 DO MSG^DIALOG("WM","",79,"","XMTEXT")
+14 WRITE !
+15 ;You may continue to reply, or delete the remaining text.
+16 ;Shall we delete the unsent response?
+17 DO BLD^DIALOG(34222.3,"","","DIR(""A"")")
+18 SET DIR(0)="Y"
+19 ; No
SET DIR("B")=$$EZBLD^DIALOG(39053)
+20 ; Enter YES to delete the unsent response...
DO BLD^DIALOG(34223,"","","DIR(""?"")")
+21 DO ^DIR
+22 ; recovering
IF $DATA(DTOUT)
DO HALT^XMJMS($$EZBLD^DIALOG(34221))
+23 IF Y=1!$DATA(DUOUT)
Begin DoDot:1
+24 DO EDITOFF^XMJMS(XMDUZ)
+25 DO KILLMSG^XMXUTIL(XMZ)
End DoDot:1
QUIT
+26 NEW XMK,XMKN,XMZOSUBJ,XMZOFROM,XMINSTR,XMABORT,XMSECURE,XMPAKMAN,XMWHICH,XMPTR,XMRESPSO,XMRESP
+27 SET XMABORT=0
+28 DO RECINIT(XMDUZ,XMZO,.XMK,.XMKN,.XMZOSUBJ,.XMZOFROM,.XMINSTR,.XMPTR,.XMRESPSO,.XMRESP)
+29 DO WAIT^XMXUTIL
+30 DO INIT^XMJMR1(XMDUZ,.XMK,.XMKN,XMZO,XMZOSUBJ,XMZOFROM,.XMINSTR,0,"",.XMWHICH,.XMABORT)
if XMV("NOSEND")
QUIT
+31 ; recovering
IF XMABORT
DO HALT^XMJMS($$EZBLD^DIALOG(34221))
+32 DO PROCESS(XMDUZ,XMK,XMKN,XMZO,XMZOSUBJ,XMZOFROM,XMZ,.XMINSTR,XMPTR,XMRESPSO,.XMRESP,"",.XMWHICH,.XMABORT)
+33 ; replying to
IF XMABORT=DTIME
DO HALT^XMJMS($$EZBLD^DIALOG(34220))
+34 DO EDITOFF^XMJMS(XMDUZ)
+35 if XMABORT
DO KILLMSG^XMXUTIL(XMZ)
+36 QUIT
RECINIT(XMDUZ,XMZO,XMK,XMKN,XMZOSUBJ,XMZOFROM,XMINSTR,XMPTR,XMRESPSO,XMRESP) ;
+1 NEW XMSECBAD,XMIM,XMIU
+2 SET XMK=+$ORDER(^XMB(3.7,"M",XMZO,XMDUZ,""))
+3 SET XMKN=$PIECE($GET(^XMB(3.7,XMDUZ,2,XMK,0)),U,1)
+4 DO DISPMSG^XMJMP(XMDUZ,XMK,XMKN,XMZO,.XMSECBAD,1)
+5 ; recovering
IF $GET(XMSECBAD)
DO HALT^XMJMS($$EZBLD^DIALOG(34221))
+6 DO INMSG^XMXUTIL2(XMDUZ,0,XMZO,"","I",.XMIM,.XMINSTR,.XMIU)
+7 SET XMZOSUBJ=XMIM("SUBJ")
+8 SET XMZOFROM=XMIM("FROM")
+9 SET XMRESPSO=XMIM("RESPS")
+10 SET XMPTR=XMIU("IEN")
+11 SET XMRESP=XMIU("RESP")
+12 QUIT
