source: IHS-VA_UTILITIES-XB/trunk/XBFCMP.m@ 1250

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

Modified directory structure; moved routines.
File size: 4.4 KB
RevLine 
[641]1XBFCMP ; IHS/ADC/GTH - COMPARES FILEMAN FILES IN TWO UCIs ; [ 10/29/2002 7:42 AM ]
2 ;;4.0;XB;;Jul 20, 2009;Build 2
3 ; XB*3*9 IHS/SET/GTH XB*3*9 10/29/2002 Cache' mods.
4 ;
5 ; Ignores the following:
6 ; ^DD(file,0,"PT",
7 ; ^DD(file,field,1,0)
8 ; ^DD(file,field,21
9 ; ^DD(file,field,"DT"
10 ;
11 ; If a field does not exist in one file, a message is
12 ; displayed and all sub-nodes of that field are ignored.
13 ;
14 ; If the compare is limited to fields containing a
15 ; particular GROUP, the second pass, which checks for
16 ; entries in the secondary UCI not in the primary UCI, is
17 ; not executed. On the first pass the GROUP multiple in the
18 ; secondary UCI is ignored.
19 ;
20START ;
21 NEW XBWHERE S XBWHERE=$S($$VERSION^%ZOSV(1)["Cache":"Namespace",1:"UCI") ;IHS/SET/GTH XB*3*9 10/29/2002
22 NEW GROUP
23 ; W !,"This program compares FileMan files in two different UCIs." ;IHS/SET/GTH XB*3*9 10/29/2002
24 W !,"This program compares FileMan files in two different ",XBWHERE,"s." ;IHS/SET/GTH XB*3*9 10/29/2002
25 S U="^"
26 X ^%ZOSF("UCI")
27 S XBFCMPU1=$P(Y,",",1)
28 ;W !!,"Primary UCI is ",XBFCMPU1 ;IHS/SET/GTH XB*3*9 10/29/2002
29 W !!,"Primary ",XBWHERE," is ",XBFCMPU1 ;IHS/SET/GTH XB*3*9 10/29/2002
30 D GET2ND
31 I XBFCMPU2="" W !!,"Bye",! D EOJ Q
32 D ^XBDSET
33 I '$D(^UTILITY("XBDSET",$J)) W !!,"No files selected",! D EOJ Q
34 R !!,"Only check fields with GROUP: ",GROUP:$G(DTIME,999)
35 I GROUP="" KILL GROUP
36 S XBFCMPFL=""
37 F XBFCMPL=0:0 S XBFCMPFL=$O(^UTILITY("XBDSET",$J,XBFCMPFL)) Q:XBFCMPFL'=+XBFCMPFL D XBFCMPFL
38 D EOJ
39 Q
40 ;
41XBFCMPFL ;
42 W !!,XBFCMPFL,!
43 F XBFCMPG="DIC","DD" D COMPARE
44 S XBCDFILE=XBFCMPFL
45 D SBTRACE
46 S XBFCMPFL=XBCDFILE
47 Q
48 ;
49COMPARE ;
50 S XBFCMPP="^["""_XBFCMPU1_"""]"_XBFCMPG_"("_XBFCMPFL_","_$S(XBFCMPG="DIC":"0,",1:"")
51 S XBFCMPS="^["""_XBFCMPU2_"""]"_XBFCMPG_"("_XBFCMPFL_","_$S(XBFCMPG="DIC":"0,",1:"")
52 ;I '$D(@($E(XBFCMPS,1,$L(XBFCMPS)-1)_")")) W " File not in ^",XBFCMPG," of secondary UCI" Q ;IHS/SET/GTH XB*3*9 10/29/2002
53 I '$D(@($E(XBFCMPS,1,$L(XBFCMPS)-1)_")")) W " File not in ^",XBFCMPG," of secondary ",XBWHERE Q ;IHS/SET/GTH XB*3*9 10/29/2002
54 S XBGP=XBFCMPP,XBGS=XBFCMPS,XBGPASS=1
55 D XBGCMP
56 S XBGP=XBFCMPS,XBGS=XBFCMPP,XBGPASS=2
57 D XBGCMP
58 Q
59 ;
60SBTRACE ; CHECK ALL SUB-FILES
61 KILL XBCDSFL
62 S XBCDC=1,XBCDSFL="",XBCDSFL(XBCDC)=XBCDFILE
63 F XBCDL=0:0 S XBCDI=$O(XBCDSFL("")) Q:XBCDI="" S XBCDSF=XBCDSFL(XBCDI) D SBTRACE2 S XBCDI=$O(XBCDSFL("")) W "." KILL XBCDSFL(XBCDI)
64 KILL XBCDC,XBCDI,XBCDSF,XBCDSFL,XBCDY,XBCDZ
65 Q
66 ;
67SBTRACE2 ;
68 S XBCDI=0
69 F XBCDL=0:0 S XBCDI=$O(^DD(XBCDSF,"SB",XBCDI)) Q:XBCDI="" W "." S XBCDC=XBCDC+1,XBCDSFL(XBCDC)=XBCDI D SBTRACE3
70 Q
71 ;
72SBTRACE3 ;
73 W !!,XBCDI,!
74 S XBFCMPG="DD",XBFCMPFL=XBCDI
75 D COMPARE
76 Q
77 ;
78GET2ND ; GET SECONDARY UCI
79 S XBFCMPU2=""
80 ;R !!,"Secondary UCI: ",X:$G(DTIME,999) ;IHS/SET/GTH XB*3*9 10/29/2002
81 W !!,"Secondary ",XBWHERE,": " R X:$G(DTIME,999) ;IHS/SET/GTH XB*3*9 10/29/2002
82 Q:X=""!(X="^")
83 S XBFCMPU2=X
84 Q
85 ;
86EOJ ;
87 KILL C,I,GDFN,GROOT,L,NOGROUP,NT,P,T,T1,T2,T3,T4,T5,T6,TT,ZZ
88 KILL XBCDFILE,XBCDL
89 KILL %UCI,%UCN,XBFCMPFL,XBFCMPG,XBFCMPL,XBFCMPP,XBFCMPS,XBFCMPU1,XBFCMPU2,X,Y
90 Q
91 ;
92XBGCMP ; COMPARES GLOBAL TREES
93 I $D(GROUP),XBFCMPG="DD",XBGPASS=2 Q
94 D SEARCH
95 KILL XBGP,XBGS,XBGPASS
96 Q
97 ;
98SEARCH ;
99 S T="T",C=",",P=")",NT=$L(XBGP,C)-1,L=1,T1=""
100 S TT=XBGP
101 F I=1:1:30 S TT=TT_T_I_C
102EXTR ;
103 S X=T_L,Y=$P(TT,C,1,L+NT)_P,@X=$O(@Y)
104 I @X]"" D:$D(@(Y))#2 SUB S L=L+1,@(T_L)="" G EXTR
105 S L=L-1
106 Q:L=0
107 G EXTR
108 ;
109SUB ;
110 W "."
111 S ZZ=XBGS_$P(Y,XBGP,2)
112 I $D(@Y)
113 Q:$P($$MSMZR^ZIBNSSV,"DD(",2)?.".".N.".".N1",0,""PT""".E
114 Q:$P($$MSMZR^ZIBNSSV,"DD(",2)?.".".N.".".N1",".".".N.".".N1",21,".E
115 Q:$P($$MSMZR^ZIBNSSV,"DD(",2)?.".".N.".".N1",".".".N.".".N1",""DT""".E
116 Q:$P($$MSMZR^ZIBNSSV,"DD(",2)?.".".N.".".N1",".".".N.".".N1",1,0)"
117 I $D(SKIP),SKIP=$E($$MSMZR^ZIBNSSV,1,$L(SKIP)) Q
118 KILL SKIP
119 I $D(GROUP),$P($$MSMZR^ZIBNSSV,"DD(",2)?.".".N.".".N1",".".".N.".".N1",0)" D CHKGROUP I NOGROUP S SKIP=$E($$MSMZR^ZIBNSSV,1,$L($$MSMZR^ZIBNSSV)-3) Q
120 I '$D(@ZZ),$P($$MSMZR^ZIBNSSV,"DD(",2)?.".".N.".".N1",".".".N.".".N1",0)" W !,$$MSMZR^ZIBNSSV," <",$P(@Y,"^",1)," field does not exist>" S SKIP=$E($$MSMZR^ZIBNSSV,1,$L($$MSMZR^ZIBNSSV)-3) Q
121 I $D(GROUP),$P($$MSMZR^ZIBNSSV,"DD(",2)?.".".N.".".N1",".".".N1",20,".E Q
122 I '$D(@ZZ) W !,$$MSMZR^ZIBNSSV,"=",@Y," <does not exist>" Q
123 Q:XBGPASS=2
124 I @ZZ'=@Y W !,$$MSMZR^ZIBNSSV," <differs>",!,@ZZ,!,@Y Q
125 Q
126 ;
127CHKGROUP ;
128 S GDFN=0,NOGROUP=1,GROOT=$E($$MSMZR^ZIBNSSV,1,$L($$MSMZR^ZIBNSSV)-3)
129 F GL=0:0 S GDFN=$O(@(GROOT_",20,GDFN)")) Q:GDFN="" I @(GROOT_",20,GDFN,0)")=GROUP S NOGROUP=0 Q
130 I $D(@Y)
131 Q
132 ;
Note: See TracBrowser for help on using the repository browser.