|
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.