We use PositionIndex to get the index values where each distinct digit occurs (these are already sorted in the order they first occur). We then use MapIndexed to create a list that looks like index -> order at which first digit occurs, and use Mod[#,10] to replace the 10th order digit with 0th order digit. and construct a SparseArray from this:

A358497$New[k_] := With[{pI = Values@PositionIndex@IntegerDigits@k},
  MapIndexed[#1 -> Mod[#2[[1]], 10] &, pI, {2}] // Flatten // 
    SparseArray // FromDigits
  ]

We can compare performance with the original function:

A358497$New[k_] := With[{pI = Values@PositionIndex@IntegerDigits@k},
  MapIndexed[#1 -> Mod[#2[[1]], 10] &, pI, {2}] // Flatten // 
    SparseArray // FromDigits
  ]

A358497$Orig[k_] := 
  FromDigits[
   Table[Mod[
     CountDistinct[Take[#, FirstPosition[#, #[[i]]][[1]]]] &[
      IntegerDigits[k]], 10], {i, 1, IntegerLength[k]}]];


tests = Prime@Range[10^8, 10^9, 10^7];
A358497$Orig /@ tests; // RepeatedTiming // ScientificForm
A358497$New /@ tests; // RepeatedTiming // ScientificForm

{8.0767*10^(-3),Null}

{1.8007*10^(-3),Null}

giving a 4-5x improvement in time. And we verify the two functions produce the same output:

(A358497$Orig /@ tests) == (A358497$New /@ tests)

(*True*)

Update

Edit: Per @SjoerdSmit here, ReplaceAll is overkill in this case, and we should instead use Lookup. We can also write this in a more readable way than my previous answer:

 Module[{digs = IntegerDigits@k, orderedDigs, rules}, 
  orderedDigs = Keys@PositionIndex@digs;
  rules = MapIndexed[#1 -> Mod[#2[[1]], 10] &, orderedDigs];
  Lookup[rules, digs] // FromDigits
  ]

And now we golf it a little to make it slightly faster by not defining any new local variables

A358497$Sjoerd[
  k_] := (Lookup[ 
      MapIndexed[#1 -> Mod[#2[[1]], 10] &, Keys@PositionIndex@#], #] //
      FromDigits) &@IntegerDigits@k

And compare our 2 new functions to the original:

tests = Prime@Range[10^8, 10^9, 10^7];

A358497$Orig /@ tests; // RepeatedTiming // ScientificForm
A358497$New /@ tests; // RepeatedTiming // ScientificForm
A358497$Sjoerd /@ tests; // RepeatedTiming // ScientificForm

(*{8.14147*10^(-3),Null}*)

(*{1.85377*10^(-3),Null}*)

(*{1.16995*10^(-3),Null}*)

So using Sjoerd's Lookup method gives a 6-7x time improvement over the original.

Original Post

We use PositionIndex to get the index values where each distinct digit occurs (these are already sorted in the order they first occur). We then use MapIndexed to create a list that looks like index -> order at which first digit occurs, and use Mod[#,10] to replace the 10th order digit with 0th order digit. and construct a SparseArray from this:

A358497$New[k_] := With[{pI = Values@PositionIndex@IntegerDigits@k},
  MapIndexed[#1 -> Mod[#2[[1]], 10] &, pI, {2}] // Flatten // 
    SparseArray // FromDigits
  ]

We can compare performance with the original function:

A358497$New[k_] := With[{pI = Values@PositionIndex@IntegerDigits@k},
  MapIndexed[#1 -> Mod[#2[[1]], 10] &, pI, {2}] // Flatten // 
    SparseArray // FromDigits
  ]

A358497$Orig[k_] := 
  FromDigits[
   Table[Mod[
     CountDistinct[Take[#, FirstPosition[#, #[[i]]][[1]]]] &[
      IntegerDigits[k]], 10], {i, 1, IntegerLength[k]}]];


tests = Prime@Range[10^8, 10^9, 10^7];
A358497$Orig /@ tests; // RepeatedTiming // ScientificForm
A358497$New /@ tests; // RepeatedTiming // ScientificForm

{8.0767*10^(-3),Null}

{1.8007*10^(-3),Null}

giving a 4-5x improvement in time. And we verify the two functions produce the same output:

(A358497$Orig /@ tests) == (A358497$New /@ tests)

(*True*)