fractran[
  program : {__ ? (Element[#, PositiveRationals] &)},        (* list of positive fractions *)
  n0_Integer,                                                (* initial state *)
  maxSteps : _Integer : Infinity] :=                         (* max number of steps *)
 NestWhileList[                                              (* Return a list representing the evolution of the state n *)
  Function[n, SelectFirst[IntegerQ][program * n]],           (* Select first integer in n*program, if none return Missing *)
  n0,
  Not @* MissingQ,                                           (* continue while the state is not Missing *)
  1,
  maxSteps]

$PRIMEGAME = {17/91, 78/85, 19/51, 23/38, 29/33, 77/29, 95/23, 77/19, 1/17, 11/13, 13/11, 15/14, 15/2, 55/1};
fractran[$PRIMEGAME, 2, 50]