TAA Tools
ZSHIFT          Z SHIFT RPG SUBROUTINE                 TAARPHF

The Z Shift  RPG Subroutine tool  provides two subroutines that  can be
copied  into a program  for shifting a  character field left  or right.
ZSHIFTL  does  a left  shift.   ZSHIFTR does  a right  shift.   A field
length of up to 50 bytes may be processed.

The same  type  of  interface is  used  for  both programs,  but  MOVEL
should  be  used  for  ZSHFTL  and  MOVE should  be  used  for  ZSHFTR.
Padding  with blanks should  occur on the  first MOVE or  MOVEL and use
EXSR to either  ZSHFTL or ZSHFTR.   The result is  then placed back  in
the ZSHFLD field and you would move the result to your field.

     C                     MOVELxxx       ZSHFLD    P      Fld to shift
     C                     EXSR ZSHFTL                     Shift left
     C                     MOVELZSHFLD    xxx              Move out

Only blank characters (X'40') are shifted out.

Both RPG III and  RPG IV code is provided for each  subroutine.  RPG IV
users should consider the direct use of %TRIM or %TRIML.

RPG III Code
------------

                      Shift left interface and subroutine
                      -----------------------------------

     C                     MOVELxxx       ZSHFLD    P      Fld to shift
     C                     EXSR ZSHFTL                     Shift left
     C                     MOVELZSHFLD    xxx              Move out
     C****************************************************************
     C*                                                              *
     C*     ZSHFTL Subroutine - Does a shift left to first non-blank *
     C*                                                              *
     C****************************************************************
     C           ZSHFTL    BEGSR                           Shift lft su
     C                     DO   50                         Do 50 times
     C                     MOVELZSHFLD    ZSHFL1  1        Move left
     C           ZSHFL1    CABGT' '       ZSHFLE           Branch
     C                     MOVE ZSHFLD    ZSHFLX 49        Drop one
     C                     MOVELZSHFLX    ZSHFLD 50 P      Move back
     C                     ENDDO                           Do 50 times
     C           ZSHFLE    ENDSR                           ZSHFTL subr
     C****************************************************************

                      Shift right interface and subroutine
                      ------------------------------------

     C                     MOVE xxx       ZSHFLD    P      Fld to shift
     C                     EXSR ZSHFTR                     Shift right
     C                     MOVE ZSHFLD    xxx              Move out
     C****************************************************************
     C*                                                              *
     C*     ZSHFTR Subroutine - Does a shift right to 1st non-blank  *
     C*                                                              *
     C****************************************************************
     C           ZSHFTR    BEGSR                           Shift lft su
     C                     DO   50                         Do 50 times
     C                     MOVE ZSHFLD    ZSHFR1  1        Move right
     C           ZSHFR1    CABGT' '       ZSHFRE           Branch
     C                     MOVELZSHFLD    ZSHFRX 49        Drop one
     C                     MOVE ZSHFRX    ZSHFLD 50 P      Move back
     C                     ENDDO                           Do 50 times
     C           ZSHFRE    ENDSR                           ZSHFTL subr
     C****************************************************************

RPG IV Code
-----------

RPG  IV users should  consider the direct  use of the  %TRIM and %TRIML
functions.

                      Shift left interface and subroutine
                      -----------------------------------


     C                   EVAL      ZSHFLD = xxx
     C                   EXSR      ZSHFTL
     C                   EVAL      xxx    = ZSHFLD
     C****************************************************************
     C*                                                              *
     C*     ZSHFTL Subroutine - Does a shift left to first non-blank *
     C*         Use EVAL for input and output of ZSHFLD              *
     C*                                                              *
     C****************************************************************
     C     ZSHFTL        BEGSR
     C                   MOVEL     ' '           ZSHFLDL          50
     C     *LIKE         DEFINE    ZSHFLDL       ZSHFLD
     C                   EVAL      ZSHFLD = %TRIML(ZSHFLD)
     C                   ENDSR
     C****************************************************************

                      Shift right interface and subroutine
                      ------------------------------------

     C                   EVAL      ZSHFLD = xxx
     C                   EXSR      ZSHFTR
     C                   EVAL      xxx    = ZSHFLD
     C****************************************************************
     C*                                                              *
     C*     ZSHFTR Subroutine - Does a shift right to 1st non-blank  *
     C*         Use EVAL for input and output of ZSHFLD              *
     C*                                                              *
     C****************************************************************
     C     ZSHFTR        BEGSR
     C                   MOVEL     ' '           ZSHFLDR          50
     C     *LIKE         DEFINE    ZSHFLDR       ZSHFLD
     C                   EVAL      ZSHFLD = %TRIM(ZSHFLD)
     C                   ENDSR
     C************************************************************

Restrictions
------------

A maximum of a 50 byte field is supported.

Prerequisites
-------------

None.

Implementation
--------------

You must copy the source into your program.

Objects used by the tool
------------------------

None.  The tool documentation contains the source.
					

Added to TAA Productivity tools August 1, 1998


Home Page Up to Top