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

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

initial load of WorldVistAEHR
File size: 5.3 KB
RevLine 
[613]1XMUT4C ;ISC-SF/GMB-Integrity Checker for file 3.9 ;04/19/2002 13:00
2 ;;8.0;MailMan;;Jun 28, 2002
3 ; Was (WASH ISC)/CAP
4MESSAGE(XMABORT) ;
5 N XMZ,XMCNT,XMZREC,XMCRE8
6 W !!,$$EZBLD^DIALOG(36094),! ; Checking MESSAGE file 3.9
7 F S XMZ=$O(^XMB(3.9,":"),-1) Q:XMZ?1N.N D BOGUS(XMZ)
8 S (XMZ,XMCNT)=0
9 F S XMZ=$O(^XMB(3.9,XMZ)) Q:XMZ'>0 D Q:XMABORT
10 . I XMZ'?1N.N D BOGUS(XMZ) Q
11 . S XMCNT=XMCNT+1 I XMCNT#5000=0 D Q:XMABORT
12 . . I '$D(ZTQUEUED) W:$X>40 ! W XMCNT,"." Q
13 . . I $$S^%ZTLOAD S (XMABORT,ZTSTOP)=1 ; User asked the task to stop
14 . S XMZREC=$G(^XMB(3.9,XMZ,0))
15 . I "^^^^^^^^"[XMZREC D
16 . . D ERR(XMZ,201) ; Msg has bad/no 0 node: not fixed
17 . E D
18 . . D SUBJ(XMZ,XMZREC)
19 . . I $P(XMZREC,U,2)="" D
20 . . . S $P(^XMB(3.9,XMZ,0),U,2)=$$EZBLD^DIALOG(34009) ;* No Name *
21 . . . D ERR(XMZ,206) ; Msg has no sender: fixed
22 . . I $P(XMZREC,U,3)="" D
23 . . . S $P(^XMB(3.9,XMZ,0),U,3)=DT
24 . . . D ERR(XMZ,207) ; Msg has no date/time: fixed
25 . D CRE8DT(XMZ,$P(XMZREC,U,3))
26 . D RESP(XMZ,XMZREC)
27 . D:$D(^XMB(3.9,XMZ,1)) RECIP(XMZ)
28 Q:XMABORT
29 W !!,$$EZBLD^DIALOG(36093,XMCNT) ; |1| messages in the MESSAGE file 3.9
30 I XMCNT=$P(^XMB(3.9,0),U,4) W !,$$EZBLD^DIALOG(36095) Q ; Zero node is OK
31 L +^XMB(3.9,0):1
32 S $P(^XMB(3.9,0),U,4)=XMCNT
33 L -^XMB(3.9,0)
34 W !,$$EZBLD^DIALOG(36096) ; I reset the zero node.
35 Q
36BOGUS(XMZ) ;
37 D ERR(XMZ,210) ; Msg IEN is corrupted: fixed
38 I $L($P($G(^XMB(3.9,XMZ,0)),U,1)) K ^XMB(3.9,"B",$E($P(^XMB(3.9,XMZ,0),U,1),1,30),XMZ)
39 K ^XMB(3.9,"C",+$P($G(^XMB(3.9,XMZ,.6)),U,1),XMZ)
40 K ^XMB(3.9,XMZ)
41 Q
42SUBJ(XMZ,XMZREC) ;
43 N XMSUBJ
44 S XMSUBJ=$P(XMZREC,U)
45 I XMSUBJ="" D
46 . S XMSUBJ=$$EZBLD^DIALOG(34012) ;* No Subject *
47 . S $P(^XMB(3.9,XMZ,0),U,1)=XMSUBJ
48 . S ^XMB(3.9,"B",XMSUBJ,XMZ)=""
49 . D ERR(XMZ,202) ; Msg has no subject: fixed
50 I '$D(^XMB(3.9,"B",$E(XMSUBJ,1,30),XMZ)) D
51 . I $L(XMSUBJ)>30,$D(^XMB(3.9,"B",XMSUBJ,XMZ)) D
52 . . K ^XMB(3.9,"B",XMSUBJ,XMZ)
53 . . D ERR(XMZ,205) ; Subject B xref too long: xref shortened
54 . E D ERR(XMZ,204) ; Subject has no B xref: xref created
55 . S ^XMB(3.9,"B",$E(XMSUBJ,1,30),XMZ)=""
56 I $L(XMSUBJ)<3!($L(XMSUBJ)>65) D
57 . D ERR(XMZ,203) ; Msg subject <3 or >65: fixed
58 . S XMSUBJ=$S($L(XMSUBJ)<3:XMSUBJ_"...",1:$E(XMSUBJ,1,65))
59 . N XMFDA
60 . S XMFDA(3.9,XMZ_",",.01)=XMSUBJ
61 . D FILE^DIE("","XMFDA")
62 Q
63RESP(XMZ,XMZREC) ;
64 N XMZO
65 I $P(XMZREC,U,8) D Q
66 . S XMZO=$P(XMZREC,U,8)
67 . I XMZO=XMZ D Q
68 . . D ERR(XMZ,211) ; Message thinks it's a response to itself: fixed
69 . . S $P(^XMB(3.9,XMZ,0),U,8)=""
70 . I '$D(^XMB(3.9,XMZO,0)) D Q
71 . . D ERR(XMZ,212,XMZO) ; No original message |1| for this response: fixed
72 . . S $P(^XMB(3.9,XMZ,0),U,8)=""
73 . I $$ATTACHED(XMZO,XMZ) Q
74 . D ERR(XMZ,213,XMZO) ; Not in response chain of |1|: fixed
75 . S $P(^XMB(3.9,XMZ,0),U,8)=""
76 N XMSUBJ
77 S XMSUBJ=$P(XMZREC,U)
78 Q:XMSUBJ'?1"R"1.N
79 Q:$P(XMZREC,U,2)["@"
80 S XMZO=+$E(XMSUBJ,2,99)
81 I '$D(^XMB(3.9,XMZO,0)) D Q
82 . D ERR(XMZ,216,XMZO) ; No original message |1| for this response: not fixed
83 I '$$ATTACHED(XMZO,XMZ) D Q
84 . D ERR(XMZ,217,XMZO) ; Not in response chain of |1|: not fixed
85 D ERR(XMZ,218,XMZO) ; Piece 8 didn't point to original message |1|: fixed
86 S $P(^XMB(3.9,XMZ,0),U,8)=XMZO
87 Q
88ATTACHED(XMZO,XMZ) ; Is XMZ in the response chain of XMZO?
89 N I
90 S I=0
91 F S I=$O(^XMB(3.9,XMZO,3,I)) Q:'I Q:$P($G(^(I,0)),U)=XMZ
92 Q +I
93CRE8DT(XMZ,XMDATE) ;
94 S XMCRE8=$P($G(^XMB(3.9,XMZ,.6)),U,1)
95 I 'XMCRE8 D Q
96 . I $P(XMDATE,".",1)?7N S XMDATE=$P(XMDATE,".",1)
97 . E I XMDATE="" S XMDATE=DT
98 . E D
99 . . S XMDATE=$$CONVERT^XMXUTIL1(XMDATE)
100 . . S:XMDATE=-1 XMDATE=DT
101 . S $P(^XMB(3.9,XMZ,.6),U,1)=XMDATE
102 . S ^XMB(3.9,"C",XMDATE,XMZ)=""
103 . D ERR(XMZ,208) ; Msg has no local create date: fixed
104 I '$D(^XMB(3.9,"C",XMCRE8,XMZ)) D
105 . S ^XMB(3.9,"C",XMCRE8,XMZ)=""
106 . D ERR(XMZ,209) ; Local create date C xref missing: fixed
107 Q
108RECIP(XMZ) ; Check recipient multiple
109 N I,XMVAL,XMXREF,XMRECIPS
110 D CXREF(XMZ)
111 S (I,XMRECIPS)=0
112 F S I=$O(^XMB(3.9,XMZ,1,I)) Q:'I D
113 . S XMVAL=$P($G(^XMB(3.9,XMZ,1,I,0)),U)
114 . I XMVAL="" D Q
115 . . Q:$P(^XMB(3.9,XMZ,.6),U,1)=DT
116 . . K ^XMB(3.9,XMZ,1,I)
117 . . D ERR(XMZ,221,I) ; Recipient |1| null, no C xref: fixed
118 . S XMRECIPS=XMRECIPS+1
119 . Q:$D(^XMB(3.9,XMZ,1,"C",$E(XMVAL,1,30),I))
120 . I $L(XMVAL)>30,$D(^XMB(3.9,XMZ,1,"C",XMVAL,I)) D Q
121 . . ;K ^XMB(3.9,XMZ,1,"C",XMVAL,I)
122 . . ;D ERR(XMZ,223,I) ; Recipient |1| C xref too long: xref shortened
123 . . ;S ^XMB(3.9,XMZ,1,"C",$E(XMVAL,1,30),I)=""
124 . D ERR(XMZ,222,I) ; Recipient |1| no C xref: xref created
125 . S ^XMB(3.9,XMZ,1,"C",$E(XMVAL,1,30),I)=""
126 I $D(^XMB(3.9,XMZ,1,0)) S:$P(^XMB(3.9,XMZ,1,0),U,4)'=XMRECIPS $P(^(0),U,4)=XMRECIPS Q
127 S ^XMB(3.9,XMZ,1,0)="^3.91A^"_I_U_XMRECIPS
128 Q
129CXREF(XMZ) ; Check C xref for Recipient multiple
130 N I,XMVAL,XMXREF
131 S (I,XMXREF)=""
132 F S XMXREF=$O(^XMB(3.9,XMZ,1,"C",XMXREF)) Q:XMXREF="" D
133 . F S I=$O(^XMB(3.9,XMZ,1,"C",XMXREF,I)) Q:'I D
134 . . S XMVAL=$P($G(^XMB(3.9,XMZ,1,I,0)),U)
135 . . Q:$E(XMVAL,1,30)=$E(XMXREF,1,30)
136 . . I XMVAL="" D Q
137 . . . S $P(^XMB(3.9,XMZ,1,I,0),U)=XMXREF
138 . . . I $L(XMXREF)<30 D ERR(XMZ,231,I) Q ; C xref, but recip |1| null: fixed using xref
139 . . . D ERR(XMZ,232,I) ; C xref, but recip |1| null: fixed, but CHECK
140 . . K ^XMB(3.9,XMZ,1,"C",XMXREF,I)
141 . . D ERR(XMZ,233,I) ; C xref for recip |1| doesn't match recip: xref killed
142 Q
143ERR(XMZ,XMERRNUM,XMDPARM) ;
144 N XMPARM
145 S XMERROR(XMERRNUM)=$G(XMERROR(XMERRNUM))+1
146 S XMPARM(1)=XMZ,XMPARM(2)=$J(XMERRNUM,3)
147 S XMPARM(3)=$$EZBLD^DIALOG(36300+XMERRNUM,.XMDPARM)
148 W !,$$EZBLD^DIALOG(36097,.XMPARM) ;Msg=|1|, Err=|2| |3|
149 Q
Note: See TracBrowser for help on using the repository browser.