Что не так (стеки)?

Program prstack;
type
   tovar=record
      dd:byte;    //День заказа
      mm:byte;    //Месяц заказа
      gg:integer;    //Год заказа
      nazv:string[20];   //Название товара
      kol:integer;   //Кол-во товара
      cena:real;   //цена товара
   end;
   celltype = record 
        element:tovar;
        next: ^celltype;
    end; 
    STACK =^celltype;
    
var 
   top: STACK;
   naf:string;
 
function Empty( top: STACK) :boolean;
begin
Empty:= Top=nil;
end;        {  EMPTY }
 
procedure Push(x: tovar; var top: STACK);
{добавление элемента в стек}
Var p: STACK;
begin
  new(p); {создаем новый узел}
  p^.next:= top; {он будет находиться перед вершиной}
  p^.element:= x;
  top:=p;   {Делаем p вершиной стека}
end;        {  PUSH }
 
procedure Pop(var top: STACK; var x: tovar);
{Возвращает число из вершины стека и затем уничтожает вершину}
Var p: STACK;
begin
  if Empty(top)=False then begin
    p:= top^.next;     {запоминаем следующий узел}
    x:=top^.element;   {вытаскиваем инф-цию из вершины}
    dispose(top);      {уничтожаем вершину}
    top:=p;               {делаем p вершиной}
  end  else
     Writeln('стек уже пуст');
end;
 
procedure open(naf:string); //Процедура чтения из файла
   var
      txt:Text;
      x:tovar;
   begin
      Assign(txt,naf);
      Reset(txt);
      while not Eof(txt) do 
         begin
            readln(txt, x.dd);
            readln(txt, x.mm);
            readln(txt, x.gg);
            readln(txt, x.nazv);
            readln(txt, x.kol);
            readln(txt, x.cena);
            push(x,top);
         end;
      Close(txt);
      end;
      
procedure Scan(top: STACK);
  {Просмотр стека}
var
  p: Stack;   {вспомогательный указатель}
  x:tovar;
begin
  new(p);
  while top <> nil do begin  {пока не конец стека}
        p:= top^.next;     {запоминаем следующий узел}
    x:=top^.element;   {вытаскиваем инф-цию из вершины}
    dispose(top);      {уничтожаем вершину}
    top:=p; 
        write(x.dd:3);   {Вывод значения элемента}
        write(x.mm:3);
        write(x.gg:5);
        write(x.nazv:15);
        write(x.kol:3);
        write(x.cena:5);
        writeln;   
  end;
  writeln;
end;            {  Scan_Stack  }
 
Begin
Write('Введите название файла: ');
Readln(naf);
open(naf);
scan(Top);
writeln;
scan(Top);
end.

type
  tovar = class
    dd:byte;    //День заказа
    mm:byte;    //Месяц заказа
    gg:integer;    //Год заказа
    nazv:string[20];   //Название товара
    kol:integer;   //Кол-во товара
    cena:real;   //цена товара
      
    constructor (a : array of String);
    begin
      dd := StrToInt(a[0]); mm := StrToInt(a[1]); gg := StrToInt(a[2]);
      nazv := a[3]; kol := StrToInt(a[4]); cena := StrToFloat(a[5]);
    end;
    
    function ToString := Format('{0:3} {1:3} {2:3} {3:-15} {4:3} {5:f2}', dd, mm, gg, nazv, kol, cena);
  end;
   
   STACK = class
     element:tovar;
     next: STACK;
     
     constructor (t : STACK; e : tovar);
     begin
       element := e; next := t;
     end;
   end; 
    
var 
  top : STACK := nil;
 
function Empty( top: STACK) := top = nil;
 
procedure Push(x: tovar; var top: STACK) := top := New STACK(top, x);
 
function Pop(var top: STACK) : tovar;
begin
  if Empty(top) then
    Result := nil
  else
    begin
      Result := top.element;
      top := top.next;
    end;
end;
 
procedure open(naf:string);
begin
   foreach var s in ReadLines(naf) do
     begin
       var a := s.ToWords;
       if a.Length = 6 then
         try
           var x := New tovar(a);
           push(x, top);
         except end;
     end;
end;
      
procedure Scan(top: STACK);
begin
  while top <> nil do
    begin
      WriteLn(top.element.ToString);
      top := top.next;
    end;
end;
 
Begin
  open('i1.txt');
  scan(Top);
  writeln;
  scan(Top);
end.