source: WorldVistAEHR/trunk/r/MAILMAN-XM/XMJMC.m@ 1261

Last change on this file since 1261 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 5.3 KB
RevLine 
[613]1XMJMC ;ISC-SF/GMB-Copy message ;02/23/2000 15:34
2 ;;8.0;MailMan;;Jun 28, 2002
3 ; Replaces ^XMA2C,^XMA2C0 (ISC-WASH/CAP)
4COPY(XMDUZ,XMK,XMZ,XMFROM) ;
5 N XMABORT,XMWHICH,XMLR,XMSAME,XMZREC
6 D INIT(XMDUZ,XMK,XMZ,XMFROM,.XMZREC,.XMWHICH,.XMLR,.XMSAME,.XMABORT) Q:XMABORT
7 D COPYIT(XMDUZ,XMZ,$P(XMZREC,U,1),XMFROM,$P(XMZREC,U,3),XMWHICH,XMLR,XMSAME)
8 Q
9INIT(XMDUZ,XMK,XMZ,XMFROM,XMZREC,XMWHICH,XMLR,XMSAME,XMABORT) ;
10 S XMZREC=^XMB(3.9,XMZ,0)
11 S XMABORT=0
12 D INIT^XMJMS(XMDUZ,.XMABORT) Q:XMABORT
13 S XMWHICH=0
14 D WHICH(XMZ,$$EZBLD^DIALOG(34600),.XMWHICH,.XMABORT) Q:XMABORT ; copy
15 I '$$COPYRECP^XMXSEC1(XMZ) D Q
16 . S (XMLR,XMSAME)=0
17 . D SHOW^XMJERR
18 D LISTR(.XMLR,.XMABORT) Q:XMABORT
19 D TOSAME(.XMSAME,.XMABORT)
20 Q
21WHICH(XMZ,XMVERB,XMWHICH,XMABORT) ;
22 N XMRESPS
23 S XMRESPS=+$P($G(^XMB(3.9,XMZ,3,0)),U,4)
24 I XMRESPS=0 S XMWHICH=0
25 E D WHICH^XMJMP(XMZ,XMRESPS,XMVERB,.XMWHICH,.XMABORT) Q:XMABORT!'$D(XMWHICH)
26 Q:$$COPYAMT^XMXSEC1(XMZ,XMWHICH)
27 S XMABORT=1
28 D SHOW^XMJERR
29 ;You may use the 'Transfer' option of the FileMan Editor
30 ;to move text from this message or its responses into a new message.
31 N XMTEXT
32 D BLD^DIALOG(34601,"","","XMTEXT","F")
33 D MSG^DIALOG("WH","","","","XMTEXT")
34 Q
35LISTR(XMLR,XMABORT) ;
36 N DIR,Y
37 S DIR("A")=$$EZBLD^DIALOG(34602) ; List original recipients in text
38 S DIR("B")=$$EZBLD^DIALOG(39053),DIR(0)="Y",DIR("??")="XM-U-M-COPY-2" ; No
39 D ^DIR I $D(DIRUT) S XMABORT=1 Q
40 S XMLR=Y
41 Q
42TOSAME(XMSAME,XMABORT) ;
43 N DIR,Y
44 S DIR("A")=$$EZBLD^DIALOG(34603) ; Deliver to the same recipients
45 S DIR("B")=$$EZBLD^DIALOG(39053),DIR(0)="Y",DIR("??")="XM-U-M-COPY-2" ; No
46 D ^DIR I $D(DIRUT) S XMABORT=1 Q
47 S XMSAME=Y
48 Q:'XMSAME
49 ;LOCAL recipients (NOT Recipients on remote network nodes) will be copied.
50 N XMTEXT
51 W !
52 D BLD^DIALOG(34604,"","","XMTEXT","F")
53 D MSG^DIALOG("WM","","","","XMTEXT")
54 Q
55COPYIT(XMDUZ,XMZO,XMSUBJO,XMFROM,XMDATEO,XMWHICH,XMLR,XMSAME) ;
56 ; XMWHICH List of responses to copy
57 ; XMLR 1=list original recipients in msg; 0=don't
58 ; XMSAME 1=deliver to the original recipients; 0=don't
59 N XMZ,XMSUBJ,XMABORT
60 S XMABORT=0
61 D INIT^XMXADDR
62 S XMSUBJ=$E($$EZBLD^DIALOG(34605,XMSUBJO),1,65) ; Copy of:
63 D SUBJ^XMJMS(.XMSUBJ,.XMABORT) Q:XMABORT
64 D CRE8XMZ^XMXSEND(XMSUBJ,.XMZ,1) I XMZ<1 S XMABORT=1 Q
65 D:'$G(XMPAKMAN) EDITON^XMJMS(XMDUZ,XMZ)
66 D CPROCESS(XMDUZ,XMZO,XMSUBJO,XMFROM,XMDATEO,XMWHICH,XMLR,XMSAME,XMZ,XMSUBJ,.XMABORT)
67 D:XMABORT=DTIME HALT^XMJMS($$EZBLD^DIALOG(34606)) ; copying
68 D:'$G(XMPAKMAN) EDITOFF^XMJMS(XMDUZ)
69 D:XMABORT KILLMSG^XMXUTIL(XMZ)
70 Q
71CPROCESS(XMDUZ,XMZO,XMSUBJO,XMFROM,XMDATEO,XMWHICH,XMLR,XMSAME,XMZ,XMSUBJ,XMABORT) ;
72 N XMINSTR,XMRESTR,XMC
73 D COPYTEXT(XMZO,XMSUBJO,XMFROM,XMDATEO,XMZ,XMWHICH,.XMC)
74 D:XMLR!XMSAME COPYRECP(XMLR,XMSAME,XMZO,XMZ,.XMINSTR,.XMC)
75 S ^XMB(3.9,XMZ,2,0)="^3.92A^"_XMC_U_XMC_U_DT
76 D ET^XMJMSO Q:XMABORT
77 D TOWHOM^XMJMT(XMDUZ,$$EZBLD^DIALOG(34110),.XMINSTR,.XMRESTR,.XMABORT) Q:XMABORT ; Send to add'l recipients
78 I $G(XMPAKMAN) S XMINSTR("TYPE")=$S($P(^XMB(3.9,XMZO,0),U,7)["K":"K",1:"X")
79 D SENDMSG^XMJMSO(XMDUZ,XMZ,XMSUBJ,.XMINSTR,.XMRESTR,.XMABORT) Q:XMABORT ; transmit prompt
80 N XMIEN
81 S XMIEN=+$O(^XMB(3.9,XMZO,1,"C",XMDUZ,0))
82 I XMIEN S ^XMB(3.9,XMZO,1,XMIEN,"C")=$$NOW^XLFDT
83 Q
84COPYTEXT(XMZO,XMSUBJO,XMFROM,XMDATEO,XMZ,XMWHICH,XMC) ;
85 N I,XMRESP,XMRANGE
86 W !,$$EZBLD^DIALOG(34607) ; Copying text
87 D COPYHEAD(XMZO,XMSUBJO,XMFROM,XMDATEO,XMZ,"C",.XMC)
88 F I=1:1:$L(XMWHICH,",") D
89 . S XMRANGE=$P(XMWHICH,",",I)
90 . Q:XMRANGE="" ; (XMWHICH can end with a ",", giving us a null piece.)
91 . F XMRESP=$P(XMRANGE,"-",1):1:$S(XMRANGE["-":$P(XMRANGE,"-",2),1:XMRANGE) D
92 . . I XMRESP=0 D COPYRESP(XMRESP,XMZO,XMZ,.XMC) Q
93 . . D COPYRESP(XMRESP,+$G(^XMB(3.9,XMZO,3,XMRESP,0)),XMZ,.XMC)
94 Q
95COPYHEAD(XMZO,XMSUBJ,XMFROM,XMDATE,XMZ,XMTYPE,XMC) ;
96 N XMPRE
97 S XMPRE=$S(XMTYPE="C":"",1:">")
98 S ^XMB(3.9,XMZ,2,1,0)=XMPRE_$$EZBLD^DIALOG(34205)_": """_XMSUBJ_""""_$S(XMTYPE="C":" "_$$EZBLD^DIALOG(34537,XMZO),1:"") ; Original message:
99 S ^XMB(3.9,XMZ,2,2,0)=XMPRE_$$EZBLD^DIALOG(34538,$$NAME^XMXUTIL(XMFROM)) ; From
100 S ^XMB(3.9,XMZ,2,3,0)=XMPRE_$$EZBLD^DIALOG(34585,$$MMDT^XMXUTIL1(XMDATE)) ; Sent:
101 S XMC=3
102 Q
103COPYRESP(XMRESP,XMZR,XMZ,XMC) ;
104 N XMF,XMFROM,XMDT,XMZREC
105 S XMC=XMC+1
106 S ^XMB(3.9,XMZ,2,XMC,0)=""
107 I XMRESP D
108 . S XMZREC=$G(^XMB(3.9,XMZR,0))
109 . S XMFROM=$$NAME^XMXUTIL($P(XMZREC,U,2))
110 . S XMDT=$P(XMZREC,U,3)
111 . S XMC=XMC+1
112 . S ^XMB(3.9,XMZ,2,XMC,0)=$$EZBLD^DIALOG(34204,XMRESP)_": "_XMFROM_" "_$$MMDT^XMXUTIL1(XMDT) ; Response #
113 S XMF=.999999
114 F S XMF=$O(^XMB(3.9,XMZR,2,XMF)) Q:XMF="" D
115 . S XMC=XMC+1
116 . W:XMC#50=0 "."
117 . S ^XMB(3.9,XMZ,2,XMC,0)=^XMB(3.9,XMZR,2,XMF,0)
118 Q
119COPYRECP(XMLR,XMSAME,XMZO,XMZ,XMINSTR,XMC) ;
120 N XMTO,XMNAME
121 I XMLR D
122 . W !,$$EZBLD^DIALOG($S(XMSAME:34610,1:34611)) ; Copying recipients into text (and onto message)
123 . N XMTEXT,X
124 . S XMTEXT=$$EZBLD^DIALOG(34608) ; Original Recipients
125 . S XMC=XMC+1,^XMB(3.9,XMZ,2,XMC,0)=""
126 . S XMC=XMC+1,^XMB(3.9,XMZ,2,XMC,0)=XMTEXT
127 . S X="",$P(X,"-",$L(XMTEXT)+1)="" ; "-------------------"
128 . S XMC=XMC+1,^XMB(3.9,XMZ,2,XMC,0)=X
129 E W !,$$EZBLD^DIALOG(34612) ; Copying recipients onto message
130 S XMTO=""
131 F S XMTO=$O(^XMB(3.9,XMZO,1,"C",XMTO)) Q:XMTO="" D
132 . I XMSAME,XMTO=+XMTO W ! D ADDR^XMXADDR(XMDUZ,"`"_XMTO,.XMINSTR)
133 . Q:'XMLR
134 . I +XMTO=XMTO S XMNAME=$$NAME^XMXUTIL(XMTO)
135 . E I $L(XMTO)<30 S XMNAME=XMTO
136 . E S XMNAME=$P($G(^XMB(3.9,XMZO,1,$O(^XMB(3.9,XMZO,1,"C",XMTO,0)),0)),U,1)
137 . S XMC=XMC+1,^XMB(3.9,XMZ,2,XMC,0)=XMNAME
138 Q
Note: See TracBrowser for help on using the repository browser.