Как убрать ошибку?

uses crt;
Function IntToBin(A : Longint) : String;
Var S : String;
Begin
S:='';
While A > 0 do Begin
S := Chr(Ord('0') + (A mod 2)) + S;
A := A div 2;
end;
IntToBin:=S;
end;
Function k2(k : Byte) : Longint;
Begin
k2 := 1 shl k;
end;
Function BinToInt(S : String) : Longint;
Begin
If Length(S) > 1 then
BinToInt := (Ord(S[1]) - Ord('0')) * k2(Length(S)-1) + BinToInt(Copy(S, 2, Length(S) - 1))
else
BinToInt := Ord(S[1])-Ord('0');
end;
Function BinSum(A,B :String) : String;
Var
S,s1,s2 : String;
Perenos : Boolean;
Procedure tSum(a1,a2 : String);
Var pp : Word;
Begin
pp := Ord(a1[Length(a1)]) + Ord(a2[Length(a2)]) - 2 * Ord('0') + Ord(Perenos);
If pp > 1 then Begin
Perenos:=True;
Dec(pp, 2);
end
else Perenos:=False;
S := Chr(Ord('0') + pp) + S;
If Length(a1) > 1 then
tSum(Copy(a1, 1, Length(a1) - 1), Copy(a2, 1, Length(a2) - 1))
else
S := Chr(Ord('0') + Ord(Perenos)) + S;
end;
Begin
s1:=A; s2:=B;
While Length(s2)<Length(s1) do s2:='0'+s2;
While Length(s1)<Length(s2) do s1:='0'+s1;
S:=''; Perenos:=False;
tSum(s1,s2);
While (S[1]='0') and (Length(S)>1) do Delete(S,1,1);
BinSum:=S;
end;
var
N1, N2    : Integer;
S1, S2, S : String;
begin
ClrScr;
repeat
textcolor(green);
write('');
write('Введите 1 положительное целое число: ');
readln(N1);
write('');
write('Число в 2 сист. счисл.: ');
S1 := IntToBin(N1);
WriteLn(S1);
readln(S);
textcolor(blue);
write('');
write('Введите 2 положительное целое число: ');
readln(N2);
write('');
write('Число в 2 сист. счисл.: ');
S2 := IntToBin(N2);
Writeln(S2);
readln(IntoBin);
write('');
write('Cумма двух положительных целых чисел: ');
S := BinSum(S1, S2);
WriteLn(BinToInt(S));
readln(BinSum);
write('Cумма двух положительных целых чисел в 2 сист счисл.: ');
WriteLn(S);
readln(tSum,pp);
write('');
WriteLn;
WriteLn('Для выхода нажмите Esc...');
until ReadKey = #27;
end.

Ord(x:boolean);

readln(IntoBin);