cICHKGLO(home,UCIL,G,S,X,COMP) ;Checksum globals for scheme S ;%ICHKGLO; [ 04/14/2000  4:06 PM ]
 ; UCI voor ZZLOG, UCI's, globals, schema, volumegroep met %LOG , switch of de compare automatisch moet opgestart worden (=1)
 ;
T0 ;Checksum van bestanden ;
 ;
T0F ;Checksum des fichiers ;
 ;
 I '$L(home)!'$L(UCIL)!'$L(G) G YZ
 S $ZT="^cA406",D="\",IU=0 K UCS
 S LOG="^|home|ZZLOG(""CHECK"",""G"")"
 S %LOG="^|""MGR,"_X_"""|%LOG(X,""CHECK"",""G"")"
 S %LOGC="^|""MGR,"_X_"""|%LOG(X,""CENTRAL"",""G"")"
 S EX="\%QUERY\HULPSTA\UTILITY\ZUT\ZZLOG\SQL\SQLCHG\SQLCK\SQLCUR\SQLEMP\SQLEMPN\SQLEX\SQLIC\SQLIN\SQLIX\SQLJ\SQLP\SQLPROJ\SQLRD\SQLS\SQLSQ\SQLXP\SQLXQ\SQLXR\SQLXT\SQLXX\"
 ;
 F I=1:1:$L(UCIL,D) S K=$P(UCIL,D,I) I $L(K) S IU=IU+1,UCS(IU)=K
 S UCS=$ZU(5) L +@LOG@(S,0,UCS):15 E  G YZ
 D ^cA105,^cA106 S DT1=DT,TD1=TD,%GT=0,%G="",%I=0
 F  S %G=$O(@LOG@(S,%G)) Q:%G=""  K ^(%G,UCS)
 I $P(G,D)="special" S I=0,G="" D
 . F  S I=$O(@%LOG@(S,"GLOBALS",I)) Q:I=""  S G=G_^(I)_D
 I $P(G,D)="central" S I=0,K="" D
 . S K=$G(@%LOGC@($P(G,D,2),"GLOBALS"))
 . I $P(K,D)="special" S I=0,K="" D
 .. F  S I=$O(@%LOGC@($P(G,D,2),"GLOBALS",I)) Q:I=""  S K=K_^(I)_D
 . S G=K
 ;
 I G="*" S %G="%" F  S %G=$O(@("^"_%G)) Q:%G=""  D GCHECK(%G)
 I G'="*" F %J=1:1:$L(G,D) S K=$P(G,D,%J) I $L(K) D
 . I K'["*" S %G=K D PROC(%G) Q
 . I $E(K,$L(K))="*"  D
 .. S K=$E(K,1,$L(K)-1),%G=$E(K,1,$L(K)-1)_$C($A(K,$L(K))-1)
 .. F  S %G=$O(@("^"_%G)) Q:%G=""!($E(%G,1,$L(K))]$E(K,1,$L(K)))  I $E(%G,1,$L(K))=K D GCHECK(%G)
 . I $E(K)="*"  S %G="%" F  S %G=$O(@("^"_%G)) Q:%G=""  I "*"_$E(%G,$L(%G)-$L(K)+2,$L(%G))=K D GCHECK(%G)
 ;
 D ^cA105,^cA106 S @LOG@(S,0,UCS)=%GT_D_%I_D_DT1_D_TD1_D_DT_D_TD_D
 L -@LOG@(S,0,UCS):1
 ;
 I UCS=UCS(1) D
 . F  Q:$$LOCK  H 15
 . D CLEAN
 . I $G(COMP),$L($O(@LOG@(S,0))) J ^cICHKCCH(S)  ; opstarten controle data
 . D UNLOCK
 ;
YZ Q
 ;
PROC(%GN)         ;
 I '$F(%GN,"(,")&'$F(%GN,",,")&'$F(%GN,"-") D GCHECK(%GN) Q
 N %GSD,IND,K,i,%GEN,OGN
 I $E(%GN)'="^" S %GN="^"_%GN
 S OGN=%GN
 S %GSD=$TR($P($P(%GN,"(",2,99),")"),"""","")
 S %GN=$P(%GN,"("),IND=1
 F i=1:1:$L(%GSD,",") D
 . S K=$TR($P(%GSD,",",i),"""","")
 . I K["-" S %GEN(i)=K,%GEN=i Q
 . I $L(K) S %GEN(i)=K_"-"_K,%GEN=i I $E(%GN,$L(%GN))
 . I $L(K),i=1!($L($P($P(%GN,"(",2),",",i-1))&$L($P(%GSD,",",i-1))&($P(%GSD,",",i-1)'["-")) S %GN=%GN_$S(i=1:"(",1:",")_""""_K_"""",IND=IND+1
 I %GN["(" S %GN=%GN_")"
 S K="" I $L($P($G(%GEN(IND)),"-")) S K=$O(@%GN@($P($G(%GEN(IND)),"-")),-1)
 S (%ST,%S1)=0
 F  S %GN=$NA(@%GN,IND-1),K=$O(@%GN@(K)) Q:K]]$P($G(%GEN(IND)),"-",2)&$D(%GEN(IND))!'$L(K)  D
 . S %GN=$NA(@%GN@(K))
 . S %T=$$CHECK(%GN),%GT=%GT+%T
 . S %ST=%ST+%T,%S1=%S1+%1
 S @LOG@(S,$S($E(OGN)="^":"",1:"^")_OGN,UCS)=$E(%ST_D_%S1_D,1,253),%I=%I+1
 Q
 ;
GCHECK(%G)         ;
 Q:$G(EX)[(D_%G_D)
 S %T=$$CHECK(%G),%GT=%GT+%T,%I=%I+1
 S @LOG@(S,$S($E(%G)="^":"",1:"^")_%G,UCS)=$E(%T_D_%1_D,1,253)
 Q
 ;
CHECK(%GN) ;
 N %GX,K S (%T,%1)=0 S:$E(%GN)'="^" %GN="^"_%GN
 S %GX=%GN,%GS=0 I %GX["(" S %GS=$L(%GX,",")
 I $D(@%GX)#10=1 S %T=%T+$$CRC(%GX),%1=1
 F  S %GX=$Q(@%GX) Q:%GX=""  Q:$NA(@%GX,%GS)'=$NA(@%GN,%GS)  D  Q:%GX=""
 . I $G(%GEN) S K=$$TEST(%GX) Q:K=1  I K=2 S %GX="" Q
 . S %T=%T+$$CRC(%GX),%1=%1+1
 Q %T
 ;
TEST(%GN)          ;
 N OK,K
 S OK=0
 F i=$G(%GEN):-1:1 S K=$TR($P($P(%GN,"(",2),",",i),"()""","") I $D(%GEN(i)),K'=$P(%GEN(i),"-"),K']]$P(%GEN(i),"-") S OK=1 Q
 I 'OK F i=$G(%GEN):-1:1 S K=$TR($P($P(%GN,"(",2),",",i),"()""","") I $D(%GEN(i)),K]]$P(%GEN(i),"-",2) S OK=2 Q
 Q OK
 ;
CRC(%GR) S %GD=@%GR
 I $E(%GR,2)="[" S %GR="^"_$P(%GR,"]",2,$L(%GR,"]"))
 I $E(%GR,2)="|" S %GR="^"_$P(%GR,"|",3,$L(%GR,"|"))
 S %X=$ZCRC(%GR,1)+$ZCRC(%GD,1)
 Q %X
 ;
LOCK() S IU=$G(IU,0),SW=1 F I=1:1:IU Q:'SW  L +@LOG@(S,0,UCS(I)):0 E  S SW=0
 I 'SW D UNLOCK
LOCKZ Q SW
 ;
UNLOCK S IU=$G(IU,0) F I=1:1:IU L -@LOG@(S,0,UCS(I))
UNLOCKZ Q  
 ;
CLEAN N UCI
 M UCI=UCS
 F I=1:1:IU I $P($G(@LOG@(S,0,UCS(I))),D)'?1.N K UCI(I)
 S %G=0
 F  S %G=$O(@LOG@(S,%G)) Q:%G=""  D
 . K A
 . F I=1:1:IU I $D(UCI(I)) S A(UCI(I))=$P($G(@LOG@(S,%G,UCI(I))),D,1,2)
 . S SW=1 F II=2:1:IU I $D(UCI(II)),$G(A(UCI(1)))'=$G(A(UCI(II))) S SW=0
 . I SW K @LOG@(S,%G)
CLEANZ Q
 ;
ZZ ; 30.07.98 - 20 u 02 * V6.7