I wrote a script that calculate database fragmentation level (between 0 and 100%). The idea is to fetch all blocks, to find which global they belongs to, and then count how many segments exists (one sequence being a set of consecutive blocks belonging to same global (eg: in AAAADDBBAACCC there is 5 segments). It's based on Dmitry BlocksExplorer open source project. The formula is as such :

Fragmentation % = (TotalSegments - GlobalCount) / (TotalBlocks - GlobalCount)

///usage: do ..ReadBlocks("D:\YOUR_DATABASE\")ClassMethod ReadBlocks(path As%String)
{
    new$namespaceznspace"%sys"//get total amount of blocksset db = ##class(SYS.Database).%OpenId(path)
    set totalblocks = db.Blocks
    set db = ""set blockcount = 0open63:"^^"_path	
    set^TEMP("DEFRAG", "NODES", 3)=$listbuild("", 0)	
    while$data(^TEMP("DEFRAG", "NODES"))=10//any childs
    {
        set blockId = ""for
        {		
            set blockId = $order(^TEMP("DEFRAG", "NODES", blockId),1,node)
            quit:blockId=""kill^TEMP("DEFRAG", "NODES", blockId)
            
            set globalname = $lg(node,1)
            set hasLong = $lg(node,2)
            
            do:blockId'=0..ReadBlock(blockId, globalname, hasLong, .totalblocks, .blockcount)			
        }	
    }
    close63set^TEMP("DEFRAG","PROGRESS") = "DONE"do..CalculateFragmentation()
}

ClassMethod ReadBlock(blockId As%String, globalname As%String, hasLong As%Boolean, ByRef totalblocks As%Integer, ByRef blockcount As%Integer)
{
    view blockId   	
    set blockType=$view(4,0,1)
    
    if blockType=8//data block
    {
        if hasLong 
        {
            for N=1:1
            {
                setX=$VIEW(N*2,-6)
                quit:X=""set gdview=$ascii(X)
                if$listfind($listbuild(5,7,3),gdview) 
                {
                    set cnt=$piece(X,",",2)
                    set blocks=$piece(X,",",4,*)
                    for i=1:1:cnt 
                    {
                        set nextBlock=$piece(X,",",3+i)
                        
                        set^TEMP("DEFRAG","GLOBAL",nextBlock) = globalname		
                        set blockcount = blockcount + 1//update progressset^TEMP("DEFRAG","PROGRESS") = $number(blockcount / totalblocks * 100, 2)
                    }
                }
            }
        }
    } 
    else//block of pointers
    {		
        if blockType = 9//catalog
        {
            set nextglobal=$view(8,0,4)	//large catalogs might spawn on multiple blocksquit:$data(^TEMP("DEFRAG","GLOBAL",nextglobal))
            set:nextglobal'=0^TEMP("DEFRAG", "NODES", nextglobal) = $listbuild("",0) //next catalog
        }
        
        for N=1:1
        {
            setX=$VIEW(N-1*2+1,-6)
            quit:X=""set nextBlock=$VIEW(N*2,-5)
            if blockType=9set globalname=Xset haslong=0if$piece($view(N*2,-6),",",1) 
            {
                set haslong=1
            }
            
            continue:$data(^TEMP("DEFRAG","GLOBAL",nextBlock) )//already seen?set^TEMP("DEFRAG", "NODES", nextBlock) = $listbuild(globalname,haslong)				
            set^TEMP("DEFRAG","GLOBAL",nextBlock) = globalname	
            set blockcount = blockcount + 1set^TEMP("DEFRAG","PROGRESS") = $number(blockcount / totalblocks * 100, 2)
        }
    }
}

ClassMethod CalculateFragmentation()
{
    set segments = 0, blocks = 0, blocktypes = 0kill^TEMP("DEFRAG", "UNIQUE")
    
    set previousglobal = ""set key = ""for
    {	    
        set key = $order(^TEMP("DEFRAG","GLOBAL",key),1,global)
        quit:key=""if global '= previousglobal
        {	   		   	
            set previousglobal = global		   		
            set segments = segments + 1
        }
        
        if '$data(^TEMP("DEFRAG", "UNIQUE", global))	
        {
            set^TEMP("DEFRAG", "UNIQUE", global)=""set blocktypes = blocktypes + 1
        }
        
        set blocks = blocks + 1
    }
    write$number((segments - blocktypes) / (blocks - blocktypes) * 100, 2)
}

Notes : 

• Use it at your own risks. It's not supposed to write anything in database (doing only read operations) but I'm unfamiliar with the VIEW command and it's possible caveats.
• This might take a really long time to complete (several hours), especially if database is huge (TB in size). Progress can be checked by reading ^TEMP("DEFRAG","PROGRESS") node.