EXTOL RPG Program: LEFT01R

EXTOL RPG - External Call LEFT01R - Suppress leading blanks and Left Justify

     H/TITLE Suppress leading blanks and left-justify
     H            Y
     Z* CRTRPGPGM
     Z* OPTION(*NOXREF) GENOPT(*OPTIMIZE)
      *
     W* Warning: This program does not set on the LR indicator
      *
      * Parameter declarations
     I            DS
      * I :  Code trans directions    1
     I                                        1   1 P1CDTT
      * I :  Code table reference    10
     I                                        2  11 P2TABL
      * B :  Code in standard form   80
     I                                       12  91 P3CDST
      * B :  Code qualifier data     80
     I                                       92 171 P4CDQD
      * B :  Code in local form      80
     I                                      172 251 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
      *****************************************************************
      *
     C                     MOVE *BLANKS   OUT80  80
      * CASE: PAR.Code trans directions is Inward translation
     C           P1CDTT    IFEQ 'I'
      * Use Standard if non-blank; else use qualifier:
     C           P3CDST    IFNE *BLANKS
     C                     MOVELP3CDST    OUT80
     C                     ELSE
     C                     MOVELP4CDQD    OUT80
     C                     END
      * Find first non-blank character:
     C           ' '       CHECKOUT80     N       30       n=non'
     C           N         IFGT 0                          if found, use
     C                     SUBSTOUT80:N   P5CDLC    P       from pos N
     C                     ELSE                            otherwise, use
     C                     MOVELOUT80     P5CDLC            input as-is
     C                     END
      *
      *
     C                     ELSE
      * CASE: PAR.Code trans directions is Outward translation
     C           P1CDTT    IFEQ 'O'
      * Use Local if non-blank; else use qualifier:
     C           P5CDLC    IFNE *BLANKS
     C                     MOVELP5CDLC    OUT80
     C                     ELSE
     C                     MOVELP4CDQD    OUT80
     C                     END
      * Find first non-blank character:
     C           ' '       CHECKOUT80     N       30       n=non' '
     C           N         IFGT 0                          if found, use
     C                     SUBSTOUT80:N   P3CDST    P       from pos N
     C                     ELSE                            otherwise, use
     C                     MOVELOUT80     P3CDST            input as-is
     C                     END
      *
      *
     C                     END
      *
     C                     END
      *
      * A "Return code" of non-blank will be logged as a translation error:
     C                     MOVEL*BLANK    P0RTN            *Return code
      * Exit program
     C                     RETRN



By: on