H/TITLE Calculate Check Digit
     H DATEDIT(*YMD)
     D* CRTRPGPGM
     D* OPTION(*NOXREF)
      *
     D* Warning: This program does not set on the LR indicator
      *
     H* SYNOPSIS :
     H*  Create check digit for License Plate number on ASN
      *
      *
      *================================================================
     D* Maintenance   :
      *================================================================
      /EJECT
      * Data structures:
      *
      * Parameter declarations
     D                 DS
      * I :  Code trans directions
     D  P1CDTT                 1      1
     D                 DS
      * I :  Code table reference
     D  P2TABL                 1     10
     D                 DS
      * B :  Code in standard form
     D  P3CDST                 1     18
     D                 DS
      * B :  Code qualifier data
     D  P4CDQD                 1     80
     D                 DS
      * B :  Code in local form
     D  P5CDLC                 1     18
      *
     D                 DS
     D  RTNV                   1     18  0
     D  FLD1                   1      8  0
     D  FLD2                   9     17  0
     D  CHKD                  18     18  0
     D  D1                     1      1  0
     D  D2                     2      2  0
     D  D3                     3      3  0
     D  D4                     4      4  0
     D  D5                     5      5  0
     D  D6                     6      6  0
     D  D7                     7      7  0
     D  D8                     8      8  0
     D  D9                     9      9  0
     D  D10                   10     10  0
     D  D11                   11     11  0
     D  D12                   12     12  0
     D  D13                   13     13  0
     D  D14                   14     14  0
     D  D15                   15     15  0
     D  D16                   16     16  0
     D  D17                   17     17  0
     D  D18                   18     18  0
      /EJECT
      *****************************************************************
      * Entry parameters
     C     *ENTRY        PLIST
     C                   PARM                    P0RTN             7
     C     P1CDTT        PARM                    WP0001            1            Code trans dire
     C     P2TABL        PARM                    WP0002           10            Code table refe
     C     P3CDST        PARM      P3CDST        WP0003           18            Code in standar
     C     P4CDQD        PARM      P4CDQD        WP0004           80            Code qualifier
     C     P5CDLC        PARM      P5CDLC        WP0005           18            Code in local f
      *****************************************************************
      * Initialisation
      *================================================================
      *================================================================
      *
      * CASE: Inbound translation
      *
     C     P1CDTT        IFEQ      'I'
      *
      * Note: Return value sent in
      *
     C                   MOVEL     P3CDST        P5CDLC
      *
     C                   ELSE
      *
      * CASE: Outbound translation
      *
      * The following logic was used to determine the check digit
      * for a Serial Shipping Container (SSCC) Number (which is 18
      * digits)
      *
      * 1. Add the values from the odd positions
      * 2. Multiple the result from step one by three
      * 3. Add the values from the even positions
      * 4. Add the result of step 2 to the sum of step 3
      * 5. The check digit is the smallest number needed to round
      *    the result of step 4 up to a multiple of 10
      *
      * EXAMPLE: if the first 17 positions are as follows
      *
      *
      *
     C     P1CDTT        IFEQ      'O'
     C                   IF        %LEN(%TRIM(P5CDLC)) = 10
     C                   EVAL      P5CDLC = %SUBST(P5CDLC:1:3) +
     C                             %SUBST(P5CDLC:5:6)
     C                   ENDIF
     C                   MOVEL     P5CDLC        FLD2
     C                   Z-ADD     0             ODD               3 0
     C                   Z-ADD     0             EVEN              3 0
     C                   Z-ADD     10890302      FLD1
      *
      *  Step 1
      *
     C     D3            ADD       D1            ODD
     C                   ADD       D5            ODD
     C                   ADD       D7            ODD
     C                   ADD       D9            ODD
     C                   ADD       D11           ODD
     C                   ADD       D13           ODD
     C                   ADD       D15           ODD
     C                   ADD       D17           ODD
      *
      *  Step 2
      *
     C                   MULT      3             ODD
      *
      *  Step 3
      *
     C     D4            ADD       D2            EVEN
     C                   ADD       D6            EVEN
     C                   ADD       D8            EVEN
     C                   ADD       D10           EVEN
     C                   ADD       D12           EVEN
     C                   ADD       D14           EVEN
     C                   ADD       D16           EVEN
      *
      *  Step 4
      *
     C     EVEN          ADD       ODD           RSLT              3 0
      *
      *  Step 5
      *
     C     RSLT          DIV       10            HLD1              3 1
     C                   Z-ADD     HLD1          HLD2              3 0
     C     HLD1          SUB       HLD2          HLD3              1 1
     C     1             SUB       HLD3          HLD4              1 1
     C     10            MULT      HLD4          CHKD
      *
     C                   MOVE      RTNV          P3CDST
      *
     C                   ENDIF
     C                   ENDIF
      *
     C                   RETURN
      *