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

[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.

[serega204]

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

Program lr_4; Uses Crt;
Const N = 10;
Type
     Struct = Record
              NF : String[15];
              AI : String[17];
              AD : String[32];
             Tel : Longint;
              End;
         Mas = Array[1..N] Of Struct;
         Fl = File Of Struct;
Var Z : Array [1..N] Of Struct;
    C : Struct;
    I : Integer;
   Fi : Text;
    F : Fl;

{Ввод массива записей}
Procedure Vivod;
Begin
For I := 1 to N do
    Begin with Z[I] do
    Writeln (NF, AI, AD, Tel);
    End;
End;

{Вывод массива записей из текстового файла}
Procedure Vvod;
Begin
     Assign (FI, '2.dat'); Reset (FI);
     Writeln('                       Туристические фирмы г.Москвы', #10#13);
For I := 1 to N do
With Z [I] do Begin
Readln (FI, NF, AI, AD, Tel);
End;
     Vivod;
     Close (FI);
     End;

{Процедура сортировки записей методом последовательного слияния}
Procedure Posl_Sl;
Type Mas = Array[1..N] of Struct;
    TMas = ^Mas;
Var A, B : Tmas;
    N, k, j, t, q, r, p0, q0, s0, p : Integer;
Begin
     Reset(F);
     N := FileSize(F);
     GetMem(A, N*SizeOf(Struct));
     k := 1;
     while k < N do
     Begin
          t := 0;
          While t + k < N do
          Begin
               p := t; q := t + k;
               If (t+2*k) > N then r := t+2*k;
               p0 := p; q0 := q; s0 := p;
               While (p0 <> q) or (q0 <> r) do
               Begin
                    If (p0 < q) and ((q0 = r) or ((q0 < r) and
                    (A^[p0 + 1].NF <= A^[q0 + 1].NF))) then
                    Begin
                         B^[p0 + 1].NF := A^[p0 + 1].NF;
                         Inc(p0);
                    End
                                                        else
                         Begin
                              B^[s0 + 1].NF := A^[q0 + 1].NF;
                              Inc(q0);
                         End;
               Inc(s0);
               End;
          t := r;
          End;
     k := k shl 1;
     A^ := B^;
     End;
     For k := 1 To N do
         Begin
              C := B^[k]; Write(F, C);
              Writeln (C.NF, C.AI, C.AD, C.Tel);
              Close(F);
              FreeMem(A, N*SizeOf(Struct));
         End;
End;

{----- ОСНОВНАЯ ПРОГРАММА -----}
BEGIN Clrscr;
Assign(F, 't.typ');
Writeln('Массив до сортировки');
   Vvod;
Writeln(#10#13, 'Массив после сортировки');
        Posl_Sl;
Repeat Until KeyPressed;
END.