ClearAll[HP, HPChain] HP[n_] := FromDigits[Catenate[IntegerDigits /@ Sort[Catenate[ConstantArray @@@ FactorInteger[n]]]]] HPChain[n_] := NestWhileList[HP, n, PrimeQ/*Not] Row[Prepend["Home prime chain for " <> ToString[#] <> ": "]@Riffle[HPChain[#], ", "]] & /@ Range[2, 20] // Column Row[Prepend["Home prime chain for 65: "]@Riffle[HPChain[65], ", "]]