Задача по сортировке диагоналей массивов методом пирамидальной сортировки

type mas=array[0..10000] of integer;
procedure Sort(var A: mas; Count: Integer);
  procedure DownHeap(index, Count: integer; Current: integer);
  {Функция пробегает по пирамиде восстанавливая ее
  Также используется для изначального создания пирамиды
  Использование: Передать номер следующего элемента в index
  Процедура пробежит по всем потомкам и найдет нужное место для следующего элемента}
  var
    Child: Integer;
  begin
    while index < Count div 2 do
     begin
      Child := (index+1)*2-1;
      if (Child < Count-1) and (A[Child] < A[Child+1]) then
        Child:=Child+1;
      if Current >= A[Child] then
        break;
      A[index] := A[Child];
      index := Child;
    end;
    A[index] := Current;
  end;
 
{Основная функция }
var
  i: integer;
  Current: integer;
begin
  {Собираем пирамиду}
  for i := (Count div 2)-1 downto 0 do
    DownHeap(i, Count, A[i]);
  {Пирамида собрана. Теперь сортируем}
  for i := Count downto 0 do begin
    Current := A[i];{перемещаем верхушку в начало отсортированного списка}
    A[i] := A[0];
    DownHeap(0, i, Current);{находим нужное место в пирамиде для нового элемента}
  end;
end;
var a:array[1..10,1..10] of integer;
    b:mas;
    n,m,i,j,p,k:integer;
begin
randomize;
repeat
write('Введите размер матрицы от 4 до 10 n=');
readln(n);
until n in [4..10];
writeln('Матрица');
for i:=1 to n do
 begin
  for j:=1 to n do
   begin
    a[i,j]:=10+random(20);
    write(a[i,j]:3);
   end;
  writeln;
 end;
writeln;
//выше главной диагонали
for k:=n-1 downto 2 do 
 begin
  m:=0; //собираем диагональ в массив
  i:=1;
  j:=k;
  while j>=15 do
   begin
    inc(m);
    b[m]:=a[i,j];
    inc(i);
    dec(j);
   end;
  Sort(b,m);//сортируем его по возрастанию
  p:=0; //возвращаем на место
  i:=1;
  j:=k;
  while j>=1 do
   begin
    inc(p);
    a[i,j]:=b[p];
    inc(i);
    dec(j);
   end;
 end;
 //ниже главной диагонали
for k:=2 to n-1 do
 begin
  m:=0;//собираем диагональ в массив
  i:=k;
  j:=n;
  while i<=n do
   begin
    inc(m);
    b[m]:=a[i,j];
    inc(i);
    j:=j-1;
   end;
  Sort(b,m); 
  p:=0;    //возвращаем на место
  i:=k;
  j:=n;
  while i<=n do
   begin
    inc(p);
    a[i,j]:=b[p];
    inc(i);
    j:=j-1;
   end;
 end;
writeln;     //выводим измененный массив
for i:=1 to n do
 begin
  for j:=1 to n do
  write(a[i,j]:3);
  writeln;
 end;
end.