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

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

initial load of WorldVistAEHR

File size: 8.2 KB
Line 
1XM ;ISC-SF/GMB-MailMan Main Driver ;04/22/2002 14:31
2 ;;8.0;MailMan;;Jun 28, 2002
3 ; Replaces ^XM,EN^XMA01,INTRO^XMA6,REC^XMA22,MULTI^XM0,^XMAK (ISC-WASH/CAP/THM)
4 ;
5 ; Entry points (DBIA 10064):
6 ; ^XM Programmer entry into MailMan
7 ; CHECKIN Meant to be included in option ENTRY ACTION
8 ; CHECKOUT Meant to be included in option EXIT ACTION
9 ; EN Option entry point into MailMan
10 ; HEADER Displays user intro when entering MailMan
11 ; KILL Kill MailMan variables
12 ; N1 Create a mailbox
13 ; NEW Create a mailbox
14 ; $$NU Tell user how many new messages he has
15 ;
16 ; Entry points used by MailMan options (not covered by DBIA):
17 ; NEWMBOX XMMGR-NEW-MAIL-BOX - Create a mailbox
18 D KILL^XUSCLEAN
19 N XMXUSEC,XMABORT,XMMENU
20 S XMMENU(0)="^XM"
21 I '$D(IOF) D HOME^%ZIS
22 D EN
23 I $D(XQUIT)!'$D(XMDUZ) K XQUIT D CLEANUP Q
24 D:'$D(^DOPT("XM")) OPTIONS
25 S XMABORT=0
26 F D Q:XMABORT ; Programmer option choices
27 . N DIC,X,Y
28 . S XMXUSEC=$S($G(DUZ(0))="@":1,$D(^XUSEC("XUPROG",XMDUZ)):1,$D(^XUSEC("XUPROGMODE",XMDUZ)):1,1:0)
29 . S DIC="^DOPT(""XM"","
30 . S DIC(0)="AEQMZ"
31 . S DIC("S")="Q:XMXUSEC I ^(0)'[""LOAD"""
32 . W !!
33 . D ^DIC I Y<0 S XMABORT=1 Q
34 . K DIC,X
35 . X $P(Y(0),U,2,999)
36 D CLEANUP
37 Q
38EN ;Initialize
39 ;N XMDUZ,XMDISPI,XMDUN,XMNOSEND,XMV
40 Q:$D(DUZ("SAV")) ; Set by option XUTESTUSER
41 D SETUP
42 D HEADER
43 Q
44SETUP ;
45 I $G(IO)'=$G(IO(0))!'$D(IO(0)) D HOME^%ZIS U IO
46 D CHECK^XMKPL ; Make sure background filers are running.
47 I '$D(IOF)!'$D(IOM)!'$D(IOSL) S IOP="" D ^%ZIS K IOP
48 S XMDUZ=DUZ
49 D INIT^XMVVITAE
50 K XMERR,^TMP("XMERR",$J)
51 Q
52HEADER ;
53 N XMPERSON,XMPARM,XMTEXT
54 I $D(XMV("SYSERR")) D ERROR(.XMV,"SYSERR") S:$D(XMMENU) XQUIT="" Q ; Fatal Errors
55 I $D(XMV("ERROR")) D ERROR(.XMV,"ERROR") S:$D(XMMENU) XQUIT="" Q ; Fatal Errors
56 I $D(XMV("WARNING")) D WARNING(XMDUZ,.XMV)
57 S XMPARM(1)=XMV("VERSION"),XMPARM(2)=XMV("NETNAME")
58 W !!,$$EZBLD^DIALOG(38150,.XMPARM) ; |1| service for |2|
59 I XMDUZ'=DUZ W !,$$EZBLD^DIALOG(38008,XMV("DUZ NAME")) ; (Surrogate: |1|)
60 I XMDUZ'=.6 D
61 . S XMPARM(1)=XMV("LAST USE"),XMPARM(2)=XMV("NAME")
62 . W !,$$EZBLD^DIALOG($S(XMDUZ=DUZ:38151,1:38152),.XMPARM) ; You/|2| last used MailMan: |1|
63 . Q:'$D(XMV("BANNER"))
64 . S XMPARM(1)=XMV("BANNER"),XMPARM(2)=XMV("NAME")
65 . D BLD^DIALOG($S(XMDUZ=DUZ:38153,1:38154),.XMPARM,"","XMTEXT","F")
66 . D MSG^DIALOG("WM","","","","XMTEXT")
67 . ; Your/|2|'s current banner: |1|
68 . ;E W !,$S(XMDUZ=DUZ:"You have",1:XMV("NAME")_" has")," no banner."
69 S XMPARM(1)=XMV("NEW MSGS"),XMPARM(2)=XMV("NAME")
70 W !,$$EZBLD^DIALOG($S(XMDUZ=DUZ:38155,1:38156)+$S(XMV("NEW MSGS")>1:0,'XMV("NEW MSGS"):.2,1:.1),.XMPARM) ; You have/|2| has |1|/no new message(s).
71 I XMV("NEW MSGS")<0!(XMV("NEW MSGS")&'$D(^XMB(3.7,XMDUZ,"N0")))!('XMV("NEW MSGS")&$D(^XMB(3.7,XMDUZ,"N0"))) D
72 . D MSG(38160)
73 . ; There's a discrepancy in the 'new message' count. Checking the mailbox...
74 . D USER^XMUT4(XMDUZ)
75 Q
76ERROR(XMV,XMTYPE) ;
77 N I
78 S I=0
79 F S I=$O(XMV(XMTYPE,I)) Q:I="" W !,$C(7),XMV(XMTYPE,I)
80 K XMDUZ
81 Q
82WARNING(XMDUZ,XMV) ;
83 D:$D(XMV("WARNING",5)) POST(XMV("WARNING",5))
84 D:$D(XMV("WARNING",4)) MULTI
85 D:$D(XMV("WARNING",3)) INTRO(XMDUZ)
86 D:$D(XMV("WARNING",2)) UNSENT(XMDUZ)
87 D:$D(XMV("WARNING",1)) LISTPRI^XMJML(XMDUZ)
88 ;D:$D(XMV("WARNING",1)) PRIO^XMJML(XMDUZ)
89 K XMV("WARNING")
90 Q
91MSG(XMDIALOG) ;
92 N XMTEXT
93 W !
94 D BLD^DIALOG(XMDIALOG,"","","XMTEXT","F")
95 D MSG^DIALOG("WM","","","","XMTEXT")
96 Q
97POST(XMMSG) ;
98 W !!,$C(7),XMMSG ; "POSTMASTER has X baskets."
99 D MSG(38113.1)
100 ;POSTMASTER may not have more than 999 baskets.
101 ;Baskets numbered above 999 are reserved for network transmission
102 ;queues and for server queues.
103 Q
104MULTI ;
105 ;It appears someone is signed on as you/|1| already.
106 ;You may not send mail or respond to mail in this session.
107 ;(Only the 1st of multiple MailMan sessions may send or respond to mail.)
108 N XMTEXT
109 W !
110 D BLD^DIALOG($S(XMDUZ=DUZ:38110.1,1:38110.2),XMV("NAME"),"","XMTEXT","F")
111 D BLD^DIALOG(38110.3,"","","XMTEXT","F")
112 D MSG^DIALOG("WM","","","","XMTEXT")
113 Q
114INTRO(XMDUZ) ;
115 D MSG(38114.1)
116 ;You have not yet introduced yourself to the group.
117 ;Please enter a short introduction, so that others may use
118 ;the HELP option to find out more about you.
119 ;You may change your INTRODUCTION later
120 ;under 'Personal Preferences|User Options Edit.
121 W !!
122 N DIR S DIR(0)="E" D ^DIR Q:$D(DIRUT)
123 N DWPK,DIC
124 S DWPK=1,DIC="^XMB(3.7,XMDUZ,1,"
125 D EN^DIWE
126 Q
127UNSENT(XMDUZ) ;
128 N XMREC,XMZ
129 L +^XMB(3.7,"AD",XMDUZ):0 E D Q
130 . S XMV("NOSEND")=1
131 . D MULTI
132 S XMREC=^XMB(3.7,XMDUZ,"T")
133 S XMZ=$P(XMREC,U) Q:'XMZ
134 I $P(XMREC,U,3) D RECOVER^XMJMR(XMDUZ,XMZ,$P(XMREC,U,3)) Q ; Reply
135 D RECOVER^XMJMS(XMDUZ,XMZ,$P(XMREC,U,4)) ; Original Message (w/BLOB)
136 Q
137CHECKIN ;
138 Q:$D(XMMENU(0)) ; Set by option XMUSER or other options using MailMan
139 Q:$D(DUZ("SAV")) ; Set by option XUTESTUSER
140 D SETUP
141 I $D(XMV("WARNING")) D WARNING(XMDUZ,.XMV)
142 Q
143CHECKOUT ;
144 K XMERR,^TMP("XMERR",$J)
145 Q:$D(XMMENU(0))
146 K XMDISPI,XMDUN,XMDUZ,XMNOSEND,XMPRIV,XMV
147 L -^XMB(3.7,"AD",DUZ)
148 Q
149LOCK ;
150 S Y=1
151 Q:'$D(XMMENU(0))
152 L +^XMB(3.7,"AD",DUZ):0 E D MULTI S Y=-1
153 Q
154UNLOCK ;
155 Q:'$D(XMMENU(0))
156 L -^XMB(3.7,"AD",DUZ)
157 Q
158CHK ; Entry used by Kernel
159 K ^TMP("XMY",$J),^TMP("XMY0",$J)
160 S XMDUZ=$G(XMDUZ,DUZ)
161 Q:XMDUZ=.6
162 D NUS(0)
163 Q
164NU(XMFORCE) ;API for new message display
165 ; XMFORCE (in) 1=force new display; 0=display only if recent receipt
166 N XMNEW
167 D NUS(XMFORCE,.XMNEW)
168 Q XMNEW
169NUS(XMFORCE,XMNEW) ; new message display
170 ; XMFORCE (in) 1=force new display; 0=display only if recent receipt
171 ; XMNEW (out) number of new messages
172 ; XMLAST last message arrival date (FM format)
173 N XMREC,XMNEW2U,XMLAST
174 S XMDUZ=$G(XMDUZ,DUZ)
175 S XMREC=$$NEWS^XMXUTIL(XMDUZ,$D(DUZ("SAV")))
176 Q:XMREC=-1
177 S XMNEW=$P(XMREC,U,1)
178 I 'XMFORCE,'XMNEW Q
179 S XMLAST=$P(XMREC,U,4)
180 S XMNEW2U=$P(XMREC,U,5)
181 I XMNEW2U!XMFORCE D
182 . N XMPARM,XMDIALOG
183 . S XMPARM(1)=XMNEW
184 . I XMDUZ=DUZ S XMDIALOG=38155
185 . E S XMDIALOG=38156,XMPARM(2)=$$NAME^XMXUTIL(XMDUZ)
186 . W !,$$EZBLD^DIALOG(XMDIALOG+$S(XMNEW>1:0,'XMNEW:.2,1:.1),.XMPARM) ; You have/|2| has |1|/no new message(s).
187 . Q:'XMNEW
188 . W " ",$$EZBLD^DIALOG(38158,$$MMDT^XMXUTIL1(XMLAST)) ; (Last arrival: |1|)
189 D:$P(XMREC,U,2) NOTEPRIO
190 Q
191NOTEPRIO ;
192 N XMDIALOG,XMPARM
193 I XMDUZ=DUZ S XMDIALOG=38159 ;You've got PRIORITY Mail!
194 E S XMDIALOG=38159.1,XMPARM(1)=$$NAME^XMXUTIL(XMDUZ) ;|1| has PRIORITY Mail!
195 D ZIS
196 W $C(7),!!,$G(IORVON),$$EZBLD^DIALOG(XMDIALOG,.XMPARM),!!,$G(IORVOFF)
197 Q
198ZIS ;
199 Q:$D(IORVON)
200 N X
201 S X="IORVON;IORVOFF;IOBON;IOBOFF"
202 D ENDR^%ZISS
203 Q
204NEWMBOX ; Create a mailbox for a user
205 N DIC,XMZ
206 D MSG(38165)
207 ;Ready to create a mailbox for a user.
208 ;You will only be able to select a user who does not already have a mailbox.
209 S DIC="^VA(200,"
210 S DIC(0)="AEQM"
211 S DIC("S")="I '$D(^XMB(3.7,Y,0))"
212 D ^DIC Q:Y=-1
213 S Y=+Y
214 D NEW
215 W !,$$EZBLD^DIALOG(38165.1) ; Mailbox created.
216 Q
217N1 S Y=XMDUZ
218NEW ; CREATE MAILBOX 4 NEW USER
219N L +^XMB(3.7,0):0 E H 1 G N
220 D CRE8MBOX^XMXMBOX(Y,$S($D(XMZ):DT,1:""))
221 L -^XMB(3.7,0)
222 D:$D(XMERR) SHOW^XMJERR
223 Q
224KILL ;
225CLEANUP ;
226 K XMV,XMDISPI,XMDUN,XMDUZ,XMPRIV,XMNOSEND,XMERR
227 K:$D(^TMP("XMERR",$J)) ^TMP("XMERR",$J)
228 D KILLALL
229 D UNLOCK
230 Q
231KILLALL ;All variables except XMDISPI,XMDUZ,XMDUN and XMPRIV are killed here on
232 ;exit from the MailMan package or by calls to this code.
233 K A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,V,W,X,Z,%,%0,%1,%2,%3,%4
234 K XM,XMA,XMA0,XMAPBLOB,XMB,XMB0
235 K XMC,XMC0,XMCH,XMCI,XMCL,XMCNT,XMCT
236 K XMD,XMD0,XMDATE,XMDI,XMDT,XME,XME0,XMF,XMF0,XMG,XMG0
237 K XMK,XMKM,XMKN,XMI,XMJ
238 K XML,XMLOAD,XMLOC,XMLOCK,XMM,XMMG,XMN,XMOUT,XMP
239 K XMR,XMRES,XMS,XMSEN,XMSUB
240 K XMT,XMTYPE,XMU,XMY,XMZ,XMZ1,XMZ2
241 Q
242DSP ;
243 D INIT^XMVVITAE
244 Q
245OPTIONS ; Set up options
246 N DIK,I,X
247 K ^DOPT("XM")
248 S DIK="^DOPT(""XM"","
249 S ^DOPT("XM",0)="MailMan Option^1N^"
250 F I=1:1 S X=$P($T(T+I)," ",1,3) Q:X=" ;;" S X=$E(X,4,255),^DOPT("XM",I,0)=$$UP^XLFSTR($$EZBLD^DIALOG(+X))_U_$P(X,U,2,3)
251 D IXALL^DIK
252 Q
253T ;;TABLE
254 ;;38170^D SEND^XMJMS ; SEND A MESSAGE
255 ;;38171^D MANAGE^XMJBM ; READ/MANAGE MESSAGES
256 ;;38172^D NEW^XMJBN ; NEW MESSAGES AND RESPONSES
257 ;;38173^D PAKMAN^XMJMS ; LOAD PACKMAN MESSAGE
258 ;;38174^D EDIT^XMVVITA ; EDIT USER OPTIONS
259 ;;38175^D PERSONAL^XMVGROUP ; PERSONAL MAIL GROUP EDIT
260 ;;38176^D ENROLL^XMVGROUP ; JOIN MAIL GROUP
261 ;;38177^D LISTMBOX^XMJBL ; MAILBOX CONTENTS LIST
262 ;;38178^D TALK^XMC ; LOG-IN TO ANOTHER SYSTEM (TalkMan)
263 ;;38179^D FIND^XMJMF ; QUERY/SEARCH FOR MESSAGES
264 ;;
265 ;;**OBSOLETE**
266 ;;BLOB SEND^D BLOB^XMA2B
267 ;;
Note: See TracBrowser for help on using the repository browser.