My code:

Program t1116;

Const MaxN=15000;

Type Kusok=record A,B,Y :integer end;

Var F1,F2,F      :array[1..MaxN]of Kusok;
    n1,n2,i,j,n  :integer;
    j1,j2,i2     :integer;

begin
read(n1);for i:=1 to n1 do read(f1[i].a,f1[i].b,f1[i].y);
read(n2);for i:=1 to n2 do read(f2[i].a,f2[i].b,f2[i].y);
n:=0;
j1:=1;
j2:=1;
for j1:=1 to n1 do begin
 for i2:=j2 to n2 do begin
  if f1[j1].b<f2[i2].a then break;
  if (f1[j1].a<f2[i2].a)and(f1[j1].b>f2[i2].b) then begin
    n:=n+1;
    f[n].a:=f1[j1].a;
    f[n].b:=f2[i2].a;
    f[n].y:=f1[j1].y;
    f1[j1].b:=f2[i2].b;
   end else
  if (f1[j1].a<f2[i2].a)and(f1[j1].b<f2[i2].b) then begin
    n:=n+1;
    f[n].a:=f1[j1].a;
    f[n].b:=f2[i2].a;
    f[n].y:=f1[j1].y;
    f1[j1].a:=f1[j1].b;
    break;
   end else
  if (f1[j1].a>f2[i2].a)and(f1[j1].b<f2[i2].b) then begin
    f1[j1].a:=f1[j1].b;
    break;
   end else
  if (f1[j1].a>f2[i2].a)and(f1[j1].b>f2[i2].b) then begin
   f1[j1].a:=f2[i2].b;
  end;
 end;
 j2:=i2;
 if f1[j1].a<>f1[j1].b then begin
  n:=n+1;
  f[n]:=f1[j1];
 end;
end;
write(n,' ');
for i:=1 to n do write(f[i].a,' ',f[i].b,' ',f[i].y,' ');
writeln;
end.