test_decode: procedure options (main); /* 28 January 2013 */
   declare roman character (20) varying;

   do roman = 'i', 'ii', 'iii', 'iv', 'v', 'vi', 'vii', 'viii', 'iix',
              'ix', 'x', 'xi', 'xiv', 'MCMLXIV', 'MCMXC', 'MDCLXVI',
              'MIM', 'MM', 'MMXIII';
      put skip list (roman, decode(roman));
   end;

decode: procedure (roman) returns (fixed(15));
   declare roman character (*) varying;
   declare (current, previous) character (1);
   declare n fixed (15);
   declare i fixed binary;

   previous = ''; n = 0;
   do i = length(roman) to 1 by -1;
      current = substr(roman, i, 1);
      if digit_value(current) < digit_value(previous) then
         n = n - digit_value(current);
      else if digit_value(current) > digit_value(previous) then
         do;
            n = n + digit_value(current);
            previous = current;
         end;
      else
         n = n + digit_value(current);
   end;
   return (n);
end decode;

digit_value: procedure (roman_char) returns (fixed);
   declare roman_char character(1);
      select (roman_char);
         when ('M', 'm') return (1000);
         when ('D', 'd') return (500);
         when ('C', 'c') return (100);
         when ('L', 'l') return (50);
         when ('X', 'x') return (10);
         when ('V', 'v') return (5);
         when ('I', 'i') return (1);
         otherwise       return (0);
      end;
end digit_value;

end test_decode;