Dynamic number of host-variables in embedded SQL - cobol

I have this code in MicroFocus COBOL:
move 'select * from TABLE where a = ? and b = ? and c = ? to w-sql
exec sql
open cur_read_2 using :w-a,
:w-b,
:w-c
end-exec
But this select can be variable, so I can have here for example only
... where a = ? ...
or
... where a = ? and c = ? ...
So, can I somehow setup exec-sql part dynamically, to have proper number of host-variables here? In actual case I have 7 WHERE variables and full list of combinations is possible.

analyze this example. Maybe help you.
WORKING STORAGE SECTION.
*VARIABLE COMMAND
01 DSTRING.
02 STR-LEN PIC S9(04) COMP VALUE +200
02 STR-TEXT PIC X(200).
01 W-ABC.
03 W-A-FROM PIC 99 VALUE 0.
03 W-A-TO PIC 99 VALUE 99.
03 W-B-FROM PIC XX VALUE LOW-VALUES.
03 W-B-TO PIC XX VALUE HIGH-VALUES.
03 W-C-FROM PIC 99 VALUE 0.
03 W-C-TO PIC 99 VALUE 99.
*DECLARE CURSOR
EXEC SQL
DECLARE CURSOR1 CURSOR
FOR STMT1
END-EXEC.
PROCEDURE DIVISION.
MOVE 'TABLE' TO TS-TABLA.
* YOU MUST MOVE THE VALUE THAT CORRESPONDS TO THE VARIABLE TO USE.
* THE VARIABLE THAT IS NOT USED IS LEFT WITH THE DEFAULT VALUE
*
MOVE W-INPUT-A TO W-A-FROM.
MOVE W-INPUT-A TO W-A-TO.
* THE W-B VARIABLE IS NOT USED. LEFT WITH THE DEFAULT VALUE.
MOVE W-INPUT-C TO W-C-FROM.
MOVE W-INPUT-C TO W-C-TO.
*OPEN CURSOR
MOVE SPACES TO STR-TEXT
STRING ‘SELECT * FROM’
‘ ‘ DELIMITED BY SIZE
TS-TABLA DELIMITED BY SPACE
‘ ‘ DELIMITED BY SIZE
‘WHERE’ DELIMITED BY SIZE
‘ ‘ DELIMITED BY SIZE
‘A’ DELIMITED BY SIZE
‘ ‘ DELIMITED BY SIZE
‘BETWEEN ?’ DELIMITED BY SIZE
‘ ‘ DELIMITED BY SIZE
‘AND ?’ DELIMITED BY SIZE
‘ ‘ DELIMITED BY SIZE
‘AND’ DELIMITED BY SIZE
‘ ‘ DELIMITED BY SIZE
‘B’ DELIMITED BY SIZE
‘ ‘ DELIMITED BY SIZE
‘BETWEEN ?’ DELIMITED BY SIZE
‘ ‘ DELIMITED BY SIZE
‘AND ?’ DELIMITED BY SIZE
‘AND’ DELIMITED BY SIZE
‘ ‘ DELIMITED BY SIZE
‘C’ DELIMITED BY SIZE
‘ ‘ DELIMITED BY SIZE
‘BETWEEN ?’ DELIMITED BY SIZE
‘ ‘ DELIMITED BY SIZE
‘AND ?’ DELIMITED BY SIZE
‘ ‘ DELIMITED BY SIZE
‘ORDER BY’ DELIMITED BY SIZE
‘ ‘ DELIMITED BY SIZE
‘CODIGO’ DELIMITED BY SIZE
INTO STR-TEXT.
*OPEN CURSOR (cont)
EXEC SQL
PREPARE STMT1 FROM :DSTING
END-EXEC.
EXEC SQL
OPEN CURSOR1 USING :WS-CODIGO-SQL
END-EXEC.

Related

How do I remove spaces when creating a CSV document

I have program that creates a CSV document. One field from a database table, Z-ZYSR-MONTAN(IZYSR), has the format NOT NULL NUMBER(11,2).
My code is :
05 H-ZYSR-MONTAN PIC S9(11)V9(2) COMP-3.
* Taux horaire formation
05 W-Z18 PIC -(12),99.
05 FILLER PIC X(001) VALUE ';'.
ALIM-WZ18 SECTION.
MOVE Z-ZYSR-NOMBRE TO IZYSR.
MOVE ZERO TO H-ZYSR-MONTAN.
IF Z-ZYSR-NOMBRE > ZERO
PERFORM VARYING IZYSR FROM Z-ZYSR-NOMBRE BY -1 UNTIL
IZYSR = ZERO
IF Z-ZYSR-CODRUB(IZYSR) = 'THF'
MOVE Z-ZYSR-MONTAN(IZYSR) TO
H-ZYSR-MONTAN
MOVE ZERO TO IZYSR
END-IF
END-PERFORM
IF H-ZYSR-MONTAN < 0
MOVE 0 TO W-Z18
END-IF
IF H-ZYSR-MONTAN >= 0
MOVE H-ZYSR-MONTAN TO W-Z18
END-IF
END-IF.
Results:
2223,55
-10,98
-1,08
82,61
But the problem I have in my CSV document is that there are spaces before the number. As may be seen in the picture in this forum :
https://www.developpez.net/forums/d1940330/autres-langages/autres-langages/cobol/numerique-condense-cobol/#post10895608
So my question how can I obtain the correct results without spaces before the number?
You could try to make a loop (PERFORM UNTIL), for every character, and if it is SPACE, then change it by 0.
You can use the TRIM() function to remove white space if you're using GnuCOBOL(OpenCOBOL) on Linux.
WORKING-STORAGE SECTION.
01.
05 H-ZYSR-MONTAN PIC S9(11)V9(2) COMP-3.
05 W-Z18 PIC -(12).99.
05 H-Z18-C REDEFINES W-Z18 PIC X(15).
05 H-ZYSR-DISPLAY PIC X(15).
PROCEDURE DIVISION.
0000-MAIN.
MOVE 1234.56 TO H-ZYSR-MONTAN.
move H-ZYSR-MONTAN to W-Z18.
MOVE FUNCTION TRIM(H-Z18-C) TO H-ZYSR-DISPLAY.
DISPLAY H-ZYSR-DISPLAY.
STOP RUN.
I did have to change the , to . to match my locale so remember to change it back.
And if you don't have access to that function there is a simple work around.
WORKING-STORAGE SECTION.
01.
05 H-ZYSR-MONTAN PIC S9(11)V9(2) COMP-3.
05 W-Z18 PIC -(12).99.
05 VAR-Z18 PIC X(15).
05 ws-counter pic 9(3) COMP-3 value 0.
01 VARIABLES.
05 VAR1 PIC X(10).
05 VAR2 PIC X(10).
05 VAR3 PIC X(10).
05 VAR4 PIC X(10).
05 VAR5 PIC X(10).
05 VAR6 PIC X(10).
05 VAR7 PIC X(10).
05 VAR8 PIC X(10).
01 WS-DELIMITED-TEXT PIC X(200).
PROCEDURE DIVISION.
0000-MAIN.
INITIALIZE VARIABLES
MOVE 'CEX18' TO VAR6
MOVE -1234.56 TO H-ZYSR-MONTAN
MOVE H-ZYSR-MONTAN TO W-Z18
INSPECT W-Z18 TALLYING WS-COUNTER FOR LEADING SPACES
IF WS-COUNTER > 0
COMPUTE WS-COUNTER = WS-COUNTER + 1
MOVE W-Z18(ws-counter:) TO VAR-Z18
ELSE
MOVE W-Z18 TO VAR-Z18
END-IF
String VAR1 delimited by SPACE
";" delimited by size
VAR2 delimited by SPACE
";" delimited by size
VAR3 delimited by SPACE
";" delimited by size
VAR4 delimited by SPACE
";" delimited by size
VAR5 delimited by SPACE
";" delimited by size
VAR6 delimited by SPACE
";" delimited by size
VAR-Z18 delimited by SPACE
";" delimited by size
VAR7 delimited by SPACE
";" delimited by size
VAR8 delimited by SPACE
";" delimited by size
into WS-DELIMITED-TEXT
DISPLAY WS-DELIMITED-TEXT.
GOBACK.
Using STRING to assemble the final text field was already suggested by the other forum I only include it here to round out the example.
Based on our conversation and other information, I changed the code a little bit. I removed all references to CSV, since that seems to occur outside the COBOL program. I replaced the STRING statement. The data-name for the group containing W-Z18 and the ; was not given in other references, so here I named it, W-Z18-FIELD. I placed the result in W-Z18-TEXT.
environment division.
configuration section.
special-names.
decimal-point is comma.
data division.
working-storage section.
1 w-z18-text pic x(16) value space.
1 w-z18-pointer comp pic 9(4) value 1.
1 w-z18-field.
* Taux horaire formation
3 w-z18 pic -(12),99.
3 pic x value ";".
1 leading-spaces comp pic 9(4) value 0.
1 move-length comp pic 9(4) value 0.
procedure division.
begin.
move -10,98 to w-z18
move 0 to leading-spaces
inspect w-z18 tallying
leading-spaces for leading space
compute move-length =
function length (w-z18 (leading-spaces + 1:))
move space to w-z18-text
move 1 to w-z18-pointer
move w-z18 (leading-spaces + 1:)
to w-z18-text (w-z18-pointer:move-length)
compute w-z18-pointer = w-z18-pointer + move-length
move ";" to w-z18-text (w-z18-pointer:1)
add 1 to w-z18-pointer
display quote w-z18-field quote
display quote w-z18-text quote
stop run
.
Result: (the quotes were added to show the change)
" -10,98;" - what it looked like before, w-z18-field
"-10,98; " - with the changes, w-z18-text
This only moves the spaces from before the number to after the semi-colon. Whether this will be enough depends on whether the next program removes trailing spaces.

Find out the length of a String [duplicate]

This question already has answers here:
compute length string of variable with cobol
(4 answers)
Closed 6 years ago.
Suppose I have a variable PIC X(20).
The variable contains some value e.g. ABC WXYZ.
How to find out the length of the string excluding the space in between?
If you're really sure that you don't want the space in between you can define test-val and use this in PERFORM:
77 some-len PIC 9(02). *> make sure to use appropriate length, if "big" use COMP-5
77 string-ptr PIC 9(02). *> make sure to use appropriate length
77 some-var PIC X(20) VALUE ' ABC WXYZ'.
77 var-len PIC 9(02) VALUE LENGTH OF some-var.
01 test-char PIC X.
88 no-spaces values 'A' THROUGH 'Z'
'a' THROUGH 'z'
'0' THROUGH '9'
'-', '.'.
PROCEDURE DIVISION.
MOVE 0 TO some-len
PERFORM VARYING string-ptr FROM 1 BY 1
UNTIL string-ptr > var-len
MOVE some-var (string-ptr) TO test-char
IF no-spaces ADD 1 TO some-len END-IF
END-PERFORM
As Bill pointed out if you ONLY want to know the "not spaces" characters there's a faster option that needs less vars (make sure you comment this letting you and others know what this does:
*> set numbers of all non-spaces in some-len
MOVE 0 TO some-len
INSPECT some-var TALLYING some-len FOR ALL SPACES
*> add more counts here if you want to remove more chars like x'0D'/x'0A'/x'00', ...
*> INSPECT some-var TALLYING some-len FOR ALL x'00'
*> INSPECT some-var TALLYING some-len FOR ALL x'0D'
*> INSPECT some-var TALLYING some-len FOR ALL x'0A'
*> and finally subtract it from the fields length
SUBTRACT some-len FROM LENGTH OF some-var GIVING some-len
*>

Formatting a name from first, middle-initial and last

Record has name in this format:
01 LAST-NAME PIC X(18).
01 FIRST-NAME PIC X(12).
01 MI-NAME PIC X(01).
The last and first names can of course be any size when they come in.
I need to put the name fields together (with no trailing spaces - but with a SPACE between each name) into a single working storage field 42 spaces in length:
01 WS-FULL-NAME PIC X(42)
Example:
LAST-NAME = Smithington
FIRST-NAME = Edward
MI-NAME = H
Desired result:
Edward H Smithington
If Middle initial is blank I of course don't include it and desired result would be:
Edward Smithington
I have a routine to determine the actual length of each name field already that takes care of the trailing spaces (*I don't need to worry about leading spaces) (SEE BELOW):
01 W-SUB PIC 9(02) VALUE 0.
PROCESS-LAST-NAME.
PERFORM VARYING W-SUB FROM LENGTH OF LAST-NAME BY -1
UNTIL W-SUB LESS THAN 1
OR LAST-NAME(W-SUB:1) NOT = ' '
END-PERFORM
IF W-SUB > ZERO
MOVE LAST-NAME(1:W-SUB) TO ?????
'MOVE LAST-NAME(1:W-SUB) TO ?????' is where I am 'stuck'.
i.e. How to 'STRING' the three name fields together to produce DESIRED RESULT = Edward H Smithington (* Including a space between F, MI + L).
You were asked to do it with STRING. The argument against using STRING for names is that names can have embedded spaces. DE LA HAYE for instance as a last-name, 'ST JOHN' (pronounced sinjun) as a first-name. There can also be typos giving leading blanks and embedded blanks. You seem to know that you have no leading blanks, but genuine or false embedded blanks make the simple use of STRING more tricky.
If you can guarantee no leading or embedded blanks (absolutely guarantee) then
IF MI-NAME EQUAL TO SPACE
STRING FIRST-NAME
DELIMITED BY SPACE
' '
DELIMITED BY SIZE
LAST-NAME
DELIMITED BY SPACE
INTO FULL-NAME
ELSE
STRING FIRST-NAME
DELIMITED BY SPACE
' '
DELIMITED BY SIZE
MI-NAME
DELIMITED BY SIZE
' '
DELIMITED BY SIZE
LAST-NAME
DELIMITED BY SPACE
INTO FULL-NAME
END-IF
Before the IF you need to MOVE SPACE to FULL-NAME, else you'll end up with part of the previous name when the current name is shorter than the previous.
If you can't guarantee the lack of leading and embedded blanks, you have to use reference-modified fields for the first-name and last-name (one length each) and use DELIMITED BY SIZE for those. Then what's the point?
01 W-FULL-NAME.
05 W-FIRST-NAME.
10 FILLER OCCURS 0 TO 12 TIMES
DEPENDING ON length-of-first-name.
15 FILLER PIC X.
05 SPACE-AFTER-FIRST-NAME PIC X.
05 W-MI-NAME.
10 FILLER OCCURS 0 TO 2 TIMES
DEPENDING ON length-for-mi.
15 FILLER PIC X.
05 W-LAST-NAME.
10 FILLER OCCURS 0 TO 18 TIMES
DEPENDING ON length-of-last-name.
15 FILLER PIC X.
You have your two PERFORMs to get the length of the first-name and last-name (as already). You MOVE ZERO to length-for-mi if WS-MI-NAME is space, else make it two.
Then:
MOVE SPACE TO SPACE-AFTER-FIRST-NAME
MOVE FIRST-NAME TO W-FIRST-NAME
MOVE LAST-NAME TO W-LAST-NAME
MOVE MI-NAME TO W-MI-NAME
The W-FULL-NAME, a variable-length field, contains the data you want in the format you want, and then you do what you like with it.
By shifting the "complexity" into the DATA DIVISION with the definition of the data, the code in the PROCEDURE DIVISION becomes very simple.
Try it out, and to see the formatted data, do this:
DISPLAY
">"
W-FULL-NAME
"<"
The > and < are just to show you exactly what the data is (I always do that when DISPLAYing data). You'll see the length of the field changing with different test-data (assuming to test with different length data...).
Test with all the input as space, you'd see this on your SYSOUT spool dataset:
><
A zero-length field.
With reference-modification you'd do it something like this:
do your PERFORM to count the first-name trailing spaces
MOVE FIRST-NAME TO WS-FULL-NAME
ADD 1 WS-SUB
GIVING next-available-output
IF MI-NAME NOT EQUAL TO SPACE
MOVE MI-NAME TO WS-FULL-NAME
( next-available-output : 1 )
ADD 2 TO next-available-output
END-IF
do your PERFORM for the last-name
MOVE LAST-NAME TO WS-FULL-NAME
( next-available-output : W-SUB )
The first MOVE to the output will copy the first name to the full-name. Neither needs to be reference-modified, the effect will be that other than the characters of the name the rest of the target field will be blank.
The number of characters present are known, so the next available position for data in the target field can be calculated by adding one.
The second MOVE is made conditional on whether there is any middle-initial data, and if so it is MOVEd to the next available output position calculated above. The number of bytes (one) MOVEd are limited in the target.
The third MOVE is like the second MOVE, except unconditional and the limit for the bytes MOVEd is variable.
Variations of the above are possible. There's a much neater way, but depends somewhat on your compiler. So which one are you using?
You calculation of the number of trailing blanks can be simplified:
01 W-SUB COMP PIC 9(4).
PROCESS-LAST-NAME.
MOVE ZERO TO W-SUB
IF LAST-NAME NOT EQUAL TO SPACE
MOVE FUNCTION LENGTH ( LAST-NAME )
TO W-SUB
PERFORM
UNTIL LAST-NAME ( W-SUB : 1 )
NOT EQUAL TO SPACE
SUBTRACT 1 FROM W-SUB
END-PERFORM
END-IF
That way, you don't have to have the double termination-conditions. I'd REDEFINES the field, and use subscripting not reference-modification. I'd also rename W-SUB to indicate that it contains the length of the data.

Concatenate string by its length COBOL

Need to concatenate 4 strings to a destination variable in cobol.
Like,
01 WS-S1 X(10) VALUE "HI ".
01 WS-S2 X(10) VALUE "HOW ".
01 WS-S3 X(10) VALUE "ARE ".
01 WS-S4 X(10) VALUE "YOU?".
to a resultant string
"HI HOW ARE YOU?"
Can anyone please help me out?
Here is a working example of the STRING verb that does what you are looking for:
IDENTIFICATION DIVISION.
PROGRAM-ID. EXAMPLE.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 WS-S1 PIC X(10) VALUE 'HI '.
01 WS-S2 PIC X(10) VALUE 'HOW '.
01 WS-S3 PIC X(10) VALUE 'ARE '.
01 WS-S4 PIC X(10) VALUE 'YOU?'.
01 WS-CONCAT PIC X(43) VALUE SPACES.
PROCEDURE DIVISION.
MAIN-PARAGRAPH.
STRING WS-S1 DELIMITED BY SPACE
' ' DELIMITED BY SIZE
WS-S2 DELIMITED BY SPACE
' ' DELIMITED BY SIZE
WS-S3 DELIMITED BY SPACE
' ' DELIMITED BY SIZE
WS-S4 DELIMITED BY SPACE
INTO WS-CONCAT
END-STRING
DISPLAY '>' WS-CONCAT '<'
GOBACK
.
Output is:
>HI HOW ARE YOU? <
OpenCOBOL has an intrinsic FUNCTION extension, CONCATENATE.
DISPLAY FUNCTION CONCATENATE(
FUNCTION TRIM(WS-S1); SPACE;
FUNCTION TRIM(WS-S2); SPACE;
FUNCTION TRIM(WS-S3); SPACE;
FUNCTION TRIM(WS-S4))
END-DISPLAY
but I like the STRING verb DELIMITED BY answer, as it'll work with most, if not all, compilers.
As to the reason for semi-colon delimiters inside FUNCTION parameter lists, it isn't strictly necessary, personal preference, as it sometimes avoids potential problems with
SPECIAL-NAMES.
DECIMAL POINT IS COMMA.
and COBOL, being the robust lexical animal that it is
DISPLAY FUNCTION CONCATENATE(WS-S1 WS-S2 WS-S3 WS-S4)
DISPLAY FUNCTION CONCATENATE(WS-S1, WS-S2, WS-S3, WS-S4)
syntax works as well.
There is a problem with 'delimited by space'. If ws-s1 = 'how are' - delimited by space will put only 'how'.
Here are some examples:
01 ws-string-test.
03 y1 pic x(10) value 'y1 a'.
03 y2 pic x(10) value 'y2 b'.
03 y3 pic x(10) value 'y3 c'.
01 ws-work pic x(200).
move spaces to ws-work
string y1 delimited by size
y2 delimited by space
y3 delimited by size
into ws-work.
ws-work = "y1 a y2y3 c "
move spaces to ws-work
string y1
y2
y3
delimited by size into ws-work
ws-work = "y1 a y2 b y3 c "
string y1
y2
y3
delimited by spaces into ws-work.
ws-work = "y1y2y3
string y1 y2 y3 into ws-work by csv-format.
ws-work = "y1 a,y2 b,y3 c "
Hope it will help.
zalek
Give this a whirl. Should be platform independent.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 result-string-text X(100).
01 result-string-length 9(03).
01 result-string-datalength 9(03).
01 new-string-text X(20).
01 new-string-length 9(03).
01 new-string-datalength 9(03).
01 hold-string-text X(100).
01 trailing-space-count 9(03).
PROCEDURE DIVISION.
MOVE SPACES TO result-string-text.
MOVE FUNCTION LENGTH(result-string-text) TO result-string-length.
MOVE FUNCTION LENGTH(new-string-text) TO new-string-length.
MOVE ws-s1 TO new-string-text.
PERFORM 5500-concatenate.
MOVE ws-s2 TO new-string-text.
PERFORM 5500-concatenate.
MOVE ws-s3 TO new-string-text.
PERFORM 5500-concatenate.
MOVE ws-s4 TO new-string-text.
PERFORM 5500-concatenate.
5500-concatenate.
MOVE ZERO TO trailing-space-count
INSPECT FUNCTION REVERSE(result-string-text) TALLYING trailing-space-count FOR LEADING ' '
COMPUTE result-string-datalength = result-string-length - trailing-space-count
IF (result-string-datalength > ZERO)
MOVE ZERO TO trailing-space-count
INSPECT FUNCTION REVERSE(new-string-text) TALLYING trailing-space-count FOR LEADING ' '
COMPUTE new-string-datalength = new-string-length - trailing-space-count
MOVE SPACES TO hold-string-text
STRING
result-string-text(1:result-string-datalength)
' '
new-string-text(1:new-string-datalength)
DELIMITED BY SIZE
INTO
hold-string-text
END-STRING
MOVE hold-string-text to result-string-text
ELSE
MOVE new-string-text TO result-string-text
END-IF.

Standard way to remove spaces from input in cobol?

I'm just learning COBOL; I'm writing a program that simply echos back user input. I have defined a variable as:
User-Input PIC X(30).
Later when I ACCEPT User-Input, then DISPLAY User-Input " plus some extra text", it has a bunch of spaces to fill the 30 characters. Is there a standard way (like Ruby's str.strip!) to remove the extra spaces?
One would hope for a more elegant way of simply trimming text strings
but this is pretty much the standard solution... The trimming part
is done in the SHOW-TEXT paragraph.
*************************************
* TRIM A STRING... THE HARD WAY...
*************************************
IDENTIFICATION DIVISION.
PROGRAM-ID. TESTX.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 USER-INPUT PIC X(30).
01 I PIC S9(4) BINARY.
PROCEDURE DIVISION.
MOVE SPACES TO USER-INPUT
PERFORM SHOW-TEXT
MOVE ' A B C' TO USER-INPUT
PERFORM SHOW-TEXT
MOVE 'USE ALL 30 CHARACTERS -------X' TO USER-INPUT
PERFORM SHOW-TEXT
GOBACK
.
SHOW-TEXT.
PERFORM VARYING I FROM LENGTH OF USER-INPUT BY -1
UNTIL I LESS THAN 1 OR USER-INPUT(I:1) NOT = ' '
END-PERFORM
IF I > ZERO
DISPLAY USER-INPUT(1:I) '# OTHER STUFF'
ELSE
DISPLAY '# OTHER STUFF'
END-IF
.
Produces the following output:
# OTHER STUFF
A B C# OTHER STUFF
USE ALL 30 CHARACTERS -------X# OTHER STUFF
Note that the PERFORM VARYING statement relies on the left to
right evaluation of the UNTIL clause to avoid out-of-bounds
subscripting on USER-INPUT in the case where it contains only
blank spaces.
Use OpenCOBOL 1.1 or greater.
Identification division.
Program-id. 'trimtest'.
*> Compile:
*> cobc -x -free -ffunctions-all TrimTest.cbl
*>
Data division.
Working-Storage Section.
1 myBigStr Pic X(32768) Value Spaces.
Procedure Division.
Display "Enter Something? " With no advancing.
Accept myBigStr.
Display "[" Trim(myBigStr) "]".
Goback.
The trim function also has the options; Leading or Trailing.
cobc -h formore info.
Here's a solution if you work on OpenVMS:
01 WS-STRING-LENGTH PIC S9(04) COMP.
CALL "STR$TRIM" USING BY DESCRIPTOR user_output,
user_input,
BY REFERENCE WS-STRING-LENGTH.
a more general solution:
01 length pic 99.
perform varying length from 1 by 1
until length > 30 or user-input[length] = space
end-perform.
if length > 30
display user-input 'plus some extra text'
else
display user-input[1:length] 'plus some extra text'
end-if.
untested, I don't have a compiler at hand at the moment
There are three ways you can do this.
Use the COBOL functions to determine the string's "length". This is a mix of a couple functions. This is my preferred method, but requires declaring extra variables.
Write your own function to get the "length".
Use knowledge of a "terminating" string. You have to know what key characters indicates an end-of-string, like three spaces or a low-value character.
This example code demonstrates all three.
IDENTIFICATION DIVISION.
PROGRAM-ID. TESTPROG.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 ONE-A PIC X(20) VALUE 'RALPH WIGGAM'.
01 ONE-A-TLY PIC 9(02) VALUE ZERO.
01 ONE-A-LEN PIC 9(02) VALUE ZERO.
01 ONE-B PIC X(20) VALUE 'LIKES LEARNDING'.
01 ONE-B-TLY PIC 9(02) VALUE ZERO.
01 ONE-B-LEN PIC 9(02) VALUE ZERO.
01 TWO-A PIC X(20) VALUE 'RALPH WIGGAM'.
01 TWO-A-LEN PIC 9(02) VALUE ZERO.
01 TWO-B PIC X(20) VALUE 'LIKES LEARNDING'.
01 TWO-B-LEN PIC 9(02) VALUE ZERO.
01 THREE-A PIC X(20) VALUE 'RALPH WIGGAM'.
01 THREE-B PIC X(20) VALUE 'LIKES LEARNDING'.
01 THREE-C PIC X(80) VALUE SPACES.
PROCEDURE DIVISION.
DISPLAY ' -- METHOD ONE -- '
INSPECT FUNCTION REVERSE(ONE-A)
TALLYING ONE-A-TLY FOR LEADING SPACES.
SUBTRACT ONE-A-TLY FROM LENGTH OF ONE-A GIVING ONE-A-LEN.
INSPECT FUNCTION REVERSE(ONE-B)
TALLYING ONE-B-TLY FOR LEADING SPACES.
SUBTRACT ONE-B-TLY FROM LENGTH OF ONE-A GIVING ONE-B-LEN.
DISPLAY ONE-A(1:ONE-A-LEN)
' ' ONE-B(1:ONE-B-LEN)
'.'.
DISPLAY ' -- METHOD TWO -- '
PERFORM VARYING TWO-A-LEN FROM LENGTH OF TWO-A BY -1
UNTIL TWO-A-LEN < 1 OR TWO-A(TWO-A-LEN:1) > SPACE
END-PERFORM.
PERFORM VARYING TWO-B-LEN FROM LENGTH OF TWO-B BY -1
UNTIL TWO-B-LEN < 1 OR TWO-B(TWO-B-LEN:1) > SPACE
END-PERFORM.
DISPLAY TWO-A(1:TWO-A-LEN)
' ' TWO-B(1:TWO-B-LEN)
'.'.
DISPLAY ' -- METHOD THREE, NAIVE -- '
* DELIMITING BY JUST ANY SPACES ISN'T GOOD ENOUGH.
STRING THREE-A DELIMITED BY SPACES
' ' DELIMITED BY SIZE
THREE-B DELIMITED BY SPACES
'.' DELIMITED BY SIZE
INTO THREE-C.
DISPLAY THREE-C.
DISPLAY ' -- METHOD THREE, OK -- '
STRING THREE-A DELIMITED BY ' '
' ' DELIMITED BY SIZE
THREE-B DELIMITED BY ' '
'.' DELIMITED BY SIZE
INTO THREE-C.
DISPLAY THREE-C.
EXIT-PROG.
STOP RUN.
and the output looks like this:
-- METHOD ONE --
RALPH WIGGAM LIKES LEARNDING.
-- METHOD TWO --
RALPH WIGGAM LIKES LEARNDING.
-- METHOD THREE, NAIVE --
RALPH LIKES.
-- METHOD THREE, OK --
RALPH WIGGAM LIKES LEARNDING.

Resources