RosettaCodeData/Task/SEDOLs/MUMPS/sedols.mumps
2023-07-01 13:44:08 -04:00

21 lines
636 B
Text

SEDOL
NEW A,B
SEDOL1
READ !,"Enter the first 6 digits of a SEDOL: ",A
SET B=$$SEDOLCHK(A)
WRITE !,$SELECT($LENGTH(B)=1:"Full SEDOL is "_A_B,1:B)
GOTO SEDOL1
QUIT
SEDOLCHK(STOCK)
NEW WT,VAL,I,CHK,C,FLAG
SET WT="1317391",VAL=0,FLAG=0
FOR I=1:1:6 SET C=$$TOUPPER($EXTRACT(STOCK,I)),VAL=VAL+($$SEDVAL(C)*$EXTRACT(WT,I)) SET:"AEIOUaeiou"[C FLAG=1
SET:$LENGTH(STOCK)'=6 FLAG=1
KILL WT,I,CHK,C
QUIT $SELECT(FLAG:"INVALID",'FLAG:(10-(VAL#10))#10)
SEDVAL(X)
QUIT $SELECT($ISVALIDNUM(X):X,1:$ASCII(X)-$ASCII("@")+9)
TOUPPER(X)
NEW UP,LO
SET UP="ABCDEFGHIJKLMNOPQRSTUVWXYZ",LO="abcdefghijklmnopqrstuvwxyz"
QUIT $TRANSLATE(X,LO,UP)