Find Shortest Path Algorithm in Pascal

Program ShortestPath;
Uses crt;
Var
        A: Array [1..10000,1..10000] of Integer;
        Trace: Array [1..10000,1..10000] of Integer;
        n, m, Start, Finish: Integer;
        f: Text;
Procedure Input;
        Var
                i, PosStart, PosEnd, Length, j: Integer;
        Begin
                Assign(f,'MAP.INP');
                Reset(f);
                Readln(f,n,m);
                Readln(f,Start,Finish);
                For i:=1 to n do
                        For j:=1 to n do
                                If i=j then A[i,j]:=0 else A[i,j]:=1001;
                For i:=1 to m do
                        Begin
                                Readln(f,PosStart,PosEnd,Length);
                                A[PosStart,PosEnd]:=Length;
                                A[PosEnd,PosStart]:=Length;
                        End;
                Close(f);
        End;
Procedure Process;
        Var
                i, j, k: Integer;
        Begin
                For i:=1 to n do
                        For j:=1 to n do
                                Trace[i,j]:=j;
                For k:=1 to n do
                        For i:=1 to n do
                                For j:=1 to n do
                                        If A[i,j]>A[i,k]+A[k,j] then
                                                Begin
                                                        A[i,j]:=A[i,k]+A[k,j];
                                                        Trace[i,j]:=k;
                                                End;
                For i:=1 to n do
                        Begin
                                For j:=1 to n do
                                        Write(Trace[i,j]:3);
                                Writeln;
                        End;
        End;
Procedure Output;
        Begin
                Assign(f,'MAP.OUT');
                Rewrite(f);
                If A[Start,Finish]=MaxInt then Writeln(f,'NONE')
                else
                        Begin
                                Writeln(f,A[Start,Finish]);
                                Write(f,Start,'-');
                                While (Start<>Finish) do
                                        Begin
                                                Write(f,Trace[Start,Finish],'-');
                                                Start:=Trace[Start,Finish];
                                        End;
                        End;
                Close(f);
        End;
Begin
        Input;
        Process;
        Output;
End.