f = DivisorSigma[1, #] - # &;
limit = 10^5;
c = Not /@ PrimeQ[Range[limit]];
slimit = 15 limit;
s = ConstantArray[False, slimit + 1];
untouchable = {2, 5};
Do[
 val = f[i];
 If[val <= slimit,
  s[[val]] = True
  ]
 ,
 {i, 6, slimit}
]
Do[
 If[! s[[n]],
  If[c[[n - 1]],
   If[c[[n - 3]],
    AppendTo[untouchable, n]
    ]
   ]
  ]
 ,
 {n, 6, limit, 2}
]
Multicolumn[Select[untouchable, LessEqualThan[2000]]]
Count[untouchable, _?(LessEqualThan[2000])]
Count[untouchable, _?(LessEqualThan[10])]
Count[untouchable, _?(LessEqualThan[100])]
Count[untouchable, _?(LessEqualThan[1000])]
Count[untouchable, _?(LessEqualThan[10000])]
Count[untouchable, _?(LessEqualThan[100000])]