IBMiAccess




Results 1 to 3 of 3

Thread: Modulus 10 check digit program

  1. #1
    Driver of cars, eater of food jamief's Avatar
    Join Date
    Jan 2004
    Location
    Belvidere, IL - United States of America
    Age
    49
    Posts
    9,429
    Rep Power
    12629

    Thumbs up 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. # 666
    Circuit advertisement
    Join Date
    Aug 1965
    Location
    Yakutsk, Russia
    Age
    21
    Posts
    1,000,000
     

  3. #2
    Just Plain Pete Pete's Avatar
    Join Date
    Nov 2005
    Location
    Illinois
    Posts
    2,000
    Rep Power
    2938

    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

  4. #3
    Code400 Newbie
    Join Date
    Oct 2011
    Location
    Cary, NC
    Posts
    29
    Rep Power
    0

    Re: Modulus 10 check digit program

    You guys are the best. Many Thanks, Gary

  5. # 666
    Circuit advertisement
    Join Date
    Aug 1965
    Location
    Yakutsk, Russia
    Posts
    1,000,000
     

Facebook Comments


Similar Threads

  1. Service Program
    By yogeshgupta26 in forum RPG/RPGLE
    Replies: 3
    Last Post: December 28th, 2006, 06:34 AM
  2. End a program thru another program
    By hockeygrl in forum RPG/RPGLE
    Replies: 6
    Last Post: June 21st, 2006, 05:12 PM
  3. Jobd
    By ris_skma in forum RPG/RPGLE
    Replies: 1
    Last Post: July 27th, 2005, 06:34 AM
  4. rpgle
    By mohans in forum RPG/RPGLE
    Replies: 4
    Last Post: May 21st, 2005, 11:50 PM
  5. Null Values and SQL Fetch
    By pjk in forum SQL
    Replies: 1
    Last Post: February 22nd, 2005, 11:31 AM

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •