(* CUSIP *)

block

  unit check_digit: function (cusip: string): integer;
  var
    sum, v, i_first, i_last, i: integer,
    c: character,
    check_needed: boolean,
    ccusip: arrayof character;
  begin
    sum := 0;
    ccusip := unpack(cusip);
    i, i_first := lower(ccusip);
    i_last := upper(ccusip);
    check_needed := true;
    while (i < i_last) and check_needed
    do
      c := ccusip(i);
      if ord(c) >= ord('0') and ord(c) <= ord('9')
      then
        v := ord(c) - ord('0')
      else
        if ord('A') <= ord(c) and ord(c) <= ord('Z')
        then
          v := ord(c) - ord('A') + 10
        else
          case c
            when '*': v := 36;
            when '@': v := 37;
            when '#': v := 38;
            otherwise
              result := -1;
              check_needed := false
          esac
        fi
      fi;
      if check_needed
      then
        if (i - i_first) mod 2 = 1 then v := 2 * v fi;
        if i - i_first <= 7 then sum := sum + v div 10 + v mod 10 fi;
        i := i + 1
      fi;
    od;
    if check_needed
    then
      if i - i_first =/= 8
      then
        result := -1
      else
        result := (10 - sum mod 10) mod 10
      fi;
    fi;
  end check_digit;

  unit is_valid: function (cusip: string): boolean;
  var
    check: integer,
    ccusip: arrayof character;
  begin
    check := check_digit(cusip);
    if check < 0
    then
      result := false
    else
      ccusip := unpack(cusip);
      result := ord(ccusip(lower(ccusip) + 8)) = ord('0') + check
    fi;
  end is_valid;

  unit write_verdict: procedure (cusip: string);
  begin
    if is_valid(cusip)
    then
      writeln(cusip, " : Valid")
    else
      writeln(cusip, " : Invalid")
    fi
  end write_verdict;

begin
  writeln("CUSIP       Verdict");
  call write_verdict("037833100");
  call write_verdict("17275R102");
  call write_verdict("38259P508");
  call write_verdict("594918104");
  call write_verdict("68389X106");
  call write_verdict("68389X105");
end;