Упорядочить строки матрицы по возрастанию количества одинаковых элементов в каждой строке - Turbo Pascal

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

1) Упорядочить строки целочисленной прямоугольной матрицы по возрастанию количества одинаковых элементов в каждой строке (оформить в виде процедуры). Помогите пожалуйста!!))

program xxx;
uses crt;
var
a:array [1..12, 1..10] of integer;
i, l, p, s, j, x, y, n, k: integer;
m, d:boolean;
begin
clrscr;
randomize;
writeln(' Введите размер массива');
readln(n, k);
clrscr;
for i:= 1 to n do
for j:= 1 to k do
begin
a[i, j]:=Random(10)-5;
GoToXY(j*4, i);
write(a[i, j], ' ');
end;
 
for i:=1 to n do
begin
l:=1;
s:=0;
for j:=1 to k do
begin
if j<>k then
for x:=j+1 to k do
if a[i, j]=a[i, x] then
begin
m:=false;
if j<>1 then
begin
for y:=1 to j-1 do
if a[i, y]=a[i, j] then
m:=true;
end;
if m<>true then
l:=l+1;
end;
if l<>1 then
s:=s+1;
l:=1;
end;
a[i, k+1]:=s;
end;

for j:=1 to n-1 do
for x:=1 to n-1 do
begin
if a[x, k+1]>a[x+1, k+1] then
begin
for y:=1 to k+1 do
begin
a[n+1, y]:=a[x, y];
a[x, y]:=a[x+1, y];
a[x+1, y]:=a[n+1, y];
end;
end;
end;
writeln(' ');
writeln(' упорядоченный массив');
writeln(' ');
for i:=1 to n do
for j:=1 to k do
if j<>k then
write(a[i, j], ' ')
else
writeln(a[i, j]);
 
for i:=1 to n do
begin
for j:=1 to k do
begin
if a[i, j]<0 then d:=true;
end;
l:=1;
if (d=false) and (y=1) then
begin
p:=j;
l:=l+1;
end
else p:=0;
end;
writeln(p);
readln;
end.

вот есть программа, там есть недочет один, но может кто-нибудь сможет переделать, а именно сделать в виде процедуры и в виде функци??? пожалуйста!!))

Решение задачи: «Упорядочить строки матрицы по возрастанию количества одинаковых элементов в каждой строке»

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

                            program aaa;
Type mas=array[1..5] of integer;
Var a: array[1..5, 1..5] of integer;
s, d:mas; {массив элементов одной строки и массив количеств одинаковых элементов в строках}
j,k,w, min, m :integer;
 
procedure kolich(b:mas; Var kol: integer); {кол-во одинаковых элементов с строке}
Var j, k, max :integer;
c:mas;
begin
for j:=1 to 5 do
begin
c[j]:=0;
for k:=1 to 5 do
if b[k]= b[j] then c[j]:=c[j]+1;
end;
max:=c[1];
for j:=2 to 5 do
if c[j]> max then max:=c[j];
kol:=max;
end; {конец процедуры}
 
Procedure obmen(Var x,y:integer); {для обмена местами элементов}
Var prom:integer;
begin
prom:=x;
x:=y;
y:=prom;
end; {конец процедуры}
 
begin
writeln('Исходный массив ');
for j:=1 to 5 do
begin
for k:=1 to 5 do
begin
a [j, k ] := Random(10);
write( a [ j,k ]:3,' ');
end;
writeln;
end;
 
for j:=1 to 5 do
begin
for k:=1 to 5 do
s [ k] := a [ j,k ]; {формирование матрицы из элементов строки};
kolich(s, d[j]);
writeln('Количество одинаковых элементов в ', j, ' строке= ', d[j]);
end;
 
{сортировка массива d и перестановка строк}
for j:=1 to 4 do
begin
min:=d[j]; m:=j;
for k:=j+1 to 5 do
if d[k]< min then begin min:=d[k]; m:=k end;
obmen(d[j],d[m]);
for w:=1 to 5 do {перестановка строк}
obmen(a[j,w],a[m,w]);
end;
 
writeln('матрица с переставленными строками в соответствии с ростом количества одинаковых элементов в строке: ');
for j:=1 to 5 do
begin
for k:=1 to 5 do
write( a[j,k]:3,' ');
writeln;
end;
end.
                        