Список с заглавным звеном, из текстового файла получить список из записей и по нему уже сделать з Опции

[Zigfried]

Структура записи:
-ФИО(40 знаков)
-Адрес:
-Улица(20 знаков)
-Номер дома
-Квартира
-Номер телефона(10 знаков)
-Баланс

Задание:Найти телефонную сеть(первые 3 цифры номера),имеющую наибольшее число абонентов.

Помогите пожалуйста с решением.Заранее спасибо.

[Zigfried]

type
  tPage = record
    FIO: string[30];
    Ul: string[20];
    Dom,Kv: integer;
    Tel: string[10];
    Bal:single
  end;
  tlist=^tElem;
  tElem = record
    Page: tPage;
    Next:tlist
  end;
var
  Spis:tlist;
   z:tPage;
   x:text;

procedure list_init(var m:tlist);
  begin
   new(m);
   m^.next:=nil
  end;

procedure list_read(var z:tPage);
  begin
   readln(x,z.FIO);
   readln(x,z.Ul);
   readln(x,z.Dom);
   readln(x,z.Kv);
   readln(x,z.Tel);
   readln(x,z.Bal);
   if not eof(x) then readln(x)
  end;

function sort(z1,z2:tPage):boolean;
  begin
   sort:=((z1.FIO<z2.FIO) or (z1.FIO=z2.FIO))
  end;

 procedure list_add(var m:tlist; z:tPage);
  var
   p,q:tlist;
  begin
   q:=m;
   while (q^.next<>nil) and sort(q^.next^.Page,z) do
    q:=q^.next;
   new(p);
   p^.Page:=z;
   p^.next:=q^.next;
   q^.next:=p
  end;

procedure list_create(var x:text;var m:tlist);
  begin
   assign(x,'input.txt');
   reset(x);
   list_init(m);
   while not eof(x) do
    begin
     list_read(z);
     list_add(m,z)
     end
  end;
procedure list_print(m:tlist);
  begin
   if m=nil then writeln('konec spiska')
    else
     begin
      writeln(m^.Page.FIO);
      writeln(m^.Page.Ul);
      writeln(m^.Page.Dom);
      writeln(m^.Page.Kv);
      writeln(m^.Page.Tel);
      writeln(m^.Page.Bal);
      writeln;
      list_print(m^.next)
     end
  end;
begin
  list_create(x,spis);
  Writeln('spisok:');
  list_print(spis^.next)
end.

Вот что получилось(начальный этап). Выдаёт ошибку.

[мисс_граффити]

Вот что получилось(начальный этап). Выдаёт ошибку.

Какую и на каких данных? Лучше прикрепи свой текстовый файлик с данными.
Компилируется вроде нормально.