Удалите все столбцы матрицы, в которых находится минимальный элемент - Pascal ABC

uses crt;
const nmax=10;
var a:array[1..nmax,1..nmax] of integer;
    m,n,i,j,min,max,k,q:integer;
    b:set of byte;
begin
randomize;
repeat
write('Количество строк от 2 до ',nmax,' n=');
readln(n);
until n in [2..nmax];
repeat
write('Количество столбцов от 2 до ',nmax,' m=');
readln(m);
until m in [2..nmax];
writeln('Исходная матрица:');
for i:=1 to n do
 begin
  for j:=1 to m do
   begin
    a[i,j]:=random(10);
    write(a[i,j]:3);
   end;
  writeln;
 end;
{найдем мин и макс}
min:=a[1,1];
max:=a[1,1];
for i:=1 to n do
for j:=1 to m do
if a[i,j]<min then min:=a[i,j]
else if a[i,j]>max then max:=a[i,j];
writeln('Минимальный элемент=',min);
writeln('Максимальный элемент=',max);
{запомним строки где больше 1 максимального}
b:=[];
for i:=1 to n do
 begin
  q:=0;
  for j:=1 to m do
  if a[i,j]=max then inc(q);
  if q>1 then b:=b+[i];
 end;
{удаление столбцов с минимальным}
j:=1;
while j<=m do
 begin
  q:=0;
  i:=1;
  while (i<=n)and(q=0) do
  if a[i,j]=min then q:=1
  else inc(i);
  if q=1 then{если есть минимальный}
   begin
    if j<m then
     begin
      for k:=j to m-1 do{от этого столбца до предпоследнего}
      for i:=1 to n do{всем элементам столбцов}
      a[i,k]:=a[i,k+1];{присваиваем значения правого}
     end;
    m:=m-1;{уменьшаем количество}
   end
  else j:=j+1;{если нет минимального, вперед}
 end;
if m=0 then writeln('Все столбцы удалены!')
else
 begin
  writeln('Удаление столбцов с минимальными:');
  for i:=1 to n do
   begin
    for j:=1 to m do
    write(a[i,j]:3);
    writeln;
   end;
  if b=[] then writeln('В матрице не было строк с более чем 1 максимальным')
  else
   begin
    writeln('Строки в которых было более 1 максимального');
    for i:=1 to n do
    if i in b then write(i,' ');
    writeln;
    writeln('Их удаление');
    i:=n;{начнем снизу}
    while i>1 do
    if i in b then{если есть}
     begin
      if i<n then
       begin
        for k:=i to n-1 do{от этой строки до предпоследней}
        for j:=1 to m do{всем элементам строки}
        a[k,j]:=a[k+1,j];{присваиваем значения нижней}
       end;
      n:=n-1;{уменьшаем количество}
      i:=i-1;
     end
    else i:=i-1;{если нет, вверх}
   writeln('n=',n);
   for i:=1 to n do
    begin
     for j:=1 to m do
     write(a[i,j]:3);
     writeln;
    end;
  end;
 end;
end.