This is mine.
Program 1078;
Var
  p,t,max,x,p1,y,i,j,n:integer;
  a,b,c:array [0..500] of integer;
Procedure Qsort(x,y:integer);
Var p:integer;
Begin
  p:=random(y-x+1)+x;
  a[0]:=a[p];b[0]:=b[p];c[0]:=c[p];
  a[p]:=a[x];b[p]:=b[x];c[p]:=c[x];
  i:=x;j:=y;
  While i<j do
  Begin
    While (i<j) and ((b[j]>b[0]) or ((b[j]=b[0]) and (a[j]<=a[0]))) do dec(j);
    a[i]:=a[j];b[i]:=b[j];c[i]:=c[j];
    While (i<j) and ((b[i]<b[0]) or ((b[i]=b[0]) and (a[i]>=a[0]))) do inc(i);
    a[j]:=a[i];b[j]:=b[i];c[j]:=c[i];
  End;
  a[i]:=a[0];b[i]:=b[0];c[i]:=c[0];
  If (i+1<y) then Qsort(i+1,y);
  If (x<i-1) then Qsort(x,i-1);
End;{Qsort}
Begin
  randomize;
  readln(n);
  For i:=1 to n do
  Begin
    readln(a[i],b[i]);
    If a[i]>b[i] then
    Begin
      p:=a[i];
      a[i]:=b[i];
      b[i]:=p;
    End;
    c[i]:=i;
  End;
  Qsort(1,n);
  max:=0;
  For i:=1 to n-1 do
  Begin
    p:=1;p1:=i;
    For j:=2 to n do
    Begin
      If (b[j]>b[p1]) and (a[j]<a[p1]) then
      Begin
        p1:=j;inc(p);
      End;
    End;
    If p>max then
    Begin
      max:=p;t:=i;
    End;
  End;
  writeln(max);p:=t;
  For i:=t+1 to n do
  Begin
    If (b[i]>b[p]) and (a[i]<a[p]) then
    Begin
      write(c[p],' ');p:=i;
    End;
  End;
  writeln(c[p]);
End.

Could you please give me some tests?
I'll buy much ice-cream to you.
Thanks very much.