source: WorldVistAEHR/trunk/r/MAILMAN-XM/XMJMOI.m@ 1073

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

initial load of WorldVistAEHR
File size: 8.3 KB
Line 
1XMJMOI ;ISC-SF/GMB-Options at Ignore prompt ;03/20/2003 09:28
2 ;;8.0;MailMan;**15**;Jun 28, 2002
3 ; Replaces ^XMA1,^XMA10 (ISC-WASH/CAP/THM)
4READMSG(XMNEWS,XMDUZ,XMK,XMKN,XMZ,XMABORT) ;
5 N XMFINISH,XMFROM,XMINSTR,XMRESTR,XMIEN,XMSUBJ,XMSETPRI,XMRESPSO,XMRESP,XMORIGN8,XMDIR,XMY,XMOPT,XMOX
6 D INIT^XMJMOI1(XMDUZ,XMZ,.XMSUBJ,.XMFROM,.XMORIGN8,.XMINSTR,.XMRESTR,.XMIEN,.XMRESPSO,.XMRESP)
7 S (XMFINISH,XMABORT)=0
8 F D Q:XMFINISH!XMABORT
9 . N XMNAME,XMEDITOK
10 . D CHKBSKT(XMDUZ,XMZ,.XMK,.XMKN)
11 . D READSET^XMJMOI1(XMDUZ,XMK,XMKN,XMZ,XMFROM,XMORIGN8,.XMINSTR,XMIEN,.XMDIR,.XMOPT,.XMOX)
12 . I XMIEN,'$D(XMOPT("B","?")) D CHKRESP^XMJMP(XMDUZ,XMZ,XMRESPSO,XMRESP)
13 . D XMDIR^XMJDIR(.XMDIR,.XMOPT,.XMOX,.XMY,.XMABORT)
14 . S XMEDITOK='$D(XMOPT("E","?")) ; Used in 'forward'
15 . K XMDIR,XMOPT,XMOX
16 . Q:XMABORT
17 . D CHKBSKT(XMDUZ,XMZ,.XMK,.XMKN)
18 . D @XMY
19 D:XMINSTR("FLAGS")["P" PRIORITY^XMJMOI1
20 I XMINSTR("FLAGS")["N" D Q
21 . I XMNEWS D Q
22 . . I $D(^XTMP("XM","MAKENEW",XMDUZ,XMZ)),$D(^XMB(3.7,XMDUZ,"N0",XMK,XMZ)) D NONEW^XMXUTIL(XMDUZ,XMK,XMZ,1)
23 . D MAKENEW^XMXUTIL(XMDUZ,XMK,XMZ,1)
24 ;I 'XMABORT,$D(^XMB(3.7,XMDUZ,"N0",XMK,XMZ)),+XMRESP=+$P($G(^XMB(3.9,XMZ,3,0)),U,4) D NONEW^XMXUTIL(XMDUZ,XMK,XMZ,1)
25 I 'XMABORT,$D(^XMB(3.7,XMDUZ,"N0",XMK,XMZ)) D NONEW^XMXUTIL(XMDUZ,XMK,XMZ,1)
26 I XMABORT,XMNEWS,'$D(^XMB(3.7,XMDUZ,"N0",XMK,XMZ)) S ^XTMP("XM","MAKENEW",XMDUZ,XMZ)=""
27 Q
28CHKBSKT(XMDUZ,XMZ,XMK,XMKN) ; Is the message still where we think it is?
29 I XMK,'$D(^XMB(3.7,"M",XMZ,XMDUZ,XMK)) D RESETXMK^XMJMOI1(XMDUZ,XMZ,.XMK,.XMKN) Q
30 I 'XMK,$D(^XMB(3.7,"M",XMZ,XMDUZ)) D RESETXMK^XMJMOI1(XMDUZ,XMZ,.XMK,.XMKN)
31 Q
32A ; Answer to sender only
33 I '$$GOTNS^XMVVITA(XMDUZ) D Q:'$$GOTNS^XMVVITA(XMDUZ)
34 . W !!,$$EZBLD^DIALOG(37401.1) ; You must have a Network Signature to Answer a message.
35 . D CRE8NS^XMVVITA
36 D ANSWER^XMJMA(XMDUZ,XMZ,XMSUBJ,XMFROM)
37 D IMBACK^XMJMOI1(34070) ; Finished with 'Answer' command.
38 Q
39AA ; Access Attachments
40 N XMAPBLOB
41 I $G(IOT)="IMPC" D BLOB^XMAPBLOB Q
42 D NODISP^XMAPBLOB
43 Q
44B ; Backup
45 D BACKUP^XMJMP(XMDUZ,XMK,XMKN,XMZ)
46 S XMRESP=$P($G(^XMB(3.9,XMZ,1,XMIEN,0)),U,2)
47 Q
48BR ; Print to the Browser
49 D PRINT(1,1)
50 Q
51C ; Copy
52 D COPY^XMJMC(XMDUZ,XMK,XMZ,XMFROM)
53 D IMBACK^XMJMOI1(34071) ; Finished with 'Copy' command.
54 Q
55D ; Delete
56 D DEL^XMXMSGS2(XMDUZ,XMK,XMZ)
57 W !,$$EZBLD^DIALOG(34302.2) ; Message deleted.
58 S XMFINISH=1
59 Q:XMINSTR("FLAGS")'["N"
60 S XMINSTR("FLAGS")=$TR(XMINSTR("FLAGS"),"N")
61 K:XMNEWS ^XTMP("XM","MAKENEW",XMDUZ,XMZ)
62 Q
63E ; Edit
64 D EDIT^XMJMOIE(XMDUZ,XMK,XMZ,.XMSUBJ,.XMINSTR,.XMRESTR)
65 Q
66F ; Forward
67 N XMABORT
68 D GETRESTR^XMJMOI1(XMDUZ,XMZ,"",.XMINSTR,.XMRESTR)
69 S XMABORT=0
70 D INIT^XMXADDR
71 D TOWHOM^XMJMT(XMDUZ,$$EZBLD^DIALOG(34111),.XMINSTR,.XMRESTR,.XMABORT) ; Find out to whom to forward
72 I 'XMABORT D
73 . I XMEDITOK,'$D(XMINSTR("VAPOR")),$$BCAST^XMJMSO D I XMABORT W !,$$EZBLD^DIALOG(34309.4) Q ; Message not forwarded.
74 . . I '$$QVAPOR^XMJMSO S:$D(DTOUT)!$D(DUOUT) XMABORT=1 Q
75 . . D V^XMJMOIE I $D(DTOUT)!$D(DUOUT) S XMABORT=1
76 . D FWD^XMKP(XMDUZ,XMZ,.XMINSTR)
77 . W !,$$EZBLD^DIALOG(34309.2) ; Message forwarded.
78 D CLEANUP^XMXADDR
79 Q
80H ; Headerless Print
81 D PRINT(0)
82 Q
83HG ; Help:Group Information
84 D HELP^XMHIG
85 Q
86HU ; Help:User Information
87 D HELP^XMHIU
88 Q
89I ; Ignore
90 S XMFINISH=1
91 Q
92IN ; Information Only toggle
93 I $G(XMINSTR("FLAGS"))["I" D
94 . S XMINSTR("FLAGS")=$TR(XMINSTR("FLAGS"),"I")
95 . S $P(^XMB(3.9,XMZ,0),U,12)=""
96 . W !,$$EZBLD^DIALOG(37409.9) ; Message is no longer 'Information only'.
97 E D
98 . S XMINSTR("FLAGS")=$G(XMINSTR("FLAGS"))_"I"
99 . S $P(^XMB(3.9,XMZ,0),U,12)="y"
100 . W !,$$EZBLD^DIALOG(37408.9) ; Message is now 'Information only'. No one may reply.
101 Q
102K ; Toggle Priority of future replies
103 I $G(XMINSTR("FLAGS"))["K" D
104 . S XMINSTR("FLAGS")=$TR(XMINSTR("FLAGS"),"K")
105 . S $P(^XMB(3.9,XMZ,1,XMIEN,0),U,9)=1
106 . W !,$$EZBLD^DIALOG(37412.9) ; Responses will not be delivered as Priority Mail.
107 E D
108 . S XMINSTR("FLAGS")=$G(XMINSTR("FLAGS"))_"K"
109 . S $P(^XMB(3.9,XMZ,1,XMIEN,0),U,9)=""
110 . W !,$$EZBLD^DIALOG(37411.9) ; Responses will be delivered as Priority Mail.
111 S XMSETPRI=1
112 Q
113L ; Later
114 D LATER^XMJMD(XMDUZ,XMZ)
115 Q
116N ; Toggle New
117 I XMINSTR("FLAGS")["N" D
118 . S XMINSTR("FLAGS")=$TR(XMINSTR("FLAGS"),"N")
119 . K:XMNEWS ^XTMP("XM","MAKENEW",XMDUZ,XMZ)
120 . W !,$$EZBLD^DIALOG(37415.9) ; Message will NOT be new next time.
121 E D
122 . S XMINSTR("FLAGS")=XMINSTR("FLAGS")_"N"
123 . S:XMNEWS ^XTMP("XM","MAKENEW",XMDUZ,XMZ)=""
124 . W !,$$EZBLD^DIALOG(37414.9) ; Message will be new next time.
125 . I XMK>.5!XMNEWS Q
126 . D SAVEMSG(XMDUZ,.XMK,.XMKN,XMZ,XMSUBJ,XMFROM,$G(XMINSTR("RCPT BSKT")))
127 Q
128P ; Print
129 D PRINT(1)
130 Q
131PRINT(XMPRTHDR,XMBROWSE) ;
132 N XMABORT
133 S XMABORT=0
134 I '$G(XMBROWSE),XMINSTR("TYPE")["K"!(XMINSTR("TYPE")["X") D Q:XMABORT
135 . N DIR,XMMSG,XMPARM
136 . S XMMSG=$$EZBLD^DIALOG($S(XMINSTR("TYPE")["K":34076,1:34077)) ; KIDS build / PackMan message
137 . D BLD^DIALOG(34078,XMMSG,"","DIR(""A"")") ; Print just the descriptive text of this _XMMSG
138 . ;This is a _XMMSG_.
139 . ;Answer YES to print just the descriptive text.
140 . ;Answer NO to print the whole thing (x lines) and/or any responses.
141 . S XMPARM(1)=XMMSG,XMPARM(2)=$$LINE^XMXUTIL2(XMZ)
142 . D BLD^DIALOG(34079,.XMPARM,"","DIR(""?"")") ; Print just the descriptive text of this _XMMSG
143 . S DIR(0)="Y",DIR("B")=$$EZBLD^DIALOG(39054) ; Yes
144 . D ^DIR I $D(DIRUT) S XMABORT=1 Q
145 . Q:'Y
146 . N A,DIE,DIF,X,XCF,XCN,XMR
147 . S XMR=^XMB(3.9,XMZ,0)
148 . D XT^XMP2
149 . S XMABORT=1
150 D PRINT^XMJMP(XMDUZ,XMK,XMZ,XMPRTHDR,.XMBROWSE)
151 S XMRESP=$P($G(^XMB(3.9,XMZ,1,XMIEN,0)),U,2)
152 Q
153Q ; Query
154 D Q^XMJMQ(XMDUZ,XMK,XMKN,XMZ)
155 Q
156QC ; Query Current
157 D QX^XMJMQ(XMDUZ,XMK,XMKN,XMZ,"QC")
158 Q
159QD ; Query Detailed
160 I $D(XMNAME) D QNAMEX^XMJMQ(XMDUZ,XMK,XMKN,XMZ,XMNAME) Q
161 D QD^XMJMQ(XMDUZ,XMK,XMKN,XMZ)
162 Q
163QN ; Query Network
164 D QN^XMJMQ(XMDUZ,XMK,XMKN,XMZ)
165 Q
166QNC ; Query Not Current
167 D QX^XMJMQ(XMDUZ,XMK,XMKN,XMZ,"QNC")
168 Q
169QT ; Query Terminated
170 D QX^XMJMQ(XMDUZ,XMK,XMKN,XMZ,"QT")
171 Q
172RI ; Reply, Include previous response(s)
173R ; Reply
174 N XMINCL
175 S XMINCL=(XMY="RI")
176 I $D(^XMB(3.7,XMDUZ,"N0",XMK,XMZ)),+XMRESP=+$P($G(^XMB(3.9,XMZ,3,0)),U,4) D NONEW^XMXUTIL(XMDUZ,XMK,XMZ,1)
177 D REPLY^XMJMR(XMDUZ,.XMK,.XMKN,XMZ,XMSUBJ,XMFROM,.XMINSTR,XMIEN,XMRESPSO,XMINCL,.XMRESP)
178 Q
179S ; Save (replaces S^XMA1B)
180 N XMKTO,XMDIC
181 I XMK,XMK'=.5 S XMDIC("B")="@" ; no default basket
182 E D
183 . N XMKTO
184 . S XMKTO=0
185 . D CHEKBSKT^XMTDL2(XMDUZ,.XMKTO,XMSUBJ,XMFROM,$G(XMINSTR("RCPT BSKT")))
186 . S XMDIC("B")=$P(^XMB(3.7,XMDUZ,2,XMKTO,0),U)
187 D SELBSKT^XMJBU(XMDUZ,$$EZBLD^DIALOG(34325.1),"L",.XMDIC,.XMKTO) Q:XMKTO=U ; Save message into basket:
188 D CHKBSKT(XMDUZ,XMZ,.XMK,.XMKN)
189 I XMKTO=XMK D
190 . W !,$$EZBLD^DIALOG(34326.1) ; That's the same basket the message is already in.
191 E D
192 . I $D(^XMB(3.7,XMDUZ,"N0",XMK,XMZ)) D NONEW^XMXUTIL(XMDUZ,XMK,XMZ,1)
193 . D MOVEIT^XMXMSGS2(XMDUZ,XMK,XMZ,XMKTO)
194 . W !,$$EZBLD^DIALOG(34324.2) ; Message saved.
195 . S XMK=XMKTO
196 S XMFINISH=1
197 Q
198T ; Terminate (replaces T^XMA1)
199 D TERM^XMXMSGS2(XMDUZ,XMK,XMZ)
200 W !,$$EZBLD^DIALOG($S(XMK<1:34331.1,1:34331)) ; You won't see future replies. (In WASTE basket)
201 S XMFINISH=1
202 S:XMINSTR("FLAGS")["P" XMINSTR("FLAGS")=$TR(XMINSTR("FLAGS"),"P")
203 Q:XMINSTR("FLAGS")'["N"
204 S XMINSTR("FLAGS")=$TR(XMINSTR("FLAGS"),"N")
205 K:XMNEWS ^XTMP("XM","MAKENEW",XMDUZ,XMZ)
206 Q
207V ; Set Vaporize date for msg in basket (replaces DATE^XMA11A)
208 N DIE,DA,DR
209 L +^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0):1
210 S DIE="^XMB(3.7,"_XMDUZ_",2,"_XMK_",1,"
211 S DA(2)=XMDUZ,DA(1)=XMK,DA=XMZ
212 S DR=5
213 D ^DIE
214 L -^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0)
215 Q
216W ; Write a new msg
217 N XMSECURE,XMPAKMAN,XMSECBAD ; Needed! (In case Write from KIDS msg.)
218 D SEND^XMJMS
219 D IMBACK^XMJMOI1(34072) ; Finished with 'Write' command.
220 Q
221X ; Xtract PackMan msg
222 I XMDUZ=.5,XMK>999 G XP
223 N X,DIC,C,I,ER,J,K,T,X2,XCF,XCM,XCN,XMLOC,XMN,XMP0,XMR,XMS
224 S X=XMZ,DIC(0)="N"
225 D MM^XMP
226 Q
227XP ; Xmit Priority Toggle (for remote transmit queues only)
228 N XMTPRI,XMABORT
229 S XMABORT=0
230 D ASKPRI^XMJMORX(.XMTPRI,.XMABORT) Q:XMABORT
231 D XP^XMXMSGS1(XMDUZ,XMK,XMZ,XMTPRI)
232 Q
233SAVEMSG(XMDUZ,XMK,XMKN,XMZ,XMSUBJ,XMFROM,XMZBSKT) ;
234 ; The message is currently in the waste basket or no basket.
235 ; Save it to an appropriate (not waste) basket.
236 N XMKTO
237 S XMKTO=0
238 D CHEKBSKT^XMTDL2(XMDUZ,.XMKTO,XMSUBJ,XMFROM,$G(XMINSTR("RCPT BSKT")))
239 S:XMKTO=.5 XMKTO=1
240 S XMKN=$P(^XMB(3.7,XMDUZ,2,XMKTO,0),U,1)
241 I 'XMK D
242 . D PUTMSG^XMXMSGS2(XMDUZ,XMKTO,XMKN,XMZ)
243 E D
244 . ; Message is in waste basket
245 . D COPYIT^XMXMSGS2(XMDUZ,.5,XMZ,XMKTO)
246 . D ZAPIT^XMXMSGS2(XMDUZ,.5,XMZ)
247 S XMK=XMKTO
248 W !,$$EZBLD^DIALOG(34325.9,XMKN) ; Message saved to _XMKN_ basket.
249 Q
Note: See TracBrowser for help on using the repository browser.