Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XBFCMP

XBFCMP.m

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