- 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 Feb 18, 2025@23:38:27 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