source: WorldVistAEHR/trunk/r/MAILMAN-XM/XMJMOR.m@ 1800

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

initial load of WorldVistAEHR
File size: 8.8 KB
Line 
1XMJMOR ;ISC-SF/GMB-Range actions ;12/04/2002 10:10
2 ;;8.0;MailMan;**9**;Jun 28, 2002
3 ; Replaces ^XMA0,^XMA01 (ISC-WASH/CAP)
4DELETE(XMDUZ,XMK) ; Delete a range of messages
5 N XMWHICH,XMMSG,XMABORT
6 S XMABORT=0
7 I $D(^TMP("XM",$J,".")) D
8 . D SELMSG^XMJMORX1(XMDUZ,0,0,XMK,"XDEL",34302,34303,.XMMSG,.XMABORT)
9 . ;K ^TMP("XM",$J,".")
10 E D
11 . D WHICH(XMDUZ,XMK,34301,34303.1,.XMWHICH,.XMABORT) Q:XMABORT
12 . D DELMSG^XMXMSGS(XMDUZ,XMK,XMWHICH,.XMMSG)
13 . D:$D(XMERR) ZSHOW^XMJERR
14 Q:XMABORT
15 W:$D(XMMSG) !,XMMSG
16 Q
17FILTER(XMDUZ,XMK) ; Filter a range of messages
18 N XMWHICH,XMMSG,XMABORT
19 S XMABORT=0
20 I $D(^TMP("XM",$J,".")) D
21 . N XMKZ
22 . D SELMSG(XMDUZ,XMK,"XFLTR^XMXMSGS2",34306,.XMMSG)
23 . S XMKZ=""
24 . F S XMKZ=$O(^TMP("XM",$J,".",XMKZ)) Q:'XMKZ K:'$D(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ)) ^TMP("XM",$J,".",XMKZ)
25 E D
26 . D WHICH(XMDUZ,XMK,34305,0,.XMWHICH,.XMABORT) Q:XMABORT
27 . D FLTRMSG^XMXMSGS(XMDUZ,XMK,XMWHICH,.XMMSG)
28 . D:$D(XMERR) ZSHOW^XMJERR
29 Q:XMABORT
30 W:$D(XMMSG) !,XMMSG
31 Q
32FORWARD(XMDUZ,XMK) ; Forward a range of messages
33 N XMWHICH,XMMSG,XMABORT,XMINSTR
34 S XMABORT=0
35 I $D(^TMP("XM",$J,".")) D Q
36 . N XMKZ
37 . D INIT^XMXADDR
38 . S XMKZ=$O(^TMP("XM",$J,".",""))
39 . I '$O(^TMP("XM",$J,".",XMKZ)) D Q
40 . . D FWDONE(XMDUZ,$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ,"")),.XMINSTR,.XMABORT)
41 . D TOWHOM^XMJMT(XMDUZ,$$EZBLD^DIALOG(34111),.XMINSTR,"",.XMABORT) Q:XMABORT ; Forward
42 . D SELMSG(XMDUZ,XMK,"XFWD^XMXMSGS1",34309,.XMMSG)
43 . D CLEANUP^XMXADDR
44 . D:$D(XMERR) ZSHOW^XMJERR
45 . W:$D(XMMSG) !,XMMSG
46 D WHICH(XMDUZ,XMK,34308,0,.XMWHICH,.XMABORT) Q:XMABORT
47 D INIT^XMXADDR
48 I $P(XMWHICH,",",2,99)="",$P(XMWHICH,",",1)=+XMWHICH D Q
49 . N XMZ
50 . S XMZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",+XMWHICH,""))
51 . I 'XMZ W !,$$EZBLD^DIALOG(34309.3) Q ; No messages forwarded.
52 . D FWDONE(XMDUZ,XMZ,.XMINSTR,.XMABORT)
53 D TOWHOM^XMJMT(XMDUZ,$$EZBLD^DIALOG(34111),.XMINSTR,"",.XMABORT) Q:XMABORT ; Forward
54 S XMINSTR("ADDR FLAGS")="I"
55 D FWDMSG^XMXMSGS(XMDUZ,XMK,XMWHICH,"",.XMINSTR,.XMMSG)
56 D:$D(XMERR) ZSHOW^XMJERR
57 W:$D(XMMSG) !,XMMSG
58 Q
59FWDONE(XMDUZ,XMZ,XMINSTR,XMABORT) ; Forward just one message
60 N XMZREC,XMRESTR
61 S XMZREC=^XMB(3.9,XMZ,0)
62 I '$$FORWARD^XMXSEC(XMDUZ,XMZ,XMZREC) D SHOW^XMJERR Q
63 D GETRESTR^XMXSEC1(XMDUZ,XMZ,XMZREC,"",.XMRESTR) ; Get restrictions on the msg
64 D TOWHOM^XMJMT(XMDUZ,$$EZBLD^DIALOG(34111),.XMINSTR,.XMRESTR,.XMABORT) Q:XMABORT ; Forward
65 D FWD^XMKP(XMDUZ,XMZ,.XMINSTR)
66 D CLEANUP^XMXADDR
67 W !,$$EZBLD^DIALOG(34309.2) ; Message forwarded.
68 Q
69LATER(XMDUZ,XMK) ; Later a range of messages
70 N XMWHICH,XMMSG,XMABORT,XMWHEN
71 S XMABORT=0
72 I $D(^TMP("XM",$J,".")) D
73 . D LTRDATE^XMJMD(.XMWHEN,.XMABORT) Q:XMABORT
74 . D SELMSG(XMDUZ,XMK,"XLATER^XMXMSGS2",34312,.XMMSG)
75 E D
76 . D WHICH(XMDUZ,XMK,34311,0,.XMWHICH,.XMABORT) Q:XMABORT
77 . D LTRDATE^XMJMD(.XMWHEN,.XMABORT) Q:XMABORT
78 . D LATERMSG^XMXMSGS(XMDUZ,XMK,XMWHICH,XMWHEN,.XMMSG)
79 . D:$D(XMERR) ZSHOW^XMJERR
80 Q:XMABORT
81 W:$D(XMMSG) !,XMMSG
82 Q
83NEWTOGL(XMDUZ,XMK) ; New Toggle a range of messages
84 N XMWHICH,XMMSG,XMABORT
85 S XMABORT=0
86 I $D(^TMP("XM",$J,".")) D
87 . N XMKZ
88 . D SELMSG(XMDUZ,XMK,"XNTOGL^XMXMSGS2",34315,.XMMSG)
89 . S XMKZ=""
90 . F S XMKZ=$O(^TMP("XM",$J,".",XMKZ)) Q:'XMKZ K:'$D(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ)) ^TMP("XM",$J,".",XMKZ)
91 E D
92 . D WHICH(XMDUZ,XMK,34314,0,.XMWHICH,.XMABORT) Q:XMABORT
93 . D NTOGLMSG^XMXMSGS(XMDUZ,XMK,XMWHICH,.XMMSG)
94 . D:$D(XMERR) ZSHOW^XMJERR
95 Q:XMABORT
96 W:$D(XMMSG) !,XMMSG
97 Q
98PRINT(XMDUZ,XMK,XMPRTHDR) ; Print a range of messages
99 N XMWHICH,XMMSG,XMRECIPS,XMABORT
100 ; XMPRTHDR 1=Print header
101 ; 0=don't (headerless print)
102 ; XMRECIPS 0=Don't print recipients
103 ; 1=Print summary recipients
104 ; 2=Print detail recipients
105 N XMSAVE,XMMSG,XMZLIST,I
106 S XMABORT=0
107 S:$G(XMPRTHDR)="" XMPRTHDR=1 ; default is to print with headers
108 I $D(^TMP("XM",$J,".")) D
109 . D LISTSEL(XMDUZ,XMK,.XMZLIST)
110 E D Q:XMABORT
111 . N XMWHICH
112 . D WHICH(XMDUZ,XMK,$S(XMPRTHDR:34317,1:34317.1),0,.XMWHICH,.XMABORT) Q:XMABORT
113 . D LIST(XMDUZ,XMK,.XMWHICH,.XMZLIST)
114 I '$D(XMZLIST) W !!,$$EZBLD^DIALOG(34319) Q ; No valid messages selected.
115 I +XMZLIST(1)=XMZLIST(1) D PRTONE(XMDUZ,XMK,XMZLIST(1),XMPRTHDR,.XMABORT) Q
116 D QRECIP^XMJMP(.XMRECIPS,.XMABORT) Q:XMABORT
117 F I="DUZ","XMDUZ","XMV(","XMZLIST(","XMRECIPS","XMPRTHDR" S XMSAVE(I)=""
118 D EN^XUTMDEVQ("PLISTX^XMJMP",$$EZBLD^DIALOG(34501),.XMSAVE) ; MailMan: Print
119 Q:XMABORT!$G(POP)
120 W:$D(XMMSG) !!,XMMSG
121 Q
122LISTSEL(XMDUZ,XMK,XMZLIST) ;
123 N XMKZ,J,XMZ
124 S (XMKZ,J)=0
125 F S XMKZ=$O(^TMP("XM",$J,".",XMKZ)) Q:'XMKZ D
126 . S XMZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ,"")) Q:'XMZ
127 . I J=0 S J=1,XMZLIST(1)=XMZ Q
128 . I $L(XMZLIST(J))+$L(XMZ)>240 S J=J+1,XMZLIST(J)=XMZ Q
129 . S XMZLIST(J)=XMZLIST(J)_","_XMZ
130 Q
131LIST(XMDUZ,XMK,XMWHICH,XMZLIST) ;
132 N I,J,XMRANGE,XMKZ,XMZ,XMLAST
133 S J=0
134 F I=1:1:$L(XMWHICH,",") D
135 . S XMRANGE=$P(XMWHICH,",",I)
136 . Q:'XMRANGE
137 . S XMKZ=$P(XMRANGE,"-",1)-.1
138 . S XMLAST=$S(XMRANGE["-":$P(XMRANGE,"-",2),1:XMRANGE)
139 . F S XMKZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ)) Q:'XMKZ!(XMKZ>XMLAST) D
140 . . S XMZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ,"")) Q:'XMZ
141 . . I J=0 S J=1,XMZLIST(1)=XMZ Q
142 . . I $L(XMZLIST(J))+$L(XMZ)>240 S J=J+1,XMZLIST(J)=XMZ Q
143 . . S XMZLIST(J)=XMZLIST(J)_","_XMZ
144 Q
145PRTONE(XMDUZ,XMK,XMZ,XMPRTHDR,XMABORT) ;
146 D PONE^XMJMP(XMDUZ,XMK,XMZ,XMPRTHDR,.XMABORT)
147 W !!,$$EZBLD^DIALOG($S(XMABORT:34318.4,1:34318.1)) ; Message (not) printed.
148 Q
149SAVE(XMDUZ,XMK) ; Save a range of messages to another basket
150 N XMWHICH,XMMSG,XMABORT,XMKTO,XMDIC
151 S XMABORT=0
152 S XMDIC("B")="@" ; no default basket
153 I $D(^TMP("XM",$J,".")) D
154 . D SELBSKT^XMJBU(XMDUZ,$$EZBLD^DIALOG(34325),"L",.XMDIC,.XMKTO) ; Save messages to which basket?
155 . I XMKTO=U S XMMSG=$$EZBLD^DIALOG(34324.3) Q ; No messages saved.
156 . I XMKTO=XMK S XMMSG=$$EZBLD^DIALOG(34326) Q ; Same basket. No messages saved.
157 . D SELMSG(XMDUZ,XMK,"XMOVE^XMXMSGS2",34324,.XMMSG)
158 . K ^TMP("XM",$J,".")
159 E D
160 . D WHICH(XMDUZ,XMK,34323,0,.XMWHICH,.XMABORT) Q:XMABORT
161 . D SELBSKT^XMJBU(XMDUZ,$$EZBLD^DIALOG(34325),"L",.XMDIC,.XMKTO) ; Save messages to which basket?
162 . I XMKTO=U S XMMSG=$$EZBLD^DIALOG(34324.3) Q ; No messages saved.
163 . I XMKTO=XMK S XMMSG=$$EZBLD^DIALOG(34326) Q ; Same basket. No messages saved.
164 . D MOVEMSG^XMXMSGS(XMDUZ,XMK,XMWHICH,XMKTO,.XMMSG)
165 . D:$D(XMERR) ZSHOW^XMJERR
166 Q:XMABORT
167 W:$D(XMMSG) !,XMMSG
168 Q
169TERM(XMDUZ,XMK) ; Terminate a range of messages
170 N XMWHICH,XMMSG,XMABORT
171 S XMABORT=0
172 I $D(^TMP("XM",$J,".")) D
173 . D SELMSG^XMJMORX1(XMDUZ,0,0,XMK,"XTERM",34329,34330,.XMMSG,.XMABORT)
174 . ;K ^TMP("XM",$J,".")
175 E D
176 . D WHICH(XMDUZ,XMK,34328,34330.1,.XMWHICH,.XMABORT) Q:XMABORT
177 . D TERMMSG^XMXMSGS(XMDUZ,XMK,XMWHICH,.XMMSG)
178 . D:$D(XMERR) ZSHOW^XMJERR
179 Q:XMABORT
180 Q:'$D(XMMSG)
181 W !,XMMSG
182 I XMMSG W !,$$EZBLD^DIALOG($S(XMK<1:34331.1,1:34331)) ; You won't see future responses. (In WASTE basket)
183 Q
184VAPOR(XMDUZ,XMK) ; Set Vaporize date for a range of messages
185 N XMWHICH,XMMSG,XMABORT,XMWHEN
186 S XMABORT=0
187 I $D(^TMP("XM",$J,".")) D
188 . D VAPRDATE(.XMWHEN,.XMABORT) Q:XMABORT
189 . D SELMSG^XMJMORX1(XMDUZ,0,0,XMK,"XVAPOR^XMXMSGS2",$S(XMWHEN="@":34337.2,1:34337),$S(XMWHEN="@":34338.2,1:34338),.XMMSG,.XMABORT)
190 E D
191 . D VAPRDATE(.XMWHEN,.XMABORT) Q:XMABORT
192 . D WHICH(XMDUZ,XMK,$S(XMWHEN="@":34336.1,1:34336),$S(XMWHEN="@":34338.3,1:34338.1),.XMWHICH,.XMABORT) Q:XMABORT
193 . D VAPORMSG^XMXMSGS(XMDUZ,XMK,XMWHICH,XMWHEN,.XMMSG)
194 . D:$D(XMERR) ZSHOW^XMJERR
195 Q:XMABORT
196 W:$D(XMMSG) !,XMMSG
197 Q
198VAPRDATE(XMWHEN,XMABORT) ;
199 N DIR,X,Y
200 S DIR(0)="DO^NOW::EFT"
201 D BLD^DIALOG(37317.1,"","","DIR(""A"")")
202 D BLD^DIALOG(34339,"","","DIR(""?"")")
203 D ^DIR
204 I X="@" S XMWHEN="@" Q
205 I $D(DIRUT) S XMABORT=1 Q
206 S XMWHEN=Y
207 Q
208XMTPRI(XMDUZ,XMK) ; Toggle transmission priority for a range of msgs
209 ; XMDUZ better be .5 and XMK better be > 999!
210 N XMTPRI,XMWHICH,XMMSG,XMABORT
211 S XMABORT=0
212 I $D(^TMP("XM",$J,".")) D
213 . D ASKPRI^XMJMORX(.XMTPRI,.XMABORT) Q:XMABORT
214 . D SELMSG^XMJMORX1(XMDUZ,0,0,XMK,"XXP^XMXMSGS1",34334,34335,.XMMSG,.XMABORT)
215 E D
216 . D WHICH(XMDUZ,XMK,34333,34335.1,.XMWHICH,.XMABORT) Q:XMABORT
217 . D ASKPRI^XMJMORX(.XMTPRI,.XMABORT) Q:XMABORT
218 . D XPMSG^XMXMSGS(XMDUZ,XMK,XMWHICH,XMTPRI,.XMMSG)
219 . D:$D(XMERR) ZSHOW^XMJERR
220 Q:XMABORT
221 W:$D(XMMSG) !,XMMSG
222 Q
223WHICH(XMDUZ,XMK,XMPROMPT,XMCONFRM,XMWHICH,XMABORT) ;
224 N DIR,X,Y,XMHI,XMLO
225 S XMLO=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",""))
226 S XMHI=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",""),-1)
227 S DIR("A")=$$EZBLD^DIALOG(XMPROMPT) ; ... which messages?
228 S DIR("??")="XM-U-M-CHOOSE RANGE"
229 S DIR(0)="LC^"_XMLO_":"_XMHI
230 D ^DIR I $D(DIRUT) S XMABORT=1 Q
231 S XMWHICH=Y
232 I XMCONFRM D CONFIRM(XMCONFRM,.XMABORT)
233 Q
234CONFIRM(XMCONFRM,XMABORT) ;
235 N DIR
236 D BLD^DIALOG(XMCONFRM,"","","DIR(""A"")") ; Do you really want to ... these messages?
237 S DIR("B")=$$EZBLD^DIALOG(39053) ; No
238 S DIR(0)="Y"
239 D ^DIR I $D(DIRUT)!'Y S XMABORT=1
240 Q
241POSTPRIV() ;
242 Q:$$POSTPRIV^XMXSEC 1
243 D SHOW^XMJERR
244 Q 0
245SELMSG(XMDUZ,XMK,XMRTN,XMSUM,XMMSG) ;
246 N XMCNT,XMKZ,XMZ,XMKALL
247 S (XMCNT,XMKZ)=0
248 F S XMKZ=$O(^TMP("XM",$J,".",XMKZ)) Q:'XMKZ D
249 . S XMZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ,"")) Q:'XMZ
250 . D @XMRTN
251 S XMMSG=$$EZBLD^DIALOG($S(XMCNT=1:XMSUM+.1,1:XMSUM),XMCNT)
252 D INCRDECR^XMXMSGS(XMDUZ,.XMCNT)
253 Q
Note: See TracBrowser for help on using the repository browser.