by P. Drula.
PHP Code:
H DftActGrp(*No) ActGrp(*Caller) Option(*NoDebugIO) BndDir('QC2LE')
H DatFmt(*ISO) TimFmt(*ISO)
H COPYRIGHT('(c) MyCompany - Data Processing')
*� Calculate Modulus 10 check digit for a given number.
*� Append the check digit to the original number.
*�Program Variables
D I s 2s 0 Inz(1)
D Numbers c Const('0123456789')
D Alpha# s Like(My_Parm)Inz(*All'0')
D Chr_Pos s 2s 0 Inz
*�Put the Base Number into an Array
D Original# ds Inz
D My_Number 15s 0
D Array 1s 0 Dim(15) Overlay(My_Number)
*�Check Digit(s)
D Digits ds Inz
D Chk_Digits 2s 0
D Check_Digit 1s 0 Overlay(Chk_Digits:2)
*�Position
D Position ds Inz
D Pos 2s 0
D Pos_Left 1s 0 Overlay(Pos:1)
D Pos_Right 1s 0 Overlay(Pos:2)
*�Procedure(s) Definition(s)
*�Entry Parms
D EntryList pr EXTPGM('M10')
D 15a
*�Entry Parms
D EntryList pi
D My_Parm 15a
*� Let's begin
*�Up to 14 digits can be passed
c If %len(%trim(My_Parm)) > %size(My_Parm) - 1
c EvalR My_Parm = ('Max. 14 digits!')
c ExSr ByeBye
c EndIf
*�Check for Numbers only
c EvalR Alpha# = Alpha# + %trim(My_Parm)
c Eval Chr_Pos = %Check(Numbers:Alpha#:1)
c If Chr_Pos <> *Zeros
c EvalR My_Parm = ('Numbers Only!')
c ExSr ByeBye
c EndIf
*�Modulus10 Check Digit - Main logic
c Eval My_Number = %Int(%trim(My_Parm))
c For I = %elem(Array) DownTo 1 by 2
c Eval Pos = Array(I) * 2
c Eval Pos_Left = Pos_Left + Pos_Right
c Eval Array(I) = Pos_Left
c EndFor
c Eval Chk_Digits = 100 - %xFoot(Array)
*�Return parm with check digit appended
c Eval My_Parm = %trim(My_Parm) +
c %char(Check_Digit)
c ExSr ByeBye
*� ByeBye - Exit Program Sub-procedure
c ByeBye BegSr
c Dsply My_Parm
c Eval *inLR =*On
c Return
c EndSr
Comment