ibmi-brunch-learn

Announcement

Collapse
No announcement yet.

Modulus 10 check digit program

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Modulus 10 check digit program

    by P. Drula.

    PHP Code:
         H DftActGrp(*NoActGrp(*CallerOption(*NoDebugIOBndDir('QC2LE')
         
    H DatFmt(*ISOTimFmt(*ISO)
         
    H COPYRIGHT('(c) MyCompany - Data Processing')

          *&
    #65533; 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(15Overlay(My_Number)

          *&
    #65533;Check Digit(s)
         
    D Digits            ds                      Inz
         D  Chk_Digits                     2s 0
         D  Check_Digit                   1s 0 Overlay
    (Chk_Digits:2)

          *&
    #65533;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)

          *&
    #65533;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

          *&
    #65533;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

          *&
    #65533;Modulus10 Check Digit - Main logic
         
    c                   Eval      My_Number = %Int(%trim(My_Parm))
         
    c                   For       = %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)

          *&
    #65533;Return parm with check digit appended
         
    c                   Eval      My_Parm = %trim(My_Parm) +
         
    c                             %char(Check_Digit)

         
    c                   ExSr      ByeBye
          
    *&#65533; ByeBye - Exit Program Sub-procedure
         
    c     ByeBye        BegSr

         c                   Dsply                   My_Parm

         c                   
    Eval      *inLR =*On
         c                   
    Return
         
    c                   EndSr 
    All my answers were extracted from the "Big Dummy's Guide to the As400"
    and I take no responsibility for any of them.

    www.code400.com

  • #2
    Re: Modulus 10 check digit program

    SQL function equivalents from Jonathan Ball and Spot over at comp.sys.ibm.as400.misc......

    Standard IBM Mod10:

    PHP Code:
    create function mylib.mod10 (modnumber bigintreturns smallint
    language sql
    begin
    declare wrksum smallint default 0;
    declare 
    numlen smallint;
    declare 
    iter smallint default 0;
    set numlen char_length(modnumber);
    while 
    iter numlen do
       
    set iter iter 1;
       if 
    mod(iter,2) = 0 then
          set wrksum 
    wrksum smallint(substr(char(modnumber),numlen -
    iter 1,1));
       else
          
    set wrksum wrksum +
             case 
    substr(char(modnumber),numlen iter 1,1)
                
    when '1' then 2
                when 
    '2' then 4
                when 
    '3' then 6
                when 
    '4' then 8
                when 
    '5' then 1
                when 
    '6' then 3
                when 
    '7' then 5
                when 
    '8' then 7
                when 
    '9' then 9
                
    else 0 end;
       
    end if;
    end while;
    return 
    smallint(case mod(wrksum,10when 0 then 0 else 10 -
    mod(wrksum,10end);
    end
    EAN and UPC Mod 10:

    PHP Code:

    create 
    function my.upcmod10 (modnumber bigintreturns 
    smallint language sql contains sql
    begin
    declare wrksum smallint default 0;
    declare 
    numlen smallint;
    declare 
    iter smallint default 0;
    set numlen char_length(modnumber);
    while 
    iter numlen do
        
    set iter iter 1;
        if 
    mod(iter,2) = 0 then
           set wrksum 
    wrksum +
               
    smallint(substr(char(modnumber),numlen 
    iter 1,1));
        else
           
    set wrksum wrksum +
               
    smallint(substr(char(modnumber),numlen 
    iter 1,1)) * 3;
        
    end if;
    end while;
    return 
    smallint(mod(10 mod(wrksum,10),10));
    end

    Comment


    • #3
      Re: Modulus 10 check digit program

      You guys are the best. Many Thanks, Gary

      Comment

      Working...
      X