XBFCMP ; IHS/ADC/GTH - COMPARES FILEMAN FILES IN TWO UCIs ; [ 10/29/2002 7:42 AM ]
;;3.0;IHS/VA UTILITIES;**9**;FEB 07, 1997
; XB*3*9 IHS/SET/GTH XB*3*9 10/29/2002 Cache' mods.
;
; Ignores the following:
; ^DD(file,0,"PT",
; ^DD(file,field,1,0)
; ^DD(file,field,21
; ^DD(file,field,"DT"
;
; If a field does not exist in one file, a message is
; displayed and all sub-nodes of that field are ignored.
;
; If the compare is limited to fields containing a
; particular GROUP, the second pass, which checks for
; entries in the secondary UCI not in the primary UCI, is
; not executed. On the first pass the GROUP multiple in the
; secondary UCI is ignored.
;
START ;
NEW XBWHERE S XBWHERE=$S($$VERSION^%ZOSV(1)["Cache":"Namespace",1:"UCI") ;IHS/SET/GTH XB*3*9 10/29/2002
NEW GROUP
; W !,"This program compares FileMan files in two different UCIs." ;IHS/SET/GTH XB*3*9 10/29/2002
W !,"This program compares FileMan files in two different ",XBWHERE,"s." ;IHS/SET/GTH XB*3*9 10/29/2002
S U="^"
X ^%ZOSF("UCI")
S XBFCMPU1=$P(Y,",",1)
;W !!,"Primary UCI is ",XBFCMPU1 ;IHS/SET/GTH XB*3*9 10/29/2002
W !!,"Primary ",XBWHERE," is ",XBFCMPU1 ;IHS/SET/GTH XB*3*9 10/29/2002
D GET2ND
I XBFCMPU2="" W !!,"Bye",! D EOJ Q
D ^XBDSET
I '$D(^UTILITY("XBDSET",$J)) W !!,"No files selected",! D EOJ Q
R !!,"Only check fields with GROUP: ",GROUP:$G(DTIME,999)
I GROUP="" KILL GROUP
S XBFCMPFL=""
F XBFCMPL=0:0 S XBFCMPFL=$O(^UTILITY("XBDSET",$J,XBFCMPFL)) Q:XBFCMPFL'=+XBFCMPFL D XBFCMPFL
D EOJ
Q
;
XBFCMPFL ;
W !!,XBFCMPFL,!
F XBFCMPG="DIC","DD" D COMPARE
S XBCDFILE=XBFCMPFL
D SBTRACE
S XBFCMPFL=XBCDFILE
Q
;
COMPARE ;
S XBFCMPP="^["""_XBFCMPU1_"""]"_XBFCMPG_"("_XBFCMPFL_","_$S(XBFCMPG="DIC":"0,",1:"")
S XBFCMPS="^["""_XBFCMPU2_"""]"_XBFCMPG_"("_XBFCMPFL_","_$S(XBFCMPG="DIC":"0,",1:"")
;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
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
S XBGP=XBFCMPP,XBGS=XBFCMPS,XBGPASS=1
D XBGCMP
S XBGP=XBFCMPS,XBGS=XBFCMPP,XBGPASS=2
D XBGCMP
Q
;
SBTRACE ; CHECK ALL SUB-FILES
KILL XBCDSFL
S XBCDC=1,XBCDSFL="",XBCDSFL(XBCDC)=XBCDFILE
F XBCDL=0:0 S XBCDI=$O(XBCDSFL("")) Q:XBCDI="" S XBCDSF=XBCDSFL(XBCDI) D SBTRACE2 S XBCDI=$O(XBCDSFL("")) W "." KILL XBCDSFL(XBCDI)
KILL XBCDC,XBCDI,XBCDSF,XBCDSFL,XBCDY,XBCDZ
Q
;
SBTRACE2 ;
S XBCDI=0
F XBCDL=0:0 S XBCDI=$O(^DD(XBCDSF,"SB",XBCDI)) Q:XBCDI="" W "." S XBCDC=XBCDC+1,XBCDSFL(XBCDC)=XBCDI D SBTRACE3
Q
;
SBTRACE3 ;
W !!,XBCDI,!
S XBFCMPG="DD",XBFCMPFL=XBCDI
D COMPARE
Q
;
GET2ND ; GET SECONDARY UCI
S XBFCMPU2=""
;R !!,"Secondary UCI: ",X:$G(DTIME,999) ;IHS/SET/GTH XB*3*9 10/29/2002
W !!,"Secondary ",XBWHERE,": " R X:$G(DTIME,999) ;IHS/SET/GTH XB*3*9 10/29/2002
Q:X=""!(X="^")
S XBFCMPU2=X
Q
;
EOJ ;
KILL C,I,GDFN,GROOT,L,NOGROUP,NT,P,T,T1,T2,T3,T4,T5,T6,TT,ZZ
KILL XBCDFILE,XBCDL
KILL %UCI,%UCN,XBFCMPFL,XBFCMPG,XBFCMPL,XBFCMPP,XBFCMPS,XBFCMPU1,XBFCMPU2,X,Y
Q
;
XBGCMP ; COMPARES GLOBAL TREES
I $D(GROUP),XBFCMPG="DD",XBGPASS=2 Q
D SEARCH
KILL XBGP,XBGS,XBGPASS
Q
;
SEARCH ;
S T="T",C=",",P=")",NT=$L(XBGP,C)-1,L=1,T1=""
S TT=XBGP
F I=1:1:30 S TT=TT_T_I_C
EXTR ;
S X=T_L,Y=$P(TT,C,1,L+NT)_P,@X=$O(@Y)
I @X]"" D:$D(@(Y))#2 SUB S L=L+1,@(T_L)="" G EXTR
S L=L-1
Q:L=0
G EXTR
;
SUB ;
W "."
S ZZ=XBGS_$P(Y,XBGP,2)
I $D(@Y)
Q:$P($$MSMZR^ZIBNSSV,"DD(",2)?.".".N.".".N1",0,""PT""".E
Q:$P($$MSMZR^ZIBNSSV,"DD(",2)?.".".N.".".N1",".".".N.".".N1",21,".E
Q:$P($$MSMZR^ZIBNSSV,"DD(",2)?.".".N.".".N1",".".".N.".".N1",""DT""".E
Q:$P($$MSMZR^ZIBNSSV,"DD(",2)?.".".N.".".N1",".".".N.".".N1",1,0)"
I $D(SKIP),SKIP=$E($$MSMZR^ZIBNSSV,1,$L(SKIP)) Q
KILL SKIP
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
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
I $D(GROUP),$P($$MSMZR^ZIBNSSV,"DD(",2)?.".".N.".".N1",".".".N1",20,".E Q
I '$D(@ZZ) W !,$$MSMZR^ZIBNSSV,"=",@Y," <does not exist>" Q
Q:XBGPASS=2
I @ZZ'=@Y W !,$$MSMZR^ZIBNSSV," <differs>",!,@ZZ,!,@Y Q
Q
;
CHKGROUP ;
S GDFN=0,NOGROUP=1,GROOT=$E($$MSMZR^ZIBNSSV,1,$L($$MSMZR^ZIBNSSV)-3)
F GL=0:0 S GDFN=$O(@(GROOT_",20,GDFN)")) Q:GDFN="" I @(GROOT_",20,GDFN,0)")=GROUP S NOGROUP=0 Q
I $D(@Y)
Q
;
XBFCMP ; IHS/ADC/GTH - COMPARES FILEMAN FILES IN TWO UCIs ; [ 10/29/2002 7:42 AM ]
+1 ;;3.0;IHS/VA UTILITIES;**9**;FEB 07, 1997
+2 ; XB*3*9 IHS/SET/GTH XB*3*9 10/29/2002 Cache' mods.
+3 ;
+4 ; Ignores the following:
+5 ; ^DD(file,0,"PT",
+6 ; ^DD(file,field,1,0)
+7 ; ^DD(file,field,21
+8 ; ^DD(file,field,"DT"
+9 ;
+10 ; If a field does not exist in one file, a message is
+11 ; displayed and all sub-nodes of that field are ignored.
+12 ;
+13 ; If the compare is limited to fields containing a
+14 ; particular GROUP, the second pass, which checks for
+15 ; entries in the secondary UCI not in the primary UCI, is
+16 ; not executed. On the first pass the GROUP multiple in the
+17 ; secondary UCI is ignored.
+18 ;
START ;
+1 ;IHS/SET/GTH XB*3*9 10/29/2002
NEW XBWHERE
SET XBWHERE=$SELECT($$VERSION^%ZOSV(1)["Cache":"Namespace",1:"UCI")
+2 NEW GROUP
+3 ; W !,"This program compares FileMan files in two different UCIs." ;IHS/SET/GTH XB*3*9 10/29/2002
+4 ;IHS/SET/GTH XB*3*9 10/29/2002
WRITE !,"This program compares FileMan files in two different ",XBWHERE,"s."
+5 SET U="^"
+6 XECUTE ^%ZOSF("UCI")
+7 SET XBFCMPU1=$PIECE(Y,",",1)
+8 ;W !!,"Primary UCI is ",XBFCMPU1 ;IHS/SET/GTH XB*3*9 10/29/2002
+9 ;IHS/SET/GTH XB*3*9 10/29/2002
WRITE !!,"Primary ",XBWHERE," is ",XBFCMPU1
+10 DO GET2ND
+11 IF XBFCMPU2=""
WRITE !!,"Bye",!
DO EOJ
QUIT
+12 DO ^XBDSET
+13 IF '$DATA(^UTILITY("XBDSET",$JOB))
WRITE !!,"No files selected",!
DO EOJ
QUIT
+14 READ !!,"Only check fields with GROUP: ",GROUP:$GET(DTIME,999)
+15 IF GROUP=""
KILL GROUP
+16 SET XBFCMPFL=""
+17 FOR XBFCMPL=0:0
SET XBFCMPFL=$ORDER(^UTILITY("XBDSET",$JOB,XBFCMPFL))
IF XBFCMPFL'=+XBFCMPFL
QUIT
DO XBFCMPFL
+18 DO EOJ
+19 QUIT
+20 ;
XBFCMPFL ;
+1 WRITE !!,XBFCMPFL,!
+2 FOR XBFCMPG="DIC","DD"
DO COMPARE
+3 SET XBCDFILE=XBFCMPFL
+4 DO SBTRACE
+5 SET XBFCMPFL=XBCDFILE
+6 QUIT
+7 ;
COMPARE ;
+1 SET XBFCMPP="^["""_XBFCMPU1_"""]"_XBFCMPG_"("_XBFCMPFL_","_$SELECT(XBFCMPG="DIC":"0,",1:"")
+2 SET XBFCMPS="^["""_XBFCMPU2_"""]"_XBFCMPG_"("_XBFCMPFL_","_$SELECT(XBFCMPG="DIC":"0,",1:"")
+3 ;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
+4 ;IHS/SET/GTH XB*3*9 10/29/2002
IF '$DATA(@($EXTRACT(XBFCMPS,1,$LENGTH(XBFCMPS)-1)_")"))
WRITE " File not in ^",XBFCMPG," of secondary ",XBWHERE
QUIT
+5 SET XBGP=XBFCMPP
SET XBGS=XBFCMPS
SET XBGPASS=1
+6 DO XBGCMP
+7 SET XBGP=XBFCMPS
SET XBGS=XBFCMPP
SET XBGPASS=2
+8 DO XBGCMP
+9 QUIT
+10 ;
SBTRACE ; CHECK ALL SUB-FILES
+1 KILL XBCDSFL
+2 SET XBCDC=1
SET XBCDSFL=""
SET XBCDSFL(XBCDC)=XBCDFILE
+3 FOR XBCDL=0:0
SET XBCDI=$ORDER(XBCDSFL(""))
IF XBCDI=""
QUIT
SET XBCDSF=XBCDSFL(XBCDI)
DO SBTRACE2
SET XBCDI=$ORDER(XBCDSFL(""))
WRITE "."
KILL XBCDSFL(XBCDI)
+4 KILL XBCDC,XBCDI,XBCDSF,XBCDSFL,XBCDY,XBCDZ
+5 QUIT
+6 ;
SBTRACE2 ;
+1 SET XBCDI=0
+2 FOR XBCDL=0:0
SET XBCDI=$ORDER(^DD(XBCDSF,"SB",XBCDI))
IF XBCDI=""
QUIT
WRITE "."
SET XBCDC=XBCDC+1
SET XBCDSFL(XBCDC)=XBCDI
DO SBTRACE3
+3 QUIT
+4 ;
SBTRACE3 ;
+1 WRITE !!,XBCDI,!
+2 SET XBFCMPG="DD"
SET XBFCMPFL=XBCDI
+3 DO COMPARE
+4 QUIT
+5 ;
GET2ND ; GET SECONDARY UCI
+1 SET XBFCMPU2=""
+2 ;R !!,"Secondary UCI: ",X:$G(DTIME,999) ;IHS/SET/GTH XB*3*9 10/29/2002
+3 ;IHS/SET/GTH XB*3*9 10/29/2002
WRITE !!,"Secondary ",XBWHERE,": "
READ X:$GET(DTIME,999)
+4 IF X=""!(X="^")
QUIT
+5 SET XBFCMPU2=X
+6 QUIT
+7 ;
EOJ ;
+1 KILL C,I,GDFN,GROOT,L,NOGROUP,NT,P,T,T1,T2,T3,T4,T5,T6,TT,ZZ
+2 KILL XBCDFILE,XBCDL
+3 KILL %UCI,%UCN,XBFCMPFL,XBFCMPG,XBFCMPL,XBFCMPP,XBFCMPS,XBFCMPU1,XBFCMPU2,X,Y
+4 QUIT
+5 ;
XBGCMP ; COMPARES GLOBAL TREES
+1 IF $DATA(GROUP)
IF XBFCMPG="DD"
IF XBGPASS=2
QUIT
+2 DO SEARCH
+3 KILL XBGP,XBGS,XBGPASS
+4 QUIT
+5 ;
SEARCH ;
+1 SET T="T"
SET C=","
SET P=")"
SET NT=$LENGTH(XBGP,C)-1
SET L=1
SET T1=""
+2 SET TT=XBGP
+3 FOR I=1:1:30
SET TT=TT_T_I_C
EXTR ;
+1 SET X=T_L
SET Y=$PIECE(TT,C,1,L+NT)_P
SET @X=$ORDER(@Y)
+2 IF @X]""
IF $DATA(@(Y))#2
DO SUB
SET L=L+1
SET @(T_L)=""
GOTO EXTR
+3 SET L=L-1
+4 IF L=0
QUIT
+5 GOTO EXTR
+6 ;
SUB ;
+1 WRITE "."
+2 SET ZZ=XBGS_$PIECE(Y,XBGP,2)
+3 IF $DATA(@Y)
+4 IF $PIECE($$MSMZR^ZIBNSSV,"DD(",2)?.".".N.".".N1",0,""PT""".E
QUIT
+5 IF $PIECE($$MSMZR^ZIBNSSV,"DD(",2)?.".".N.".".N1",".".".N.".".N1",21,".E
QUIT
+6 IF $PIECE($$MSMZR^ZIBNSSV,"DD(",2)?.".".N.".".N1",".".".N.".".N1",""DT""".E
QUIT
+7 IF $PIECE($$MSMZR^ZIBNSSV,"DD(",2)?.".".N.".".N1",".".".N.".".N1",1,0)"
QUIT
+8 IF $DATA(SKIP)
IF SKIP=$EXTRACT($$MSMZR^ZIBNSSV,1,$LENGTH(SKIP))
QUIT
+9 KILL SKIP
+10 IF $DATA(GROUP)
IF $PIECE($$MSMZR^ZIBNSSV,"DD(",2)?.".".N.".".N1",".".".N.".".N1",0)"
DO CHKGROUP
IF NOGROUP
SET SKIP=$EXTRACT($$MSMZR^ZIBNSSV,1,$LENGTH($$MSMZR^ZIBNSSV)-3)
QUIT
+11 IF '$DATA(@ZZ)
IF $PIECE($$MSMZR^ZIBNSSV,"DD(",2)?.".".N.".".N1",".".".N.".".N1",0)"
WRITE !,$$MSMZR^ZIBNSSV," <",$PIECE(@Y,"^",1)," field does not exist>"
SET SKIP=$EXTRACT($$MSMZR^ZIBNSSV,1,$LENGTH($$MSMZR^ZIBNSSV)-3)
QUIT
+12 IF $DATA(GROUP)
IF $PIECE($$MSMZR^ZIBNSSV,"DD(",2)?.".".N.".".N1",".".".N1",20,".E
QUIT
+13 IF '$DATA(@ZZ)
WRITE !,$$MSMZR^ZIBNSSV,"=",@Y," <does not exist>"
QUIT
+14 IF XBGPASS=2
QUIT
+15 IF @ZZ'=@Y
WRITE !,$$MSMZR^ZIBNSSV," <differs>",!,@ZZ,!,@Y
QUIT
+16 QUIT
+17 ;
CHKGROUP ;
+1 SET GDFN=0
SET NOGROUP=1
SET GROOT=$EXTRACT($$MSMZR^ZIBNSSV,1,$LENGTH($$MSMZR^ZIBNSSV)-3)
+2 FOR GL=0:0
SET GDFN=$ORDER(@(GROOT_",20,GDFN)"))
IF GDFN=""
QUIT
IF @(GROOT_",20,GDFN,0)")=GROUP
SET NOGROUP=0
QUIT
+3 IF $DATA(@Y)
+4 QUIT
+5 ;
