There comes a time when the trailing blanks of a string need to be counted. This COBOL sub program tells you the length of a string based on a 500 character input buffer.
The source code is below.
[codesyntax lang=”cobol”]
000100 IDENTIFICATION DIVISION. 00010000 000200 PROGRAM-ID. ABS00004 00020000 000300 AUTHOR. ARCH BROOKS. 00030000 000400 INSTALLATION BROOKS COMPUTING SYSTEMS, LLC. 00040000 000500 DATE-WRITTEN. 09/18/2014. 00050000 000600 DATE-COMPILED. 09/18/2014. 00060000 000700 ENVIRONMENT DIVISION. 00070000 000800 CONFIGURATION SECTION. 00080000 000900 SOURCE-COMPUTER. IBM-Z-OS. 00090000 001000 OBJECT-COMPUTER. IBM-Z-OS. 00100000 001100 DATA DIVISION. 00110000 001200 WORKING-STORAGE SECTION. 00120000 001210 LINKAGE SECTION. 00121000 001211 01 FSBUF PIC X(500). 00121100 001212 01 FSBUF-RED REDEFINES FSBUF. 00121200 001213 05 BS PIC X OCCURS 500 TIMES. 00121300 001214 01 BC PIC 9(5) COMP. 00121400 001215 PROCEDURE DIVISION USING FSBUF BC. 00121500 001250 PERFORM 0010-FIND-NS VARYING BC FROM 500 BY -1 00125000 001260 UNTIL BS (BC) NOT EQUAL SPACES. 00126000 001320 GOBACK. 00132000 001330 0010-FIND-NS. 00133000
[/codesyntax]
There are two parameters passed to the sub routine and they are the 500 character buffer FSBUF and a full word binary counter BC. The routine begins at the end of the string and counts backwards until a non blank character is detected. The actual string length is in the variable BC. You can subsequently pass that to an ISPF command routine or for any other purpose you have for determining the length of a string (minus characters padded to the right).
Below is the compiled computer listing for this routine.
[codesyntax lang=”cobol”]
1PP 5655-S71 IBM Enterprise COBOL for z/OS 4.1.0 Date 09/18/2014 Time 15:26:05 Page 1
0Invocation parameters:
VBREF
0Options in effect:
NOADATA
ADV
QUOTE
ARITH(COMPAT)
NOAWO
BUFSIZE(4096)
NOCICS
CODEPAGE(1140)
NOCOMPILE(S)
NOCURRENCY
DATA(31)
NODATEPROC
DBCS
NODECK
NODIAGTRUNC
NODLL
NODUMP
NODYNAM
NOEXIT
NOEXPORTALL
NOFASTSRT
FLAG(I,I)
NOFLAGSTD
INTDATE(ANSI)
LANGUAGE(EN)
NOLIB
LINECOUNT(60)
NOLIST
NOMAP
NOMDECK
NONAME
NSYMBOL(NATIONAL)
NONUMBER
NUMPROC(NOPFD)
OBJECT
NOOFFSET
NOOPTIMIZE
OUTDD(SYSOUT)
PGMNAME(COMPAT)
RENT
RMODE(AUTO)
SEQUENCE
SIZE(MAX)
SOURCE
SPACE(1)
NOSQL
SQLCCSID
NOSSRANGE
NOTERM
NOTEST
NOTHREAD
TRUNC(STD)
VBREF
NOWORD
1PP 5655-S71 IBM Enterprise COBOL for z/OS 4.1.0 Date 09/18/2014 Time 15:26:05 Page 2
0 XMLPARSE(XMLSS)
XREF(FULL)
YEARWINDOW(1900)
ZWB
1PP 5655-S71 IBM Enterprise COBOL for z/OS 4.1.0 ABS00004 Date 09/18/2014 Time 15:26:05 Page 3
LineID PL SL ----+-*A-1-B--+----2----+----3----+----4----+----5----+----6----+----7-|--+----8 Map and Cross Reference
0 000001 000100 IDENTIFICATION DIVISION. 00010000
000002 000200 PROGRAM-ID. ABS00004 00020000
000003 000300 AUTHOR. ARCH BROOKS. 00030000
000004 000400 INSTALLATION BROOKS COMPUTING SYSTEMS, LLC. 00040000
000005 000500 DATE-WRITTEN. 09/18/2014. 00050000
000006 000600 DATE-COMPILED. 09/18/14. 00060000
000007 000700 ENVIRONMENT DIVISION. 00070000
000008 000800 CONFIGURATION SECTION. 00080000
000009 000900 SOURCE-COMPUTER. IBM-Z-OS. 00090000
000010 001000 OBJECT-COMPUTER. IBM-Z-OS. 00100000
000011 001100 DATA DIVISION. 00110000
000012 001200 WORKING-STORAGE SECTION. 00120000
000013 001202 77 RBUF PIC X(80). 00120200
000014 001207 01 OUTBUF. 00120700
000015 001208 05 RSIZ PIC 9(5). 00120800
000016 001209 05 FILLER PIC X(75). 00120900
000017 001210 LINKAGE SECTION. 00121000
000018 001211 01 FSBUF PIC X(500). 00121100
000019 001212 01 FSBUF-RED REDEFINES FSBUF. 00121200 18
000020 001213 05 BS PIC X OCCURS 500 TIMES. 00121300
000021 001214 01 BC PIC 9(5) COMP. 00121400
000022 001215 PROCEDURE DIVISION USING FSBUF BC. 00121500 18 21
000023 001250 PERFORM 0010-FIND-NS VARYING BC FROM 500 BY -1 00125000 26 21
000024 001260 UNTIL BS (BC) NOT EQUAL SPACES. 00126000 20 21 IMP
000025 001320 GOBACK. 00132000
000026 001330 0010-FIND-NS. 00133000
1PP 5655-S71 IBM Enterprise COBOL for z/OS 4.1.0 ABS00004 Date 09/18/2014 Time 15:26:05 Page 4
0 Count Cross-reference of verbs References
1 GOBACK . . . . . . . . . . . . 25
1 PERFORM. . . . . . . . . . . . 23
1PP 5655-S71 IBM Enterprise COBOL for z/OS 4.1.0 ABS00004 Date 09/18/2014 Time 15:26:05 Page 5
0An "M" preceding a data-name reference indicates that the data-name is modified by this reference.
Defined Cross-reference of data names References
21 BC . . . . . . . . . . . . . . 22 M23 24
20 BS . . . . . . . . . . . . . . 24
18 FSBUF. . . . . . . . . . . . . 19 22
19 FSBUF-RED
14 OUTBUF
13 RBUF
15 RSIZ
1PP 5655-S71 IBM Enterprise COBOL for z/OS 4.1.0 ABS00004 Date 09/18/2014 Time 15:26:05 Page 6
0Context usage is indicated by the letter preceding a procedure-name reference.
These letters and their meanings are:
A = ALTER (procedure-name)
D = GO TO (procedure-name) DEPENDING ON
E = End of range of (PERFORM) through (procedure-name)
G = GO TO (procedure-name)
P = PERFORM (procedure-name)
T = (ALTER) TO PROCEED TO (procedure-name)
U = USE FOR DEBUGGING (procedure-name)
Defined Cross-reference of procedures References
26 0010-FIND-NS . . . . . . . . . P23
1PP 5655-S71 IBM Enterprise COBOL for z/OS 4.1.0 ABS00004 Date 09/18/2014 Time 15:26:05 Page 7
0 Defined Cross-reference of programs References
2 ABS00004
-* Statistics for COBOL program ABS00004:
* Source records = 26
* Data Division statements = 7
* Procedure Division statements = 2
0End of compilation 1, program ABS00004, no statements flagged.
0Return code 0
[/codesyntax]
Please feel free to comment about this program in the comments section.
Mr. Arch Brooks, Software Engineer, Brooks Computing Systems, LLC authored this article.