source: FOIAVistA/trunk/r/MAILMAN-XM/XMUT4.m@ 1794

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

initial load of FOIAVistA 6/30/08 version
File size: 8.8 KB
Line 
1XMUT4 ;ISC-SF/GMB-Integrity Checker for files 3.7, 3.9 ;07/15/2002 07:25
2 ;;8.0;MailMan;;Jun 28, 2002
3 ; Was (WASH ISC)/CAP
4 ;
5 ; Entry points used by MailMan options (not covered by DBIA):
6 ; CHKFILES XMUT-CHKFIL
7 Q
8CHKFILES ;
9 I $D(ZTQUEUED) D PROCESS Q
10 N XMABORT
11 S XMABORT=0
12 D WARNING^XMUT41(.XMABORT) Q:XMABORT
13 D EN^XUTMDEVQ("PROCESS^XMUT4",$$EZBLD^DIALOG(36080)) ; MailMan: Global Integrity Checker
14 Q
15PROCESS ;
16 I $D(ZTQUEUED) S ZTREQ="@"
17 N XMABORT
18 S XMABORT=0
19 D MAILBOX(.XMABORT)
20 D:'XMABORT MESSAGE^XMUT4C(.XMABORT)
21 D SUMMARY^XMUT41(XMABORT)
22 Q
23MAILBOX(XMABORT) ;
24 W:'$D(ZTQUEUED) !!,$$EZBLD^DIALOG(36081) ; Checking MAILBOX file 3.7
25 D USERS(.XMABORT) Q:XMABORT
26 D MXREF^XMUT41(.XMABORT) Q:XMABORT
27 D POSTBSKT^XMUT41
28 Q
29USERS(XMABORT) ;
30 ; XMUCNT # users
31 ; XMUKCNT # bskts for a particular user
32 ; XMUECNT # msg entries for a particular user
33 ; XMKCNT # bskts
34 ; XMECNT # msg entries
35 N XMUSER,XMECNT,XMUCNT,XMKCNT,XMUKCNT,XMUECNT
36 W:'$D(ZTQUEUED) !!,$$EZBLD^DIALOG(36082),! ; Checking each user mailbox
37 S (XMUSER,XMECNT,XMUCNT,XMKCNT)=0
38 F S XMUSER=$O(^XMB(3.7,XMUSER)) Q:XMUSER'>0 D Q:XMABORT
39 . S XMUCNT=XMUCNT+1 I XMUCNT#20=0 D Q:XMABORT
40 . . I '$D(ZTQUEUED) W:$X>40 ! W XMUCNT,"." Q
41 . . I $$S^%ZTLOAD S (XMABORT,ZTSTOP)=1 ; User asked the task to stop
42 . D USER(XMUSER,.XMUKCNT,.XMUECNT)
43 . S XMKCNT=XMKCNT+XMUKCNT
44 . S XMECNT=XMECNT+XMUECNT
45 Q:XMABORT
46 I '$D(ZTQUEUED) D
47 . N XMPARM,XMTEXT
48 . S XMPARM(1)=XMUCNT,XMPARM(2)=XMKCNT,XMPARM(3)=XMECNT
49 . W !
50 . D BLD^DIALOG(36083,.XMPARM,"","XMTEXT","F")
51 . D MSG^DIALOG("WM","","","","XMTEXT")
52 . ;|1| Users, |2| Baskets, |3| Msg Entries"
53 I $D(^XMB(3.7,0)) S:$P(^XMB(3.7,0),U,4)'=XMUCNT $P(^(0),U,4)=XMUCNT Q
54 S ^XMB(3.7,0)="MAILBOX^3.7P^3^"_XMUCNT
55 Q
56USER(XMUSER,XMUKCNT,XMUECNT) ;
57 ; XMUNCNT # new msgs for a user
58 ; XMUKECNT # msgs in a user's bskt
59 ; XMUKNCNT # new msgs in a user's bskt
60 N XMK,XMUKNCNT,XMUKECNT,XMUNCNT
61 D BXREF(XMUSER)
62 D N0XREF(XMUSER)
63 S (XMK,XMUKCNT,XMUNCNT,XMUECNT)=0
64 F S XMK=$O(^XMB(3.7,XMUSER,2,XMK)) Q:XMK'>0 D
65 . Q:XMK=.95
66 . S XMUKCNT=XMUKCNT+1
67 . D BSKT(XMUSER,XMK,.XMUKNCNT,.XMUKECNT)
68 . S XMUNCNT=XMUNCNT+XMUKNCNT
69 . S XMUECNT=XMUECNT+XMUKECNT
70 S:$P($G(^XMB(3.7,XMUSER,0)),U,1)'=XMUSER $P(^(0),U,1)=XMUSER
71 S:$P(^XMB(3.7,XMUSER,0),U,6)'=XMUNCNT $P(^(0),U,6)=XMUNCNT
72 S:'$D(^XMB(3.7,"B",XMUSER,XMUSER)) ^XMB(3.7,"B",XMUSER,XMUSER)=""
73 I $D(^XMB(3.7,XMUSER,2,0)) S:$P(^XMB(3.7,XMUSER,2,0),U,4)'=XMUKCNT $P(^(0),U,4)=XMUKCNT Q
74 S ^XMB(3.7,XMUSER,2,0)="^3.701^"_$O(^XMB(3.7,XMUSER,2,"B"),-1)_U_XMUKCNT
75 Q
76BSKT(XMUSER,XMK,XMUKNCNT,XMUKECNT) ;
77 N XMKN,XMKZ,XMZ,XMREC,XMRESEQ,XMKNAME
78 S XMKNAME(1)=$$EZBLD^DIALOG(37005) ; IN
79 S XMKNAME(.5)=$$EZBLD^DIALOG(37004) ; WASTE
80 S XMKNAME("?")=$$EZBLD^DIALOG(34009) ; * No Name *
81 D CXREF(XMUSER,XMK,.XMRESEQ)
82 S (XMZ,XMUKNCNT,XMUKECNT)=0
83 F S XMZ=$O(^XMB(3.7,XMUSER,2,XMK,1,XMZ)) Q:XMZ'>0 D
84 . S XMREC=^XMB(3.7,XMUSER,2,XMK,1,XMZ,0)
85 . I $P(XMREC,U,1)'=XMZ D
86 . . S $P(^XMB(3.7,XMUSER,2,XMK,1,XMZ,0),U,1)=XMZ
87 . . D ERR(103,XMUSER,XMK,XMZ) ; Msg in bskt, but no .01 field: .01 field created
88 . I '$D(^XMB(3.9,XMZ,0)) D Q
89 . . D ERR(101,XMUSER,XMK,XMZ) ; Msg in bskt, but no msg: removed from bskt
90 . . D ZAPIT^XMXMSGS2(XMUSER,XMK,XMZ)
91 . S XMUKECNT=XMUKECNT+1
92 . S XMKZ=$P(XMREC,U,2)
93 . I XMKZ D
94 . . I '$D(^XMB(3.7,XMUSER,2,XMK,1,"C",XMKZ,XMZ)) S ^(XMZ)="" D ERR(112,XMUSER,XMK,XMZ) ; Msg in bskt, but no C xref: xref created
95 . E D
96 . . S XMKZ=$O(^XMB(3.7,XMUSER,2,XMK,1,"C",""),-1)+1
97 . . S $P(^XMB(3.7,XMUSER,2,XMK,1,XMZ,0),U,2)=XMKZ
98 . . S ^XMB(3.7,XMUSER,2,XMK,1,"C",XMKZ,XMZ)=""
99 . . D ERR(102,XMUSER,XMK,XMZ) ; Msg in bskt, but no seq #: seq # created
100 . I '$D(^XMB(3.7,"M",XMZ,XMUSER,XMK,XMZ)) S ^(XMZ)="" D ERR(111,XMUSER,XMK,XMZ) ; Msg in bskt, but no M xref: xref created
101 . ;I XMUSER=.5,XMK>999 Q
102 . I $P(XMREC,U,3) D
103 . . I XMK=.5 D Q
104 . . . D ERR(104,XMUSER,XMK,XMZ) ; New msg in WASTE bskt: msg made not new
105 . . . S $P(^XMB(3.7,XMUSER,2,XMK,1,XMZ,0),U,3)=""
106 . . . K ^XMB(3.7,XMUSER,"N0",XMK,XMZ)
107 . . S XMUKNCNT=XMUKNCNT+1
108 . . I '$D(^XMB(3.7,XMUSER,"N0",XMK,XMZ)) S ^(XMZ)="" D ERR(113,XMUSER,XMK,XMZ) ; New msg, but no N0 xref: xref created
109 I '$D(^XMB(3.7,XMUSER,2,XMK,0)) D
110 . S XMKN=$G(XMKNAME(XMK),XMKNAME("?"))
111 . S ^XMB(3.7,XMUSER,2,XMK,0)=XMKN
112 . D ERR(131,XMUSER,XMK) ; No bskt 0 node: created
113 E D
114 . S XMKN=$P(^XMB(3.7,XMUSER,2,XMK,0),U)
115 . I XMKN="" D Q
116 . . S XMKN=$G(XMKNAME(XMK),XMKNAME("?"))
117 . . S $P(^XMB(3.7,XMUSER,2,XMK,0),U)=XMKN
118 . . D ERR(132,XMUSER,XMK) ; Bskt name null: created
119 . Q:XMK>1
120 . Q:'$D(XMKNAME(XMK))
121 . Q:XMKN=XMKNAME(XMK)
122 . N XMKNBAD
123 . S XMKNBAD=XMKN
124 . S XMKN=XMKNAME(XMK)
125 . S $P(^XMB(3.7,XMUSER,2,XMK,0),U)=XMKN
126 . K ^XMB(3.7,XMUSER,2,"B",XMKNBAD,XMK)
127 . D ERR(134,XMUSER,XMK,"",XMKNBAD) ; Bskt name '|1|' wrong: corrected
128 I '$D(^XMB(3.7,XMUSER,2,"B",$E(XMKN,1,30),XMK)) S ^(XMK)="" D ERR(141,XMUSER,XMK) ; Bskt name, but no B xref: xref created
129 S:$P(^XMB(3.7,XMUSER,2,XMK,0),U,2)'=XMUKNCNT $P(^(0),U,2)=XMUKNCNT
130 I $D(^XMB(3.7,XMUSER,2,XMK,1,0)) D
131 . S:$P(^XMB(3.7,XMUSER,2,XMK,1,0),U,4)'=XMUKECNT $P(^(0),U,4)=XMUKECNT
132 E I XMUKECNT D
133 . S ^XMB(3.7,XMUSER,2,XMK,1,0)="^3.702P^"_$O(^XMB(3.7,XMUSER,2,XMK,1,"C"),-1)_U_XMUKECNT
134 . D ERR(133,XMUSER,XMK) ; No msg multiple 0 node: created
135 Q:'$G(XMRESEQ)
136 D RSEQ^XMXBSKT(XMUSER,XMK)
137 D ERR(125,XMUSER,XMK) ; C xref duplicate seq #s: bskt reseq'd
138 Q
139CXREF(XMUSER,XMK,XMRESEQ) ; Check the bskt's C xref (msg seq numbers in bskt)
140 N XMKZ,XMZ,XMCNT
141 S XMKZ=0
142 F S XMKZ=$O(^XMB(3.7,XMUSER,2,XMK,1,"C",XMKZ)) Q:'XMKZ D
143 . S (XMZ,XMCNT)=0
144 . F S XMZ=$O(^XMB(3.7,XMUSER,2,XMK,1,"C",XMKZ,XMZ)) Q:'XMZ D
145 . . S XMCNT=XMCNT+1
146 . . Q:$P($G(^XMB(3.7,XMUSER,2,XMK,1,XMZ,0)),U,2)=XMKZ
147 . . I '$D(^XMB(3.7,XMUSER,2,XMK,1,XMZ,0)) D Q
148 . . . S ^XMB(3.7,XMUSER,2,XMK,1,XMZ,0)=XMZ_U_XMKZ
149 . . . D ERR(122,XMUSER,XMK,XMZ) ; C xref, but msg not in bskt: put in bskt
150 . . I $P(^XMB(3.7,XMUSER,2,XMK,1,XMZ,0),U,2)="" D Q
151 . . . S $P(^XMB(3.7,XMUSER,2,XMK,1,XMZ,0),U,2)=XMKZ
152 . . . D ERR(123,XMUSER,XMK,XMZ) ; C xref, but no msg seq #: set seq # using xref
153 . . K ^XMB(3.7,XMUSER,2,XMK,1,"C",XMKZ,XMZ)
154 . . D ERR(124,XMUSER,XMK,XMZ) ; C xref does not match msg seq #: xref killed
155 . S:XMCNT>1 XMRESEQ=1
156 Q
157N0XREF(XMUSER) ; Check the user's N0 xref (new msgs)
158 N XMK,XMZ
159 S XMK=0
160 F S XMK=$O(^XMB(3.7,XMUSER,"N0",XMK)) Q:'XMK D
161 . S XMZ=0
162 . F S XMZ=$O(^XMB(3.7,XMUSER,"N0",XMK,XMZ)) Q:'XMZ D
163 . . Q:$P($G(^XMB(3.7,XMUSER,2,XMK,1,XMZ,0)),U,3)=1
164 . . I '$D(^XMB(3.7,XMUSER,2,XMK,1,XMZ,0)) D Q
165 . . . S ^XMB(3.7,XMUSER,2,XMK,1,XMZ,0)=XMZ_"^^1"
166 . . . D ERR(126,XMUSER,XMK,XMZ) ; N0 xref, but msg not in bskt: msg put in bskt
167 . . S $P(^XMB(3.7,XMUSER,2,XMK,1,XMZ,0),U,3)=1
168 . . D ERR(127,XMUSER,XMK,XMZ) ; N0 xref, but msg not new: new flag set
169 Q
170BXREF(XMUSER) ; Check the user's B xref (bskt names)
171 N XMK,XMKN
172 S XMKN=""
173 F S XMKN=$O(^XMB(3.7,XMUSER,2,"B",XMKN)) Q:XMKN="" D
174 . S XMK=0
175 . F S XMK=$O(^XMB(3.7,XMUSER,2,"B",XMKN,XMK)) Q:'XMK D
176 . . Q:$E($P($G(^XMB(3.7,XMUSER,2,XMK,0)),U),1,30)=XMKN
177 . . I $D(^XMB(3.7,XMUSER,2,XMK,0)) D Q
178 . . . I $P($G(^XMB(3.7,XMUSER,2,XMK,0)),U)="" D Q
179 . . . . S $P(^XMB(3.7,XMUSER,2,XMK,0),U)=XMKN
180 . . . . D ERR(151,XMUSER,XMK) ; B xref, but bskt name null: name set using xref
181 . . . D ERR(153,XMUSER,XMK) ; B xref does not match bskt name: xref killed
182 . . . K ^XMB(3.7,XMUSER,2,"B",XMKN,XMK)
183 . . S $P(^XMB(3.7,XMUSER,2,XMK,0),U)=XMKN
184 . . D ERR(152,XMUSER,XMK) ; B xref, but no bskt node: node set using xref
185 Q
186ERR(XMERRNUM,XMUSER,XMK,XMZ,XMDPARM) ;
187 S XMERROR(XMERRNUM)=$G(XMERROR(XMERRNUM))+1
188 Q:$D(ZTQUEUED)
189 N XMPARM
190 S XMPARM(1)=XMUSER,XMPARM(2)=XMK,XMPARM(3)=XMERRNUM
191 S XMPARM(4)=$$EZBLD^DIALOG(36000+XMERRNUM,.XMDPARM)
192 ;DUZ=|1|, Bskt=|2|$S($G(XMZ):", Msg=|5|",1:""), Err=|3| |4|
193 I $G(XMZ) S XMPARM(5)=XMZ W !,$$EZBLD^DIALOG(36099,.XMPARM) Q
194 W !,$$EZBLD^DIALOG(36098,.XMPARM)
195 Q
196 ;34009 * No Name *
197 ;37004 WASTE
198 ;37005 IN
199 ;36098 DUZ=|1|, Bskt=|2|, Err=|3| |4|
200 ;36099 DUZ=|1|, Bskt=|2|, Msg=|5|, Err=|3| |4|
201 ;36101 Msg in bskt, but no msg: removed from bskt
202 ;36102 Msg in bskt, but no seq #: seq # created
203 ;36103 Msg in bskt, but no .01 field: .01 field
204 ;36104 New msg in WASTE bskt: msg made not new
205 ;36111 Msg in bskt, but no M xref: xref created
206 ;36112 Msg in bskt, but no C xref: xref created
207 ;36113 New msg, but no N0 xref: xref created
208 ;36122 C xref, but msg not in bskt: put in bskt
209 ;36123 C xref, but no msg seq #: set seq # using
210 ;36124 C xref does not match msg seq #: xref kill
211 ;36125 C xref duplicate seq #s: bskt reseq'd
212 ;36126 N0 xref, but msg not in bskt: msg put in
213 ;36127 N0 xref, but msg not new: new flag set
214 ;36131 No bskt 0 node: created
215 ;36132 Bskt name null: created
216 ;36133 No msg multiple 0 node: created
217 ;36134 Bskt name '|1|' wrong: corrected
218 ;36141 Bskt name, but no B xref: xref created
219 ;36151 B xref, but bskt name null: name set using
220 ;36152 B xref, but no bskt node: node set using
221 ;36153 B xref does not match bskt name: xref kill
Note: See TracBrowser for help on using the repository browser.