H/TITLE Increment a numeric data area - ext call table
     H            Y
     Z* CRTRPGPGM
     Z* OPTION(*NOXREF) GENOPT(*OPTIMIZE)
      *
     W* Warning: This program does not set on the LR indicator
      *
     H* SYNOPSIS :
     H*  Example of external call code translation using the "short"
     H*  parameter list.  This program accepts a data area name in
     H*  the "qualifier" field.  The data area should be a numeric data
     H*  area with any size from (1 0) to (24 9).
     H*
     H*  The data area may have a fractional part; if it does,
     H*  the integer part will be incremented and the fractional part
     H*  will be preserved providing that the entire value "fits" within
     H*  a 15.9 representation (e.g., maximum = 999999.999999999).
     H*
     H*  If there are no decimal positions, the data area may be up
     H*  to 15 digits in the integer part.
      *
     H* (C) Copyright : ExtoL, Inc. 1988,1992
      *
      *================================================================
     M* Maintenance   :
      *================================================================
      *
      *
      * Named constants:
     I              'INCDTAARAC'          C         INCPGM
      *
      * Data structures:
      *
      * For parsing qual data (of the form "library/dataarea")
     I            DS
     I                                        1  80 QD80
      * Parameter declarations
     IP1PARM      DS
      * I :  Code trans directions
     I                                        1   1 P1CDTT
     IP2PARM      DS
      * I :  Code table reference
     I                                        1  10 P2TABL
     IP3PARM      DS
      * B :  Code in standard form
     I                                        1  80 P3CDST
     IP4PARM      DS
      * B :  Code qualifier data
     I                                        1  80 P4CDQD
     IP5PARM      DS
      * B :  Code in local form
     I                                        1  80 P5CDLC
      /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 80        Code in standar
     C           P4CDQD    PARM P4CDQD    WP0004 80        Code qualifier
     C           P5CDLC    PARM P5CDLC    WP0005 80        Code in local f
      *****************************************************************
      *
      * External code process P1
      *
      * Initialise
     C                     MOVE *BLANK    P0RTN
     C                     MOVE *BLANK    W0RTN   7
      * Initialise indicators for re-entry
     C                     MOVE '0'       *IN
      *
     C                     MOVELP4CDQD    QD80             Qual data
      * Scan for '/' character (library/dtaarea):
     C           '/'       SCAN QD80      N       30
     C           N         IFGT 0
      * If found, data area name is next 10 chars after '/':
     C           N         ADD  1         DTP     30
     C           10        SUBSTQD80:DTP  DTAN   10 P
      * (just in case '/' in first character...)
     C           N         IFGT 1
      * Library name starts in pos 1, length N-1:
     C           N         SUB  1         LBN     30
     C           LBN       SUBSTQD80:1    LIBN   10 P
     C                     ELSE
      * Use *LIBL if '/' in 1st character:
     C                     MOVEL'*LIBL'   LIBN      P
     C                     END
     C                     ELSE
      * If no '/', use 1st 10 characters as data area name:
     C                     MOVELQD80      DTAN
      * Use *LIBL if no '/' found:
     C                     MOVEL'*LIBL'   LIBN      P
     C                     END
      *
     C                     MOVE LIBN      QUALNM 20 P
     C                     MOVELDTAN      QUALNM
     C                     MOVE *ZEROS    VALUE  150
      *
     C                     CALL INCPGM                 90  'INCDTAARAC'
     C                     PARM QUALNM    W00001 20
     C           VALUE     PARM           W00002 150
      *
      * If Call to program ended in error
     C           *IN90     IFEQ '1'
      * A "Return code" of non-blank will be logged as a translation error:
     C                     MOVEL'Y2U0021' W0RTN   7
      *
     C                     ELSE
      *
      * CASE: PAR.Code trans directions is Inward translation
     C           P1CDTT    IFEQ 'I'                        *IF
      *        Incoming ("I") - Standard -> Application translation.
     C                     MOVELVALUE     P5CDLC    P      Code in local f
     C                     ELSE
      * CASE: PAR.Code trans directions is Outward translation
     C           P1CDTT    IFEQ 'O'                        *IF
      *        Outgoing ("O") - Application -> Standard translation.
     C                     MOVELVALUE     P3CDST    P      Code in standar
     C                     END                             *FI
     C                     END                             *FI
      *
     C                     END                             *FI
      *================================================================
      * Exit program: Direct
     C                     RETRN
      *================================================================