Modulus 10 check digit program

Sent in by P. Drula.

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

[report a broken link by clicking here]