source: FOIAVistA/trunk/r/MAILMAN-XM/XMXUTIL.m@ 1119

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

initial load of FOIAVistA 6/30/08 version
File size: 8.6 KB
Line 
1XMXUTIL ;ISC-SF/GMB-Message & Mailbox Utilities ;06/19/2002 07:39
2 ;;8.0;MailMan;;Jun 28, 2002
3 ; All entry points covered by DBIA 2734.
4WAIT ;
5 N DIR,Y,DIRUT S DIR(0)="E",DIR("A")=$$EZBLD^DIALOG(37003) D ^DIR ; Press RETURN to continue
6 Q
7PAGE(XMABORT) ;
8 N DIR,Y,DIRUT S DIR(0)="E" D ^DIR I $D(DIRUT) S XMABORT=1
9 Q
10NEWS(XMDUZ,XMTEST) ;
11 ; Given:
12 ; XMDUZ User's DUZ
13 ; XMTEST 0=this is not a test. (DEFAULT)
14 ; (Field 1.12 LAST NEW MSG NOTIFY DATE/TIME may be updated)
15 ; 1=this is just a test.
16 ; (Field 1.12 will not be updated)
17 ; Returns:
18 ; -1 If no record of this user
19 ; 0 If no new mail
20 ; Otherwise, if the user has new mail, returns an ^-delimited string:
21 ; Piece 1: # New Msgs
22 ; Piece 2: Does the user have new priority mail? (1=yes;0=no)
23 ; Piece 3: # New Msgs in IN basket
24 ; Piece 4: Date/Time (FileMan) that the last msg was received
25 ; Piece 5: Have there been any new messages since the last time
26 ; this function was called? (1=yes;0=no)
27 ; And for the first priority read basket with new messages in it:
28 ; (If none has new messages, then first priority read basket)
29 ; Piece 6: # New Msgs in basket
30 ; Piece 7: Basket IEN
31 ; Piece 8: Basket name
32 N XMREC,XMNEW,XMRECEIV,XMNOTIFY
33 S XMREC=$G(^XMB(3.7,XMDUZ,0))
34 Q:XMREC="" -1
35 S XMNEW=+$P(XMREC,U,6)
36 Q:'XMNEW 0
37 S XMRECEIV=$P(XMREC,U,14) ; date/time last msg received
38 S XMNOTIFY=$P(XMREC,U,15) ; date/time user last notified
39 I XMRECEIV>XMNOTIFY,'$G(XMTEST) S $P(^XMB(3.7,XMDUZ,0),U,15)=XMRECEIV
40 Q XMNEW_U_($D(^XMB(3.7,XMDUZ,"N"))>0)_U_+$P(^XMB(3.7,XMDUZ,2,1,0),U,2)_U_XMRECEIV_U_(XMRECEIV>XMNOTIFY)_U_$$NPBSKT^XMJBN(XMDUZ)
41TNMSGCT(XMDUZ) ; Total new msg count
42 Q +$P(^XMB(3.7,XMDUZ,0),U,6)
43BNMSGCT(XMDUZ,XMK) ; Basket new msg count
44 Q +$P(^XMB(3.7,XMDUZ,2,XMK,0),U,2)
45TPMSGCT(XMDUZ) ; Total new priority msg count
46 I '$D(^XMB(3.7,XMDUZ,"N")) Q 0
47 N XMK,I,XMZ
48 S (XMK,I,XMZ)=0
49 F S XMK=$O(^XMB(3.7,XMDUZ,"N",XMK)) Q:'XMK D
50 . F I=I:1 S XMZ=$O(^XMB(3.7,XMDUZ,"N",XMK,XMZ)) Q:'XMZ
51 Q I
52BPMSGCT(XMDUZ,XMK) ; Basket new priority msg count
53 I '$D(^XMB(3.7,XMDUZ,"N",XMK)) Q 0
54 N I,XMZ
55 S XMZ=0
56 F I=0:1 S XMZ=$O(^XMB(3.7,XMDUZ,"N",XMK,XMZ)) Q:'XMZ
57 Q I
58TMSGCT(XMDUZ) ; Total msg count
59 N I,XMK
60 S I=0,XMK=.99
61 F S XMK=$O(^XMB(3.7,XMDUZ,2,XMK)) Q:XMK'>0 S I=I+$$BMSGCT(XMDUZ,XMK)
62 Q I
63BMSGCT(XMDUZ,XMK) ; Basket msg count
64 Q +$P($G(^XMB(3.7,XMDUZ,2,XMK,1,0)),U,4)
65KVAPOR(XMDUZ,XMK,XMZ,XMVAPOR,XMIU) ; Set/delete a message's vaporize date in user's basket
66 ; XMVAPOR ="@" delete it
67 ; =FM date/time set/change it
68 N XMFDA,XMIENS
69 S XMIENS=XMZ_","_XMK_","_XMDUZ_","
70 S XMFDA(3.702,XMIENS,5)=XMVAPOR
71 I XMVAPOR="@" D
72 . K XMIU("KVAPOR")
73 . S XMFDA(3.702,XMIENS,7)="@"
74 E D
75 . S XMIU("KVAPOR")=XMVAPOR
76 . S XMFDA(3.702,XMIENS,7)=0
77 D FILE^DIE("","XMFDA")
78 Q
79BSKTNAME(XMDUZ,XMK) ; What's the name of this basket for this user?
80 Q $P($G(^XMB(3.7,XMDUZ,2,XMK,0)),U,1)
81NAME(XMID,XMIT) ; Given a name or DUZ, return the name
82 ; XMID user's DUZ or name
83 ; XMIT 1=if DUZ, return institution and title, too, if needed
84 ; 0=just return the name (default)
85 Q:+XMID'=XMID $S(XMID'="":XMID,1:$$EZBLD^DIALOG(34009)) ; * No Name *
86 N XMNAME,XMTITLE,XMINST
87 I '$D(^VA(200,XMID,0)) Q $$EZBLD^DIALOG(34010,XMID) ; * User #|1| * (not in NEW PERSON file)
88 S XMNAME("FILE")=200,XMNAME("IENS")=XMID_",",XMNAME("FIELD")=.01
89 S XMNAME=$$NAMEFMT^XLFNAME(.XMNAME,"F","C")
90 Q:'$G(XMIT) XMNAME
91 I XMV("SHOW TITL") D
92 . I XMV("TITL SRC")="S" S XMTITLE=$P($G(^VA(200,XMID,20)),U,3) ; field 20.3, SIGNATURE BLOCK TITLE
93 . I $G(XMTITLE)="",$P(^VA(200,XMID,0),U,9) S XMTITLE=$P($G(^DIC(3.1,$P(^(0),U,9),0)),U) ; field 8, TITLE
94 . S:$G(XMTITLE)'="" XMNAME=XMNAME_" - "_XMTITLE
95 I XMV("SHOW INST"),$D(^XMB(3.7,XMID,6000)) D
96 . S XMINST=$P(^XMB(3.7,XMID,6000),U)
97 . S:XMINST'="" XMNAME=XMNAME_" ("_XMINST_")"
98 Q XMNAME
99NETNAME(XMDUZ) ; Given a DUZ or a string, return an internet name @ site name.
100 N XMNETNAM
101 Q:XMDUZ["@" XMDUZ
102 I +XMDUZ=XMDUZ!(XMDUZ="") D
103 . S:'XMDUZ XMDUZ=.5
104 . ; Use Mail Name. Lacking that, use real name.
105 . S XMNETNAM=$S($L($P($G(^XMB(3.7,XMDUZ,.3)),U)):$P(^(.3),U),1:$$NAME(XMDUZ))
106 . I $E(XMNETNAM)=$C(34),$E(XMNETNAM,$L(XMNETNAM))=$C(34) Q ; Ignore if quoted
107 . I XMNETNAM?.E1C.E!($TR(XMNETNAM,$C(34)_"<>()[];:")'=XMNETNAM) S XMNETNAM=$C(34)_XMNETNAM_$C(34) Q ; Quote if illegal
108 . I XMNETNAM[","!(XMNETNAM[" ") S XMNETNAM=$TR(XMNETNAM,", .","._+") ; Translate
109 E D
110 . S XMNETNAM=XMDUZ
111 . I $E(XMNETNAM)'=$C(34),$E(XMNETNAM,$L(XMNETNAM))'=$C(34) D
112 . . I $E(XMNETNAM)="<",$E(XMNETNAM,$L(XMNETNAM))=">" D I $E(XMNETNAM)=$C(34),$E(XMNETNAM,$L(XMNETNAM))=$C(34) Q
113 . . . S XMNETNAM=$E(XMNETNAM,2,$L(XMNETNAM)-1)
114 . . I XMNETNAM?.E1C.E!($TR(XMNETNAM,$C(34)_" ,<>()[];:")'=XMNETNAM) S XMNETNAM=$C(34)_XMNETNAM_$C(34) ; Quote if illegal
115 Q XMNETNAM_"@"_^XMB("NETNAME")
116LOCK(XMDOOR,XMLOCKED,XMWAIT) ; Lock a global (** NOT USED **)
117 L +@XMDOOR:$G(XMWAIT,0) E S XMLOCKED=0 Q
118 S XMLOCKED=1
119 Q
120MAKENEW(XMDUZ,XMK,XMZ,XMLOCKIT) ; Make a message new
121 ; Should lock before calling AND unlock after.
122 ; If you set XMLOCKIT=1, I'll do the locking for you.
123 Q:$D(^XMB(3.7,XMDUZ,"N0",XMK,XMZ))
124 Q:'$D(^XMB(3.7,XMDUZ,2,XMK,1,XMZ))
125 N XMFDA
126 S XMFDA(3.702,XMZ_","_XMK_","_XMDUZ_",",3)="1" ; new
127 I $G(XMLOCKIT) L +^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0):1
128 D FILE^DIE("","XMFDA")
129 I $G(XMLOCKIT) L -^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0)
130 D INCRNEW(XMDUZ,XMK)
131 Q
132INCRNEW(XMDUZ,XMK,XMCNT) ; Increment the number of new messages in a basket
133 ; For internal use only!
134 S:'$D(XMCNT) XMCNT=1
135 L +^XMB(3.7,XMDUZ,0):1
136 S $P(^(0),U,2)=$P(^XMB(3.7,XMDUZ,2,XMK,0),U,2)+XMCNT ; New msgs in bskt
137 S $P(^(0),U,6)=$P(^XMB(3.7,XMDUZ,0),U,6)+XMCNT ; New msgs for user
138 S $P(^XMB(3.7,XMDUZ,0),U,14)=$$NOW^XLFDT ; When last msg rec'd
139 L -^XMB(3.7,XMDUZ,0)
140 Q
141NONEW(XMDUZ,XMK,XMZ,XMLOCKIT) ; Make a message not new
142 ; Should lock before calling AND unlock after.
143 ; If you set XMLOCKIT=1, I'll do the locking for you.
144 Q:'$D(^XMB(3.7,XMDUZ,"N0",XMK,XMZ))
145 N XMFDA
146 S XMFDA(3.702,XMZ_","_XMK_","_XMDUZ_",",3)="@" ; no longer new
147 I $G(XMLOCKIT) L +^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0):1
148 D FILE^DIE("","XMFDA")
149 I $G(XMLOCKIT) L -^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0)
150 D DECRNEW(XMDUZ,XMK)
151 Q
152DECRNEW(XMDUZ,XMK,XMCNT) ; Decrement the number of new messages in a basket
153 ; For internal use only!
154 S:'$D(XMCNT) XMCNT=1
155 L +^XMB(3.7,XMDUZ,0):1
156 I $P(^XMB(3.7,XMDUZ,2,XMK,0),U,2) S $P(^(0),U,2)=$P(^(0),U,2)-XMCNT ; New msgs in bskt
157 I $P(^XMB(3.7,XMDUZ,0),U,6) S $P(^(0),U,6)=$P(^(0),U,6)-XMCNT ; New msgs for user
158 L -^XMB(3.7,XMDUZ,0)
159 Q
160KILLMSG(DA) ; For internal MM use only. Kill a msg in ^XMB(3.9
161 N DIK
162 S DIK="^XMB(3.9,"
163 L +^XMB(3.9,0):1
164 D ^DIK
165 L -^XMB(3.9,0)
166 Q
167LASTACC(XMDUZ,XMK,XMZ,XMRESP,XMIM,XMINSTR,XMIU,XMCONFRM) ; Note first, last accesses, number of responses read
168 ; in:
169 ; XMDUZ,XMK,XMZ the usual. If message not in basket, set XMK=0.
170 ; XMRESP last response read this time
171 ; XMIM "SUBJ", "FROM"
172 ; XMINSTR "FLAGS"
173 ; XMIU "IEN", "RESP"
174 ; out:
175 ; XMCONFRM Confirmation message was sent to message sender (0=no; 1=yes)
176 N XMNOW,XMREC,XMFDA,XMIENS
177 I XMRESP D
178 . N XMRESPS ; User can't read more responses than there are.
179 . S XMRESPS=+$P($G(^XMB(3.9,XMZ,3,0)),U,4)
180 . I XMRESP>XMRESPS S XMRESP=XMRESPS
181 S XMCONFRM=0
182 I 'XMIU("IEN") D Q
183 . I XMRESP>XMIU("RESP")!(XMIU("RESP")="") S XMIU("RESP")=XMRESP
184 S XMNOW=$$NOW^XLFDT
185 S XMREC=^XMB(3.9,XMZ,1,XMIU("IEN"),0)
186 I $P(XMREC,U,10)="" D
187 . S $P(XMREC,U,10)=XMNOW ; first access
188 . ; If confirmation requested, and user is not sender, send confirmation
189 . I XMINSTR("FLAGS")["R",XMDUZ'=XMIM("FROM") D CONFIRM^XMXUTIL1(XMDUZ,XMZ,.XMIM) S XMCONFRM=1
190 S $P(XMREC,U,3)=XMNOW ; last access
191 I $S(XMRESP>$P(XMREC,U,2):1,1:$P(XMREC,U,2)="") S XMIU("RESP")=XMRESP,$P(XMREC,U,2)=XMRESP ; last response read
192 S ^XMB(3.9,XMZ,1,XMIU("IEN"),0)=XMREC
193 I XMDUZ'=DUZ,XMDUZ'=.6 S ^XMB(3.9,XMZ,1,XMIU("IEN"),"S")=XMV("DUZ NAME")
194 Q:'XMK
195 S XMREC=$G(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0))
196 Q:XMREC="" ; Message is not in the user's basket
197 I '$P(XMREC,U,7) D Q
198 . S $P(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0),U,4)=XMNOW ; last access (for MailMan's auto-vaporize)
199 ; MailMan has set an automatic delete date. Since this message was
200 ; just accessed, we must delete that date.
201 S XMIENS=XMZ_","_XMK_","_XMDUZ_","
202 S XMFDA(3.702,XMIENS,4)=XMNOW ; last access (for MailMan's auto-vaporize)
203 S XMFDA(3.702,XMIENS,5)="@" ; automatic delete date
204 S XMFDA(3.702,XMIENS,7)="@" ; delete date set by MailMan?
205 D FILE^DIE("","XMFDA")
206 Q
207ERRSET(XMID,XMPARM,XMZ) ; For internal MailMan use only.
208 S XMERR=$G(XMERR)+1
209 S ^TMP("XMERR",$J,XMERR)=XMID
210 I $D(XMZ) S ^TMP("XMERR",$J,XMERR,"XMZ")=XMZ
211 I $D(XMPARM("PARAM")) M ^TMP("XMERR",$J,XMERR,"PARAM")=XMPARM("PARAM")
212 D BLD^DIALOG(XMID,.XMPARM,"","^TMP(""XMERR"",$J,"_XMERR_",""TEXT"")")
213 S ^TMP("XMERR",$J,"E",XMID,XMERR)=""
214 Q
Note: See TracBrowser for help on using the repository browser.