RE: upc check digit routine

[Jim Langston <jlangston@xxxxxxxxxxx>]

I had to write this myself about a month ago.  Here's what I came up with.
This is Visual Age RPG, but should compile on the AS/400 with few
modifications.

      *** Check Digit Variables ***
     D                 DS
     D CheckChar               1      1A
     D CheckNum                1      1S 0

     D                 DS
     D CheckDigit              1      1S 0
     D CheckDigitAlp           1      1A

     D Weight          S              1S 0
     D CheckTotal      S              3S 0

      *** BARCODE File ***
     D Barcode         S             11A
     D @Barcode        S               *   Inz(%Addr(Barcode))

      *****************************
      *** Calculate Check Digit ***
      *****************************

     C     CalcCheckDig  BegSR

     C                   Eval      Weight = 3
     C                   Eval      CheckTotal = 0

     C     1             Do        11            X
     C                   Eval      CheckChar = %SubSt(Barcode: X: 1)
     C                   Eval      CheckTotal = CheckTotal + CheckNum *
Weight
     C                   If        ( Weight = 1 )
     C                   Eval      Weight = 3
     C                   Else
     C                   Eval      Weight = 1
     C                   EndIf
     C                   EndDo

     C     CheckTotal    DIV       10            CheckTotal
     C                   MVR                     CheckDigit

     C                   If        CheckDigit <> 0
     C                   Eval      CheckDigit = 10 - CheckDigit
     C                   EndIf

     C                   EndSR

Regards,

Jim Langston