AbsoluteTiming[
 f[n_, a_, b_, c_, k_] := Module[{x = IntegerDigits[n]},
   If[{a, k} != {1, 0},
    x[[a]] = x[[b]] = x[[c]] = k;
    FromDigits[x], 0]];
 g[n_, a_, b_, c_] := Length[Select[Flatten[
     Table[f[n, a, b, c, k], {k, 0, 9}]], PrimeQ]];
 h[n_] := Table[g[n, a, b, c], {a, 1, IntegerLength[n] - 3},
   {b, a + 1, IntegerLength[n] - 2}, {c, b + 1, IntegerLength[n] - 1}];
 nmin = SelectFirst[
   Table[Prime[k], {k, PrimePi[56003] + 1, PrimePi[10^6]}],
   Max[h[#]] == 8 &];
 lst = Accumulate@Flatten[Position[h[nmin], 8]];

 ans = Min[
   Select[Table[f[nmin, lst[[1]], lst[[2]], lst[[3]], k], {k, 0, 9}],
    PrimeQ]]]