midrange.com code scratchpad
Name:
Calculate UPC Check Digit
Scriptlanguage:
Plain Text
Tabwidth:
4
Date:
08/16/2010 07:33:10 pm
IP:
Logged
Description:
The user was to lazy to give a description
Code:
  1. <prototype>
  2.       *--------------------------------------------------
  3.       * Procedure name: Utl_CalcUPCChkD
  4.       * Purpose:        Calculate the UPC check digit
  5.       * Returns:        Check digit
  6.       * Parameter:      UPC
  7.       *--------------------------------------------------
  8.      D UTL_CalcUPCChkD...
  9.      D                 PR             1P 0 EXTPROC('CALCUPCCHKD')
  10.      D  UPC                          15P 0 Value
  11. </prototype>
  12. <code>
  13.      P*--------------------------------------------------
  14.      P* Procedure name: CalcUPCChkD
  15.      P* Purpose:        Calculate the UPC check digit
  16.      P* Returns:        Check digit
  17.      P* Parameter:      UPC
  18.      P* Description:    This calculation was pulled from
  19.      P*      from a document labeled SIL2000.PDF. Its the
  20.      P*      UCS Standard Interchange Language reference.
  21.      P*      The algorithm is located in Appendix B.
  22.      P*--------------------------------------------------
  23.      P CalcUPCChkD     B                   EXPORT
  24.      D CalcUPCChkD     PI             1P 0
  25.      D  UPC                          15P 0
  26.  
  27.  
  28.      D* Local fields
  29.      D CheckDigit      S              1P 0
  30.      D Step1Val        S              5P 0
  31.      D Step2Val        S              5P 0
  32.      D Step3Val        S              5P 0
  33.      D Step4Val        S              5P 0
  34.  
  35.      D                 DS
  36.      D UPCField                      15S 0
  37.      D UPCAr                          1S 0 DIM(15) Overlay(UPCField)
  38.  
  39.       /FREE
  40.  
  41.        // Array Elm: 01 02 03 04 05 06 07 08 09 10 11 12 13 14 15
  42.        // Positions: 15 14 13 12 11 10 09 08 07 06 05 04 03 02 01
  43.        //             0  0  0  0  5  1  0  0  0  0  0  0  1  1  ? <- Check Digit
  44.         UPCField = UPC*10; // move to left by one
  45.        // Starting from position 2 of the number, add up the
  46.        //  values in the even numbered positions.
  47.         Step1Val = UPCar(14) +UPCar(12) +UPCar(10) +UPCar(08)
  48.                   +UPCar(06) +UPCar(04) +UPCAr(02);
  49.         Step2Val = Step1Val * 3;
  50.        // Starting from position 3 of the number, add up the values
  51.        //  in the odd numbered positions. That is, add up all the
  52.        //  numbers left over from step 1. You're skipping position 1
  53.        //  because position 1 is the check digit.
  54.         Step3Val = UPCar(13) +UPCar(11) +UPCar(09) +UPCar(07)
  55.                   +UPCar(05) +UPCar(03) +UPCar(01);
  56.         Step4Val = Step2Val + Step3Val;
  57.         Monitor;
  58.           CheckDigit = 10 - %Rem(Step4Val:10);
  59.         On-error *All;
  60.           CheckDigit = 0;
  61.         EndMon;
  62.  
  63.         RETURN CheckDigit;
  64.  
  65.       /END-FREE
  66.      P CalcUPCChkD     E
  67. </code>
© 2004-2019 by midrange.com generated in 0.006s valid xhtml & css