Solving for unknowns that are related

Question

For this code:

A002110 = 510510;
primeFactorsOfPrimorial = {2, 3, 5, 7, 11, 13, 17};
A038110 = 3072;
A060753 = 17017;
list1 = Range[1, EulerPhi[A002110], A038110];
list2 = {-1415, 1657, 4729, 7801, 10873, 13945} 
Differences[list2]
possibleTotatives = 
  Table[(A060753*list1[[i]] - list2[[j]])/A038110, {i, 1, 
    Length[list1]}, {j, 1, Length[list2]}];
sortedPossibleTotatives = 
 Sort /@ possibleTotatives;(*for this A002110=510510 example,these \
values have no gaps,but other primorials there are \
gaps*)sortedPossibleTotatives2 = 
 Map[Select[#, 
    FreeQ[Divisible[#, primeFactorsOfPrimorial], True] &] &, 
  sortedPossibleTotatives] (*possible totatives*)
A286941 = 
  Table[Function[P, Select[Range@P, CoprimeQ[#, P] &]]@
    Product[Prime@i, {i, n}], {n, 7}];
A286941row = Last[A286941];
A286941row[[list1]]  (*actual totatives*)

I'd like to find values for list2, where list2 is a variable length list of integers that are spaced at multiples of 3072 (in this case they are equally spaced at 3072). The output is sortedPossibleTotatives2 and should be integers or natural numbers.

Edit1: the full code:

nToCheck = 7;
firstNthTotativeToCheck = 1; (*max firstNthTotativeToCheck is A038110(n)*)
A002110values = FoldList[Times, 1, Prime[Range[nToCheck]]];
A002110 = Last[A002110values];
primeFactorsOfPrimorial =
  DeleteDuplicates[FactorInteger[A002110][[All, 1]]];
A038110values =
  Numerator@
   Table[Product[1 - 1/Prime[k], {k, n - 1}]/Prime[n], {n,
     nToCheck + 1}];
A038110 = Last[A038110values];
A060753values =
  Table[Denominator@Product[EulerPhi@Prime[i]/Prime@i, {i, n}], {n, 0,
     nToCheck}];
A060753 = Last[A060753values];
A286941 =
  Table[Function[P, Select[Range@P, CoprimeQ[#, P] &]]@
    Product[Prime@i, {i, n}], {n, nToCheck}];
A286941row = Last[A286941];
A309497[n_] := -(v =
      Numerator[Product[1 - 1/Prime[i], {i, 1, n}]/Prime[n]]*
       Select[Range[(p = Product[Prime[i], {i, 1, n}])],
        CoprimeQ[p, #] &]) +
   Denominator[Product[((pr = Prime[i]) - 1)/pr, {i, 1, n}]]*
    Range[Length[v]];
A309497row = A309497[nToCheck];

indexes =
  Table[Range[n, Length[A309497row], A038110], {n, 1, A038110}];
lists = Table[A309497row[[idx]], {idx, indexes}];
list1 = indexes[[
  firstNthTotativeToCheck]]; (*the totative indexes to check *)
list2 = Sort[
  DeleteDuplicates[
   lists[[firstNthTotativeToCheck]]]] (*the possible short ruler \
values to check for each totative*)
possibleTotatives =
  Table[(A060753*list1[[i]] - list2[[j]])/A038110, {i, 1,
    Length[list1]}, {j, 1, Length[list2]}];
sortedPossibleTotatives = Sort /@ possibleTotatives;
A286941row[[list1]] (*actual totatives*)
sortedPossibleTotatives2 =
 Map[Select[#,
    FreeQ[Divisible[#, primeFactorsOfPrimorial], True] &] &,
  sortedPossibleTotatives] (*possible totatives*)

cheers, Jamie