RosettaCodeData/Task/SEDOLs/PL-I/sedols.pli
2023-07-01 13:44:08 -04:00

23 lines
774 B
Text

/* Compute SEDOLs; includes check for invalid characters. */
sedol: procedure options (main); /* 3 March 2012 */
declare alphabet character (36) static initial
('0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ');
declare weight (6) fixed static initial (1, 3, 1, 7, 3, 9);
declare s character (6);
declare (i, v, k) fixed;
do while ('1'b);
get edit (s) (a(6));
put skip edit (s) (a);
/* Check for invalid characters: */
if verify(s, '0123456789BCDFGHJKLMNPQRSTVWXYZ') > 0 then stop;
v = 0;
do i = 1 to 6;
k = index(alphabet, substr(s, i, 1)) - 1;
v = v + weight(i) * k;
end;
k = mod(v, 10);
v = mod(10 - k, 10);
put edit (s, v) (x(2), a, f(1)); put edit (' ') (a);
end;
end sedol;