Sivasubrahmanian,

This program to Right Justify and Zero Fill handles everything except decimal 
places.

In the calling program:

--------------------------------------------------
WORKING-STORAGE SECTION.
77  WS-ALPHA   PIC X(4) VALUE '07  '.
77  WS-LENGTH  PIC 99 VALUE 4.
77  WS-NUMERIC PIC S9(4).
PROCEDURE DIVISION.
CALL 'RJZF' USING WS-ALPHA WS-LENGTH WS-NUMERIC.
--------------------------------------------------

The sub-program follows:
--------------------------------------------------
       ID DIVISION.
       PROGRAM-ID.  RJZF.
      * Right Justify and Zero Fill
      * peter_lunde@hotmail.com
      * 2002/11/01
       DATA DIVISION.
       WORKING-STORAGE SECTION.
       01  WS-SUB-FROM PIC 99.
       01  WS-SUB-TO   PIC 99.
       01  WS-SIGN     PIC S9.
       LINKAGE SECTION.
       01  LS-ALPHA.
           05  LS-BYTE PIC X OCCURS 18.
       01  LS-LENGTH   PIC 99.
       01  LS-NUMBER.
           05  LS-DIGIT PIC S9 OCCURS 18.
       PROCEDURE DIVISION USING LS-ALPHA
                                LS-LENGTH
                                LS-NUMBER.

       0-MAIN.

           MOVE ZEROS TO LS-NUMBER(1:LS-LENGTH)

           MOVE +1 TO WS-SIGN.

           MOVE LS-LENGTH TO WS-SUB-TO.

           PERFORM 1-RJZF-DIGITS
             VARYING WS-SUB-FROM FROM LS-LENGTH BY -1
               UNTIL WS-SUB-FROM < 1.

           IF WS-SIGN = -1
             IF LS-NUMBER(1:LS-LENGTH) > ZERO
               IF LS-NUMBER(LS-LENGTH:1) = ZERO
                 MOVE "}" TO LS-NUMBER(LS-LENGTH:1)
               ELSE
                 COMPUTE LS-DIGIT(LS-LENGTH)
                       = 0 - LS-DIGIT(LS-LENGTH)
               END-IF
            END-IF
           END-IF.

           GOBACK.

       1-RJZF-DIGITS.

           IF LS-BYTE(WS-SUB-FROM) = "-"
               MOVE -1 TO WS-SIGN
           ELSE
               IF LS-BYTE(WS-SUB-FROM) >= "0"
               AND LS-BYTE(WS-SUB-FROM) <= "9"
                   MOVE LS-BYTE(WS-SUB-FROM)
                     TO LS-DIGIT(WS-SUB-TO)
                   SUBTRACT 1 FROM WS-SUB-TO
               END-IF
           END-IF.
--------------------------------------------------
Peter.

>
> From: "Sivasubrahmanian Ananthakrishnan" 
><sivasubrahmanian.ananthakrishnan@wipro.com>
> Date: 2002/10/31 Thu PM 01:47:41 EST
> To: <cobol400-l@midrange.com>
> Subject: Remove trailing blanks
>
<snip>
>
> I have variable of character data type of length 4. It has a value of
> '07bb' where b denoted blanks. I want to remove the trailing blanks.
>
> Thanks & Regards
> Sivasubrahmanian. A
> Project Engineer
> Wipro Technologies (Finance & Insurance)
> Electronics City, Bangalore, India
> Phone - 8520408/8520416 x - 4364.
>




As an Amazon Associate we earn from qualifying purchases.

This thread ...


Follow On AppleNews
Return to Archive home page | Return to MIDRANGE.COM home page

This mailing list archive is Copyright 1997-2022 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].

Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.