source: WorldVistAEHR/trunk/r/MAILMAN-XM/XMJBM.m@ 1076

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

initial load of WorldVistAEHR

File size: 7.8 KB
Line 
1XMJBM ;ISC-SF/GMB-Manage Mail in Mailbox ;05/23/2002 11:35
2 ;;8.0;MailMan;;Jun 28, 2002
3 ; Replaces ^XMA0,^XMA01 (ISC-WASH/CAP/THM)
4 ; Entry points used by MailMan options (not covered by DBIA):
5 ; MANAGE XMREAD
6MANAGE ; Manage existing mail in your Mailbox
7 N XMABORT,XMK,XMKN,XMRDR
8 S XMABORT=0
9 D INIT^XMJBM1(.XMDUZ,.XMRDR,.XMABORT) Q:XMABORT
10 F D ASKBSKT^XMJBM1(XMDUZ,XMRDR,.XMK,.XMKN,.XMABORT) Q:XMABORT D Q:XMABORT
11 . D:XMRDR="C" CLASSIC(XMDUZ,XMK,XMKN,.XMABORT) ; Classic Reader
12 . D:XMRDR="D" LIST^XMJMLR(XMDUZ,XMK,.XMKN,1,.XMABORT) ; Full Screen Detail
13 . D:XMRDR="S" LIST^XMJMLR(XMDUZ,XMK,.XMKN,0,.XMABORT) ; Full Screen Summary
14 . I XMABORT,XMDUZ=.6 S XMABORT=0
15 . I '$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",0)) D NOMSGS^XMJBM1(XMDUZ,XMK,XMKN)
16 Q
17CLASSIC(XMDUZ,XMK,XMKN,XMABORT) ; Read Message
18 N XMFIRST,XMLAST,XMZ,XMNEXT,XMKZ,XMORDER,XMPARM
19 I XMDUZ=.5,XMK>999 S XMORDER=XMV("ORDER"),XMV("ORDER")=1
20 S XMKZ=""
21 F D Q:XMABORT
22 . F S XMKZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ),XMV("ORDER")) Q:'XMKZ Q:XMDUZ=DUZ Q:'$$SURRCONF^XMXSEC(XMDUZ,$O(^(XMKZ,"")))
23 . I XMKZ="" D Q:XMABORT
24 . . F S XMKZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ),XMV("ORDER")) Q:'XMKZ Q:XMDUZ=DUZ Q:'$$SURRCONF^XMXSEC(XMDUZ,$O(^(XMKZ,"")))
25 . . I XMKZ D AGAIN^XMJMLR(.XMABORT) Q
26 . . S XMABORT=1
27 . . Q:'$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",0))
28 . . N XMTEXT
29 . . W !
30 . . D BLD^DIALOG(34030.9,"","","XMTEXT","F")
31 . . ;All of the messages in this basket are confidential.
32 . . ;Surrogates may not read confidential messages.
33 . . ;Use one of the full screen readers to see a list of the messages.
34 . . D MSG^DIALOG("WM","","","","XMTEXT")
35 . S XMFIRST=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",""))
36 . S XMLAST=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",""),-1)
37 . ; have the user pick from first to last, or any xmz
38 . N XMY,XMOPT,XMOX,XMPREVU
39 . D SETCMD(XMDUZ,XMK,.XMOPT,.XMOX)
40 . S:XMV("PREVU") XMPREVU=$$PREVU(XMDUZ,XMK,XMKN,XMKZ)
41 . S XMNEXT=0
42 . F D Q:XMNEXT!XMABORT
43 . . W ! W:XMV("PREVU") !,XMPREVU
44 . . S XMPARM(1)=XMKN,XMPARM(2)=XMKZ
45 . . W !,$$EZBLD^DIALOG(34030,.XMPARM) ; XMKN," Basket Message: ",XMKZ,"// "
46 . . R XMY:DTIME I '$T S XMABORT=1 Q
47 . . I XMY[U S XMABORT=1 Q
48 . . I XMY="" S XMY=XMKZ D NUMBER Q
49 . . I XMY?.N D NUMBER Q
50 . . I $E(XMY)="?" D QUESTION Q
51 . . S XMY=$$COMMAND^XMJDIR(.XMOPT,.XMOX,XMY)
52 . . I XMY=-1 D HELPSCR Q
53 . . I $D(XMOPT(XMY,"?")) D SHOWERR^XMJDIR(.XMOPT,.XMY) Q
54 . . D @XMY
55 . . S:'$D(^XMB(3.7,XMDUZ,2,XMK,1,"C",+XMKZ)) XMNEXT=1
56 I $D(XMORDER) S XMV("ORDER")=XMORDER
57 Q
58PREVU(XMDUZ,XMK,XMKN,XMKZ) ;
59 Q:XMKZ="" ""
60 N XMZ,XMZREC,XMSUBJ,XMFROM,XMLEN,XMSL,XMFL,XMPARM
61 S XMZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ,""))
62 I '$D(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0)) D ADDITC^XMUT4A(XMDUZ,XMK,XMZ,XMKZ)
63 S XMZREC=$G(^XMB(3.9,XMZ,0))
64 S XMSUBJ=$$SUBJ^XMXUTIL2(XMZREC)
65 S XMFROM=$$NAME^XMXUTIL($P(XMZREC,U,2))
66 S XMSL=$L(XMSUBJ)
67 S XMFL=$L(XMFROM)
68 S XMLEN=64
69 I XMSL+XMFL>XMLEN D
70 . I XMSL<36 S XMFROM=$E(XMFROM,1,XMLEN-XMSL) Q
71 . I XMFL<26 S XMSUBJ=$E(XMSUBJ,1,XMLEN-XMFL) Q
72 . S XMSL=XMSL-(XMSL+XMFL-XMLEN\2)
73 . S XMSUBJ=$E(XMSUBJ,1,XMSL)
74 . S XMFROM=$E(XMFROM,1,XMLEN-XMSL)
75 S XMPARM(1)=XMSUBJ,XMPARM(2)=XMFROM
76 Q $$EZBLD^DIALOG(34031,.XMPARM) ; "Subj: "_XMSUBJ_" From: "_XMFROM
77SETCMD(XMDUZ,XMK,XMOPT,XMOX) ;
78 D OPTGRP^XMXSEC1(XMDUZ,XMK,.XMOPT,.XMOX,1)
79 I XMDUZ=.5,XMK>999 Q
80 D SET^XMXSEC1("I",37241,.XMOPT,.XMOX) ; Ignore this message
81 Q
82NUMBER ;
83 I $L(XMY)>25 W $C(7),"?" Q
84 I XMY<XMFIRST D Q
85 . S XMKZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",""))
86 . S:XMV("PREVU") XMPREVU=$$PREVU(XMDUZ,XMK,XMKN,XMKZ)
87 . W $C(7),"?"
88 I $D(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMY)) D Q
89 . S XMKZ=XMY
90 . S XMZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ,""))
91 . I '$D(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0)) D ADDITC^XMUT4A(XMDUZ,XMK,XMZ,XMKZ)
92 . D READMSG(XMDUZ,XMK,XMKN,XMZ)
93 . S XMNEXT=1
94 I XMFIRST'>XMY,XMY'>XMLAST D Q
95 . S XMKZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMY),XMV("ORDER"))
96 . S:XMV("PREVU") XMPREVU=$$PREVU(XMDUZ,XMK,XMKN,XMKZ)
97 . W $C(7),"?"
98 I $D(^XMB(3.9,XMY,0)) D NUMBERZ Q
99 I XMY>XMLAST D Q
100 . S XMKZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",""),-1)
101 . S:XMV("PREVU") XMPREVU=$$PREVU(XMDUZ,XMK,XMKN,XMKZ)
102 . W $C(7),"?"
103 W $C(7),"?"
104 Q
105NUMBERZ ;
106 I $D(^XMB(3.7,"M",XMY,XMDUZ)) D Q
107 . S XMZ=XMY
108 . I '$D(^XMB(3.7,XMDUZ,2,XMK,1,XMZ)) D
109 . . ; It's in another basket
110 . . S XMK=$O(^XMB(3.7,"M",XMZ,XMDUZ,""))
111 . . S XMKN=$P(^XMB(3.7,XMDUZ,2,XMK,0),U,1)
112 . S XMKZ=$P($G(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0)),U,2)
113 . I 'XMKZ D ADDITM^XMUT4A(XMDUZ,XMK,XMZ,.XMKZ)
114 . D READMSG(XMDUZ,XMK,XMKN,XMZ)
115 . S XMNEXT=1
116 I $D(^XMB(3.9,XMY,0)) D Q
117 . N XMOK,XMZREC
118 . S XMZ=XMY,XMZREC=^XMB(3.9,XMZ,0)
119 . I $D(XMERR) K XMERR,^TMP("XMERR",$J)
120 . I '$$ACCESS^XMXSEC(XMDUZ,XMZ,XMZREC) D Q:'XMOK
121 . . W "?"
122 . . D FWD^XMJMLR1(XMDUZ,XMZ,XMZREC,0,.XMOK)
123 . D PUTMSG^XMXMSGS2(XMDUZ,XMK,XMKN,XMZ) ; User is a recipient, so save to user's basket
124 . D READMSG(XMDUZ,XMK,XMKN,XMZ)
125 . S XMNEXT=1
126 Q
127QUESTION ;
128 I XMY="?" D LIST^XMJML(XMDUZ,XMK,XMKN,XMKZ,0) Q
129 I XMY="??" D LIST^XMJML(XMDUZ,XMK,XMKN,XMKZ,1) Q
130 I XMY="???" D HELPSCR Q
131 I XMY?4."?"!("?HELP"[$$UP^XLFSTR(XMY)) D Q
132 . N XQH
133 . S XQH="XM-U-BO-CLASSIC"
134 . D EN^XQH
135 I XMY?1"??".E D Q
136 . ; Search for messages whose subject starts with string
137 . I $E(XMY,3,99)?.N,$D(^XMB(3.9,$E(XMY,3,999),0)) D Q
138 . . S XMY=$E(XMY,3,99)
139 . . D NUMBERZ
140 . D FIND^XMJMFA(XMDUZ,$E(XMY,3,99))
141 I XMY?1"?".E D Q
142 . ; Search for messages whose subject contains string
143 . N XMF
144 . S XMF("BSKT")=XMK
145 . S XMF("SUBJ")=$E(XMY,2,99)
146 . D FIND1^XMJMFB(XMDUZ,.XMF)
147 Q
148HELPSCR ;
149 N XMTEXT,XMLINES,XMPARM
150 W !
151 S XMPARM(1)=XMKZ,XMPARM(2)=XMFIRST,XMPARM(3)=XMLAST
152 D BLD^DIALOG(34032,.XMPARM,"","XMTEXT","F")
153 ; Press ENTER to read message _XMKZ_. Enter message number (_XMFIRST_-_XMLAST_) to read
154 ; a message in this basket. Enter internal message number to read any
155 ; message still on the system, which you ever sent or received. Enter:
156 ; ? or ?? Display a summary or detailed list of messages in this basket
157 ; ???? or ?HELP Display detailed help
158 ; ?string Search for messages in this basket whose subject
159 ; contains the specified string
160 ; ??string Search for messages you once sent or received
161 ; whose subject begins with the specified string
162 S XMLINES=IOSL-DIHELP-3
163 D MSG^DIALOG("WH","",$G(IOM),"","XMTEXT")
164 D HELPCMD^XMJDIR(.XMOPT,.XMOX,XMLINES)
165 Q
166READMSG(XMDUZ,XMK,XMKN,XMZ) ;
167 I '$D(^XMB(3.9,XMZ,0)) D ZAPIT(XMDUZ,XMK,XMZ) Q
168 I XMDUZ'=DUZ,'$$SURRACC^XMXSEC(XMDUZ,"",XMZ,$G(^XMB(3.9,XMZ,0))) D Q ; "read"
169 . D SHOW^XMJERR
170 . I $G(XMRDR)'="C" D WAIT^XMXUTIL
171 N XMSECURE,XMPAKMAN,XMSECBAD ; Important 'new' - part of scramble and packman handling
172 D DISPMSG^XMJMP(XMDUZ,XMK,XMKN,XMZ,.XMSECBAD) Q:$G(XMSECBAD)
173 D READMSG^XMJMOI(0,XMDUZ,XMK,XMKN,XMZ)
174 Q
175ZAPIT(XMDUZ,XMK,XMZ) ;
176 W !,$C(7),$$EZBLD^DIALOG(34034) ; This references a message which doesn't exist - deleting it.
177 D ZAPIT^XMXMSGS2(XMDUZ,XMK,XMZ)
178 Q
179C ; Change the name of the basket
180 D NAMEBSKT^XMJBU(XMDUZ,XMK,.XMKN)
181 Q
182D ; Delete
183 D DELETE^XMJMOR(XMDUZ,XMK)
184 Q
185F ; Forward
186 D FORWARD^XMJMOR(XMDUZ,XMK)
187 Q
188FI ; Filter
189 D FILTER^XMJMOR(XMDUZ,XMK)
190 Q
191H ; Headerless Print
192 D PRINT^XMJMOR(XMDUZ,XMK,0)
193 Q
194I ; Ignore this message
195 S XMNEXT=1
196 Q
197L ; Later
198LA ; Later
199 D LATER^XMJMOR(XMDUZ,XMK)
200 Q
201LM ; List Messages (can't read)
202 D LIST^XMJML(XMDUZ,XMK,XMKN,"",1)
203 Q
204LN ; List New Messages
205 D LISTONE^XMJMLN(XMDUZ,XMK,XMKN,"N0")
206 Q
207LP ; List Priority Messages
208 D LISTONE^XMJMLN(XMDUZ,XMK,XMKN,"N")
209 Q
210N ; List New Messages (can't read)
211 D LISTNEW^XMJML(XMDUZ,XMK,XMKN)
212 Q
213NT ; New Toggle messages
214 D NEWTOGL^XMJMOR(XMDUZ,XMK)
215 Q
216P ; Print
217 D PRINT^XMJMOR(XMDUZ,XMK)
218 Q
219Q ; Query by subject, sender, and/or date
220 D FINDBSKT^XMJMF(XMDUZ,XMK,XMKN)
221 Q
222R ; Resequence
223 N XMMSG
224 W !,$$EZBLD^DIALOG(34035) ; Resequencing ...
225 D RSEQBSKT^XMXBSKT(XMDUZ,XMK,.XMMSG)
226 W !,XMMSG
227 S XMKZ=""
228 Q
229S ; Save
230 D SAVE^XMJMOR(XMDUZ,XMK)
231 Q
232T ; Terminate
233 D TERM^XMJMOR(XMDUZ,XMK)
234 Q
235V ; Vaporize
236 D VAPOR^XMJMOR(XMDUZ,XMK)
237 Q
238X ; Xmit Priority toggle (for Postmaster only)
239 D XMTPRI^XMJMOR(XMDUZ,XMK)
240 Q
Note: See TracBrowser for help on using the repository browser.