source: FOIAVistA/trunk/r/MAILMAN-XM/XMJMLR.m@ 1705

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

initial load of FOIAVistA 6/30/08 version
File size: 9.0 KB
Line 
1XMJMLR ;ISC-SF/GMB-List/Read messages in basket ;05/21/2002 06:46
2 ;;8.0;MailMan;;Jun 28, 2002
3 ; Replaces 1^XMAL0 (ISC-WASH/THM/CAP)
4LIST(XMDUZ,XMK,XMKN,XMDETAIL,XMABORT) ; List messages in basket
5 ; XMDETAIL 0=Summary; 1=Detailed
6 N XMKZ,XMLEN,XMFIRST,XMPAGE,XMPMAX,XMZOOM,XMINSTR,XMOPT,XMOX,XMORDER
7 I XMDUZ=.5,XMK>999 S XMORDER=XMV("ORDER"),XMV("ORDER")=1
8 S XMINSTR("GOTO")=1 ; may go to another page
9 D SETOPT^XMJMLR1(XMDUZ,XMK,.XMOPT,.XMOX)
10 K ^TMP("XM",$J,".")
11 S XMKZ="",(XMPAGE,XMZOOM)=0,XMPMAX=IOSL-3
12 D INIT^XMJML(XMDUZ,XMK,XMKN,XMDETAIL,.XMLEN,1)
13 F D Q:XMABORT!'$D(^XMB(3.7,XMDUZ,2,XMK,1,"C"))
14 . D DISPLAY(XMDUZ,XMDETAIL,XMK,XMKN,.XMKZ,.XMFIRST,.XMPAGE,.XMLEN,XMZOOM,XMPMAX)
15 . D CHOOSE(XMDUZ,.XMK,.XMKZ,.XMFIRST,.XMPAGE,.XMLEN,.XMZOOM,.XMINSTR,.XMOPT,.XMOX,.XMABORT)
16 K ^TMP("XM",$J,".")
17 I $D(XMORDER) S XMV("ORDER")=XMORDER
18 Q
19DISPLAY(XMDUZ,XMDETAIL,XMK,XMKN,XMKZ,XMFIRST,XMPAGE,XMLEN,XMZOOM,XMPMAX) ;
20 N XMZ
21 S XMFIRST(XMPAGE)=XMKZ
22 D HEADER^XMJML(XMDETAIL,.XMLEN,$$HEADLINE^XMJML(XMDUZ,XMK,XMKN))
23 I XMZOOM D Q
24 . F S XMKZ=$O(^TMP("XM",$J,".",XMKZ),XMV("ORDER")) Q:XMKZ="" D Q:$Y>XMPMAX
25 . . D LISTMSG^XMJML(XMK,XMKN,XMKZ,$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ,"")),XMDETAIL,.XMLEN)
26 F S XMKZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ),XMV("ORDER")) Q:XMKZ="" D Q:$Y>XMPMAX
27 . S XMZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ,""))
28 . I '$D(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0)) D ADDITC^XMUT4A(XMDUZ,XMK,XMZ,XMKZ)
29 . I '$D(^XMB(3.9,XMZ,0)) D ZAPIT^XMXMSGS2(XMDUZ,XMK,XMZ) Q
30 . D LISTMSG^XMJML(XMK,XMKN,XMKZ,XMZ,XMDETAIL,.XMLEN)
31 Q
32CHOOSE(XMDUZ,XMK,XMKZ,XMFIRST,XMPAGE,XMLEN,XMZOOM,XMINSTR,XMOPT,XMOX,XMABORT) ;
33 N XMY,XMZ,XMMORE,XMHI,XMLO
34 S XMMORE=$S(XMKZ="":0,'$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ),XMV("ORDER")):0,1:1)
35 S XMLO=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",""))
36 S XMHI=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",""),-1)
37 D XMDIR^XMJMLR1(XMDUZ,XMLO,XMHI,XMPAGE,XMMORE,"XM-U-BO-FULL SCREEN",.XMINSTR,.XMOPT,.XMOX,.XMY,.XMABORT) Q:XMABORT
38 I '$D(XMY) S XMKZ=XMFIRST(XMPAGE) Q
39 I XMY=""!($E(XMY)="+") D Q ; Page forward
40 . I XMMORE D PFWD Q
41 . I XMPAGE=0 S XMABORT=1 Q
42 . D AGAIN(.XMABORT) Q:XMABORT
43 . S XMPAGE=0
44 . S XMKZ=XMFIRST(XMPAGE)
45 I $E(XMY)="." D Q ; (De)Select messages
46 . D DODOT
47 . I XMZOOM,'$D(^TMP("XM",$J,".")) D Z
48 . S XMKZ=XMFIRST(XMPAGE)
49 I XMY>0 D Q ;
50 . N XMKZLAST
51 . S XMKZLAST=XMKZ
52 . S XMKZ=XMY
53 . S XMZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ,""))
54 . I XMZ D
55 . . I '$D(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0)) D ADDITC^XMUT4A(XMDUZ,XMK,XMZ,XMKZ)
56 . . D READMSG(XMDUZ,XMK,XMKN,XMKZ,XMZ,XMZOOM)
57 . . D FINDXMKZ(XMDUZ,XMK,.XMFIRST,.XMPAGE,XMKZLAST,XMKZ)
58 . E D
59 . . S XMZ=XMY
60 . . I $D(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0)) D Q
61 . . . S XMKZ=$P(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0),U,2)
62 . . . I 'XMKZ D ADDITM^XMUT4A(XMDUZ,XMK,XMZ,.XMKZ)
63 . . . D READMSG(XMDUZ,XMK,XMKN,XMKZ,XMZ,XMZOOM)
64 . . . D FINDXMKZ(XMDUZ,XMK,.XMFIRST,.XMPAGE,XMKZLAST,XMKZ)
65 . . I '$D(^XMB(3.9,XMZ,0)) D Q
66 . . . W $C(7)
67 . . . Q:XMZ>$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",""),-1)
68 . . . S XMKZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMZ),XMV("ORDER"))
69 . . . I 'XMKZ S XMKZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMZ),-XMV("ORDER"))
70 . . . D FINDXMKZ(XMDUZ,XMK,.XMFIRST,.XMPAGE,XMKZLAST,XMKZ)
71 . . N XMK,XMKN,XMOK
72 . . S XMK=+$O(^XMB(3.7,"M",XMZ,XMDUZ,0))
73 . . I 'XMK D Q:'XMOK
74 . . . N XMZREC
75 . . . S XMZREC=^XMB(3.9,XMZ,0)
76 . . . I $D(XMERR) K XMERR,^TMP("XMERR",$J)
77 . . . S XMOK=$$ACCESS^XMXSEC(XMDUZ,XMZ,XMZREC) Q:XMOK
78 . . . D FWD^XMJMLR1(XMDUZ,XMZ,XMZREC,1,.XMOK)
79 . . S XMKN=$S(XMK:$P(^XMB(3.7,XMDUZ,2,XMK,0),U,1),1:$$EZBLD^DIALOG(34014)) ; * N/A *
80 . . I XMK,'$D(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0)) D ADDITM^XMUT4A(XMDUZ,XMK,XMZ)
81 . . D READMSG^XMJBM(XMDUZ,XMK,XMKN,XMZ)
82 . S XMKZ=XMFIRST(XMPAGE)
83 I XMY=0 D Q ; First page
84 . S XMPAGE=0
85 . S XMKZ=XMFIRST(XMPAGE)
86 I $E(XMY)="-" D Q ; Page back
87 . N XMCNT
88 . S XMCNT=$E(XMY,2,99)
89 . S:XMCNT="" XMCNT=1
90 . S XMPAGE=XMPAGE-XMCNT
91 . S:XMPAGE<0 XMPAGE=0
92 . S XMKZ=XMFIRST(XMPAGE)
93 D @XMY
94 S XMKZ=XMFIRST(XMPAGE)
95 Q
96PFWD ;
97 N XMCNT,XMPDEST
98 S XMCNT=$E(XMY,2,99)
99 S:XMCNT="" XMCNT=1
100 I XMCNT=1 S XMPAGE=XMPAGE+1 Q
101 S XMPDEST=XMPAGE+XMCNT
102 D FINDPAGE(.XMFIRST,.XMPAGE,XMKZ,XMPDEST)
103 S XMKZ=XMFIRST(XMPAGE)
104 Q
105FINDPAGE(XMFIRST,XMPAGE,XMKZ,XMPDEST) ;
106 N XMO,I
107 S XMO=$S(XMPDEST>XMPAGE:1,1:-1)
108 F XMPAGE=XMPAGE+XMO:XMO S XMFIRST(XMPAGE)=XMKZ Q:XMPAGE=XMPDEST D Q:XMKZ=""
109 . F I=1:1:XMPMAX S XMKZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ),XMO*XMV("ORDER")) Q:XMKZ=""
110 I '$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMFIRST(XMPAGE)),XMO*XMV("ORDER")) S XMPAGE=XMPAGE-XMO Q
111 Q
112FINDXMKZ(XMDUZ,XMK,XMFIRST,XMPAGE,XMKZLAST,XMKZF) ; Find the page with XMKZF on it
113 Q:'$D(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZF))
114 I XMV("ORDER")=-1 D Q
115 . I $S(XMFIRST(XMPAGE):XMFIRST(XMPAGE)>XMKZF,1:1),XMKZF'<XMKZLAST Q
116 . N XMKZ,I
117 . I XMKZF<XMKZLAST D Q ; Go forward
118 . . S XMKZ=XMKZLAST
119 . . F XMPAGE=XMPAGE+1:1 D Q:XMKZ=XMKZF
120 . . . S XMFIRST(XMPAGE)=XMKZ
121 . . . F I=1:1:XMPMAX S XMKZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ),-1) Q:XMKZ=XMKZF
122 . E D ; Go back
123 . . F XMPAGE=XMPAGE-1:-1 Q:XMFIRST(XMPAGE)>XMKZF!'XMPAGE
124 . . ;S XMKZ=XMFIRST(XMPAGE)-1
125 . . ;F XMPAGE=XMPAGE-1:-1 D Q:XMFIRST(XMPAGE)>XMKZF
126 . . ;. F I=1:1:XMPMAX S XMKZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ)) Q:XMKZ=""
127 . . ;. S XMFIRST(XMPAGE)=$S(XMKZ:XMKZ+1,1:XMKZ)
128 I XMFIRST(XMPAGE)<XMKZF,$S(XMKZLAST:XMKZF'>XMKZLAST,1:1) Q
129 N XMKZ,I
130 I XMKZF>XMKZLAST D Q ; Go forward
131 . S XMKZ=XMKZLAST
132 . F XMPAGE=XMPAGE+1:1 D Q:XMKZ=XMKZF
133 . . S XMFIRST(XMPAGE)=XMKZ
134 . . F I=1:1:XMPMAX S XMKZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ)) Q:XMKZ=XMKZF
135 E D ; Go back
136 . F XMPAGE=XMPAGE-1:-1 Q:XMFIRST(XMPAGE)<XMKZF!'XMPAGE
137 . ;S XMKZ=XMFIRST(XMPAGE)-1
138 . ;F XMPAGE=XMPAGE-1:-1 D Q:XMFIRST(XMPAGE)<XMKZF
139 . ;. F I=1:1:XMPMAX S XMKZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ),-1) Q:XMKZ=""
140 . ;. S XMFIRST(XMPAGE)=$S(XMKZ:XMKZ+1,1:XMKZ)
141 Q
142READMSG(XMDUZ,XMK,XMKN,XMKZ,XMZ,XMZOOM) ;
143 D READMSG^XMJBM(XMDUZ,XMK,XMKN,XMZ)
144 I $D(^TMP("XM",$J,".",XMKZ)),'$D(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ,XMZ)) K ^TMP("XM",$J,".",XMKZ)
145 I XMZOOM,'$D(^TMP("XM",$J,".")) D Z
146 Q
147AGAIN(XMABORT) ;
148 N DIR,Y
149 W !
150 S DIR("A")=$$EZBLD^DIALOG(34020) ; End reached. Begin again
151 S DIR(0)="Y",DIR("B")=$$EZBLD^DIALOG(39053) ; No
152 D BLD^DIALOG(34021,"","","DIR(""?"")") ; Enter 'Yes' if you wish to continue reading messages; 'No' if you don't.
153 D ^DIR
154 Q:Y=1 ; Yes, begin again
155 S XMABORT=1 ; No, exit.
156 Q
157DODOT ;
158 N I,XMSTRIKE,XM1,XMN,XMKZ
159 I $E(XMY,2)="-" S XMSTRIKE=1,XMY=$E(XMY,3,999)
160 E S XMSTRIKE=0,XMY=$E(XMY,2,999)
161 I XMY="*" D Q
162 . I XMSTRIKE K ^TMP("XM",$J,".") Q
163 . S XMKZ=""
164 . F S XMKZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ)) Q:'XMKZ S ^TMP("XM",$J,".",XMKZ)=""
165 F I=1:1:$L(XMY,",") D
166 . S XMKZ=$P(XMY,",",I)
167 . I XMKZ["-" D Q
168 . . S XM1=$P(XMKZ,"-")
169 . . S XMN=$P(XMKZ,"-",2) S:XMN="" XMN=XMHI
170 . . S XMKZ=XM1-.1
171 . . I 'XMSTRIKE D Q
172 . . . F S XMKZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ)) Q:XMKZ>XMN!'XMKZ S:'$D(^TMP("XM",$J,".",XMKZ)) ^(XMKZ)=""
173 . . F S XMKZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ)) Q:XMKZ>XMN!'XMKZ K:$D(^TMP("XM",$J,".",XMKZ)) ^(XMKZ)
174 . I 'XMSTRIKE D Q
175 . . I $D(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ)),'$D(^TMP("XM",$J,".",XMKZ)) S ^(XMKZ)=""
176 . K:$D(^TMP("XM",$J,".",XMKZ)) ^(XMKZ)
177 Q
178C ; Change the name of this basket
179 D NAMEBSKT^XMJBU(XMDUZ,XMK,.XMKN)
180 K XMLEN
181 D INIT^XMJML(XMDUZ,XMK,XMKN,XMDETAIL,.XMLEN,1)
182 Q
183CD ; Change Detail
184 S XMDETAIL='XMDETAIL
185 D INIT^XMJML(XMDUZ,XMK,XMKN,XMDETAIL,.XMLEN,1)
186 Q
187D ; Delete messages
188 D DELETE^XMJMOR(XMDUZ,XMK)
189 D WAIT^XMXUTIL
190 I XMZOOM,'$D(^TMP("XM",$J,".")) D Z
191 Q
192F ; Forward messages
193 D FORWARD^XMJMOR(XMDUZ,XMK)
194 D WAIT^XMXUTIL
195 Q
196FI ; Filter messages
197 D FILTER^XMJMOR(XMDUZ,XMK)
198 D WAIT^XMXUTIL
199 Q
200H ; Headerless Print messages
201 D PRINT^XMJMOR(XMDUZ,XMK,0)
202 D WAIT^XMXUTIL
203 Q
204L ; Later messages
205 D LATER^XMJMOR(XMDUZ,XMK)
206 D WAIT^XMXUTIL
207 I XMZOOM,'$D(^TMP("XM",$J,".")) D Z
208 Q
209N ; New message list
210 D LISTONE^XMJMLN(XMDUZ,XMK,XMKN,"N0")
211 D WAIT^XMXUTIL
212 Q
213NT ; New Toggle messages
214 D NEWTOGL^XMJMOR(XMDUZ,XMK)
215 D WAIT^XMXUTIL
216 Q
217O ; Opposite toggle
218 N XMKZ
219 S XMKZ=0
220 F S XMKZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ)) Q:'XMKZ D
221 . I $D(^TMP("XM",$J,".",XMKZ)) K ^TMP("XM",$J,".",XMKZ) Q
222 . S ^TMP("XM",$J,".",XMKZ)=""
223 S XMPAGE=0
224 Q
225P ; Print messages
226 D PRINT^XMJMOR(XMDUZ,XMK)
227 D WAIT^XMXUTIL
228 Q
229Q ; Query messages
230 D FINDBSKT^XMJMF(XMDUZ,XMK,XMKN)
231 Q
232Q1 ; ?string - search for messages in this basket whose subject contains string.
233 N XMF
234 S XMF("BSKT")=XMK
235 S XMF("SUBJ")=XMY(0)
236 D FIND1^XMJMFB(XMDUZ,.XMF,1)
237 Q
238Q2 ; ??string - search for messages whose subject starts with string.
239 D FIND^XMJMFA(XMDUZ,XMY(0),1)
240 Q
241R ; Resequence messages
242 D R^XMJBM
243 S XMPAGE=0
244 K XMLEN,XMFIRST
245 S XMFIRST(0)=""
246 D INIT^XMJML(XMDUZ,XMK,XMKN,XMDETAIL,.XMLEN,1)
247 D WAIT^XMXUTIL
248 Q
249S ; Save messages
250 D SAVE^XMJMOR(XMDUZ,XMK)
251 D WAIT^XMXUTIL
252 Q
253T ; Terminate messages
254 D TERM^XMJMOR(XMDUZ,XMK)
255 D WAIT^XMXUTIL
256 I XMZOOM,'$D(^TMP("XM",$J,".")) D Z
257 Q
258V ; Vaporize messages
259 D VAPOR^XMJMOR(XMDUZ,XMK)
260 D WAIT^XMXUTIL
261 Q
262X ; Xmit priority toggle messages
263 D XMTPRI^XMJMOR(XMDUZ,XMK)
264 D WAIT^XMXUTIL
265 Q
266Z ; Zoom toggle
267 N I
268 I XMZOOM D
269 . S XMZOOM=0
270 . S I=""
271 . F S I=$O(XMFIRST(0,I)) Q:I="" S XMFIRST(I)=XMFIRST(0,I)
272 . S XMPAGE=XMPAGE(0)
273 E D
274 . S XMZOOM=1
275 . S I=""
276 . F S I=$O(XMFIRST(I)) Q:I="" S XMFIRST(0,I)=XMFIRST(I)
277 . S XMPAGE(0)=XMPAGE
278 . S XMPAGE=0
279 Q
Note: See TracBrowser for help on using the repository browser.