(**********************************************************************

 Test Checksum of a Credit Card Number

 This is only useful to prevent mis-spellings.
 A credit card number that passes this test is not neccesary valid
 because not all possible combinations of digits are actually already
 allocated to credit cards.

**********************************************************************)


function fullparamstr : string;
begin
  fullparamstr := string(ptr(PrefixSeg,$80)^);
end;


function v (key : char) : byte;
{ convert char to byte }
begin
  if not (key in ['0'..'9']) then halt;
  v := ord (key) - ord ('0');
end;


var
  c : string;
  i : byte;
  s : word;

BEGIN
  { get credit card number }
  if paramcount <> 0 then c := fullparamstr
  else begin
     writeln ('enter a credit card number:');
     readln (c);
  end;

  { remove anything that's not a digit }
  i := 1;
  while (i <= length(c)) do begin
     if not (c[i] in ['0'..'9']) then
        c := copy (c,1,i-1) + copy (c,i+1,255)
     else inc (i);
  end;

  { calculate checksum }
  s := 0;
  for i := 1 to length(c) do begin
     if odd(i) then begin
        inc (s, 2*v(c[i]));
        if v(c[i]) > 4 then inc (s);
     end
     else inc (s, v(c[i]));
  end;

  if s mod 10 = 0
     then writeln ('Credit Card number is OK')
     else writeln ('Credit card number is INCORRECT !!',^G);

  if s mod 10 <> 0 then halt(1);

END.