Defining a Function programmatically

Possibly this:

mon = Unique[NDSolve`Monitor];
mons = Table[Unique[mon], {3}];
vars = {t, x, y};

Block[{Set, Unset, CompoundExpression},
   With[{code = CompoundExpression @@ Join[
        Unset /@ #3,
        MapThread[
         Set,
         {Prepend[Through[Rest[#3][First[#3]]], First[#3]], #2}],
        {#1}
        ]},
    Function @@ {{#1}, 
      Function @@ Hold[#2, Internal`InheritedBlock[#3, code]]}
    ]] &[mon, mons, vars]

(*
  Function[{NDSolve`Monitor$234166}, 
   Function[{NDSolve`Monitor$234166$234167, 
     NDSolve`Monitor$234166$234168, NDSolve`Monitor$234166$234169},
    Internal`InheritedBlock[{t, x, y},
     t =.;
     x =.;
     y =.;
     t = NDSolve`Monitor$234166$234167; 
     x[t] = NDSolve`Monitor$234166$234168; 
     y[t] = NDSolve`Monitor$234166$234169;
     NDSolve`Monitor$234166
    ]]]
*)

Update: This avoids blocking system functions. It shouldn't be a problem above because of the limited scope of the Block[] and the fact that the arguments mon, mons, vars are all evaluated before injected; but maybe it seems safer the following way.

With[{code = Join[
      Hold[#1, #2, #3],    (* first args of Function and InheritedBlock *)
      Unset /@ Hold @@ #3, (* beginning of body *)
      Set @@@ Hold @@ Transpose@
         {Prepend[Through[Rest[#3][First[#3]]], First[#3]], #2},
      Hold[#1]
      ]},
   Replace[code, Hold[m1_, m2_, v_, body__] :>
     Function[{m1}, Function[m2,
       Internal`InheritedBlock[v, CompoundExpression[body]]]]]
   ] &[mon, mons, vars] 

(*  same output as above  *)

ClearAll[makeArgs, makeFunc]
makeArgs[m_, ms_, v_] := {{m}, ms, Inactive[Internal`InheritedBlock][v, 
    Inactive[CompoundExpression] @@ Flatten[
     {Inactive[Unset] /@ v, Inactive[Set][ v[[1]], ms[[1]]], 
       Inactivate[Thread[Through[Rest[v] @ First[v]] = Rest[ms]], Set], m}]]};

makeFunc = Function[#, Evaluate @ Activate @ Function[#2, #3]] & @@ makeArgs[##] &;

makeFunc[mon, mons, vars]

Function[{NDSolve`Monitor$30945}, Function[{NDSolve`Monitor$30945$30952, NDSolve`Monitor$30945$30953, NDSolve`Monitor$30945$30954}, Internal`InheritedBlock[{t, x, y}, t =.; x =.; y =.; t = NDSolve`Monitor$30945$30952; x[t] = NDSolve`Monitor$30945$30953; y[t] = NDSolve`Monitor$30945$30954; NDSolve`Monitor$30945]]]

Rather than try to figure out what your detailed intentions are, let me just give a simple example. This kind of thing is easy with Function because it holds its arguments until it is applied. You may thus reach into a Function and perform arbitrary replacements. There is no need to clumsily edit text. Here, I define powerN as a prototype, and do replacements:

powerN = Function[{x}, x^n];
power2 = powerN /. n -> 2
(* Function[{x}, x^2] *)

Another way is to define a constructor:

power[n_] := Function[{x}, x^n]
power[2]
(* Function[{x$}, x$^2] *)