XMJMC ;ISC-SF/GMB-Copy message ;02/23/2000 15:34
;;8.0;MailMan;;Jun 28, 2002
; Replaces ^XMA2C,^XMA2C0 (ISC-WASH/CAP)
COPY(XMDUZ,XMK,XMZ,XMFROM) ;
N XMABORT,XMWHICH,XMLR,XMSAME,XMZREC
D INIT(XMDUZ,XMK,XMZ,XMFROM,.XMZREC,.XMWHICH,.XMLR,.XMSAME,.XMABORT) Q:XMABORT
D COPYIT(XMDUZ,XMZ,$P(XMZREC,U,1),XMFROM,$P(XMZREC,U,3),XMWHICH,XMLR,XMSAME)
Q
INIT(XMDUZ,XMK,XMZ,XMFROM,XMZREC,XMWHICH,XMLR,XMSAME,XMABORT) ;
S XMZREC=^XMB(3.9,XMZ,0)
S XMABORT=0
D INIT^XMJMS(XMDUZ,.XMABORT) Q:XMABORT
S XMWHICH=0
D WHICH(XMZ,$$EZBLD^DIALOG(34600),.XMWHICH,.XMABORT) Q:XMABORT ; copy
I '$$COPYRECP^XMXSEC1(XMZ) D Q
. S (XMLR,XMSAME)=0
. D SHOW^XMJERR
D LISTR(.XMLR,.XMABORT) Q:XMABORT
D TOSAME(.XMSAME,.XMABORT)
Q
WHICH(XMZ,XMVERB,XMWHICH,XMABORT) ;
N XMRESPS
S XMRESPS=+$P($G(^XMB(3.9,XMZ,3,0)),U,4)
I XMRESPS=0 S XMWHICH=0
E D WHICH^XMJMP(XMZ,XMRESPS,XMVERB,.XMWHICH,.XMABORT) Q:XMABORT!'$D(XMWHICH)
Q:$$COPYAMT^XMXSEC1(XMZ,XMWHICH)
S XMABORT=1
D SHOW^XMJERR
;You may use the 'Transfer' option of the FileMan Editor
;to move text from this message or its responses into a new message.
N XMTEXT
D BLD^DIALOG(34601,"","","XMTEXT","F")
D MSG^DIALOG("WH","","","","XMTEXT")
Q
LISTR(XMLR,XMABORT) ;
N DIR,Y
S DIR("A")=$$EZBLD^DIALOG(34602) ; List original recipients in text
S DIR("B")=$$EZBLD^DIALOG(39053),DIR(0)="Y",DIR("??")="XM-U-M-COPY-2" ; No
D ^DIR I $D(DIRUT) S XMABORT=1 Q
S XMLR=Y
Q
TOSAME(XMSAME,XMABORT) ;
N DIR,Y
S DIR("A")=$$EZBLD^DIALOG(34603) ; Deliver to the same recipients
S DIR("B")=$$EZBLD^DIALOG(39053),DIR(0)="Y",DIR("??")="XM-U-M-COPY-2" ; No
D ^DIR I $D(DIRUT) S XMABORT=1 Q
S XMSAME=Y
Q:'XMSAME
;LOCAL recipients (NOT Recipients on remote network nodes) will be copied.
N XMTEXT
W !
D BLD^DIALOG(34604,"","","XMTEXT","F")
D MSG^DIALOG("WM","","","","XMTEXT")
Q
COPYIT(XMDUZ,XMZO,XMSUBJO,XMFROM,XMDATEO,XMWHICH,XMLR,XMSAME) ;
; XMWHICH List of responses to copy
; XMLR 1=list original recipients in msg; 0=don't
; XMSAME 1=deliver to the original recipients; 0=don't
N XMZ,XMSUBJ,XMABORT
S XMABORT=0
D INIT^XMXADDR
S XMSUBJ=$E($$EZBLD^DIALOG(34605,XMSUBJO),1,65) ; Copy of:
D SUBJ^XMJMS(.XMSUBJ,.XMABORT) Q:XMABORT
D CRE8XMZ^XMXSEND(XMSUBJ,.XMZ,1) I XMZ<1 S XMABORT=1 Q
D:'$G(XMPAKMAN) EDITON^XMJMS(XMDUZ,XMZ)
D CPROCESS(XMDUZ,XMZO,XMSUBJO,XMFROM,XMDATEO,XMWHICH,XMLR,XMSAME,XMZ,XMSUBJ,.XMABORT)
D:XMABORT=DTIME HALT^XMJMS($$EZBLD^DIALOG(34606)) ; copying
D:'$G(XMPAKMAN) EDITOFF^XMJMS(XMDUZ)
D:XMABORT KILLMSG^XMXUTIL(XMZ)
Q
CPROCESS(XMDUZ,XMZO,XMSUBJO,XMFROM,XMDATEO,XMWHICH,XMLR,XMSAME,XMZ,XMSUBJ,XMABORT) ;
N XMINSTR,XMRESTR,XMC
D COPYTEXT(XMZO,XMSUBJO,XMFROM,XMDATEO,XMZ,XMWHICH,.XMC)
D:XMLR!XMSAME COPYRECP(XMLR,XMSAME,XMZO,XMZ,.XMINSTR,.XMC)
S ^XMB(3.9,XMZ,2,0)="^3.92A^"_XMC_U_XMC_U_DT
D ET^XMJMSO Q:XMABORT
D TOWHOM^XMJMT(XMDUZ,$$EZBLD^DIALOG(34110),.XMINSTR,.XMRESTR,.XMABORT) Q:XMABORT ; Send to add'l recipients
I $G(XMPAKMAN) S XMINSTR("TYPE")=$S($P(^XMB(3.9,XMZO,0),U,7)["K":"K",1:"X")
D SENDMSG^XMJMSO(XMDUZ,XMZ,XMSUBJ,.XMINSTR,.XMRESTR,.XMABORT) Q:XMABORT ; transmit prompt
N XMIEN
S XMIEN=+$O(^XMB(3.9,XMZO,1,"C",XMDUZ,0))
I XMIEN S ^XMB(3.9,XMZO,1,XMIEN,"C")=$$NOW^XLFDT
Q
COPYTEXT(XMZO,XMSUBJO,XMFROM,XMDATEO,XMZ,XMWHICH,XMC) ;
N I,XMRESP,XMRANGE
W !,$$EZBLD^DIALOG(34607) ; Copying text
D COPYHEAD(XMZO,XMSUBJO,XMFROM,XMDATEO,XMZ,"C",.XMC)
F I=1:1:$L(XMWHICH,",") D
. S XMRANGE=$P(XMWHICH,",",I)
. Q:XMRANGE="" ; (XMWHICH can end with a ",", giving us a null piece.)
. F XMRESP=$P(XMRANGE,"-",1):1:$S(XMRANGE["-":$P(XMRANGE,"-",2),1:XMRANGE) D
. . I XMRESP=0 D COPYRESP(XMRESP,XMZO,XMZ,.XMC) Q
. . D COPYRESP(XMRESP,+$G(^XMB(3.9,XMZO,3,XMRESP,0)),XMZ,.XMC)
Q
COPYHEAD(XMZO,XMSUBJ,XMFROM,XMDATE,XMZ,XMTYPE,XMC) ;
N XMPRE
S XMPRE=$S(XMTYPE="C":"",1:">")
S ^XMB(3.9,XMZ,2,1,0)=XMPRE_$$EZBLD^DIALOG(34205)_": """_XMSUBJ_""""_$S(XMTYPE="C":" "_$$EZBLD^DIALOG(34537,XMZO),1:"") ; Original message:
S ^XMB(3.9,XMZ,2,2,0)=XMPRE_$$EZBLD^DIALOG(34538,$$NAME^XMXUTIL(XMFROM)) ; From
S ^XMB(3.9,XMZ,2,3,0)=XMPRE_$$EZBLD^DIALOG(34585,$$MMDT^XMXUTIL1(XMDATE)) ; Sent:
S XMC=3
Q
COPYRESP(XMRESP,XMZR,XMZ,XMC) ;
N XMF,XMFROM,XMDT,XMZREC
S XMC=XMC+1
S ^XMB(3.9,XMZ,2,XMC,0)=""
I XMRESP D
. S XMZREC=$G(^XMB(3.9,XMZR,0))
. S XMFROM=$$NAME^XMXUTIL($P(XMZREC,U,2))
. S XMDT=$P(XMZREC,U,3)
. S XMC=XMC+1
. S ^XMB(3.9,XMZ,2,XMC,0)=$$EZBLD^DIALOG(34204,XMRESP)_": "_XMFROM_" "_$$MMDT^XMXUTIL1(XMDT) ; Response #
S XMF=.999999
F S XMF=$O(^XMB(3.9,XMZR,2,XMF)) Q:XMF="" D
. S XMC=XMC+1
. W:XMC#50=0 "."
. S ^XMB(3.9,XMZ,2,XMC,0)=^XMB(3.9,XMZR,2,XMF,0)
Q
COPYRECP(XMLR,XMSAME,XMZO,XMZ,XMINSTR,XMC) ;
N XMTO,XMNAME
I XMLR D
. W !,$$EZBLD^DIALOG($S(XMSAME:34610,1:34611)) ; Copying recipients into text (and onto message)
. N XMTEXT,X
. S XMTEXT=$$EZBLD^DIALOG(34608) ; Original Recipients
. S XMC=XMC+1,^XMB(3.9,XMZ,2,XMC,0)=""
. S XMC=XMC+1,^XMB(3.9,XMZ,2,XMC,0)=XMTEXT
. S X="",$P(X,"-",$L(XMTEXT)+1)="" ; "-------------------"
. S XMC=XMC+1,^XMB(3.9,XMZ,2,XMC,0)=X
E W !,$$EZBLD^DIALOG(34612) ; Copying recipients onto message
S XMTO=""
F S XMTO=$O(^XMB(3.9,XMZO,1,"C",XMTO)) Q:XMTO="" D
. I XMSAME,XMTO=+XMTO W ! D ADDR^XMXADDR(XMDUZ,"`"_XMTO,.XMINSTR)
. Q:'XMLR
. I +XMTO=XMTO S XMNAME=$$NAME^XMXUTIL(XMTO)
. E I $L(XMTO)<30 S XMNAME=XMTO
. E S XMNAME=$P($G(^XMB(3.9,XMZO,1,$O(^XMB(3.9,XMZO,1,"C",XMTO,0)),0)),U,1)
. S XMC=XMC+1,^XMB(3.9,XMZ,2,XMC,0)=XMNAME
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMJMC 5550 printed Oct 16, 2024@18:12:37 Page 2
XMJMC ;ISC-SF/GMB-Copy message ;02/23/2000 15:34
+1 ;;8.0;MailMan;;Jun 28, 2002
+2 ; Replaces ^XMA2C,^XMA2C0 (ISC-WASH/CAP)
COPY(XMDUZ,XMK,XMZ,XMFROM) ;
+1 NEW XMABORT,XMWHICH,XMLR,XMSAME,XMZREC
+2 DO INIT(XMDUZ,XMK,XMZ,XMFROM,.XMZREC,.XMWHICH,.XMLR,.XMSAME,.XMABORT)
if XMABORT
QUIT
+3 DO COPYIT(XMDUZ,XMZ,$PIECE(XMZREC,U,1),XMFROM,$PIECE(XMZREC,U,3),XMWHICH,XMLR,XMSAME)
+4 QUIT
INIT(XMDUZ,XMK,XMZ,XMFROM,XMZREC,XMWHICH,XMLR,XMSAME,XMABORT) ;
+1 SET XMZREC=^XMB(3.9,XMZ,0)
+2 SET XMABORT=0
+3 DO INIT^XMJMS(XMDUZ,.XMABORT)
if XMABORT
QUIT
+4 SET XMWHICH=0
+5 ; copy
DO WHICH(XMZ,$$EZBLD^DIALOG(34600),.XMWHICH,.XMABORT)
if XMABORT
QUIT
+6 IF '$$COPYRECP^XMXSEC1(XMZ)
Begin DoDot:1
+7 SET (XMLR,XMSAME)=0
+8 DO SHOW^XMJERR
End DoDot:1
QUIT
+9 DO LISTR(.XMLR,.XMABORT)
if XMABORT
QUIT
+10 DO TOSAME(.XMSAME,.XMABORT)
+11 QUIT
WHICH(XMZ,XMVERB,XMWHICH,XMABORT) ;
+1 NEW XMRESPS
+2 SET XMRESPS=+$PIECE($GET(^XMB(3.9,XMZ,3,0)),U,4)
+3 IF XMRESPS=0
SET XMWHICH=0
+4 IF '$TEST
DO WHICH^XMJMP(XMZ,XMRESPS,XMVERB,.XMWHICH,.XMABORT)
if XMABORT!'$DATA(XMWHICH)
QUIT
+5 if $$COPYAMT^XMXSEC1(XMZ,XMWHICH)
QUIT
+6 SET XMABORT=1
+7 DO SHOW^XMJERR
+8 ;You may use the 'Transfer' option of the FileMan Editor
+9 ;to move text from this message or its responses into a new message.
+10 NEW XMTEXT
+11 DO BLD^DIALOG(34601,"","","XMTEXT","F")
+12 DO MSG^DIALOG("WH","","","","XMTEXT")
+13 QUIT
LISTR(XMLR,XMABORT) ;
+1 NEW DIR,Y
+2 ; List original recipients in text
SET DIR("A")=$$EZBLD^DIALOG(34602)
+3 ; No
SET DIR("B")=$$EZBLD^DIALOG(39053)
SET DIR(0)="Y"
SET DIR("??")="XM-U-M-COPY-2"
+4 DO ^DIR
IF $DATA(DIRUT)
SET XMABORT=1
QUIT
+5 SET XMLR=Y
+6 QUIT
TOSAME(XMSAME,XMABORT) ;
+1 NEW DIR,Y
+2 ; Deliver to the same recipients
SET DIR("A")=$$EZBLD^DIALOG(34603)
+3 ; No
SET DIR("B")=$$EZBLD^DIALOG(39053)
SET DIR(0)="Y"
SET DIR("??")="XM-U-M-COPY-2"
+4 DO ^DIR
IF $DATA(DIRUT)
SET XMABORT=1
QUIT
+5 SET XMSAME=Y
+6 if 'XMSAME
QUIT
+7 ;LOCAL recipients (NOT Recipients on remote network nodes) will be copied.
+8 NEW XMTEXT
+9 WRITE !
+10 DO BLD^DIALOG(34604,"","","XMTEXT","F")
+11 DO MSG^DIALOG("WM","","","","XMTEXT")
+12 QUIT
COPYIT(XMDUZ,XMZO,XMSUBJO,XMFROM,XMDATEO,XMWHICH,XMLR,XMSAME) ;
+1 ; XMWHICH List of responses to copy
+2 ; XMLR 1=list original recipients in msg; 0=don't
+3 ; XMSAME 1=deliver to the original recipients; 0=don't
+4 NEW XMZ,XMSUBJ,XMABORT
+5 SET XMABORT=0
+6 DO INIT^XMXADDR
+7 ; Copy of:
SET XMSUBJ=$EXTRACT($$EZBLD^DIALOG(34605,XMSUBJO),1,65)
+8 DO SUBJ^XMJMS(.XMSUBJ,.XMABORT)
if XMABORT
QUIT
+9 DO CRE8XMZ^XMXSEND(XMSUBJ,.XMZ,1)
IF XMZ<1
SET XMABORT=1
QUIT
+10 if '$GET(XMPAKMAN)
DO EDITON^XMJMS(XMDUZ,XMZ)
+11 DO CPROCESS(XMDUZ,XMZO,XMSUBJO,XMFROM,XMDATEO,XMWHICH,XMLR,XMSAME,XMZ,XMSUBJ,.XMABORT)
+12 ; copying
if XMABORT=DTIME
DO HALT^XMJMS($$EZBLD^DIALOG(34606))
+13 if '$GET(XMPAKMAN)
DO EDITOFF^XMJMS(XMDUZ)
+14 if XMABORT
DO KILLMSG^XMXUTIL(XMZ)
+15 QUIT
CPROCESS(XMDUZ,XMZO,XMSUBJO,XMFROM,XMDATEO,XMWHICH,XMLR,XMSAME,XMZ,XMSUBJ,XMABORT) ;
+1 NEW XMINSTR,XMRESTR,XMC
+2 DO COPYTEXT(XMZO,XMSUBJO,XMFROM,XMDATEO,XMZ,XMWHICH,.XMC)
+3 if XMLR!XMSAME
DO COPYRECP(XMLR,XMSAME,XMZO,XMZ,.XMINSTR,.XMC)
+4 SET ^XMB(3.9,XMZ,2,0)="^3.92A^"_XMC_U_XMC_U_DT
+5 DO ET^XMJMSO
if XMABORT
QUIT
+6 ; Send to add'l recipients
DO TOWHOM^XMJMT(XMDUZ,$$EZBLD^DIALOG(34110),.XMINSTR,.XMRESTR,.XMABORT)
if XMABORT
QUIT
+7 IF $GET(XMPAKMAN)
SET XMINSTR("TYPE")=$SELECT($PIECE(^XMB(3.9,XMZO,0),U,7)["K":"K",1:"X")
+8 ; transmit prompt
DO SENDMSG^XMJMSO(XMDUZ,XMZ,XMSUBJ,.XMINSTR,.XMRESTR,.XMABORT)
if XMABORT
QUIT
+9 NEW XMIEN
+10 SET XMIEN=+$ORDER(^XMB(3.9,XMZO,1,"C",XMDUZ,0))
+11 IF XMIEN
SET ^XMB(3.9,XMZO,1,XMIEN,"C")=$$NOW^XLFDT
+12 QUIT
COPYTEXT(XMZO,XMSUBJO,XMFROM,XMDATEO,XMZ,XMWHICH,XMC) ;
+1 NEW I,XMRESP,XMRANGE
+2 ; Copying text
WRITE !,$$EZBLD^DIALOG(34607)
+3 DO COPYHEAD(XMZO,XMSUBJO,XMFROM,XMDATEO,XMZ,"C",.XMC)
+4 FOR I=1:1:$LENGTH(XMWHICH,",")
Begin DoDot:1
+5 SET XMRANGE=$PIECE(XMWHICH,",",I)
+6 ; (XMWHICH can end with a ",", giving us a null piece.)
if XMRANGE=""
QUIT
+7 FOR XMRESP=$PIECE(XMRANGE,"-",1):1:$SELECT(XMRANGE["-":$PIECE(XMRANGE,"-",2),1:XMRANGE)
Begin DoDot:2
+8 IF XMRESP=0
DO COPYRESP(XMRESP,XMZO,XMZ,.XMC)
QUIT
+9 DO COPYRESP(XMRESP,+$GET(^XMB(3.9,XMZO,3,XMRESP,0)),XMZ,.XMC)
End DoDot:2
End DoDot:1
+10 QUIT
COPYHEAD(XMZO,XMSUBJ,XMFROM,XMDATE,XMZ,XMTYPE,XMC) ;
+1 NEW XMPRE
+2 SET XMPRE=$SELECT(XMTYPE="C":"",1:">")
+3 ; Original message:
SET ^XMB(3.9,XMZ,2,1,0)=XMPRE_$$EZBLD^DIALOG(34205)_": """_XMSUBJ_""""_$SELECT(XMTYPE="C":" "_$$EZBLD^DIALOG(34537,XMZO),1:"")
+4 ; From
SET ^XMB(3.9,XMZ,2,2,0)=XMPRE_$$EZBLD^DIALOG(34538,$$NAME^XMXUTIL(XMFROM))
+5 ; Sent:
SET ^XMB(3.9,XMZ,2,3,0)=XMPRE_$$EZBLD^DIALOG(34585,$$MMDT^XMXUTIL1(XMDATE))
+6 SET XMC=3
+7 QUIT
COPYRESP(XMRESP,XMZR,XMZ,XMC) ;
+1 NEW XMF,XMFROM,XMDT,XMZREC
+2 SET XMC=XMC+1
+3 SET ^XMB(3.9,XMZ,2,XMC,0)=""
+4 IF XMRESP
Begin DoDot:1
+5 SET XMZREC=$GET(^XMB(3.9,XMZR,0))
+6 SET XMFROM=$$NAME^XMXUTIL($PIECE(XMZREC,U,2))
+7 SET XMDT=$PIECE(XMZREC,U,3)
+8 SET XMC=XMC+1
+9 ; Response #
SET ^XMB(3.9,XMZ,2,XMC,0)=$$EZBLD^DIALOG(34204,XMRESP)_": "_XMFROM_" "_$$MMDT^XMXUTIL1(XMDT)
End DoDot:1
+10 SET XMF=.999999
+11 FOR
SET XMF=$ORDER(^XMB(3.9,XMZR,2,XMF))
if XMF=""
QUIT
Begin DoDot:1
+12 SET XMC=XMC+1
+13 if XMC#50=0
WRITE "."
+14 SET ^XMB(3.9,XMZ,2,XMC,0)=^XMB(3.9,XMZR,2,XMF,0)
End DoDot:1
+15 QUIT
COPYRECP(XMLR,XMSAME,XMZO,XMZ,XMINSTR,XMC) ;
+1 NEW XMTO,XMNAME
+2 IF XMLR
Begin DoDot:1
+3 ; Copying recipients into text (and onto message)
WRITE !,$$EZBLD^DIALOG($SELECT(XMSAME:34610,1:34611))
+4 NEW XMTEXT,X
+5 ; Original Recipients
SET XMTEXT=$$EZBLD^DIALOG(34608)
+6 SET XMC=XMC+1
SET ^XMB(3.9,XMZ,2,XMC,0)=""
+7 SET XMC=XMC+1
SET ^XMB(3.9,XMZ,2,XMC,0)=XMTEXT
+8 ; "-------------------"
SET X=""
SET $PIECE(X,"-",$LENGTH(XMTEXT)+1)=""
+9 SET XMC=XMC+1
SET ^XMB(3.9,XMZ,2,XMC,0)=X
End DoDot:1
+10 ; Copying recipients onto message
IF '$TEST
WRITE !,$$EZBLD^DIALOG(34612)
+11 SET XMTO=""
+12 FOR
SET XMTO=$ORDER(^XMB(3.9,XMZO,1,"C",XMTO))
if XMTO=""
QUIT
Begin DoDot:1
+13 IF XMSAME
IF XMTO=+XMTO
WRITE !
DO ADDR^XMXADDR(XMDUZ,"`"_XMTO,.XMINSTR)
+14 if 'XMLR
QUIT
+15 IF +XMTO=XMTO
SET XMNAME=$$NAME^XMXUTIL(XMTO)
+16 IF '$TEST
IF $LENGTH(XMTO)<30
SET XMNAME=XMTO
+17 IF '$TEST
SET XMNAME=$PIECE($GET(^XMB(3.9,XMZO,1,$ORDER(^XMB(3.9,XMZO,1,"C",XMTO,0)),0)),U,1)
+18 SET XMC=XMC+1
SET ^XMB(3.9,XMZ,2,XMC,0)=XMNAME
End DoDot:1
+19 QUIT
