AUFCMP ; COMPARES FILEMAN FILES IN TWO UCIs [ 05/31/88 2:00 PM ]
;
; Ignores the following:
; ^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
; the GROUP multiple in the secondary UCI is ignored.
;
START ;
W !,"This program compares FileMan files in two different UCIs."
S U="^"
D ^%GUCI
S AUFCMPU1=%UCI
W !!,"Primary UCI is ",AUFCMPU1
D GET2ND
I AUFCMPU2="" W !!,"Bye",! D EOJ Q
D ^AUDSET
I '$D(^UTILITY("AUDSET",$J)) W !!,"No files selected",! D EOJ Q
R !!,"Only check fields with GROUP: ",GROUP I GROUP="" K GROUP
S AUFCMPFL="" F AUFCMPL=0:0 S AUFCMPFL=$O(^UTILITY("AUDSET",$J,AUFCMPFL)) Q:AUFCMPFL'=+AUFCMPFL D AUFCMPFL
D EOJ
Q
;
AUFCMPFL ;
W !!,AUFCMPFL,!
S AUFCMPG="DIC" D COMPARE
S AUFCMPG="DD" D COMPARE
S AUCDFILE=AUFCMPFL D SBTRACE S AUFCMPFL=AUCDFILE
Q
;
COMPARE ;
S AUFCMPP="^["""_AUFCMPU1_"""]"_AUFCMPG_"("_AUFCMPFL_","_$S(AUFCMPG="DIC":"0,",1:"")
S AUFCMPS="^["""_AUFCMPU2_"""]"_AUFCMPG_"("_AUFCMPFL_","_$S(AUFCMPG="DIC":"0,",1:"")
I '$D(@($E(AUFCMPS,1,$L(AUFCMPS)-1)_")")) W " File not in ^"_AUFCMPG_" of secondary UCI" Q
S AUGP=AUFCMPP,AUGS=AUFCMPS,AUGPASS=1
D AUGCMP
S AUGP=AUFCMPS,AUGS=AUFCMPP,AUGPASS=2
D AUGCMP
Q
;
SBTRACE ; CHECK ALL SUB-FILES
K AUCDSFL S AUCDC=1,AUCDSFL="",AUCDSFL(AUCDC)=AUCDFILE
F AUCDL=0:0 S AUCDI=$O(AUCDSFL("")) Q:AUCDI="" S AUCDSF=AUCDSFL(AUCDI) D SBTRACE2 S AUCDI=$O(AUCDSFL("")) W "." K AUCDSFL(AUCDI)
K AUCDC,AUCDI,AUCDSF,AUCDSFL,AUCDY,AUCDZ
Q
SBTRACE2 ;
S AUCDI=0 F AUCDL=0:0 S AUCDI=$O(^DD(AUCDSF,"SB",AUCDI)) Q:AUCDI="" W "." S AUCDC=AUCDC+1,AUCDSFL(AUCDC)=AUCDI D SBTRACE3
Q
SBTRACE3 ;
W !!,AUCDI,!
S AUFCMPG="DD"
S AUFCMPFL=AUCDI
D COMPARE
Q
;
GET2ND ; GET SECONDARY UCI
S AUFCMPU2=""
R !!,"Secondary UCI: ",X Q:X=""!(X="^")
;X ^%ZOSF("UCICHECK")
;I X'=Y W !!,"Invalid UCI",! Q
S AUFCMPU2=X
Q
;
EOJ ;
K AUCDFILE,AUCDL
K %UCI,%UCN,AUFCMPFL,AUFCMPG,AUFCMPL,AUFCMPP,AUFCMPS,AUFCMPU1,AUFCMPU2,X,Y
Q
;
AUGCMP ; COMPARES GLOBAL TREES [ 02/16/88 10:11 AM ]
; CREATED BY GIS 7/17/85 FOR MSM UNIX MUMPS (2.3)
I $D(GROUP),AUFCMPG="DD",AUGPASS=2 Q
D SEARCH K AUGP,AUGS,AUGPASS Q
SEARCH ;
EDE0 ;W !!,">>>>>>> ",AUGPASS," <<<<<<<",!!
;N (AUGP,AUGS,AUGPASS,GROUP)
S T="T",C=",",P=")",NT=$L(AUGP,C)-1,L=1,T1=""
S TT=AUGP 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=AUGS_$P(Y,AUGP,2)
I $D(@Y)
EDE1 ;W !,$ZR
Q:$P($ZR,"DD(",2)?.".".N.".".N1",".".".N.".".N1",21,".E
Q:$P($ZR,"DD(",2)?.".".N.".".N1",".".".N.".".N1",""DT""".E
Q:$P($ZR,"DD(",2)?.".".N.".".N1",".".".N.".".N1",1,0)"
EDE2 ;W !,$ZR
I $D(SKIP),SKIP=$E($ZR,1,$L(SKIP)) Q
K SKIP
I $D(GROUP),$P($ZR,"DD(",2)?.".".N.".".N1",".".".N.".".N1",0)" D CHKGROUP I NOGROUP S SKIP=$E($ZR,1,$L($ZR)-3) Q
I '$D(@ZZ),$P($ZR,"DD(",2)?.".".N.".".N1",".".".N.".".N1",0)" W !,$ZR," <",$P(@Y,"^",1)," field does not exist>" S SKIP=$E($ZR,1,$L($ZR)-3) Q
I $D(GROUP),$P($ZR,"DD(",2)?.".".N.".".N1",".".".N1",20,".E Q
I '$D(@ZZ) W !,$ZR,"=",@Y," <does not exist>" Q
Q:AUGPASS=2
I @ZZ'=@Y W !,$ZR," <differs>",!,@ZZ,!,@Y Q
Q
;
CHKGROUP ;
S GDFN=0,NOGROUP=1,GROOT=$E($ZR,1,$L($ZR)-3)
EDE3 ;W !,GDFN,"-",GROOT,"-",$ZR
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)
EDE4 ;W !,"NOGROUP=",NOGROUP," ","$ZR=",$ZR,!
Q
AUFCMP ; COMPARES FILEMAN FILES IN TWO UCIs [ 05/31/88 2:00 PM ]
+1 ;
+2 ; Ignores the following:
+3 ; ^DD(file,field,1,0)
+4 ; ^DD(file,field,21
+5 ; ^DD(file,field,"DT"
+6 ;
+7 ; If a field does not exist in one file, a message is displayed and
+8 ; all sub-nodes of that field are ignored.
+9 ;
+10 ; If the compare is limited to fields containing a particular GROUP,
+11 ; the second pass, which checks for entries in the secondary UCI
+12 ; not in the primary UCI, is not executed. On the first pass the
+13 ; the GROUP multiple in the secondary UCI is ignored.
+14 ;
START ;
+1 WRITE !,"This program compares FileMan files in two different UCIs."
+2 SET U="^"
+3 DO ^%GUCI
+4 SET AUFCMPU1=%UCI
+5 WRITE !!,"Primary UCI is ",AUFCMPU1
+6 DO GET2ND
+7 IF AUFCMPU2=""
WRITE !!,"Bye",!
DO EOJ
QUIT
+8 DO ^AUDSET
+9 IF '$DATA(^UTILITY("AUDSET",$JOB))
WRITE !!,"No files selected",!
DO EOJ
QUIT
+10 READ !!,"Only check fields with GROUP: ",GROUP
IF GROUP=""
KILL GROUP
+11 SET AUFCMPFL=""
FOR AUFCMPL=0:0
SET AUFCMPFL=$ORDER(^UTILITY("AUDSET",$JOB,AUFCMPFL))
IF AUFCMPFL'=+AUFCMPFL
QUIT
DO AUFCMPFL
+12 DO EOJ
+13 QUIT
+14 ;
AUFCMPFL ;
+1 WRITE !!,AUFCMPFL,!
+2 SET AUFCMPG="DIC"
DO COMPARE
+3 SET AUFCMPG="DD"
DO COMPARE
+4 SET AUCDFILE=AUFCMPFL
DO SBTRACE
SET AUFCMPFL=AUCDFILE
+5 QUIT
+6 ;
COMPARE ;
+1 SET AUFCMPP="^["""_AUFCMPU1_"""]"_AUFCMPG_"("_AUFCMPFL_","_$SELECT(AUFCMPG="DIC":"0,",1:"")
+2 SET AUFCMPS="^["""_AUFCMPU2_"""]"_AUFCMPG_"("_AUFCMPFL_","_$SELECT(AUFCMPG="DIC":"0,",1:"")
+3 IF '$DATA(@($EXTRACT(AUFCMPS,1,$LENGTH(AUFCMPS)-1)_")"))
WRITE " File not in ^"_AUFCMPG_" of secondary UCI"
QUIT
+4 SET AUGP=AUFCMPP
SET AUGS=AUFCMPS
SET AUGPASS=1
+5 DO AUGCMP
+6 SET AUGP=AUFCMPS
SET AUGS=AUFCMPP
SET AUGPASS=2
+7 DO AUGCMP
+8 QUIT
+9 ;
SBTRACE ; CHECK ALL SUB-FILES
+1 KILL AUCDSFL
SET AUCDC=1
SET AUCDSFL=""
SET AUCDSFL(AUCDC)=AUCDFILE
+2 FOR AUCDL=0:0
SET AUCDI=$ORDER(AUCDSFL(""))
IF AUCDI=""
QUIT
SET AUCDSF=AUCDSFL(AUCDI)
DO SBTRACE2
SET AUCDI=$ORDER(AUCDSFL(""))
WRITE "."
KILL AUCDSFL(AUCDI)
+3 KILL AUCDC,AUCDI,AUCDSF,AUCDSFL,AUCDY,AUCDZ
+4 QUIT
SBTRACE2 ;
+1 SET AUCDI=0
FOR AUCDL=0:0
SET AUCDI=$ORDER(^DD(AUCDSF,"SB",AUCDI))
IF AUCDI=""
QUIT
WRITE "."
SET AUCDC=AUCDC+1
SET AUCDSFL(AUCDC)=AUCDI
DO SBTRACE3
+2 QUIT
SBTRACE3 ;
+1 WRITE !!,AUCDI,!
+2 SET AUFCMPG="DD"
+3 SET AUFCMPFL=AUCDI
+4 DO COMPARE
+5 QUIT
+6 ;
GET2ND ; GET SECONDARY UCI
+1 SET AUFCMPU2=""
+2 READ !!,"Secondary UCI: ",X
IF X=""!(X="^")
QUIT
+3 ;X ^%ZOSF("UCICHECK")
+4 ;I X'=Y W !!,"Invalid UCI",! Q
+5 SET AUFCMPU2=X
+6 QUIT
+7 ;
EOJ ;
+1 KILL AUCDFILE,AUCDL
+2 KILL %UCI,%UCN,AUFCMPFL,AUFCMPG,AUFCMPL,AUFCMPP,AUFCMPS,AUFCMPU1,AUFCMPU2,X,Y
+3 QUIT
+4 ;
AUGCMP ; COMPARES GLOBAL TREES [ 02/16/88 10:11 AM ]
+1 ; CREATED BY GIS 7/17/85 FOR MSM UNIX MUMPS (2.3)
+2 IF $DATA(GROUP)
IF AUFCMPG="DD"
IF AUGPASS=2
QUIT
+3 DO SEARCH
KILL AUGP,AUGS,AUGPASS
QUIT
SEARCH ;
EDE0 ;W !!,">>>>>>> ",AUGPASS," <<<<<<<",!!
+1 ;N (AUGP,AUGS,AUGPASS,GROUP)
+2 SET T="T"
SET C=","
SET P=")"
SET NT=$LENGTH(AUGP,C)-1
SET L=1
SET T1=""
+3 SET TT=AUGP
FOR I=1:1:30
SET TT=TT_T_I_C
EXTR SET X=T_L
SET Y=$PIECE(TT,C,1,L+NT)_P
SET @X=$ORDER(@Y)
+1 IF @X'=""
IF $DATA(@(Y))#2
DO SUB
SET L=L+1
SET @(T_L)=""
GOTO EXTR
+2 SET L=L-1
IF L=0
QUIT
GOTO EXTR
SUB WRITE "."
SET ZZ=AUGS_$PIECE(Y,AUGP,2)
+1 IF $DATA(@Y)
EDE1 ;W !,$ZR
+1 IF $PIECE($ZR,"DD(",2)?.".".N.".".N1",".".".N.".".N1",21,".E
QUIT
+2 IF $PIECE($ZR,"DD(",2)?.".".N.".".N1",".".".N.".".N1",""DT""".E
QUIT
+3 IF $PIECE($ZR,"DD(",2)?.".".N.".".N1",".".".N.".".N1",1,0)"
QUIT
EDE2 ;W !,$ZR
+1 IF $DATA(SKIP)
IF SKIP=$EXTRACT($ZR,1,$LENGTH(SKIP))
QUIT
+2 KILL SKIP
+3 IF $DATA(GROUP)
IF $PIECE($ZR,"DD(",2)?.".".N.".".N1",".".".N.".".N1",0)"
DO CHKGROUP
IF NOGROUP
SET SKIP=$EXTRACT($ZR,1,$LENGTH($ZR)-3)
QUIT
+4 IF '$DATA(@ZZ)
IF $PIECE($ZR,"DD(",2)?.".".N.".".N1",".".".N.".".N1",0)"
WRITE !,$ZR," <",$PIECE(@Y,"^",1)," field does not exist>"
SET SKIP=$EXTRACT($ZR,1,$LENGTH($ZR)-3)
QUIT
+5 IF $DATA(GROUP)
IF $PIECE($ZR,"DD(",2)?.".".N.".".N1",".".".N1",20,".E
QUIT
+6 IF '$DATA(@ZZ)
WRITE !,$ZR,"=",@Y," <does not exist>"
QUIT
+7 IF AUGPASS=2
QUIT
+8 IF @ZZ'=@Y
WRITE !,$ZR," <differs>",!,@ZZ,!,@Y
QUIT
+9 QUIT
+10 ;
CHKGROUP ;
+1 SET GDFN=0
SET NOGROUP=1
SET GROOT=$EXTRACT($ZR,1,$LENGTH($ZR)-3)
EDE3 ;W !,GDFN,"-",GROOT,"-",$ZR
+1 FOR GL=0:0
SET GDFN=$ORDER(@(GROOT_",20,GDFN)"))
IF GDFN=""
QUIT
IF @(GROOT_",20,GDFN,0)")=GROUP
SET NOGROUP=0
QUIT
+2 IF $DATA(@Y)
EDE4 ;W !,"NOGROUP=",NOGROUP," ","$ZR=",$ZR,!
+1 QUIT
