Сократить код

Program less;
const
  nmax=20;
type
  tAr1=array[1..nmax,1..nmax] of integer;
  tAr2=array[1..nmax] of integer;
 
procedure minim(a: tAr1; var b: tAr2; n,m: byte);
var i,j,imin: byte;
begin
  for j:=1 to n do
  begin
    imin:=1;
    for i:=2 to n do
      if a[i,j]>a[imin,j] then imin:=i;
    b[j]:=a[imin,j];
  end;
  writeln('Максимальные элементы по столбцам:');
  for j:=1 to n do
    writeln(j,'. ',b[j]);
end;
 
procedure maxim(b: tAr2; n: byte);
var j: byte;
    min: integer;
begin
  min:=b[1];
  for j:=2 to n do
    if b[j]<min then min:=b[j];
  writeln('Минимальный среди них = ',min);
end;
 
procedure minim1(a: tAr1; var b: tAr2; n,m: byte);
var i,j,imin: byte;
begin
  for i:=1 to n do
  begin
    imin:=1;
    for i:=2 to n do
      if a[i,j]<a[i,imin] then imin:=j;
    b[i]:=a[i,imin];
  end;
  writeln('Минимальные элементы по строкам:');
  for i:=1 to n do
    writeln(i,'. ',b[i]);
end;
 
procedure maxim1(b: tAr2; n: byte);
var i: byte;
    max: integer;
begin
  max:=b[1];
  for i:=2 to n do
    if b[i]>max then max:=b[i];
  writeln('Максимальный среди них = ',max);
end;
var
  a: tAr1;
  b: tAr2;
  n,m,i,j: byte;
begin
  write('Введите размер матрицы: n = ');
  readln(n);
  write('Введите размер матрицы: m = ');
  readln(m);
  writeln('Исходный массив:');
  for i:=1 to n do
  for j:=1 to m do
  begin
    for j:=1 to n do
    begin
      write('a[',i,',',j,']:=');
     readln(a[i,j])
    end;
  end;
  writeln;
  minim(a,b,n,m);
  maxim(b,n);
  minim1(a,b,n,m);
  maxim1(b,n);
end.

const
  nmax=20;
type
  tAr=array[1..nmax,1..nmax] of integer;
procedure minimax(a: tAr;n,m: byte; var mnmx:integer);
var i,j,imax: byte;
begin
mnmx:=maxint;
for i:=1 to n do
 begin
  imax:=1;
  for j:=2 to m do
  if a[i,j]>a[i,imax] then imax:=j;
  writeln('Максимальный элемент в строке ',i,'=',a[i,imax]);
  if a[i,imax]<mnmx then mnmx:=a[i,imax];
 end;
writeln('Минимльный из максимальных элементов строк=',mnmx);
end;
 
procedure maximin(a: tAr; n,m: byte; var mxmn:integer);
var i,j,jmin: byte;
begin
mxmn:=-maxint-1;
for j:=1 to m do
 begin
  jmin:=1;
  for i:=2 to n do
  if a[i,j]<a[jmin,j] then jmin:=i;
  writeln('Минимальный элемент в столбце ',j,'=',a[jmin,j]);
  if a[jmin,j]>mxmn then mxmn:=a[jmin,j];
 end;
writeln('Максимльный из минимальных элементов столбцов=',mxmn);
end;
var a: tAr;
    n,m,i,j: byte;
    mnmx,mxmn:integer;
begin
repeat
writeln('Введите размеры матрицы n,m');
readln(n,m);
until(n in [2..nmax])and(m in [2..nmax]);
for i:=1 to n do
for j:=1 to m do
 begin
  write('a[',i,',',j,']:=');
  readln(a[i,j])
 end;
writeln('Исходный массив:');
for i:=1 to n do
 begin
  for j:=1 to m do
  write(a[i,j]:4);
  writeln;
 end;
minimax(a,n,m,mnmx);
maximin(a,n,m,mxmn);
end.