Here is a direct approach:
digitsum = Composition[Total, IntegerDigits]; stubbornQ = PrimeQ[#] && Nor @@ PrimeQ[digitsum[#] - {1, 2, 3, 0, -1}] &; i = 1; While[! stubbornQ[++i]] i 8999
This was quite sufficient in this case. For larger search spaces see Iterate until condition is met.
A bit more efficient for v10+ using NoneTrue for early exit:
stubbornQ = PrimeQ[#] && NoneTrue[digitsum[#] - {1, 2, 3, 0, -1}, PrimeQ] &