|
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 mailing list archive is Copyright 1997-2025 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.