source: IHS-VA_UTILITIES-XB/trunk/XBCDIC3.m@ 808

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

Modified directory structure; moved routines.
File size: 4.9 KB
Line 
1XBCDIC3 ; IHS/ADC/GTH - CHECK ^DD ; [ 02/07/97 3:02 PM ]
2 ;;4.0;XB;;Jul 20, 2009;Build 2
3 ;
4 ; Part of XBCDIC
5 ;
6START ;
7 W !!,"Now checking ^DD entries."
8 S U="^",XBCDFILE=""
9 F XBCDL=0:0 S XBCDFILE=$O(^UTILITY("XBDSET",$J,XBCDFILE)) Q:XBCDFILE="" W !?5,"Checking ",XBCDFILE D XBCDDDC
10 KILL XBCDANS,XBCDFILE,XBCDL
11 Q
12 ;
13XBCDDDC ; CHECK ^DD ENTRY
14 D CHKDD0 ; CHECK ^DD 0TH NODE
15 D CHKPT ; CHECK "PT" NODE
16 D CHKTRB ; CHECK "TRB" NODE
17 D CHKACOMP ; CHECK "ACOMP" NODE
18 D SBTRACE ; CHECK "SB" NODE
19 Q
20 ;
21CHKDD0 ; CHECK 0TH NODE
22 I '($D(^DD(XBCDFILE,.01,0))#2) W !,"File ",XBCDFILE," has no ^DD(",XBCDFILE,",.01,0) entry."
23 I '$D(^DD(XBCDFILE,0,"NM")) W !,"File ",XBCDFILE," has no ^DD(",XBCDFILE,",0,""NM"") entry."
24 E S XBCDX=$O(^DD(XBCDFILE,0,"NM","")),XBCDX=$O(^(XBCDX)) I XBCDX]"" W !,"File ",XBCDFILE," has multiple names."
25 Q
26 ;
27CHKPT ; CHECK "PT" NODE
28 S XBCDPFLE=""
29 F XBCDL=0:0 S XBCDPFLE=$O(^DD(XBCDFILE,0,"PT",XBCDPFLE)) Q:XBCDPFLE="" S XBCDPFLD="" F XBCDL=0:0 S XBCDPFLD=$O(^DD(XBCDFILE,0,"PT",XBCDPFLE,XBCDPFLD)) Q:XBCDPFLD="" D PT
30 KILL XBCDPFLE,XBCDPFLD,XBCDX
31 Q
32PT ;
33 W "."
34 I '$D(^DD(XBCDPFLE)) W "|" KILL ^DD(XBCDFILE,0,"PT",XBCDPFLE) Q
35 I '$D(^DD(XBCDPFLE,XBCDPFLD)) W "|" KILL ^DD(XBCDFILE,0,"PT",XBCDPFLE,XBCDPFLD) Q
36 S XBCDX=$P(^DD(XBCDPFLE,XBCDPFLD,0),U,2)
37 I XBCDX["V",$D(^DD(XBCDPFLE,XBCDPFLD,"V","B",XBCDFILE)) Q
38 I XBCDX["P",XBCDX[XBCDFILE Q
39 W "|" KILL ^DD(XBCDFILE,0,"PT",XBCDPFLE,XBCDPFLD)
40 Q
41 ;
42CHKTRB ; CHECK "TRB" NODE
43 Q:'$D(^DD(XBCDFILE,"TRB"))
44 S XBCDTFLE=""
45 F XBCDL=0:0 S XBCDTFLE=$O(^DD(XBCDFILE,"TRB",XBCDTFLE)) Q:XBCDTFLE="" S XBCDTFLD="" F XBCDL=0:0 S XBCDTFLD=$O(^DD(XBCDFILE,"TRB",XBCDTFLE,XBCDTFLD)) Q:XBCDTFLD="" D TRB
46 KILL XBCDTFLE,XBCDTFLD,XBCDX
47 Q
48 ;
49TRB ; THIS CAN CHECK MORE THAN IT DOES ***
50 W "."
51 I '$D(^DD(XBCDTFLE)) W "|" KILL ^DD(XBCDFILE,"TRB",XBCDTFLE) Q
52 I '$D(^DD(XBCDTFLE,XBCDTFLD)) W "|" KILL ^DD(XBCDFILE,"TRB",XBCDTFLE,XBCDTFLD) Q
53 Q
54 ;
55CHKACOMP ; CHECK "ACOMP" ENTRIES
56 Q:'$D(^DD("ACOMP",XBCDFILE))
57 S XBCDFLD=""
58 F XBCDL=0:0 S XBCDFLD=$O(^DD("ACOMP",XBCDFILE,XBCDFLD)) Q:XBCDFLD'=+XBCDFLD D CHKFIELD
59 KILL XBCDFLD
60 Q
61 ;
62CHKFIELD ;
63 S XBCDAFLE=""
64 F XBCDL=0:0 S XBCDAFLE=$O(^DD("ACOMP",XBCDFILE,XBCDFLD,XBCDAFLE)) Q:XBCDAFLE="" S XBCDAFLD="" F XBCDL=0:0 S XBCDAFLD=$O(^DD("ACOMP",XBCDFILE,XBCDFLD,XBCDAFLE,XBCDAFLD)) Q:XBCDAFLD="" D ACOMP
65 KILL XBCDAFLE,XBCDAFLD,XBCDX
66 Q
67 ;
68ACOMP ;
69 W "."
70 I '$D(^DD(XBCDAFLE)) W "|" KILL ^DD("ACOMP",XBCDFILE,XBCDFLD,XBCDAFLE) Q
71 I '$D(^DD(XBCDAFLE,XBCDAFLD)) W "|" KILL ^DD("ACOMP",XBCDFILE,XBCDFLD,XBCDAFLE,XBCDAFLD) Q
72 I '($D(^DD(XBCDAFLE,XBCDAFLD,0))#2) W "|" KILL ^DD("ACOMP",XBCDFILE,XBCDFLD,XBCDAFLE,XBCDAFLD) Q
73 S XBCDX=$P(^DD(XBCDAFLE,XBCDAFLD,0),U,2)
74 I XBCDX'["C" W "|" KILL ^DD("ACOMP",XBCDFILE,XBCDFLD,XBCDAFLE,XBCDAFLD)
75 Q
76 ;
77SBTRACE ; CHECK ALL SUB-FILES
78 KILL XBCDSFL
79 S XBCDC=1,XBCDSFL="",XBCDSFL(XBCDC)=XBCDFILE
80 F XBCDL=0:0 S XBCDI=$O(XBCDSFL("")) Q:XBCDI="" S XBCDSF=XBCDSFL(XBCDI) D SBTRACE2 S XBCDI=$O(XBCDSFL("")) W "." KILL XBCDSFL(XBCDI)
81 KILL XBCDC,XBCDI,XBCDSF,XBCDSFL,XBCDY,XBCDZ
82 Q
83 ;
84SBTRACE2 ;
85 S XBCDI=0
86 F XBCDL=0:0 S XBCDI=$O(^DD(XBCDSF,"SB",XBCDI)) Q:XBCDI="" W "." S XBCDC=XBCDC+1,XBCDSFL(XBCDC)=XBCDI D SBCHECK
87 Q
88 ;
89SBCHECK ;
90 I '$D(^DD(XBCDI)) S X=$O(^DD(XBCDSF,"SB",XBCDI,0)),Y=$P(^DD(XBCDSF,X,0),U) D Q
91 . W !?10,"Subfile ",XBCDI," for field ",X," does not exists.",!?12,"Deleting field ",X," from file ",XBCDSF
92 . KILL ^DD(XBCDSF,X),^DD(XBCDSF,"SB",XBCDI),^DD(XBCDSF,"B",Y,X)
93 . Q
94 D SBTRACE3,SBTRACE4
95 Q
96 ;
97SBTRACE3 ;
98 I '$D(^DD(XBCDI,0,"UP")),$D(^DIC(XBCDI)) W !?10,XBCDI," is a primary file. Deleting ^DD(",XBCDSF,",""SB"",",XBCDI,")" KILL ^DD(XBCDSF,"SB",XBCDI) Q
99 I $D(^DD(XBCDI,0,"PT")) W !?10,XBCDI," sub-file has ""PT"" node. Deleting." KILL ^DD(XBCDI,0,"PT")
100 I '$D(^DD(XBCDI,0,"UP")) W !?10,XBCDI," has no ""UP"" node. Creating ^DD(",XBCDI,",0,""UP"")=",XBCDSF S ^DD(XBCDI,0,"UP")=XBCDSF
101 Q:^DD(XBCDI,0,"UP")=XBCDSF
102 I ^DD(XBCDI,0,"UP")="" W !?10,XBCDI," ""UP"" node is NULL. Setting ^DD(",XBCDI,",0,""UP"")=",XBCDSF S ^DD(XBCDI,0,"UP")=XBCDSF Q
103 W !?10,XBCDSF," lists ",XBCDI," as a sub-file. The ""UP"" node in ",!?10+$L(XBCDSF)+1,XBCDI," is ",^DD(XBCDI,0,"UP"),"."
104 I $D(^DD(^DD(XBCDI,0,"UP"),"SB",XBCDSF)) W !?12,"The ""SB"" in ",^DD(XBCDI,0,"UP")," agrees. Fixing." KILL ^DD(XBCDSF,"SB",XBCDI) Q
105 E W !?12,"The ""SB"" in ",^DD(XBCDI,0,"UP")," disagrees. Fixing." S ^DD(XBCDI,0,"UP")=XBCDSF
106 Q
107 ;
108SBTRACE4 ;
109 I '$D(^DD(XBCDI,0,"NM")) W !?10,"Sub-file ",XBCDI," has no ^DD(",XBCDI,",0,""NM"") entry. Fixing." D SBTFIX I 1
110 E S XBCDX=$O(^DD(XBCDI,0,"NM","")),XBCDX=$O(^(XBCDX)) I XBCDX]"" W !?10,"Sub-file ",XBCDI," has multiple names. Fixing." D SBTFIX
111 Q
112 ;
113SBTFIX ; FIX "NM"
114 KILL ^DD(XBCDI,0,"NM")
115 I '$D(^DD(XBCDI,0,"UP")) W !?12,"Can't fix. No ""UP"" node." Q
116 S XBCDX=^DD(XBCDI,0,"UP")
117 I XBCDX="" W !?12,"Can't fix. ""UP"" node is NULL." Q
118 I '$D(^DD(XBCDX,"SB",XBCDI)) W !?12,"Can't fix because can't locate parent field." Q
119 S XBCDY=$O(^DD(XBCDX,"SB",XBCDI,"")),XBCDZ=$P(^DD(XBCDX,XBCDY,0),U,1)
120 S ^DD(XBCDI,0,"NM",XBCDZ)=""
121 Q
122 ;
Note: See TracBrowser for help on using the repository browser.