сортировка последовательным слиянием..., не получается...помогите плиз Опции

[serega204]

Помогите пожалуйста с сортировкой...написал так как нам объяснили...а тут не сортируется ничего...спасибо...вот задание
Дан массив типа "запись". Запись содержит сведения о туристических фирмах и состоит из четырёх полей: название, специализация, адрес и телефон. Упорядочить элементы по названию фирмы, используя сортировку методом последовательного слияния!!!

Program LR_5; Uses Crt;
Type
St = String[15];
Struct = Record
            NF : String[15];
            AI : String[17];
            AD : String[32];
           Tel : Longint;
             End;
  Fl = File Of Struct;
Var  i : integer;
     Z : Struct;
Fi, Fr : Text;
     F : Fl;
 
{Процедура вывода данных одной строки}
Procedure P;
Begin     With Z do
Writeln (Fr, NF, AI, AD, Tel);
End;
 
{Процедура сортировки методом последовательного слияния}
Procedure Posl_Sl;
Type TA = Array[1..10] Of Struct;
    PTA = ^TA;
Var A, B : PTA;
    Dl, Dl_1, Dl_2, i1, i2, N1, N2, k, N : Integer;
    p1, p2 : Boolean;
Label M1, M2, M3;
 
{Пересылка очередного элемента в выходной массив}
Procedure PS(Var i, NP : integer; Var p : Boolean);
Begin
     B^[k] := A^[i]; i := i+1;
If i > NP then p := False;
End;
BEGIN
Reset(F);       N := FileSize(F);
GetMem(A, N*Sizeof(Struct));
Writeln(Fr, 'Массив до сортировки');
  For i := 1 to N do Begin
  Read(F, Z);   P;   A^[I] := Z;
                     End;
For i := N DownTo 2 do Begin
Dl := 1;
M1 : Dl_1 := Dl_1-1; i1 := 1;
M2 : N1 := i1+Dl_1; i2 := N1+1; N2 := i2+Dl_1;
p1 := True; p2 := True;
                       End;
If N2 <= N Then GoTo M3; N2 := N;
If i2 <= N then GoTo M3; p2 := False;
If N1 > N  then N1 := N;
M3 : For k := i1 to N2 Do
     If P1 and p2 then
        If A^[i].NF < A^[i2].NF then PS(i1, N1, p1)
                                else PS(i2, N2, p2)
                  else
        If p1 then PS(i1, N1, p1)
              else PS(i2, N2, p2);
If N2 < N then Begin
   i1 := N2+1; GoTo M2; End;
   A^ := B^;
If Dl < (N+1) div 2 then Begin
   Dl := Dl*2; GoTo M1;  End;
Writeln(Fr, #10#13, 'Массив после сортировки');
Seek(F, 0);
For i := 1 to N do Begin
    Z := A^[i]; Write(F, Z); P;
                   End;
Close(F);
FreeMem(A, N*SizeOf(Struct));
END;
 
{----- ОСНОВНАЯ ПРОГРАММА -----}
Begin CLRSCR;
Assign (F, 'lr8.typ');
Assign (Fr, ''); Rewrite (Fr);
Writeln('                     Туристические фирмы г.Москвы');
Writeln('Название            Веб-сайт                 Адрес              Телефон');
Writeln;
    Posl_Sl;
Readln;
Close (Fr);
End.