Fold[
 Last[SortBy[{#1, {#2, Length@ProperDivisors[#2]}}, Last]] &,
 {0, 0},
 Range[20000]]