Отсортировать положительные элементы столбца матрицы по убыванию - Turbo Pascal

Формулировка задачи:

Здравствуйте! Прошу помощи. Прошу подправить код. Не совсем корректно выводит. Вот задание.Среди столбцов заданной целочисленной матрицы, содержащих ТОЛЬКО такие элементы, которые по модулю не больше числа Р, найти столбец с минимальной суммой элементов Отсортировать положительные элементы этого столбца по убыванию.

program zd;
const n=5;
var 
a:array[1..n,1..n] of integer;
c:array[1..n] of integer;
i,j,min,b,k,s,m,p:integer;
begin
 
randomize;
for i:=1 to n do begin
     for j:=1 to n do begin
     a[i,j]:=random(15)-2;
     write(a[i,j]:3);
     end;
writeln;
end;
writeln('Введте число Р');readln(p);
for j:=1 to n do 
     begin
     b:=0;
     for i:=1 to n do 
     if abs(a[i,j])<=p then b:=b+a[i,j]
           else
          b:=0;
c[j]:=b;
if abs(a[i,j])>p then c[j]:=0;
end;
Writeln('Znacheniya summy stolbtsov');
for j:=1 to n do 
     begin
     write(c[j]:6);
end;
min:=c[1];
for j:=1 to n do 
     begin
     if c[j]<min then begin k:=j; min:=c[j]; end;
end;
writeln;
writeln('Nomer stolbtsa s minimalnoi summoi: ',k);
for i:=1 to n-1 do
     for m:=1 to n-1 do
     begin
     if (a[m,k]<a[m+1,k]) and (a[m,k]>0) then begin 
          s:=a[m,k];
          a[m,k]:=a[m+1,k];
          a[m+1,k]:=s;
          end;
  end;
writeln;
for i:=1 to n do
     begin
       for j:=1 to n do
     write(a[i,j]:4);
    writeln;
end;
end.

Решение задачи: «Отсортировать положительные элементы столбца матрицы по убыванию»

textual
                            Листинг программы 
                        

                            program zd;
const   n = 5;
var  a: array[1..n, 1..n] of integer;
  i, j,  k, s, p, sum: integer;
  flag: boolean;
 
begin  
  randomize;
  for i := 1 to n do 
  begin
    for j := 1 to n do 
    begin
      a[i, j] :=integer(random(15))-2;
      write(a[i, j],' ');
    end;
    writeln;
  end;
  writeln('Vvedite chislo P');readln(p);
  Writeln('Znacheniya summy stolbtsov');
  k := 0;s:=maxint;
  for j := 1 to n do 
  begin
    sum := 0;flag := true;
    for i := 1 to n do
    begin
      flag := (abs(a[i, j]) <= p) and flag;
      if flag then sum := sum + a[i, j];         
    end;
    if flag and (s > sum) then 
    begin
      write(sum, ' ');
      k := j;s := sum;
    end
    else write(' - ');
  end;    
  writeln;
  
  s := 1;
  if k = 0 then writeln('Net takih stolbcov.') else
  begin
    writeln('Nomer stolbtsa s minimalnoi summoi: ', k);
    for j:= 1 to n do
    for i := j to n  do    
    begin
      if (a[j, k] > 0) and (a[i, k] > 0)and  (a[j, k] > a[i, k])then
        begin
          p := a[i, k];
          a[i, k] := a[j, k];
          a[j, k] := p;
          s := i;
        end;
    end;
  end;
  writeln;
  
  for i := 1 to n do
  begin
    for j := 1 to n do
      write(a[i, j]:4);
    writeln;
  end;
end.
                        