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

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

initial load of WorldVistAEHR
File size: 8.8 KB
Line 
1XMXUTIL2 ;ISC-SF/GMB-Message info ;04/19/2002 13:34
2 ;;8.0;MailMan;;Jun 28, 2002
3 ; All entry points covered by DBIA 2736.
4QRESP(XMZ,XMZREC,XMWHICH) ; Function returns 0 if message XMZ is a message.
5 ; If message XMZ is a response, returns XMZ of original message
6 ; and, optionally, the response number as the second piece.
7 ; in:
8 ; XMZ XMZ of the message to be checked
9 ; XMZREC (optional) 0-node of the message
10 ; XMWHICH (optional) If the message is a response, should MailMan also
11 ; return the response number as the second piece?
12 ; (0=no (default); 1=yes)
13 N XMZO
14 I $G(XMZREC)="" S XMZREC=$G(^XMB(3.9,XMZ,0))
15 S XMZO=$S($P(XMZREC,U,8):$P(XMZREC,U,8),$P(XMZREC,U)?1"R"1.N:+$E(XMZREC,2,99),1:"")
16 ; The following test (XMZO'=XMZ) is necessary,
17 ; because some old messages point to themselves as responses.
18 I XMZO,XMZO'=XMZ Q:'$G(XMWHICH) XMZO D Q XMZO_U_XMWHICH
19 . S XMWHICH=0 ; This is a response to message XMZO.
20 . F S XMWHICH=$O(^XMB(3.9,XMZO,3,XMWHICH)) Q:'XMWHICH Q:^(XMWHICH,0)=XMZ
21 Q 0 ; This is a message.
22INMSG(XMDUZ,XMK,XMZ,XMZREC,XMFLAGS,XMIM,XMINSTR,XMIU) ;
23 ; Should NOT be called for responses!
24 ; XMFLAGS If XMFLAGS["I" return internal only
25 ; ["F" return FM date
26 ; XMIU("KVAPOR") If applicable, user-specified vaporize date for message in basket
27 ; XMIU("NEW") Is message new? (0=no; 1=yes; 2=yes, and priority, too)
28 D INMSG1(XMDUZ,XMZ,.XMZREC,.XMFLAGS,.XMIM,.XMIU)
29 D INMSG2(XMDUZ,XMZ,XMZREC,.XMIM,.XMINSTR,.XMIU)
30 Q:'XMK
31 N XMKREC
32 S XMKREC=$G(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0))
33 I $P(XMKREC,U,5) S XMIU("KVAPOR")=$P(XMKREC,U,5)
34 S XMIU("NEW")=$$NEW(XMDUZ,XMK,XMZ)
35 Q
36INMSG1(XMDUZ,XMZ,XMZREC,XMFLAGS,XMIM,XMIU) ; (Should NOT be called for responses!)
37 ; XMIM("RESPS")
38 ; XMIU("IEN")
39 ; XMIU("RESP")
40 I $G(XMZREC)="" S XMZREC=$G(^XMB(3.9,XMZ,0))
41 S XMFLAGS=$G(XMFLAGS)
42 D INM(XMZ,XMZREC,XMFLAGS,.XMIM)
43 I $D(XMIU) K XMIU
44 S XMIU("IEN")=+$O(^XMB(3.9,XMZ,1,"C",XMDUZ,0))
45 D INRESPS(XMZ,.XMIM,.XMIU)
46 Q
47INM(XMZ,XMZREC,XMFLAGS,XMIM) ; For internal MailMan use only.
48 ; XMIM and XMIU are killed first
49 ; out:
50 ; Always returned:
51 ; XMIM("XMZ")
52 ; XMIM("SUBJ")
53 ; XMIM("FROM")
54 ; XMIM("DATE")
55 ; XMIM("CRE8")
56 ; XMIM("SENDR")
57 ; XMIM("LINES")
58 ; XMIM("ENV FROM") 'Envelope From' returned only if it exists
59 ; Returned if XMFLAGS'["I":
60 ; XMIM("FROM DUZ")
61 ; XMIM("FROM NAME")
62 ; XMIM("DATE FM") Returned if XMFLAGS["F"
63 ; XMIM("DATE MM") Returned if XMFLAGS'["F"
64 ; XMIM("CRE8 MM") Returned if XMFLAGS'["F"
65 ; XMIM("SENDR DUZ")
66 ; XMIM("SENDR NAME")
67 I $D(XMIM) K XMIM
68 S XMIM("XMZ")=XMZ
69 I $G(XMZREC)="" S XMZREC=$G(^XMB(3.9,XMZ,0))
70 S XMIM("SUBJ")=$$SUBJ^XMXUTIL2(XMZREC)
71 S XMIM("FROM")=$P(XMZREC,U,2)
72 S XMIM("DATE")=$P(XMZREC,U,3)
73 S XMIM("SENDR")=$P(XMZREC,U,4)
74 S XMIM("CRE8")=$P($G(^XMB(3.9,XMZ,.6)),U)
75 S XMIM("LINES")=+$P($G(^XMB(3.9,XMZ,2,0)),U,4)
76 I $D(^XMB(3.9,XMZ,.7)) D
77 . N XMNVFROM
78 . S XMNVFROM=$P($G(^XMB(3.9,XMZ,.7)),U,1)
79 . I XMNVFROM'="" S XMIM("ENV FROM")=XMNVFROM
80 Q:XMFLAGS["I"
81 I +XMIM("FROM")'=XMIM("FROM") S XMIM("FROM NAME")=XMIM("FROM")
82 E S XMIM("FROM DUZ")=XMIM("FROM"),XMIM("FROM NAME")=$$NAME^XMXUTIL(XMIM("FROM"))
83 I XMIM("SENDR")'="" D
84 . I +XMIM("SENDR")'=XMIM("SENDR") S XMIM("SENDR NAME")=XMIM("SENDR")
85 . E S XMIM("SENDR DUZ")=XMIM("SENDR"),XMIM("SENDR NAME")=$$NAME^XMXUTIL(XMIM("SENDR"))
86 I XMFLAGS["F" D Q
87 . I XMIM("DATE")?7N.E S XMIM("DATE FM")=XMIM("DATE") Q
88 . S XMIM("DATE FM")=$$CONVERT^XMXUTIL1(XMIM("DATE"),1)
89 S XMIM("DATE MM")=$$DATE(XMZREC,1) ; MailMan date
90 S XMIM("CRE8 MM")=$$MMDT^XMXUTIL1(XMIM("CRE8")) ; MailMan date
91 Q
92INRESPS(XMZ,XMIM,XMIU) ; How many responses? What's the user read?
93 ; In:
94 ; XMZ
95 ; XMIU("IEN") ien of user's record in recipient multiple
96 ; Out:
97 ; XMIM("RESPS") message has this many responses
98 ; XMIU("RESP") last response read by the user
99 ; (null=not read at all; 0=original msg only; number=resp)
100 S XMIM("RESPS")=+$P($G(^XMB(3.9,XMZ,3,0)),U,4)
101 S XMIU("RESP")=$P($G(^XMB(3.9,XMZ,1,XMIU("IEN"),0)),U,2)
102 Q
103INRESP(XMZ,XMIEN,XMFLAGS,XMIR) ; Get info on a response to a message.
104 ; In:
105 ; XMZ XMZ of original message
106 ; XMIEN Which response (1 thru # of responses)
107 ; XMFLAGS If XMFLAGS["I" return internal only
108 ; ["F" return FM date
109 ; Out:
110 ; XMIR
111 N XMZREC,XMZR
112 K XMIR
113 I '$D(^XMB(3.9,XMZ,3,XMIEN)) Q
114 S XMZR=$G(^XMB(3.9,XMZ,3,XMIEN,0)) Q:'XMZR
115 S XMZREC=$G(^XMB(3.9,XMZR,0))
116 D INM(XMZR,XMZREC,XMFLAGS,.XMIR)
117 ;Q:XMIR("SUBJ")'?1"R".N
118 ;Q:XMFLAGS["I"
119 ;S XMZREC=$G(^XMB(3.9,XMZ,0)) Q:XMZREC=""
120 ;S XMIR("SUBJ X")="Re: "_$P(XMZREC,U,1)
121 ;I XMIR("SUBJ X")["~U~" S XMIR("SUBJ")=$$DECODEUP^XMXUTIL1(XMIR("SUBJ X"))
122 Q
123INMSG2(XMDUZ,XMZ,XMZREC,XMIM,XMINSTR,XMIU) ;
124 ; Should NOT be called for responses!
125 ; Does not kill XMIM, XMINSTR, or XMIU first
126 ; XMIM("RECIPS") number of recipients of the message
127 ; XMIU("ORIGN8") user sent message (0=no; 1=yes)
128 ; The following are set only if applicable:
129 ; XMINSTR("FLAGS")
130 ; XMINSTR("RCPT BSKT")
131 ; XMINSTR("TYPE")
132 ; XMINSTR("VAPOR")
133 ; XMINSTR("SCR HINT")
134 S XMIM("RECIPS")=$P($G(^XMB(3.9,XMZ,1,0)),U,4)
135 I $G(XMZREC)="" S XMZREC=$G(^XMB(3.9,XMZ,0))
136 S XMIU("ORIGN8")=$$ORIGIN8R^XMXSEC(XMDUZ,XMZREC)
137 S:$P(XMZREC,U,6)'="" XMINSTR("VAPOR")=$P(XMZREC,U,6)
138 S XMINSTR("TYPE")=$P(XMZREC,U,7) ; Msg type (regular, KIDS, etc.)
139 I $$PAKMAN^XMXSEC1(XMZ,XMZREC) D
140 . Q:XMINSTR("TYPE")["K" ; KIDS
141 . S:XMINSTR("TYPE")'["X" XMINSTR("TYPE")=XMINSTR("TYPE")_"X" ; PackMan
142 S XMINSTR("FLAGS")=""
143 S:"^Y^y^"[(U_$P(XMZREC,U,5)_U) XMINSTR("FLAGS")=XMINSTR("FLAGS")_"R" ; confirmation requested
144 S:"^Y^y^"[(U_$P(XMZREC,U,9)_U) XMINSTR("FLAGS")=XMINSTR("FLAGS")_"X" ; closed
145 S:"^Y^y^"[(U_$P(XMZREC,U,11)_U) XMINSTR("FLAGS")=XMINSTR("FLAGS")_"C" ; confidential
146 S:"^Y^y^"[(U_$P(XMZREC,U,12)_U) XMINSTR("FLAGS")=XMINSTR("FLAGS")_"I" ; information only
147 I $P(XMZREC,U,10)'="" S XMINSTR("SCR HINT")=$P(XMZREC,U,10)
148 I $D(^XMB(3.9,XMZ,.5)) D
149 . N XMZBSKT
150 . S XMZBSKT=$P(^XMB(3.9,XMZ,.5),U,1)
151 . S:XMZBSKT'="" XMINSTR("RCPT BSKT")=XMZBSKT
152 Q:XMINSTR("TYPE")'["P"
153 S XMINSTR("FLAGS")=XMINSTR("FLAGS")_"P" ; priority
154 S XMINSTR("TYPE")=$TR(XMINSTR("TYPE"),"P")
155 S:'$P($G(^XMB(3.9,XMZ,1,XMIU("IEN"),0)),U,9) XMINSTR("FLAGS")=XMINSTR("FLAGS")_"K" ; priority responses
156 Q
157ZNODE(XMZ) ; Returns the zero node of the message.
158 Q $G(^XMB(3.9,XMZ,0))
159ZDATE(XMZ,XMTIME) ; What is the message date? (Formatted by $$MMDT^XMXUTIL1)
160 ; XMTIME =0 Date only
161 ; =1 Date and time (default)
162 Q $$DATE($G(^XMB(3.9,XMZ,0)),.XMTIME)
163DATE(XMZREC,XMTIME) ; What is the message date? (Formatted by $$MMDT^XMXUTIL1)
164 ; XMTIME =0 Date only
165 ; =1 Date and time (default)
166 N XMDATE
167 S XMDATE=$P(XMZREC,U,3)
168 S XMTIME=+$G(XMTIME,1)
169 I XMDATE?7N.E Q $$MMDT^XMXUTIL1($S(XMTIME:XMDATE,1:$E(XMDATE,1,7)))
170 N XMFM
171 S XMFM=$$CONVERT^XMXUTIL1(XMDATE,XMTIME)
172 I XMFM=-1 Q XMDATE
173 Q $$MMDT^XMXUTIL1(XMFM)
174ZSUBJ(XMZ) ; What is the message subject?
175 Q $$SUBJ($G(^XMB(3.9,XMZ,0)))
176SUBJ(XMZREC) ; What is the message subject?
177 N XMSUBJ
178 S XMSUBJ=$P(XMZREC,U,1)
179 I XMSUBJ="" Q $$EZBLD^DIALOG(34012) ;* No Subject *
180 I XMSUBJ["~U~" Q $$DECODEUP^XMXUTIL1(XMSUBJ)
181 Q XMSUBJ
182ZFROM(XMZ) ; Who sent the message?
183 Q $$FROM($G(^XMB(3.9,XMZ,0)))
184FROM(XMZREC) ; Who sent the message?
185 Q $$NAME^XMXUTIL($P(XMZREC,U,2))
186ZPRI(XMZ) ; Is the message priority?
187 Q $$PRI($G(^XMB(3.9,XMZ,0)))
188PRI(XMZREC) ; Is the message priority?
189 Q $P(XMZREC,U,7)["P"
190LINE(XMZ) ; How many lines does the message have?
191 Q +$P($G(^XMB(3.9,XMZ,2,0)),U,4)
192RESP(XMZ) ; How many responses does this message have?
193 Q +$P($G(^XMB(3.9,XMZ,3,0)),U,4)
194ZREAD(XMDUZ,XMZ) ; How many responses has the user read?
195 ; null = the user has not read the message
196 ; 0 = the user has read the original message only
197 ; number = the user has read through this response
198 N XMUPTR
199 ;S XMUPTR=$O(^XMB(3.9,XMZ,1,"C",$S(XMDUZ=.6:DUZ,1:XMDUZ),0))
200 S XMUPTR=+$O(^XMB(3.9,XMZ,1,"C",XMDUZ,0))
201 ;Q:'XMUPTR ""
202 Q $$READ($G(^XMB(3.9,XMZ,1,XMUPTR,0)))
203READ(XMZUREC) ; How many responses has the user read?
204 ; null = the user has not read the message
205 ; 0 = the user has read the original message only
206 ; number = the user has read through this response
207 Q $P(XMZUREC,U,2)
208BSKT(XMDUZ,XMZ,XMNAME) ; Which basket is the message in for this user?
209 ; in:
210 ; XMDUZ,XMZ
211 ; XMNAME Return basket name as second piece? 0=no (default); 1=yes
212 ; returns:
213 ; 0 = it's not in any basket
214 ; number = it's in this basket ien ($G(XMNAME)=0)
215 ; number^name = it's in this basket ien^name (XMNAME=1)
216 N XMK
217 S XMK=+$O(^XMB(3.7,"M",XMZ,XMDUZ,""))
218 I 'XMK Q XMK
219 I '$G(XMNAME) Q XMK
220 Q XMK_U_$P($G(^XMB(3.7,XMDUZ,2,XMK,0)),U,1)
221NEW(XMDUZ,XMK,XMZ) ; Is the message new for this user?
222 ; 0 = no; 1 = yes; 2 = yes, and it's priority, too.
223 Q:$D(^XMB(3.7,XMDUZ,"N",XMK,XMZ)) 2
224 Q:$D(^XMB(3.7,XMDUZ,"N0",XMK,XMZ)) 1
225 Q 0
226KSEQN(XMDUZ,XMK,XMZ) ; What's the seqence number for this message in this user's basket?
227 Q $$SEQN($G(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0)))
228SEQN(XMKZREC) ; What's the seqence number for this message in this user's basket?
229 Q $P(XMKZREC,U,2)
Note: See TracBrowser for help on using the repository browser.