source: WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DDUCHK4.m@ 634

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

initial load of WorldVistAEHR
File size: 6.6 KB
Line 
1DDUCHK4 ;SFISC/MKO-CHECK INDEXES ON FILE ;6:36 AM 28 Dec 2004
2 ;;22.0;VA FileMan;*130*;Mar 30, 1999
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5INDEX(DDUCFI,DDUCFIX) ;Check and optionally fix structure of Index file entry
6 N DDUCIX
7 Q:'$G(DDUCFI) S DDUCFIX=$G(DDUCFIX)
8 ;
9 ;Loop through "B" index to find INDEXes that reside on this file
10 D WCHK
11 S DDUCIX=""
12 F S DDUCIX=$O(^DD("IX","B",DDUCFI,DDUCIX)) Q:DDUCIX="" D CHKIX
13 ;
14 ;Check "AC","BB", and "F" indexes
15 D CHKAC,CHKBB,CHKF
16 Q
17 ;
18CHKIX ;Check Index DDUCIX found in "B" index
19 ;In:
20 ; DDUCIX = index #
21 ; DDUCFI = file #
22 ; DDUCFIX = flag to fix
23 N DDUCIX0,DDUCIXID,DDUCNM,DDUCRF,DDUCRV
24 S DDUCIXID=$$IXID(DDUCIX,"")
25 ;
26 ;Check that Index exists
27 I '$D(^DD("IX",DDUCIX)) D Q
28 . D WNOIX
29 . D:DDUCFIX KILL($NA(^DD("IX","B",DDUCFI,DDUCIX)))
30 ;
31 ;Check that index has a FILE
32 S DDUCIX0=$G(^DD("IX",DDUCIX,0))
33 I $P(DDUCIX0,U)="" D
34 . D WMS("FILE (#.01) for "_DDUCIXID)
35 . D:DDUCFIX FFILE
36 ;
37 ;Get Name
38 S DDUCNM=$P(DDUCIX0,U,2)
39 I DDUCNM]"" S DDUCIXID=$$IXID(DDUCIX,DDUCNM)
40 E D WMS("NAME for "_DDUCIXID)
41 ;
42 ;Check Root File not null, and "AC" index exists
43 S DDUCRF=$P(DDUCIX0,U,9)
44 I 'DDUCRF D
45 . D WMS("ROOT FILE for "_DDUCIXID)
46 . D:DDUCFIX FRF
47 ;
48 ;Check Cross-Reference Values multiple
49 S DDUCRV=0
50 F S DDUCRV=$O(^DD("IX",DDUCIX,11.1,DDUCRV)) Q:'DDUCRV D CRV
51 ;
52 ;Reindex Index file entry
53 I DDUCFIX D
54 . N DIC,DIK,DA,X
55 . S DIK="^DD(""IX"",",DA=DDUCIX
56 . D IX^DIK
57 Q
58 ;
59CRV ;Check a Cross-Reference Value
60 ;In:
61 ; DDUCIX = Index #
62 ; DDUCRV = CRV #
63 ; DDUCFIX = Flag to fix
64 ; DDUCRF = Root file #
65 ; DDUCIXID = String that identifies Index
66 N DDUCFIL,DDUCFLD,DDUCGL,DDUCOID,DDUCORD,DDUCRV0
67 ;
68 S DDUCRV0=$G(^DD("IX",DDUCIX,11.1,DDUCRV,0))
69 Q:$P(DDUCRV0,U,2)="C"
70 S DDUCORD=$P(DDUCRV0,U),DDUCFIL=$P(DDUCRV0,U,3),DDUCFLD=$P(DDUCRV0,U,4)
71 ;
72 ;Check .01 of CRV
73 I DDUCORD="" D
74 . D WMS("ORDER NUMBER of Cross-Reference Value #"_DDUCRV_" of "_DDUCIXID)
75 . D:DDUCFIX FON
76 S DDUCOID=$$OID(DDUCORD,"","",DDUCIXID)
77 ;
78 ;Make sure FILE is not null
79 I 'DDUCFIL D
80 . D WMS("FILE for "_DDUCOID,1)
81 ;
82 ;If there's a File, make sure it is equal to Root File
83 ;and that referenced field exists.
84 E D
85 . D:DDUCFIL'=DDUCRF WNE
86 . D:$D(^DD(DDUCFIL,DDUCFLD,0))[0 WFMS
87 . I $D(^DD("IX","F",DDUCFIL,DDUCFLD,DDUCIX,DDUCRV))[0 S DDUCGL=$NA(^(DDUCRV)) D
88 .. D WMS(DDUCGL)
89 .. D:DDUCFIX SET(DDUCGL)
90 Q
91 ;
92CHKAC ;Check "AC index (In: DDUCFI = file; DDUCFIX = flag to fix)
93 N DDUCGL,DDUCIX
94 S DDUCIX=0 F S DDUCIX=$O(^DD("IX","AC",DDUCFI,DDUCIX)) Q:'DDUCIX D
95 . I $P($G(^DD("IX",DDUCIX,0)),U,9)]"",$P(^(0),U,9)'=DDUCFI D
96 .. S DDUCGL=$NA(^DD("IX","AC",DDUCFI,DDUCIX))
97 .. D WEN(DDUCGL)
98 .. D:DDUCFIX KILL(DDUCGL)
99 Q
100 ;
101CHKBB ;Check "BB" index (In: DDUCFI = file; DDUCFIX = flag to fix)
102 N DDUCGL,DDUCIX,DDUCIX0,DDUCIXID,DDUCNM,DDUCNML
103 S DDUCNM=""
104 F S DDUCNM=$O(^DD("IX","BB",DDUCFI,DDUCNM)) Q:DDUCNM="" D
105 . S DDUCIX=0
106 . F DDUCIX=$O(^DD("IX","BB",DDUCFI,DDUCNM,DDUCIX)) Q:'DDUCIX D
107 .. S DDUCIX0=$G(^DD("IX",DDUCIX,0))
108 .. I $D(^DD("IX",DDUCIX)),$P(DDUCIX0,U,2)="" S DDUCNML(DDUCIX,DDUCNM)=""
109 .. E I $P(DDUCIX0,U)'=DDUCFI!($P(DDUCIX0,U,2)'=DDUCNM) D
110 ... S DDUCGL=$NA(^DD("IX","BB",DDUCFI,DDUCNM,DDUCIX))
111 ... D WEN(DDUCGL)
112 ... D:DDUCFIX KILL(DDUCGL)
113 ;
114 ;If any of the Indexes have null Names, check whether a single name
115 ;for it was found in the "BB" index.
116 I $D(DDUCNML) S DDUCIX=0 F S DDUCIX=$O(DDUCNML(DDUCIX)) Q:'DDUCIX D
117 . S DDUCNM=$O(DDUCNML(DDUCIX,""))
118 . I $O(DDUCNML(DDUCIX,DDUCNM))="" D
119 .. S DDUCIXID=$$IXID(DDUCIX,"")
120 .. D WNM
121 .. D:DDUCFIX FNM
122 . E F D S DDUCNM=$O(DDUCNML(DDUCIX,DDUCNM)) Q:DDUCNM=""
123 .. S DDUCGL=$NA(^DD("IX","BB",DDUCFI,DDUCNM,DDUCIX))
124 .. D WEN(DDUCGL)
125 .. D:DDUCFIX KILL(DDUCGL)
126 Q
127 ;
128CHKF ;Check "F" index (In: DDUCFI = file; DDUCFIX = flag to fix)
129 N DDUCFLD,DDUCGL,DDUCIX,DDUCRV
130 S DDUCFLD=0
131 F S DDUCFLD=$O(^DD("IX","F",DDUCFI,DDUCFLD)) Q:'DDUCFLD D
132 . S DDUCIX=0
133 . F S DDUCIX=$O(^DD("IX","F",DDUCFI,DDUCFLD,DDUCIX)) Q:'DDUCIX D
134 .. S DDUCRV=0
135 .. F S DDUCRV=$O(^DD("IX","F",DDUCFI,DDUCFLD,DDUCIX,DDUCRV)) Q:'DDUCRV D
136 ... I $P($G(^DD("IX",DDUCIX,11.1,DDUCRV,0)),U,3)'=DDUCFI!($P($G(^(0)),U,4)'=DDUCFLD) D
137 .... S DDUCGL=$NA(^DD("IX","F",DDUCFI,DDUCFLD,DDUCIX,DDUCRV))
138 .... D WEN(DDUCGL)
139 .... D:DDUCFIX KILL(DDUCGL)
140 Q
141 ;
142 ;---------------
143FFILE ;Set the .01 of index to DDUCFI
144 S $P(^DD("IX",DDUCIX,0),U)=DDUCFI
145 D WRITE("FILE (#.01) for "_DDUCIXID_" set to "_DDUCFI_".",10)
146 Q
147 ;
148FRF ;Set Root File equal to File and Root Type to 'INDEX FILE'
149 S $P(^DD("IX",DDUCIX,0),U,8)="I"
150 S $P(^DD("IX",DDUCIX,0),U,9)=DDUCFI
151 S DDUCRF=DDUCFI
152 D WRITE("ROOT FILE for "_DDUCIXID_" set to "_DDUCFI_".",10)
153 D WRITE("ROOT TYPE for "_DDUCIXID_" set to 'INDEX FILE'.",10)
154 Q
155 ;
156FON ;Determine Order Number
157 N DDUCI,DDUCO
158 ;
159 ;Look for Order Number in "B" index
160 S DDUCORD=0
161 F S DDUCORD=$O(^DD("IX",DDUCIX,11.1,"B",DDUCORD)) Q:'DDUCORD Q:$O(^DD("IX",DDUCIX,11.1,"B",DDUCORD,0))=DDUCRV
162 ;
163 ;If not found, just pick an unused Order Number
164 I 'DDUCORD D
165 . S DDUCI=0
166 . F S DDUCI=$O(^DD("IX",DDUCIX,11.1,DDUCI)) Q:'DDUCI S:$P($G(^(DDUCI,0)),U)]"" DDUCO($P(^(0),U))=""
167 . S DDUCORD=$O(DDUCO(""),-1)
168 . S:'DDUCORD DDUCORD=1
169 ;
170 S $P(^DD("IX",DDUCIX,11.1,DDUCRV,0),U)=DDUCORD
171 D WRITE("ORDER NUMBER for Cross-Reference Value #"_DDUCRV_" of "_DDUCIXID_" set to "_DDUCORD_".",10)
172 Q
173 ;
174FNM ;Set the NAME for the Index
175 S $P(^DD("IX",DDUCIX,0),U,2)=DDUCNM
176 D WRITE("NAME for "_DDUCIXID_" set to '"_DDUCNM_"'.",10)
177 Q
178 ;
179KILL(GL) ;Kill a global and print a message
180 Q:'$D(@GL)
181 K @GL
182 W !?10,GL_" was killed."
183 Q
184 ;
185SET(GL,VAL) ;Set a global and print a message
186 Q:$D(@GL)
187 S VAL=$G(VAL),@GL=VAL
188 W !?10,GL_" was set"_$S(VAL]"":" to "_VAL,1:"")_"."
189 Q
190 ;
191 ;Write messages
192WCHK Q ;D WRITE("Checking Indexes.",5) Q
193WNOIX D WRITE(DDUCIXID_" does not exist.",7) Q
194WMS(S,N) D WRITE("*"_S_" is missing."_$S($G(N):" ",1:""),7) Q
195WNE D WRITE("*FILE does not equal ROOT FILE in "_DDUCOID_".",7) Q ;22*130
196WFMS D WRITE("*File/Sub-file #"_$S($G(FIL)'="":FIL,1:DDUCFIL)_", Field #"_$S($G(FLD)'="":FLD,1:DDUCFLD)_" referenced in "_DDUCOID_" is missing.",7) Q ;22*130
197WEN(GL) D WRITE("Erroneous node "_GL_" is set.",7) Q
198WNM D WRITE("NAME for "_DDUCIXID_" looks like it should be '"_DDUCNM_"'.",7) Q
199 ;
200WRITE(TXT,TAB) ;Write text, wrap at word boundaries.
201 N I
202 D WRAP^DIKCU2(.TXT,-TAB-2,-TAB)
203 W !?TAB,$G(TXT,$G(TXT(0))) F I=1:1 Q:'$D(TXT(I)) W !?TAB+2,TXT(I)
204 Q
205 ;
206IXID(IX,NM) ;Return string that identifies an Index
207 S:'$D(NM) NM=$P($G(^DD("IX",IX,0)),U,2)
208 Q $S(NM]"":"'"_NM_"' Index (#"_IX_")",1:"Index #"_IX)
209 ;
210OID(ORD,IX,NM,IXID) ;Return string that identifies Cross-Reference Value
211 I '$D(IXID),$G(IX) S IXID=$S($D(NM)#2:$$IXID(IX,NM),1:$$IXID(IX))
212 Q "Order #"_ORD_" of "_$S($G(IXID)]"":IXID,1:"")
Note: See TracBrowser for help on using the repository browser.