Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XMJMC

XMJMC.m

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