program Project2;

{$APPTYPE CONSOLE}

uses
  SysUtils;
  var  a:array [0..110,0..110] of integer;
  d:array [0..2000] of string;
  k:array[0..2000,1..2] of integer;
  x1,y1,x,y,i,sc,l,j,n,f,b1,c1:integer;
  puk:string;

  procedure ar (b,c,m:integer);
  var res:string;
  begin
  res:='';
  k[m,1]:=b; k[m,2]:=c;
   if a[b+1,c]=1 then begin a[b+1,c]:=0; res:=res+'R' end;
   if a[b,c+1]=1 then begin a[b,c+1]:=0; res:=res+'T' end;
   if a[b-1,c]=1 then begin a[b-1,c]:=0; res:=res+'L' end;
   if a[b,c-1]=1 then begin a[b,c-1]:=0; res:=res+'B' end;
  d[m]:=res;
  end;

begin
  readln (n);
  for i:= 0 to 11 do
  for j:= 0 to 11 do
   a[i,j]:=0;
   read (x1); readln (y1);
   a[x1,y1]:=0;
   writeln (x1,' ',y1);
  for i:= 2 to n do begin
  read (x);
  readln (y);
  a[x,y]:=1;
  end;
  f:=1;
  sc:=1;
  ar(x1,y1,f);
  repeat
  b1:=k[sc,1];c1:=k[sc,2];
  puk:=d[sc];
    l:=length(puk);
    if l>0 then
    for i:= 1 to l do begin
     case puk[i] of
     'R': begin f:=f+1; ar(b1+1,c1,f); end;
     'T': begin f:=f+1; ar(b1,c1+1,f); end;
     'L': begin f:=f+1; ar(b1-1,c1,f); end;
     'B': begin f:=f+1; ar(b1,c1-1,f); end;
     end;
    end;
    inc(sc)
  until sc=n;

  if f>1 then for i:= 1 to f-1 do writeln (d[i],',');
  writeln (d[f],'.')
end.

Program work ideally on my computer.

WA TEST 2 TOO