cQGCMPCT	; Global Compaction Utility ;cQGCMPCT;
	Q
	;
START	; w !,"*** Global Database Compaction and Relocation Utility ***",!!
	I ($P($P($ZV,")",2),"(",1)[" 2008")!($P($P($ZV,")",2),"(",1)[" 2010") W !,"Use the utility ^cQDCMPCT" Q
	n %ST,%TIM,%DAT,DEND,DIRINFO,DIRNAM,GD,NUMMAP,POP,RD
	K A,B D DB^cQ21(.A) S I="" F  S I=$O(A(I)) Q:I=""  S B(A(I))=I
	S DIRNAM="",nmspc=$ZU(5) K ^[nmspc]ZZLOG("GCOMPACT",$ZCVT($ZU(110),"U"))
	F  S DIRNAM=$O(B(DIRNAM)) Q:DIRNAM=""  D STRT
	D REPORT
	Q
STRT	q:DIRNAM=""
	s DIRNAM=$ZU(12,DIRNAM)
	n otherglo s otherglo=0
	n blocks,fullness,gref,otherblks,otherfull
	; w "Specify the names of all the globals for which recompaction of",!
	; w "the entire global should occur: ",!
	S %G=1,%JO=$J
	D INT^cQGSET  Q:'%G
	; Specify how full the data blocks should be
	s fullness=95
	n NSPNAM s NSPNAM="^^"_DIRNAM
	;I %G=+^[NSPNAM]UTILITY("GLO",0) G device
device	;
	;D OUT^%IS Q:POP  ; ask for output device
	D INT^%D,INT^%T
	K ^[nmspc]ZZLOG("GCOMPACT",$ZCVT($ZU(110),"U"),DIRNAM) D LOG(%DAT_" "_%TIM)
	S K=$J("",24)_"Compressed",K=K_$J("",42-$L(K))_"To" D LOG(K)
	S K="Global",K=K_$J("",25-$L(K))_"Data Blks",K=K_$J("",35-$L(K))_"Data Blks",K=K_$J("",45-$L(K))_"End Time",K=K_$J("",55-$L(K))_"Last Node" D LOG(K)
	s totfrom=0,totto=0
	N %BatchMode S %BatchMode=$ZU(68,25,1)  ; save and set batch process mode
	D process                               ; process complete globals and any special entries
	S %BatchMode=$ZU(68,25,%BatchMode) Q    ; restore original batch process mode
process	; 
	; process complete globals
	s gref="" f  s gref=$o(^UTILITY(%JO,gref)) q:gref=""  s blocks=0 d compact
	; process special entries
	f glo=1:1:otherglo s gref=otherglo(glo),blocks=otherblks(glo),fullness=otherfull(glo) d compact
	S K=$J("",25)_"_________",K=K_$J("",35-$L(K))_"_________" D LOG(K)
	S K=$J("",25)_$j(totfrom,9),K=K_$J("",35-$L(K))_$j(totto,9)
	i totfrom S K=K_" "_$j(totto*100/totfrom,5,1)_"%"
	D LOG(K)
	q
	; compress and relocate this global
compact	s $zt="comperr"
	S K=gref
	n NSPNAM s NSPNAM="^^"_DIRNAM
	s g="^["""_NSPNAM_"""]"_gref
	i '$d(@g) S K=K_$J("",25-$L(K))_"no data in global" D LOG(K) q  ;jfp034;get starting block
	s x=$zu(98,fullness,blocks)
	s totfrom=totfrom+x,totto=totto+$p(x,",",2)
	S K=K_$J("",25-$L(K))_$j(+x,9),K=K_$J("",35-$L(K))_$j($p(x,",",2),9) D INT^%T S K=K_$J("",45-$L(K))_%TIM,K=K_$J("",55-$L(K))
	i $p(x,",",3)="" S K=K_"finished global"
	e  S K=K_$p(x,",",3,1000)
	D LOG(K)
	q
comperr	S K="Error processing this entry - skipping it" D LOG(K) q
	;
LOG(K)	I $L($G(K)) D
	. N L,VNR
	. I '$D(nmspc) S nmspc=$G(^["%SYS"]cLOG(0,"NAMESPACE",0))
	. I '$L(nmspc) S nmspc=$ZU(5)
	. S L=$G(DIRNAM,0) S:'$L(L) L=0
	. S VNR=$O(^[nmspc]ZZLOG("GCOMPACT",$ZCVT($ZU(110),"U"),L,""),-1)+1
	. S ^[nmspc]ZZLOG("GCOMPACT",$ZCVT($ZU(110),"U"),L,VNR)=K
	Q
	;
REPORT	D INI^cQ6 S QU="SU",PG=$T(+0),PN=$P($T(+1),";",2)_$ZCVT($ZU(110),"U"),B1=PN
	D TOTAL,D9002^cANEM0(PG,PN,.R)
	Q
	;
TOTAL	D INI^cQ6 S QU="SU"
	F I=1,2 S R($O(R(""),-1)+1)=$G(^ZZLOG("GCOMPACT",$ZCVT($ZU(110),"U"),0,I))
	S A="",$E(A,24)="Compressed blocks",$E(A,42)="   From        To",R($O(R(""),-1)+1)=A
	S A="",$E(A,42)="-------   -------",R($O(R(""),-1)+1)=A
	S (BFF,BTT,I)=0
	F  S I=$O(^ZZLOG("GCOMPACT",$ZCVT($ZU(110),"U"),I)) Q:I=""  D
	. S A=I,B=^($O(^ZZLOG("GCOMPACT",$ZCVT($ZU(110),"U"),I,""),-1)),$E(A,34)=$E(B,20,$L(B)),R($O(R(""),-1)+1)=A
	. S B=$ZSTRIP(B,"<W")
	. S BF=$P(B," "),BFF=BFF+BF,B=$ZSTRIP($P(B,BF,2),"<W")
	. S BT=$P(B," "),BTT=BTT+BT
	S A="",$E(A,42)="-------   -------",R($O(R(""),-1)+1)=A
	S A="",$E(A,42)=$J(BFF,7)_"   "_$J(BTT,7),R($O(R(""),-1)+1)=A
	S A="",R($O(R(""),-1)+1)=A
	S A="",$E(A,24)="Space gained",$E(A,42)=$J(BFF-BTT,7)_"   "_$J(BFF-BTT*2\1024,7)_" MB",R($O(R(""),-1)+1)=A
	S I="" F  S I=$O(R(I)) Q:I=""  S R(I)=$TR(R(I),"\","/")
	Q
	;
ZZ	; 17.01.2012 - 15:58 * Cache-r6.4.9