source: IHS-VA_UTILITIES-XB/XBCFXREF.m@ 641

Last change on this file since 641 was 641, checked in by Sam Habiel, 15 years ago

Initial commit of XB, move away from sf.net.
Includes kids file and documentation.
File size: 4.4 KB
Line 
1XBCFXREF ; IHS/ADC/GTH - CHECK/FIX XREFS ; [ 02/07/97 3:02 PM ]
2 ;;4.0;XB;;Jul 20, 2009;Build 2
3 ;
4 ; This routine checks all REGULAR xrefs at the file level
5 ; for selected files to insure all pointed to entries exist.
6 ;
7START ;
8 D INIT
9 I XBCFXREF("QFLG") D EOJ Q
10 D FILES
11 D EOJ
12 Q
13 ;
14INIT ;
15 S XBCFXREF("QFLG")=0
16 D ^XBKVAR
17 W !,"This routine will check the xrefs for the files you select and display",!," all errors found. You may also delete the bad xrefs."
18 W !!,"You should probably capture the output to an aux printer."
19 S XBCFXREF("DF")=$$DIR^XBDIR("S^1:DISPLAY ONLY;2:DISPLAY & FIX","","1")
20 I $D(DIRUT) S XBCFXREF("QFLG")=1 Q
21 D ^XBDSET
22 I '$D(^UTILITY("XBDSET")) S XBCFXREF("QFLG")=1 Q
23 Q
24 ;
25FILES ; CHECK FILES
26 S XBCFXREF("C")=0
27 F XBCFXREF("FILE")=0:0 S XBCFXREF("FILE")=$O(^UTILITY("XBDSET",$J,XBCFXREF("FILE"))) Q:XBCFXREF("FILE")="" D FILE
28 Q
29 ;
30 ;---------------------------------------------------------------------
31 ; Gather up xrefs to check
32 ;
33FILE ; CHECK ONE FILE
34 W !!,"Checking the ",$P(^DIC(XBCFXREF("FILE"),0),U,1)," (",XBCFXREF("FILE"),") file"
35 KILL XBCFXREF("TBL")
36 S XBCFXREF("XREF")=""
37 F S XBCFXREF("XREF")=$O(^DD(XBCFXREF("FILE"),0,"IX",XBCFXREF("XREF"))) Q:XBCFXREF("XREF")="" S XBCFXREF("XREF FILE")=$O(^(XBCFXREF("XREF"),0)),XBCFXREF("XREF FIELD")=$O(^(XBCFXREF("XREF FILE"),0)) D
38 . S XBCFXREF("TBL",XBCFXREF("XREF FILE"),XBCFXREF("XREF FIELD"),XBCFXREF("XREF"))=""
39 .Q
40 I $D(XBCFXREF("TBL")) D XREFILE KILL XBCFXREF("TBL")
41 I $D(XBCFXREF("TBL2")) D CHECK KILL XBCFXREF("TBL2")
42 Q
43 ;
44XREFILE ; CHECK EACH FILE/FIELD CREATING XREFS
45 F XBCFXREF("XREF FILE")=0:0 S XBCFXREF("XREF FILE")=$O(XBCFXREF("TBL",XBCFXREF("XREF FILE"))) Q:XBCFXREF("XREF FILE")="" D D XREFIELD
46 . S XBCFXREF("TOP DA")=0,XBCFXREF("PARENT")=""
47 . Q:'$D(^DD(XBCFXREF("XREF FILE"),0,"UP")) ; quit if not subfile
48 . NEW SUBFILE,PARENT,FIELD,LVL
49 . S SUBFILE=XBCFXREF("XREF FILE"),PARENT="",LVL=1
50 . D BACKUP
51 . S XBCFXREF("TOP DA")=LVL,XBCFXREF("PARENT")=PARENT
52 . Q
53 Q
54 ;
55BACKUP ; BACKUP TREE (CALLED RECURSIVELY)
56 S PARENT=^DD(SUBFILE,0,"UP")
57 S FIELD=$O(^DD(PARENT,"SB",SUBFILE,""))
58 I $D(^DD(PARENT,0,"UP")) S SUBFILE=PARENT,LVL=LVL+1 D BACKUP ; Recurse
59 Q
60 ;
61XREFIELD ; CHECK EACH FIELD CREATING XREFS
62 F XBCFXREF("XREF FIELD")=0:0 S XBCFXREF("XREF FIELD")=$O(XBCFXREF("TBL",XBCFXREF("XREF FILE"),XBCFXREF("XREF FIELD"))) Q:XBCFXREF("XREF FIELD")="" D XREF
63 Q
64 ;
65XREF ; CHECK XREFS ON FIELD
66 NEW G,L,S,X,Y
67 KILL XBCFXRT,XBCFXREF("XREFS")
68 D ^XBGXREFS(XBCFXREF("XREF FILE"),XBCFXREF("XREF FIELD"),.XBCFXRT)
69 F XBCFXREF("XN")=0:0 S XBCFXREF("XN")=$O(XBCFXRT(XBCFXREF("XREF FIELD"),XBCFXREF("XN"))) Q:XBCFXREF("XN")="" S X=XBCFXRT(XBCFXREF("XREF FIELD"),XBCFXREF("XN")) D
70 . Q:$P(X,U,2)="" ; must be trigger
71 . Q:$P(X,U,3)]"" ; not REGULAR xref
72 . Q:'$D(XBCFXREF("TBL",XBCFXREF("XREF FILE"),XBCFXREF("XREF FIELD"),$P(X,U,2))) ; not of interest
73 . Q:'$D(XBCFXRT(XBCFXREF("XREF FIELD"),XBCFXREF("XN"),"S")) ; no set
74 . S Y=XBCFXRT(XBCFXREF("XREF FIELD"),XBCFXREF("XN"),"S")
75 . I '$F(Y,",DA"),'$F(Y,",D0") D Q
76 .. W !?2,$P(X,U,2)," doesn't use DA or D0. Skipping."
77 .. Q
78 . I $F(Y,",D0)=") D SAVE Q
79 . I XBCFXREF("PARENT")="",$F(Y,",DA)=") D SAVE Q
80 . I XBCFXREF("PARENT")]"" S S=",DA("_XBCFXREF("TOP DA")_"))=" I $F(Y,S) D SAVE Q
81 . Q
82 KILL XBCFXRT
83 Q
84 ;
85SAVE ; SAVE XREF TO CHECK
86 S XBCFXREF("C")=XBCFXREF("C")+1
87 S XBCFXREF("TBL2",XBCFXREF("C"))=$P(X,U,2) ; save it
88 Q
89 ;
90 ;---------------------------------------------------------------------
91 ; Check data global for xrefs previously gathered
92 ;
93CHECK ; CHECK DATA GLOBAL FOR XREFS
94 W !!," Checking the following xrefs:"
95 NEW I
96 F I=0:0 S I=$O(XBCFXREF("TBL2",I)) Q:I="" W:$X>73 ! W " ",XBCFXREF("TBL2",I)
97 F XBCFXREF("C")=0:0 S XBCFXREF("C")=$O(XBCFXREF("TBL2",XBCFXREF("C"))) Q:XBCFXREF("C")="" S XBCFXREF("XREF")=XBCFXREF("TBL2",XBCFXREF("C")) D CHKXREF
98 Q
99 ;
100CHKXREF ; CHECK ONE XREF
101 W !!," Checking the """,XBCFXREF("XREF"),""" xref."
102 NEW G,L,R,V,X,Y
103 S X=XBCFXREF("XREF")
104 S G=^DIC(XBCFXREF("FILE"),0,"GL"),R=G_""""_X_""",",X=$E(R,1,$L(R)-1)_")",L=$L(R)
105 F S X=$Q(@X) Q:$E(X,1,L)'=R D
106 . Q:@X ; quit if mnemonic xref
107 . S Y=+$P(X,",",$L(X,","))
108 . Q:$D(@(G_Y_",0)"))
109 . W !?4,$$MSMZR^ZIBNSSV," does not exist.",!?6,"XREF node=",X
110 . I XBCFXREF("DF")=2 KILL @X W " deleted."
111 .Q
112 Q
113 ;
114 ;---------------------------------------------------------------------
115EOJ ;
116 KILL ^UTILITY("XBDSET",$J)
117 KILL XBCFXREF,XBCFXRT
118 KILL DIRUT,DUOUT,DTOUT
119 W !!,"All done",!
120 Q
121 ;
Note: See TracBrowser for help on using the repository browser.