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
