midrange.com code scratchpad
Name:
SubGTIN
Scriptlanguage:
Plain Text
Tabwidth:
4
Date:
03/30/2012 03:57:13 pm
IP:
Logged
Description:
A service program with 2 procedures for GTIN (Global Trade ID Number) 14 digits long, the 14th digit is the check digit.

The 2 procedures are:

1) ClcChkDgt - Calculates the check digit and returns it in a separate parm. The check digit is not put into the GTIN 14th position, you must do that outside of this routine.

2) VfyChkDgt - Verify the validity of the check digit. If it is correct, "Y" is returned. If not "N" is returned.
Code:
  1.       //===============================================================
  2.       //
  3.       // Service program  : SubGTIN
  4.       // Description      : Various procs for GTIN (Global Trade ID
  5.       //                    Number).
  6.       //
  7.       // To compile:
  8.       //
  9.       //      CRTRPGMOD  MODULE(XXX/COMMAND) SRCFILE(XXX/QRPGLESRC)
  10.       //
  11.       //      CRTSRVPGM  SRVPGM(XXX/COMMAND) MODULE(XXX/COMMAND) +
  12.       //                   EXPORT(*ALL) ACTGRP(*CALLER)
  13.       //
  14.       //===============================================================
  15.  
  16.      H NoMain
  17.  
  18.       //
  19.       // Prototypes.  Normally I put prototypes in a separate member.
  20.       //
  21.  
  22.       //==================================================================*
  23.       //                                                                  *
  24.       //  FUNCTION:  ClcChkDgt  - Calculate check digit for a GTIN.       *
  25.       //                                                                  *
  26.       //             INPUT:     - GTIN                                    *
  27.       //            OUTPUT:     - Check digit (1,0 numeric value)         *
  28.       //                                                                  *
  29.       //==================================================================*
  30.  
  31.      D ClcChkDgt       PR             1S 0
  32.      D  GTIN                         14S 0
  33.  
  34.       //==================================================================*
  35.       //                                                                  *
  36.       //  FUNCTION:  VfyChkDgt  - Verify the check digit in a GTIN.       *
  37.       //                                                                  *
  38.       //             INPUT:     - GTIN                                    *
  39.       //            OUTPUT:     - "Y" if correct, "N" if wrong            *
  40.       //                                                                  *
  41.       //==================================================================*
  42.  
  43.      D VfyChkDgt       PR             1A
  44.      D  GTIN                         14S 0
  45.  
  46.       //
  47.       // Constants
  48.       //
  49.      D @Yes            C                   'Y'
  50.      D @No             C                   'N'
  51.  
  52.      P/EJECT
  53.       //===============================================================
  54.       //
  55.       // Procedure    : ClcChkDgt
  56.       // Description  : Calculate check digit for a GTIN
  57.       //
  58.       //===============================================================
  59.  
  60.      P ClcChkDgt       B                   Export
  61.      D ClcChkDgt       PI             1S 0
  62.      D  GTIN                         14S 0
  63.  
  64.      D                 DS
  65.      D GTINField                     14S 0
  66.      D  GTINAry                       1S 0 Dim(14) Overlay(GTINField)
  67.  
  68.      D ChkDgt          S              1S 0
  69.      D Sum             S              3P 0
  70.  
  71.       /FREE
  72.  
  73.        GTINField = GTIN;
  74.  
  75.        Sum = 3 * (GTINAry(1) +
  76.                   GTINARY(3) +
  77.                   GTINARY(5) +
  78.                   GTINARY(7) +
  79.                   GTINARY(9) +
  80.                   GTINARY(11) +
  81.                   GTINARY(13)) +
  82.              GTINAry(2) +
  83.              GTINAry(4) +
  84.              GTINAry(6) +
  85.              GTINAry(8) +
  86.              GTINAry(10) +
  87.              GTINAry(12);
  88.  
  89.        Sum = %Rem(Sum:10);
  90.  
  91.        If Sum > *Zero;
  92.          ChkDgt = 10 - Sum;
  93.        Else;
  94.          ChkDgt = *Zero;
  95.        Endif;
  96.  
  97.        Return ChkDgt;
  98.  
  99.       /END-FREE
  100.  
  101.      P ClcChkDgt       E
  102.  
  103.      P/EJECT
  104.       //===============================================================
  105.       //
  106.       // Procedure    : VfyChkDgt
  107.       // Description  : Verify the validity of the check digit in a GTIN
  108.       //
  109.       //===============================================================
  110.  
  111.      P VfyChkDgt       B                   Export
  112.      D VfyChkDgt       PI             1A
  113.      D  GTIN                         14S 0
  114.  
  115.      D                 DS
  116.      D GTINField                     14S 0
  117.      D  GTINAry                       1S 0 Dim(14) Overlay(GTINField)
  118.  
  119.      D ChkDgt          S              1S 0
  120.      D VldChkDgt       S              1A
  121.  
  122.       /FREE
  123.  
  124.        // Grab field
  125.        GTINField = GTIN;
  126.  
  127.        // Get what the valid check digit should be
  128.        ChkDgt = ClcChkDgt(GTIN);
  129.  
  130.        // Valid or not
  131.        If GTINAry(14) = ChkDgt;
  132.          VldChkDgt = @Yes;
  133.        Else;
  134.          VldChkDgt = @No;
  135.        Endif;
  136.  
  137.        Return VldChkDgt;
  138.  
  139.       /END-FREE
  140.  
  141.      P VfyChkDgt       E 
© 2004-2019 by midrange.com generated in 0.007s valid xhtml & css