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 $namespace
    znspace "%sys"
    //get total amount of blocks
    set db = ##class(SYS.Database).%OpenId(path)
    set totalblocks = db.Blocks
    set db = ""
    set blockcount = 0
    open 63:"^^"_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)			
        }	
    }
    close 63
    set ^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
            {
                set X=$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 progress
                        set ^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 blocks
            quit:$data(^TEMP("DEFRAG","GLOBAL",nextglobal))
            set:nextglobal'=0 ^TEMP("DEFRAG", "NODES", nextglobal) = $listbuild("",0) //next catalog
        }
        
        for N=1:1
        {
            set X=$VIEW(N-1*2+1,-6)
            quit:X=""
            set nextBlock=$VIEW(N*2,-5)
            if blockType=9 set globalname=X
            set haslong=0
            if $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 + 1
            set ^TEMP("DEFRAG","PROGRESS") = $number(blockcount / totalblocks * 100, 2)
        }
    }
}

ClassMethod CalculateFragmentation()
{
    set segments = 0, blocks = 0, blocktypes = 0
    kill ^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.