Ошибка

Const NMax = 100;
Type Digit = 0..9; Dl_Ch = Array[1..Nmax] Of Digit;
Var S : String;
M, N : Dl_Ch;
I, MaxF : Word;
j,q:longint;
Procedure Zero(Var A : Dl_Ch);
Var I : Integer;
Begin
For I := 1 To NMax Do A[I] := 0;
End;
Function Dlina(C : Dl_Ch) : Integer;
Var I : Integer;
Begin
I := NMax;
While (I > 1) And (C[I] = 0) Do I := I - 1;
Dlina := I
End;
Procedure Translate(S : String; Var A : Dl_Ch );
Var I : Word;
Begin
Zero(A); I := Length(S);
While (I >= 1) Do
Begin
A[Length(S) - I+ 1] := Ord(S[I]) - 48;
I := I - 1;
End
End;
Procedure Umn(A, B : Dl_Ch; Var C : Dl_Ch);
Var I, J : Integer; P : Digit; Rez : 0..99;
Begin
Zero(C);
For I := 1 To Dlina(A) Do
Begin P := 0;
For J := 1 To Dlina(B) Do
Begin
Rez := A[I] * B[J] + P + C[I + J - 1];
C[I + J - 1] := Rez Mod 10;
P := Rez Div 10
End;
C[I + J] := P
End
End;
procedure zmen ( A:Dl_Ch; var B:Dl_Ch );
var i1,i2:longint;
begin
i1:=1;
if a[i1]=0 then
begin
while a[i1]=0 do
begin
b[i1]:=9;
inc ( i1 );
end;
end;
b[i1]:=a[i1]-1;
inc ( i1 );
for i2:=i1 to Dlina(a) do b[i2]:=a[i2];
end;
procedure factorial ( n:Dl_Ch; var a:Dl_Ch );
var b,c:Dl_Ch;
begin
if (n[1]=1) and (Dlina(n)=1) then a[1]:=1
   else
   begin
   zmen ( n,b );
   factorial ( b,c );
   umn ( n,c,a );
   end;
end;
Begin
ReadLn(S); Translate(S, N);
factorial ( n,m );
j:=Dlina(m);
writeln ( m[j] );
End.