H
     F********************************************************************
     F*- PROGRAM......: CCED01
     F*- DESIGNED BY..: VP
     F*
     F********************************************************************
     F*=ÄProgram Change Log:·
     F*= Chgid   Date    By Description
     F*= ----- -------- --- ----------------------------------------------
     F*=       03-22-04  VP NEW.
      ********************************************************************
     D AR1             S             10    DIM(16) CTDATA PERRCD(1)
     D AR2             S              1    DIM(16)
     D AR3             S              1    DIM(16)
      ********************************************************************
     D NM              C                   CONST('0123456789')
      *
     D CH              C                   CONST('!@#$%›&*()')
      *
     D DATA            DS
     D  FLD#                   1     16
     D  TYPE                  17     17
      ********************************************************************
     C     *ENTRY        PLIST
     C                   PARM                    ##PARM           17
      *
     C                   MOVEL(p)  ##PARM        DATA
      *
      * GET LENGTH OF THE CREDIT CARD NUMBER
     C     '  '          CHECKR    FLD#          L                 2 0
      *
     C                   SELECT
      *
     C     TYPE          WHENEQ    'E'
      *
      *
      * 1) ENCRYPTION
     C                   MOVEA(P)  FLD#          AR2
      *
     C                   Z-ADD     1             I                 2 0
      *
     C     1             DO        L             I
      *
     C                   Z-ADD     1             J                 2 0
     C     AR2(I)        SCAN      AR1(I)        J                        50
     C     *IN50         IFEQ      *ON
     C                   MOVE(P)   J             AR3(I)
     C                   ENDIF
      *
     C                   ENDDO
      *
     C                   MOVEA(P)  AR3           FLD#
      *
      * TRANSLATE NUMERIC TO CHARACTER
     C     NM:CH         XLATE     FLD#          FLD#
      *
     C                   MOVEL(P)  DATA          ##PARM
      *
     C     TYPE          WHENEQ    'D'
      * 2) DECRYPTION
      *
      * TRANSLATE CHARACTER TO NUMERIC
     C     CH:NM         XLATE     FLD#          FLD#
      *
     C                   MOVEA(P)  FLD#          AR2
      *
     C                   Z-ADD     1             I                 2 0
     C                   Z-ADD     1             K                 1 0
      *
     C     1             DO        L             I
      *
     C                   MOVE      AR2(I)        K
     C     K             IFEQ      *ZERO
     C                   MOVE(P)   AR1(I)        AR3(I)
     C                   ELSE
     C     1             SUBST(P)  AR1(I):K      AR3(I)
     C                   ENDIF
      *
     C                   ENDDO
      *
     C                   MOVEA(P)  AR3           FLD#
      *
     C                   MOVEL(P)  DATA          ##PARM
      *
     C                   OTHER
     C                   ENDSL
      *
     C                   MOVE      *ON           *INLR
      *****************************************************************
**
0123456789
1234567890
2345678901
3456789012
4567890123
5678901234
6789012345
7890123456
8901234567
9012345678
0123456789
1234567890
2345678901
3456789012
4567890123
5678901234