H/TITLE Return negated input value
     H            Y
     Z* CRTRPGPGM
     Z* OPTION(*NOXREF) GENOPT(*OPTIMIZE)
     W* Warning: Needs V2R2M0+ for CHEKR opcode.
      *
     W* Warning: This program does not set on the LR indicator
      *
     E                    P5         80  1
      *
      * 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
     I                                       12  12 P301
     I                                       13  91 P30280
      * B :  Code qualifier data     80
     I                                       92 171 P4CDQD
      * B :  Code in local form      80
     I                                      172 251 P5CDLC
     I                                      172 251 P5
      *
      /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
      *****************************************************************
      *
      * CASE: PAR.Code trans directions is Inward translation
     C           P1CDTT    IFEQ 'I'
      *
      * For incoming translation, this is intended to be attached to
      * a numeric element type (N0-N9, R). It will turn positive values
      * to negative and vice-versa. If attached to a non-numeric data
      * element, bizzare results will occur.
      *
      *   std data                local data
      *   1234             ===>   -1234
      *   +1234            ===>   -1234
      *   -1234            ===>   1234
      *
     C                     MOVE *BLANK    P5CDLC
      *
     C           P3CDST    IFNE *BLANKS
      *
     C           P301      IFEQ '-'
      * Explicit "-": make implicit positive:
     C                     MOVELP30280    P5CDLC
     C                     ELSE
     C           P301      IFEQ '+'
      * Explicit "+": make explicit negative:
     C           '-'       CAT  P30280    P5CDLC
     C                     ELSE
      * Implicit "+": make explicit negative:
     C           '-'       CAT  P3CDST    P5CDLC
     C                     END                             P301 = '+'
     C                     END                             P301 = '-'
      *
     C                     END                             P3CDST <> ' '
      *
     C                     ELSE
      * CASE: PAR.Code trans directions is Outward translation
     C           P1CDTT    IFEQ 'O'
      *
      * For outgoing translation, this is intended to be attached to a
      * numeric (P or S) field.  The translator converts any numeric
      * to a zoned equivalent string left-justified before calling this
      * function.  The sign is in zoned format, i.e., the rightmost
      * non-blank character is X'F0'-X'F9' for positive, X'D0'-X'D9' for
      * negative.  This function simply flips "bit 2" of the rightmost
      * non-blank character.  As before, bizzare results will occur if
      * used on non-numeric fields.
      *
      * Example: (only rightmost character shown)
      *                   bit positions:        01234567
      *                         '5' = HEX F5 = '11110101'
      *                        '-5' = HEX D5 = '11010101'
      *
     C                     MOVE *BLANK    P3CDST
      *
     C           P5CDLC    IFNE *BLANKS
      * Find last non-blank character:
     C           ' '       CHEKRP5CDLC    N       30       n=non' '
      * If found, flip sign bit:
     C           N         IFGT 0
     C                     MOVELP5,N      CHAR    1        get char #N
     C                     TESTB'2'       CHAR           01 on = positive
     C  N01                BITON'2'       CHAR             Make positive
     C   01                BITOF'2'       CHAR             Make negative
     C                     MOVELCHAR      P5,N             put char #N
      *
     C                     MOVELP5CDLC    P3CDST
      *
     C                     END                             N IFGT 0
      *
      *
     C                     END                             P5CDLC <> ' '
      *
     C                     END                             P1CDTT = 'O'
      *
     C                     END                             P1CDTT = 'I'
      *
      * A "Return code" of non-blank will be logged as a translation error:
     C                     MOVEL*BLANK    P0RTN            *Return code
      * Exit program
     C                     RETRN