source: FOIAVistA/trunk/r/MAILMAN-XM/XMJMC.m@ 1384

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