Римские цифры

Program rim;
uses CRT;
Const
R: Array[1..13] of String[2] =
('I','IV','V','IX','X','XL','L','XC','C','CD','D','CM','M');
A: Array[1..13] of Integer=
(1,4,5,9,10,40,50,90,100,400,500,900,1000);
Function Roman(N : Integer) : String;
Var Result:String;
i:Integer;
begin
Result := '';
i:= 13;
While N >0 do
begin
While A[i]>N do Dec(i);
Result:=Result+R[i];
Dec(N,A[i]);
end;
Roman:=Result;
end;
Function Arabic(S:String):Integer;
Var Result:Integer;
i, p:Integer;
begin
Arabic := -1;
Result := 0;
i:=13;
p:=1;
While p <=Length(S) do
begin
While Copy(S, p, Length(R[i])) <>R[i] do
begin
Dec(i);
If i = 0 then Exit;
end;
Result := Result + A[i];
p := p + Length(R[i]);
end;
If Roman(Result) = S then Arabic := Result
end;
Var N, Err : Integer;
S : String;
BEGIN
repeat
ReadLn(S);
If S = '' then Break;
Val(S, N, Err);
If Err = 0 then
WriteLn(Roman(N))
else
WriteLn(Arabic(S));
until false;
END.

program Roman;
uses CRT;
const
  TransTable: array[1..13] of record
    AN: word;
    RN: string[2];
  end = ((AN: 1000; RN:'M'),  (AN: 900; RN: 'CM'), (AN: 500; RN: 'D'),
         (AN: 400; RN: 'CD'), (AN: 100; RN: 'C'),  (AN: 90; RN: 'XC'),
         (AN: 50; RN: 'L'),   (AN: 40; RN: 'XL'),  (AN: 10; RN: 'X'),
         (AN: 9; RN: 'IX'),   (AN: 5; RN: 'V'),    (AN: 4; RN: 'IV'),
         (AN: 1; RN: 'I'));
var
RomanNumber: string;
ArabianNumber: longint;
CurNum: byte;
CurSymb: string[2];
CurVal: word;
begin
  Write('Натуральное число:');
  ReadLn(RomanNumber);
  ArabianNumber := 0;
  CurNum := 1;
repeat
CurSymb := TransTable[CurNum].RN;
CurVal := TransTable[CurNum].AN;
while Copy(RomanNumber, 1, Length(CurSymb)) = CurSymb do
begin
Inc(ArabianNumber, CurVal);
Delete(RomanNumber, 1, Length(CurSymb));
end;
Inc(CurNum);
until RomanNumber = '';
WriteLn(': ', ArabianNumber);
end.