INHSYS07.m

INHSYS07 ;JPD; 13 Nov 98 13:35;gis sys con data installation utility 

 ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001

 ;COPYRIGHT 1991-2000 SAIC

 ;CHCS TOOLS_450; GEN 4; 26-SEP-1996

 ;COPYRIGHT 1995 SAIC

 Q

%GCMP ;Global file element compare

 N %FIL,%FILNM,%EL1,%EL2,DIC,Y,%THATVOL,%THATUCI,%THISVOL,%THISUCI,%GBL

 N %ROOT,%XIEN,%NIEN,%DONE,INY,GBL,%UTL,X,ND

 I ^%ZOSF("OS")'["VAX" W !,"Not implemented yet" Q

 D ENV^UTIL

 W @IOF

 Q:'$$GETFLE(.%FIL,.%NIEN,.%FILNM)

 S (%THATUCI,%THATVOL)="",%DONE=0

 F  D  Q:%DONE

 .U 0 R !,"Enter UCI you want to compare element from: ",%THATUCI:DTIME

 .I %THATUCI["?" W !,"Pick a valid UCI" Q

 .I %THATUCI="^"!'$L(%THATUCI) S %DONE=1 Q

 .I '$$UCICHECK^%ZTF(%THATUCI) W !,"Not a valid UCI" Q

 .I %THATUCI["," S %THATVOL=$P(%THATUCI,",",2),%THATUCI=$P(%THATUCI,","),%DONE=1 Q

 .U 0 R !,"Enter VOL you want to compare element from: ",%THATVOL:DTIME

 .I %THATVOL["?" W !,"Pick a valid volume set" Q

 .I %THATVOL="^"!'$L(%THATVOL) S %DONE=1 Q

 .I %THATVOL=^%ZOSF("VOL") W !,"You must pick a different Volume set" Q

 .I '$$UCICHECK^%ZTF(%THATUCI_","_%THATVOL) W !,"Not a valid UCI or Volume set" Q

 .S %DONE=1

 Q:'$L(%THATUCI)!'$L(%THATVOL)!(%THATVOL="^")!(%THATUCI="^")

 S X=%FILNM,%GBL=$P(%GBL,"^",2)

 S Y=$O(@("^[%THATUCI,%THATVOL]"_%GBL_"""B"","""_X_""","""")"))

 I Y="" W !,"File element does not exist in ["_%THATUCI_","_%THATVOL_"]"

 E  D

 .S %ROOT="^[%THATUCI,%THATVOL]"_%GBL

 .S %XIEN=Y,ND=%ROOT_Y_")"

 .S %UTL="^UTILITY(""INHSYS"","_$J_","""_%FIL_""","

 .F  S ND=$Q(@ND) Q:%XIEN'=+$P(ND,%GBL,2)  D

 ..S INY=@ND,GBL=%UTL_$P(ND,%GBL,2),@GBL=INY

 .D CMP(%NIEN,"^"_%GBL,%FIL,%XIEN)

 Q

CMP(%NIEN,%ROOT,%FL,%OIEN,%RSLV) ;Compare global entries

 ; %NIEN - ien of data in current environment

 ; %ROOT - Root node of file

 ; %FL - Fileman File number

 ; %OIEN - ien from other environment

 ; %RSLV - 1 - Resolve ptr values 0 - don't resolve

 N %UTILITY,%NODE,%L1,%L2,%P

 K ^UTILITY($J,%FL)

 S %RSLV=$G(%RSLV)

 ;Extract data from exisitng global

 D XTRK(%NIEN,%ROOT,"^UTILITY($J,"""_%FL_""",",%FL)

 ;resolve pointer values

 I %RSLV D EXPND^INHSYS09(%NIEN,%FL,%ROOT,%ROOT_%NIEN_",",1,%NIEN,0,%NIEN)

 ;Build temp storage for existing files

 S %NODE="^UTILITY($J,%FL,%NIEN)",%UTILITY(1,0)=0

 F  S %NODE=$Q(@%NODE) Q:'$L(%NODE)  Q:+$QS(%NODE,3)'=%NIEN  D

 .S %UTILITY(1,0)=%UTILITY(1,0)+1

 .S %UTILITY(1,%UTILITY(1,0))=$P(%NODE,",",4,999)_"="_@%NODE

 S %UTILITY(1,0)=%UTILITY(1,0)+1,%UTILITY(1,%UTILITY(1,0))=""

 ;Build temp storage for new files

 S %NODE="^UTILITY(""INHSYS"",$J,%FL,%OIEN)",%UTILITY(2,0)=0

 F  S %NODE=$Q(@%NODE) Q:'$L(%NODE)  Q:+$QS(%NODE,4)'=%OIEN  D

 .S %UTILITY(2,0)=%UTILITY(2,0)+1

 .S %UTILITY(2,%UTILITY(2,0))=$P(%NODE,",",5,999)_"="_@%NODE

 S %UTILITY(1,0)=%UTILITY(1,0)+1,%UTILITY(1,%UTILITY(1,0))=""

 D GCMP(.%UTILITY)

 K ^UTILITY($J)

 Q

GCMP(%UTILITY) ;Compare values from %UTILITY nodes

 ; Input:

 ; %UTILITY - Global with files to compare

 N %L1,%L2,%FOUND

 S (%L1,%L2)=1,%FOUND=0

 ;Determine differences

 F  Q:%UTILITY(1,0)<%L1!(%UTILITY(2,0)<%L2)  D

 .I %UTILITY(1,%L1)'=%UTILITY(2,%L2) D

 ..D PG

 ..I '%FOUND W !,"The following difference(s) appear for the above entry:",!

 ..S %FOUND=1

 ..D DIFF(.%L1,.%L2,.%UTILITY)

 .S %L1=%L1+1,%L2=%L2+1

 I '%FOUND W !,"No differences found",!

 Q

DIFF(%L1,%L2,%UTILITY) ;Diff found

 ;Input/Output:

 ; %L1 - Position in %UTILITY global node 1

 ; %L2 - Position in %UTILITY global node 2

 ;Establish point where diff took place

 S %P(1)=%L1,%P(2)=%L2,%P=0

 F  Q:'$$DL(.%P,.%L1,.%L2,.%UTILITY)

 Q

DL(%P,%L1,%L2,%UTILITY) ;

 ;%P - Position in Array

 ; %L1 - Position in %UTILITY global node 1

 ; %L2 - Position in %UTILITY global node 2

 N %A2,%A,%J,%K,%EXIT

 ;Increment %P by 1 and %A by %P and %P(%A) by 1

 S %P=%P+1#2,%A=%P+1,%P(%A)=%P(%A)+1

 S:%UTILITY(%A,0)'>%P(%A) %P(%A)=%UTILITY(%A,0)

 I %UTILITY(%A,%P(%A))="" D  Q 0

 .S %A2=%P+1#2+1,%P(%A2)=%UTILITY(%A2,0)

 .S %J=%P(1),%K=%P(2)

 .D WRITE

 S %EXIT=0

 ;loop and look for same values between utility globals

 S %J=%P(1) F %K=%L2:1:%P(2) I %UTILITY(1,%J)=%UTILITY(2,%K) D WRITE S %EXIT=1 Q

 Q:%EXIT 0

 S %K=%P(2) F %J=%L1:1:%P(1) I %UTILITY(1,%J)=%UTILITY(2,%K) D WRITE S %EXIT=1 Q

 Q '%EXIT

WRITE ;

 N %Z,%LI

 S %P(1)=%J,%P(2)=%K

 ;Write existing lines that are different

 W !,"Current Environment "_$G(^%ZOSF("VOL"))_"  ***********************",!

 F %Z=%L1:1:%P(1) I %UTILITY(1,%Z)'="" D

 .S %LI=%UTILITY(1,%Z)

 .D PG

 .W ?2,%Z,")",?7,%ROOT,%NIEN,",",%LI,!

 ;

 ;Write new lines that are different

 W !,"Other Environment  --------",!

 F %Z=%L2:1:%P(2) I %UTILITY(2,%Z)'="" D

 .S %LI=%UTILITY(2,%Z)

 .D PG

 .W ?2,%Z,")",?7,%ROOT,%OIEN,",",%LI,!

 W !,"***************",!

 ;set counters to new repositioned values

 S %L1=%P(1),%L2=%P(2)

 Q

XTRK(%XIEN,%ROOT,%UTL,%FILE) ;xtract existing global

 ; Input:

 ; %XIEN - ien of file extracting data from

 ; %ROOT - global root in fileman format

 ; %UTL - temporary storage buffer

 ; %FILE - file 4000,4005,4006,4004,4011,4010,4012,4090.2,4012.1,4020

 ; Output - ^UTILITY global

 N ND,INY,GBL

 S ND=%ROOT_%XIEN_")"

 F  S ND=$Q(@ND) Q:%XIEN'=+$P(ND,%ROOT,2)  D

 .S INY=@ND,GBL=%UTL_$P(ND,%ROOT,2),@GBL=INY

 Q

PG ;Page break

 I IOSL-5'>$Y D

 .I $E(IOST)="C",INCR,$$CR^UTSRD(0,IOSL-1)

 .W @IOF

 Q

GETFLE(%FIL,%NIEN,%FILNM) ;Get file entry

 ; Output:

 ;  %FIL - File Number

 ;  %NIEN - Entry in file

 ;  %FILNM - File name

 S DIC="^DIC(",DIC(0)="AEQ",DIC("A")="Enter File Name:  "

 D ^DIC

 Q:Y=-1 0

 S %FIL=+Y

 S (%GBL,DIC)=^DIC($P(Y,U),0,"GL"),DIC("A")="Enter File Element Name:  "

 D ^DIC

 Q:Y=-1 0

 S %NIEN=+Y,%FILNM=$P(Y,U,2)

 Q 1

INHSYS07  ;JPD; 13 Nov 98 13:35;gis sys con data installation utility 

 +1       ;;3.01;BHL IHS Interfaces with GIS;;JUL 01, 2001

 +2       ;COPYRIGHT 1991-2000 SAIC

 +3       ;CHCS TOOLS_450; GEN 4; 26-SEP-1996

 +4       ;COPYRIGHT 1995 SAIC

 +5        QUIT 

%GCMP     ;Global file element compare

 +1        NEW %FIL,%FILNM,%EL1,%EL2,DIC,Y,%THATVOL,%THATUCI,%THISVOL,%THISUCI,%GBL

 +2        NEW %ROOT,%XIEN,%NIEN,%DONE,INY,GBL,%UTL,X,ND

 +3        IF ^%ZOSF("OS")'["VAX"

               WRITE !,"Not implemented yet"

               QUIT 

 +4        DO ENV^UTIL

 +5        WRITE @IOF

 +6        IF '$$GETFLE(.%FIL,.%NIEN,.%FILNM)

               QUIT 

 +7        SET (%THATUCI,%THATVOL)=""

           SET %DONE=0

 +8        FOR 

               Begin DoDot:1

 +9                USE 0

                   READ !,"Enter UCI you want to compare element from: ",%THATUCI:DTIME

 +10               IF %THATUCI["?"

                       WRITE !,"Pick a valid UCI"

                       QUIT 

 +11               IF %THATUCI="^"!'$LENGTH(%THATUCI)

                       SET %DONE=1

                       QUIT 

 +12               IF '$$UCICHECK^%ZTF(%THATUCI)

                       WRITE !,"Not a valid UCI"

                       QUIT 

 +13               IF %THATUCI[","

                       SET %THATVOL=$PIECE(%THATUCI,",",2)

                       SET %THATUCI=$PIECE(%THATUCI,",")

                       SET %DONE=1

                       QUIT 

 +14               USE 0

                   READ !,"Enter VOL you want to compare element from: ",%THATVOL:DTIME

 +15               IF %THATVOL["?"

                       WRITE !,"Pick a valid volume set"

                       QUIT 

 +16               IF %THATVOL="^"!'$LENGTH(%THATVOL)

                       SET %DONE=1

                       QUIT 

 +17               IF %THATVOL=^%ZOSF("VOL")

                       WRITE !,"You must pick a different Volume set"

                       QUIT 

 +18               IF '$$UCICHECK^%ZTF(%THATUCI_","_%THATVOL)

                       WRITE !,"Not a valid UCI or Volume set"

                       QUIT 

 +19               SET %DONE=1

               End DoDot:1

               IF %DONE

                   QUIT 

 +20       IF '$LENGTH(%THATUCI)!'$LENGTH(%THATVOL)!(%THATVOL="^")!(%THATUCI="^")

               QUIT 

 +21       SET X=%FILNM

           SET %GBL=$PIECE(%GBL,"^",2)

 +22       SET Y=$ORDER(@("^[%THATUCI,%THATVOL]"_%GBL_"""B"","""_X_""","""")"))

 +23       IF Y=""

               WRITE !,"File element does not exist in ["_%THATUCI_","_%THATVOL_"]"

 +24      IF '$TEST

               Begin DoDot:1

 +25               SET %ROOT="^[%THATUCI,%THATVOL]"_%GBL

 +26               SET %XIEN=Y

                   SET ND=%ROOT_Y_")"

 +27               SET %UTL="^UTILITY(""INHSYS"","_$JOB_","""_%FIL_""","

 +28               FOR 

                       SET ND=$QUERY(@ND)

                       IF %XIEN'=+$PIECE(ND,%GBL,2)

                           QUIT 

                       Begin DoDot:2

 +29                       SET INY=@ND

                           SET GBL=%UTL_$PIECE(ND,%GBL,2)

                           SET @GBL=INY

                       End DoDot:2

 +30               DO CMP(%NIEN,"^"_%GBL,%FIL,%XIEN)

               End DoDot:1

 +31       QUIT 

CMP(%NIEN,%ROOT,%FL,%OIEN,%RSLV) ;Compare global entries

 +1       ; %NIEN - ien of data in current environment

 +2       ; %ROOT - Root node of file

 +3       ; %FL - Fileman File number

 +4       ; %OIEN - ien from other environment

 +5       ; %RSLV - 1 - Resolve ptr values 0 - don't resolve

 +6        NEW %UTILITY,%NODE,%L1,%L2,%P

 +7        KILL ^UTILITY($JOB,%FL)

 +8        SET %RSLV=$GET(%RSLV)

 +9       ;Extract data from exisitng global

 +10       DO XTRK(%NIEN,%ROOT,"^UTILITY($J,"""_%FL_""",",%FL)

 +11      ;resolve pointer values

 +12       IF %RSLV

               DO EXPND^INHSYS09(%NIEN,%FL,%ROOT,%ROOT_%NIEN_",",1,%NIEN,0,%NIEN)

 +13      ;Build temp storage for existing files

 +14       SET %NODE="^UTILITY($J,%FL,%NIEN)"

           SET %UTILITY(1,0)=0

 +15       FOR 

               SET %NODE=$QUERY(@%NODE)

               IF '$LENGTH(%NODE)

                   QUIT 

               IF +$QSUBSCRIPT(%NODE,3)'=%NIEN

                   QUIT 

               Begin DoDot:1

 +16               SET %UTILITY(1,0)=%UTILITY(1,0)+1

 +17               SET %UTILITY(1,%UTILITY(1,0))=$PIECE(%NODE,",",4,999)_"="_@%NODE

               End DoDot:1

 +18       SET %UTILITY(1,0)=%UTILITY(1,0)+1

           SET %UTILITY(1,%UTILITY(1,0))=""

 +19      ;Build temp storage for new files

 +20       SET %NODE="^UTILITY(""INHSYS"",$J,%FL,%OIEN)"

           SET %UTILITY(2,0)=0

 +21       FOR 

               SET %NODE=$QUERY(@%NODE)

               IF '$LENGTH(%NODE)

                   QUIT 

               IF +$QSUBSCRIPT(%NODE,4)'=%OIEN

                   QUIT 

               Begin DoDot:1

 +22               SET %UTILITY(2,0)=%UTILITY(2,0)+1

 +23               SET %UTILITY(2,%UTILITY(2,0))=$PIECE(%NODE,",",5,999)_"="_@%NODE

               End DoDot:1

 +24       SET %UTILITY(1,0)=%UTILITY(1,0)+1

           SET %UTILITY(1,%UTILITY(1,0))=""

 +25       DO GCMP(.%UTILITY)

 +26       KILL ^UTILITY($JOB)

 +27       QUIT 

GCMP(%UTILITY) ;Compare values from %UTILITY nodes

 +1       ; Input:

 +2       ; %UTILITY - Global with files to compare

 +3        NEW %L1,%L2,%FOUND

 +4        SET (%L1,%L2)=1

           SET %FOUND=0

 +5       ;Determine differences

 +6        FOR 

               IF %UTILITY(1,0)<%L1!(%UTILITY(2,0)<%L2)

                   QUIT 

               Begin DoDot:1

 +7                IF %UTILITY(1,%L1)'=%UTILITY(2,%L2)

                       Begin DoDot:2

 +8                        DO PG

 +9                        IF '%FOUND

                               WRITE !,"The following difference(s) appear for the above entry:",!

 +10                       SET %FOUND=1

 +11                       DO DIFF(.%L1,.%L2,.%UTILITY)

                       End DoDot:2

 +12               SET %L1=%L1+1

                   SET %L2=%L2+1

               End DoDot:1

 +13       IF '%FOUND

               WRITE !,"No differences found",!

 +14       QUIT 

DIFF(%L1,%L2,%UTILITY) ;Diff found

 +1       ;Input/Output:

 +2       ; %L1 - Position in %UTILITY global node 1

 +3       ; %L2 - Position in %UTILITY global node 2

 +4       ;Establish point where diff took place

 +5        SET %P(1)=%L1

           SET %P(2)=%L2

           SET %P=0

 +6        FOR 

               IF '$$DL(.%P,.%L1,.%L2,.%UTILITY)

                   QUIT 

 +7        QUIT 

DL(%P,%L1,%L2,%UTILITY) ;

 +1       ;%P - Position in Array

 +2       ; %L1 - Position in %UTILITY global node 1

 +3       ; %L2 - Position in %UTILITY global node 2

 +4        NEW %A2,%A,%J,%K,%EXIT

 +5       ;Increment %P by 1 and %A by %P and %P(%A) by 1

 +6        SET %P=%P+1#2

           SET %A=%P+1

           SET %P(%A)=%P(%A)+1

 +7        IF %UTILITY(%A,0)'>%P(%A)

               SET %P(%A)=%UTILITY(%A,0)

 +8        IF %UTILITY(%A,%P(%A))=""

               Begin DoDot:1

 +9                SET %A2=%P+1#2+1

                   SET %P(%A2)=%UTILITY(%A2,0)

 +10               SET %J=%P(1)

                   SET %K=%P(2)

 +11               DO WRITE

               End DoDot:1

               QUIT 0

 +12       SET %EXIT=0

 +13      ;loop and look for same values between utility globals

 +14       SET %J=%P(1)

           FOR %K=%L2:1:%P(2)

               IF %UTILITY(1,%J)=%UTILITY(2,%K)

                   DO WRITE

                   SET %EXIT=1

                   QUIT 

 +15       IF %EXIT

               QUIT 0

 +16       SET %K=%P(2)

           FOR %J=%L1:1:%P(1)

               IF %UTILITY(1,%J)=%UTILITY(2,%K)

                   DO WRITE

                   SET %EXIT=1

                   QUIT 

 +17       QUIT '%EXIT

WRITE     ;

 +1        NEW %Z,%LI

 +2        SET %P(1)=%J

           SET %P(2)=%K

 +3       ;Write existing lines that are different

 +4        WRITE !,"Current Environment "_$GET(^%ZOSF("VOL"))_"  ***********************",!

 +5        FOR %Z=%L1:1:%P(1)

               IF %UTILITY(1,%Z)'=""

                   Begin DoDot:1

 +6                    SET %LI=%UTILITY(1,%Z)

 +7                    DO PG

 +8                    WRITE ?2,%Z,")",?7,%ROOT,%NIEN,",",%LI,!

                   End DoDot:1

 +9       ;

 +10      ;Write new lines that are different

 +11       WRITE !,"Other Environment  --------",!

 +12       FOR %Z=%L2:1:%P(2)

               IF %UTILITY(2,%Z)'=""

                   Begin DoDot:1

 +13                   SET %LI=%UTILITY(2,%Z)

 +14                   DO PG

 +15                   WRITE ?2,%Z,")",?7,%ROOT,%OIEN,",",%LI,!

                   End DoDot:1

 +16       WRITE !,"***************",!

 +17      ;set counters to new repositioned values

 +18       SET %L1=%P(1)

           SET %L2=%P(2)

 +19       QUIT 

XTRK(%XIEN,%ROOT,%UTL,%FILE) ;xtract existing global

 +1       ; Input:

 +2       ; %XIEN - ien of file extracting data from

 +3       ; %ROOT - global root in fileman format

 +4       ; %UTL - temporary storage buffer

 +5       ; %FILE - file 4000,4005,4006,4004,4011,4010,4012,4090.2,4012.1,4020

 +6       ; Output - ^UTILITY global

 +7        NEW ND,INY,GBL

 +8        SET ND=%ROOT_%XIEN_")"

 +9        FOR 

               SET ND=$QUERY(@ND)

               IF %XIEN'=+$PIECE(ND,%ROOT,2)

                   QUIT 

               Begin DoDot:1

 +10               SET INY=@ND

                   SET GBL=%UTL_$PIECE(ND,%ROOT,2)

                   SET @GBL=INY

               End DoDot:1

 +11       QUIT 

PG        ;Page break

 +1        IF IOSL-5'>$Y

               Begin DoDot:1

 +2                IF $EXTRACT(IOST)="C"

                       IF INCR

                           IF $$CR^UTSRD(0,IOSL-1)

 +3                WRITE @IOF

               End DoDot:1

 +4        QUIT 

GETFLE(%FIL,%NIEN,%FILNM) ;Get file entry

 +1       ; Output:

 +2       ;  %FIL - File Number

 +3       ;  %NIEN - Entry in file

 +4       ;  %FILNM - File name

 +5        SET DIC="^DIC("

           SET DIC(0)="AEQ"

           SET DIC("A")="Enter File Name:  "

 +6        DO ^DIC

 +7        IF Y=-1

               QUIT 0

 +8        SET %FIL=+Y

 +9        SET (%GBL,DIC)=^DIC($PIECE(Y,U),0,"GL")

           SET DIC("A")="Enter File Element Name:  "

 +10       DO ^DIC

 +11       IF Y=-1

               QUIT 0

 +12       SET %NIEN=+Y

           SET %FILNM=$PIECE(Y,U,2)

 +13       QUIT 1