cQCPFR ;Check global location with globalmapping in cache.cpf ;cQCPFR;
Q
;
date ;date
N %H,%J,%R S %H=1+$H,%J=%H\1461,%R=%H#1461,DJ=%J*4+1841+(%R\365),DD=%R#365,DM=1 I %R=1460 S DD=365,DJ=DJ-1
F %J=31,(%R>1154)+28,31,30,31,30,31,31,30,31,30 Q:%J'
$L(GA) S GX=48 D L(GA,GB,GX,DB(L)) Q
..... I $L(GB)=$L(GA) S GX=$A($E(GA,$L(GA))),GA=$E(GA,1,$L(GA)-1) D L(GA,GB,GX,DB(L)) Q
..... I $L(GB)<$L(GA) S GX=48,GA=$E(GA,1,$L(GB)) D L(GA,GB,GX,DB(L)) Q
.... S LOC("^"_K)=DB(L)
. S H=""
. F S H=$O(DB(H)) Q:H="" K C D GD^cQVGGLO("^^"_DB(H),.C) S G="" D
.. F S G=$O(LOC(G)) Q:G="" S GS="" D
... I $O(LOC(G,GS))="" D Q
.... I G?1"^".AN1"*" D Q
..... S (GX,GY)=$P(G,"*"),GX=$O(C(GX),-1)
..... F S GX=$O(C(GX)) Q:GX="" Q:$E(GX,1,6)="^mtemp" Q:$E(GX,1,$L(GY))'=GY Q:$D(LOC(GX)) D GC(GX,LOC(G),.DB,AUTO)
.... I $D(C(G)) D GC(G,LOC(G),.DB,AUTO)
... F S GS=$O(LOC(G,GS)) Q:GS="" D
.... I GS'[":" I $D(C(G)) D GC(G_GS,LOC(G,GS),.DB,AUTO) Q
.... I GS[":" D Q
..... S GA=$TR($P(GS,":"),"("")"),GB=$TR($P(GS,":",2),"("")")
..... F I=1:1 S X=GA_I D:$D(B(X)) GC(G_"("""_X_""")",LOC(G,GS),.DB,AUTO) Q:X=GB
.. F S G=$O(C(G)) Q:G="" Q:G="^mtemp" S SW=0 D
... I $O(LOC(G,""))'="" S GS="" D Q
.... F S GS=$O(@("^[""^^"_DB(H)_"""]"_$E(G,2,$L(G))_"("""_GS_""")")) Q:GS="" D
..... I GS["""" S GS=$$DOUBLEQ^cQ9(GS)
..... Q:$D(LOCI(G_"("""_GS_""")")) Q:$D(LOCI(G_"("_GS_")"))
..... D GC(G_"("""_GS_""")",LOC(G),.DB,AUTO) S SW=1
... I 'SW I $D(LOC(G)) D GC(G,LOC(G),.DB,AUTO) S SW=1 Q
... I 'SW F I=$L(G):-1:2 S GS=$E(G,1,I)_"*" I $D(LOC(GS)) D GC(G,LOC(GS),.DB,AUTO) S SW=1 Q
... Q:$E(G,1,10)="^CacheTemp" Q:G="^ROUTINE"
... I 'SW,'$D(LOC(G)) D GC(G,A(B(N,"globals")),.DB)
;
W !!,"Summary:",! S J=""
I $O(ACT(J))="" W !,"Nothing to do!",!
E F S J=$O(ACT(J)) Q:J="" W !,ACT(J)
;
YZ Q
;
PC ;Purge queries and Compile objects
D $System.SQL.Purge()
D $System.OBJ.CompileAll("bckr")
PCZ Q
;
CI ;Controle indexen
D UPDI^cABVBP18("DC"),UPDI^cABVBP18("DP"),UPDI^cABVBP18("G"),UPDI^cABVBP18("F")
CIZ Q
;
;
L(A,B,X,Z) N I,O
F I=X:1:122 I $C(I)?1AN S O=A_$C(I) Q:O]B I '$D(LOC("^"_O)) S LOC("^"_O_"*")=Z
LZ Q
;
GM(X) ;Get Global Mapping for Namespace X
N G,I,J,K,L,M,N,RPN,SW,Y S X=$G(X) Q:'$L(X)
S L=0,Y=$S(($P($P($ZV,")",2),"(",1)[" 2010"):"[Map.",1:"[NspMap.") K GM
F S L=$O(^TEMP($J,"org",L)) Q:L="" S K=^(L) D
. I $E(K,1,$L(Y))=Y D
.. S (RPN,N)=$P($P(K,".",2),"]"),G=1
.. I N'?1"V".N D
... S (RPN,G)=""
... F I=1:1:$L(N) Q:$E(N,I)?1N S RPN=RPN_$E(N,I)
... F I=I:1:$L(N) Q:$E(N,I)'?1N S G=G_$E(N,I)
... I $E(N,I)?1A S RPN=RPN_"-" F I=I:1:$L(N) S RPN=RPN_$E(N,I)
.. I N=X D
... S GM(0)=K
... ;Is this our globalmapping?
... S SW=0,M=$S(($P($P($ZV,")",2),"(",1)[" 2010"):"Global_BA=",1:"GloMap_1=BA,"),K=^($O(^TEMP($J,"org",L))) I $E(K,1,$L(M))=M S SW=1
... ;Skip until line is empty, if 'SW keep these lines else skip them
... F S L=$O(^TEMP($J,"org",L)) Q:L="" S K=^(L) Q:K="" S:SW GM($O(GM(""),-1)+1)=K
GMZ Q
;
GMX(B,C,E) ;Set globalmapping for database B, number C
N J,K,L,M,N,O,R S B=$G(B),C=$G(C),E=$G(E) Q:'$L(B)!'$L(C)
S R=$P(B,"-"),L="^cQCPF"_$S(($P($P($ZV,")",2),"(",1)[" 2010"):"10",1:"0") K GMX
F J=1:1 S M="1+"_J_L,K=$T(@M) S K=$P(K,";",2) Q:K="END" D
. F Q:K'["roepnaam" S K=$P(K,"roepnaam")_R_$P(K,"roepnaam",2,$L(K,"roepnaam"))
. F Q:K'["database" S K=$P(K,"database")_B_$P(K,"database",2,$L(K,"database"))
. F Q:K'["Gx" S K=$P(K,"Gx")_$S($L(E):E_"-",1:"")_"G"_C_$P(K,"Gx",2,$L(K,"Gx"))
. I $L(E),K["G0" S K=$P(K,"G0")_E_"-G0"
. I ($P($P($ZV,")",2),"(",1)[" 2008") D
.. I K["GloMap_",$P(K,",",5)=-1 S $P(K,",",5)=5
.. I K["GloSLM_",$P(K,"~",3)=1 S $P(K,"~",3)=0
. S GMX($O(GMX(""),-1)+1)=K
S J=""
F S J=$O(GMX(J)) Q:J="" I GMX(J)[($P(B,"-")_99) K M,R D
. I ($P($P($ZV,")",2),"(",1)[" 2010") D Q
.. S K=$P(GMX(J),"("),L="" F S L=$O(GMX(L)) Q:L="" I $E(GMX(L),1,$L(K))=K S M(L)=GMX(L),R(GMX(L))=L
.. S (L,K)="" F S L=$O(M(L)) Q:L="" S GMX(L)=M(L) I M(L)["(" S K=$O(R(K)),GMX(L)=K
. E D
.. S K=$P(GMX(J),"_",2),L="" F S L=$O(GMX(L)) Q:L="" I $P(GMX(L),"_",2)=K,$P($P(GMX(L),"=",2),"~")'="(0)" S M(L)=GMX(L),R($P(GMX(L),"=",2))=L
.. S (L,N)="",O=1 F S L=$O(M(L)) Q:L="" S GMX(L)=M(L) I M(L)["(" S O=O+1,N=$O(R(N)),GMX(L)="GloSLM_"_K_"_"_O_"="_N
GMXZ Q
;
GC(G,L,Z,S) ;Check global G, must be in L not in other databases
N C1,C2,K,L1,L2,X
S G=$G(G),L=$G(L),S=+$G(S),K="" Q:'$L(G) Q:'$L(L) I $E(G)="^" S G=$E(G,2,$L(G))
S %ZT=$ZT,$ZT="GCE"
F S K=$O(Z(K)) Q:K="" I Z(K)'=L,$D(@("^[""^^"_Z(K)_"""]"_G)) D
. W !,"Global ",G
. W !?20," should be in ",L
. W !?20," also found in ",Z(K)
. S L1="^[""^^"_L_"""]"_G
. S L2="^[""^^"_Z(K)_"""]"_G
. S C1=$$CHECK^cQVGGLO(L1,0) W !,"Checksum is ",C1
. S C2=$$CHECK^cQVGGLO(L2,0) W $S(C1=C2:"=",1:"<>"),C2
. I C1=C2 S X="Kill "_L2 D ACT(X,S) Q
. S X="Merge "_L1_"="_L2 D ACT(X,S) S X="Kill "_L2 D ACT(X,S)
S $ZT=%ZT
GCZ Q
;
GCE I $ZE["" Q
W !,$ZE,! ZQ
;
ACT(X,S) N I,SW S X=$G(X),S=+$G(S),SW=0 Q:'$L(X)
F I=1:1:$O(ACT(""),-1) I ACT(I)=X S SW=1 Q
Q:SW W !,X S ACT($O(ACT(""),-1)+1)=X
I S X X
ACTZ Q
;
V5(Z) ;Check V5 global mapping
;If Z=1 => update all mappings
N G,J,K,L,N,RPN,Y
S Z=+$G(Z),X=$G(X) I 'Z,'$L(X) Q
;Do not proceed on TBxxx systems
S K=$E($ZCVT($ZU(110),"U"),1,2) I (K="TB") Q
I '($P($P($ZV,")",2),"(",1)[" 5.") Q
D TEMPI^cQCPF() S (SW,L)=0,Y="[NspMap." K ^TEMP($J,"new")
F S L=$O(^TEMP($J,"org",L)) Q:L="" S K=^(L) D S(K) D
. I $E(K,1,$L(Y))=Y D
.. S (RPN,N)=$P($P(K,".",2),"]"),G=1
.. I N'?1"V".N D
... S (RPN,G)=""
... F I=1:1:$L(N) Q:$E(N,I)?1N S RPN=RPN_$E(N,I)
... F I=I:1:$L(N) Q:$E(N,I)'?1N S G=G_$E(N,I)
... I $E(N,I)?1A S RPN=RPN_"-" F I=I:1:$L(N) S RPN=RPN_$E(N,I)
.. I N=X!Z D
... ;Is this our globalmapping?
... S M="GloMap_1=BA,",K=^($O(^TEMP($J,"org",L))) I $E(K,1,$L(M))=M S SW=1
... ;Skip until line is empty, if 'SW keep these lines else check them
... F S L=$O(^TEMP($J,"org",L)) Q:L="" S K=^(L) D Q:K=""
.... I SW D
..... I K["GloMap_" D
...... I $P(K,",",5)=5,^($O(^TEMP($J,"org",L)))'["GloSLM_" S $P(K,",",5)=-1 Q
...... I $P(K,",",5)=-1,^($O(^TEMP($J,"org",L)))["GloSLM_" S $P(K,",",5)=5 Q
..... I K["GloSLM_",$P(K,"~",3)=0 S $P(K,"~",3)=1
.... D S(K)
D BUC^cQCPF(),TEMPO^cQCPF()
V5Z Q
;
S(R) S ^($O(^TEMP($J,"new",""),-1)+1)=R
SZ Q
;
ER U 0 W !,$ZE,!
ERZ Q
;
ZZ ; 17.01.2012 - 15:58 * Cache-r6.4.9