Routine: AUFCMP

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

AUFCMPFL ;

 W !!,AUFCMPFL,!

 S AUFCMPG="DIC" D COMPARE

 S AUFCMPG="DD" D COMPARE

 S AUCDFILE=AUFCMPFL D SBTRACE S AUFCMPFL=AUCDFILE

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

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

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

SBTRACE3 ;

 W !!,AUCDI,!

 S AUFCMPG="DD"

 S AUFCMPFL=AUCDI

 D COMPARE

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

EOJ ;

 K AUCDFILE,AUCDL

 K %UCI,%UCN,AUFCMPFL,AUFCMPG,AUFCMPL,AUFCMPP,AUFCMPS,AUFCMPU1,AUFCMPU2,X,Y

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

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,!

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

AUFCMP.m