buildpart[a_List, p_List] :=
  buildpart[a, p] = Module[{f, sym, res}, Attributes[f] = Orderless;
    sym = Unique["x", Temporary] & /@ p;
    res =
     ReplaceList[f @@ a,
      f @@ MapThread[Pattern[#, Repeated[_, {#2}]] &, {sym, p}] ->
       List /@ sym];
    DeleteDuplicates@Map[Sort, res]
    ];
buildpartitions[n_?IntegerQ, k_?IntegerQ ] :=
  Map[buildpart[Range[n], #] &,
   Select[IntegerPartitions[n], Length[#] == k &]];
(* One could use KSetPartitions[n,k] from the Combinatorica package instead of using Flatten[buildpartitions[n,k],1] *)
genusNew[al_, nmax_] :=
  With[{cyc = RotateRight[Range[nmax]],
    almksi = PermutationList[System`Cycles[al], nmax]},
   1/2  ((nmax + 1) - (Length[al] +
        Length[PermutationCycles[cyc[[almksi]], Identity]]))];
qpart[n_, k_] :=
 qpart[n, k] =
  If[k > Floor[n/2], {{0, 0}},
   Tally[(genusNew[#1, n] &) /@
     DeleteCases[Flatten[buildpartitions[n, k], 1],
      x_ /; MemberQ[Map[Length, x, 1], 1] == True]]]
qpart[n_, k_, g_] :=
 If[g >= Length[qpart[n, k]  \[RawEscape]], 0, qpart[n, k][[g + 1, 2]]]
ppart[n_, k_, g_] := \!\(
\*UnderoverscriptBox[\(\[Sum]\), \(s = 0\), \(k\)]\(qpart[n - s,
    k - s, g]\  Binomial[n, s]\)\)
fillppart[n_, k_] := (ppartfilled[n, k] = {}; gg = 0;
  Until[ppart[n, k, gg] == 0,
   ppartfilled[n, k] = Append[ppartfilled[n, k], ppart[n, k, gg]]; gg++])
(* Example. Calculation of S2(n,k,g) and subsequence B(n,g) of a(n) for n = 8 *)
Module[{n = 8, res},
 Do[fillppart[n, k], {k, 1, n}];
 Print["S(n,k,g): ", Table[{k, ppartfilled[n, k]}, {k, 1, n}]];
 res = Table[
   Sum[With[{li = ppartfilled[n, k] },
     If[Length[li] > g ,  li[[g + 1]], 0]], {k, 1, n}], {g,
    0, (n - 1)/2}];
 Print["Test: BellB[n] = Sum_g B(n,g)= ", BellB[n], ", ",
  Total[res] == BellB[n]];
 Print["B(n,g): ", res]]
(* _Robert Coquereaux_, Feb 16 2024 *)