Неправильно работает функция

const
    n=10;
    type
      t1= array[1..n] of Integer;
var
   x:t1;
   i:integer;
 
procedure Input(x:t1);
  var i:Integer;
  begin
     Writeln('ââåäèòå 10 ÷èñåë: ');
     for i:=1 to n do
         Readln(x[i]);
  end;
 //-------------------------------------
   function Seach(var a:integer; d:Byte): Integer;
   var
       i: Integer;
    begin
      for i:=1 to d-1 do
          a:= a div 10;
      Seach:= a mod 10;
    end;
 //-------------------------------------
  procedure change(var a: integer) ;
   var k,b:Integer;
  begin
       k:= Seach(a,2);
       b:= Seach(a,3);
    a:=(a div 1000)*1000+ k*100+ b*10+ a mod 10
  end;
 //-------------------------------------
begin
 SetConsoleOutputCP(1251);
 Input(x);
 for i:=1 to n do
 begin
   change(x[i]);
   write( x[i],'  ');
 end;
 
 
 Readln
end.

procedure Input(var x:t1);