Parsing Micro Focus XML in COBOL variables - xml-parsing

I have the following xml-structure that I want to parse in Cobol.
<LDO>
<OD>1</OD> //OD 1'st occurrence
<OLD>1</OLD> //OLD 1'st occurrence
<OLD>2</OLD> //OLD 2'nd occurrence
<OLD>3</OLD> //OLD 3'rd occurrence
<OD>2</OD> //OD 2'nd occurrence
<OLD>4</OLD> //OLD 4'th occurrence
</LDO>
As you guys can see there is several OLD tags after an OD tag. What I want to do is reading this xml file step by step and display it's attributes in the following way:
1
1
2
3
2
4
READ xml-stream.
START xml-stream KEY IS OD.
*>check status
START xml-stream KEY IS OLD.
*> check stream status
PERFORM UNTIL EXIT
READ xml-stream next key is
old
IF stream-status = -7
EXIT PERFORM
END-IF
*> check stream status less than 0
display od-value
display old-value
But the od-value doesn't change when i excecute the program. It return the following values
1
1
2
3
1
4
I want that the second occurrence to return the value of the second element OD not the first one.
I would like some help to achieve this.

You could use the "xml parse" syntax:
program-id. xp.
01 xdoc pic x(1024) value
" <LDO>" &
" <OD>1</OD>" &
" <OLD>1</OLD>" &
" <OLD>2</OLD>" &
" <OLD>3</OLD>" &
" <OD>2</OD>" &
" <OLD>4</OLD>" &
"</LDO>".
procedure division.
Xml parse xdoc processing procedure p
ON EXCEPTION
display 'XML document error 'XML-CODE
NOT ON EXCEPTION
display 'XML document successfully parsed'
END-XML
goback.
p.
Evaluate xml-event
When 'START-OF-ELEMENT'
When 'CONTENT-CHARACTERS'
exhibit named xml-text
When 'CONTENT-CHARACTER'
exhibit named xml-text
When 'END-OF-ELEMENT'
exhibit named xml-event
When other
exhibit named xml-event
End-evaluate
.
end program xp.

Related

Nested perform needs and doesn't need an end-perform

With this code, I get
16: Perform stmnt not terminated by end-perform
33: syntax error, unexpected end-perform
Why is it saying that I need an end-perform and also not need it?
identification division.
program-id. xxx.
* will accept and display a num until 0 is called then
* asks to go again
data division.
file section.
working-storage section.
01 num pic 9(4).
01 hold pic 9(4).
01 another pic x.
procedure division.
perform until another = 'N' (line 16)
Display "Another Session (Y/N)? "
with no advancing
if another = 'Y'
Display "Enter a 4-digit unsigned number (0 to stop): "
with no advancing
accept num
move num to hold
perform until num = 0
Display "Enter a 4-digit unsigned number (0 to stop): "
with no advancing
accept num
if num <> 0
move num to hold
end-perform.
display space
Display "The last number entered: "hold
End-perform. (Line 33)
stop run.
end-perform.
display space
Display "The last number entered: "hold
End-perform. (Line 33)
It's that full-stop/period (Line 30) which is the killer.
Although since the 1985 Standard COBOL is much more relaxed about full-stops/periods, a single one will bring all current scopes screaming to a halt. You could have nesting 50 levels deep, and one single full-stop/period would end them all, in one fell swoop.
My advice is to use the absolute minimum of full-stop/periods in the PROCEDURE DIVISION.
That is: one to terminate the PROCEDURE DIVISION header; one to terminate each paragraph/SECTION label; one to terminate a paragrpah/SECTION; one to terminate a program (for a program with no paragraphs/SECTIONS). Also, if you have PROCEDURE DIVISION COPY or REPLACE statements, you'll need full-stops/periods to terminate those.
Except for the termination of the labels I put each full-stop/period on a line of its own, never attached to any code. I can then move code around and insert code without worrying about whether I need to add/remove a full-stop/period.
As to why you need END-PERFORM, it is an "inline PERFORM". Syntactically, an inline PERFORM requires an END-PERFORM, but your use of the full-stop/period caused termination of the PERFORM scope before the END-PERFORM was located, so the error on line 16. Subsequently an END-PERFORM unconnected to a PERFORM was located, so the error on line 33.
It is important when putting error messages in your questions that you include the error message exactly as you see it. Copy/paste, don't re-trype, please. Include any message numbers, as well.
You absolutely can not mix the full stop "." scope terminator from Cobol-74 with the End-* scope terminators from Cobol-85.
The difference is that the full stop "." terminates ALL scopes.
The End-* terminates only the most recent scope, just like you might expect.
Putting a "." in the middle of code with End-* is kinda like dropping a nuclear bomb in the middle of it. As a rule, for compilers made in the last quarter century or so, a period should only occur in the procedure division at the end of a paragraph name, or at the end of a paragraph (and sections too, but those are useless in an age where segmentation and overlays are managed by the operating system). I like to use "EXIT." or "CONTINUE." just to highlight that I'm using one of the bad-nasty-best-avoided-periods in the procedure division.

Dot rules in nested conditional statements - COBOL

I'm wondering if anybody can explain to me the dot ruling in nested IF statements in COBOL. Example:
*The first if statement*
IF SUCCESSFUL-STATUS
PERFORM 8300-REPL-LNNTBI00
THRU 8300-REPL-LNNTBI00-EXIT
*The second if statement*
IF SUCCESSFUL-STATUS
DISPLAY 'RECORD ALREADY UPDATED :' WS-INF-REC
ELSE
DISPLAY 'UPDATE ERROR : ' WS-INF-REC ' / '
WS-RETURN-STATUS
READ INFILE INTO WS-INF-REC.
Which if statement does the dot placed after "WS-INF-REC" belong to? The first IF or the second IF-ELSE? I know that in most programming, it should be for the last if statement but just to make sure, is it the same for COBOL?
AFAIR a period always closes ALL preceding statements - regardless wether they are IF, PERFORM or whatever - so in your case the first IF-statement is closed as well. And since periods are so small and easily overlooked I use the following rule:
Avoid using periods, they are evil!
Only put a period where it is strictly required by the syntax rules and nowhere else. Use explicit scope-terminators like END-IF or END-PERFORM. They make your code more readable and clearly structured while periods tend to generate confusion because of multiple closures and their habit of hiding in plain view.
The period character "." ends all if statements. Remember that spacing is ignored by the compiler so therefore the READ statement is part of the ELSE of the second IF statement.
Us humans want to see the indentation used logically. And, if it were me, I would make the end-if's be explicit. I tend to have one period per paragraph:
* The first if statement *
IF SUCCESSFUL-STATUS
PERFORM 8300-REPL-LNNTBI00
THRU 8300-REPL-LNNTBI00-EXIT
* The second if statement*
IF SUCCESSFUL-STATUS
DISPLAY 'RECORD ALREADY UPDATED :' WS-INF-REC
ELSE
DISPLAY 'UPDATE ERROR : ' WS-INF-REC ' / '
WS-RETURN-STATUS
READ INFILE INTO WS-INF-REC
END-IF
END-IF
.
This is really bad, very archaic Cobol, but how it behaves is like this:
*The first if statement*
IF SUCCESSFUL-STATUS
PERFORM 8300-REPL-LNNTBI00
THRU 8300-REPL-LNNTBI00-EXIT
*The second if statement*
IF SUCCESSFUL-STATUS
DISPLAY 'RECORD ALREADY UPDATED :' WS-INF-REC
ELSE
DISPLAY 'UPDATE ERROR : ' WS-INF-REC ' / ' WS-RETURN-STATUS
READ INFILE INTO WS-INF-REC
END-IF ## from period
END-IF ## from period

AppleScript parsing html from site

What I'm trying to do is to get the names of all TV shows on this Wikipedia page.
Ok, so I did this first:
property showsWebList : {}
tell application "Safari"
set loadDelay to 2 -- in seconds; test for your system
make new document at end of every document
set URL of document 1 to "http://en.wikipedia.org/wiki/List_of_television_programs_by_name"
delay loadDelay
set nrOfUls to do JavaScript "document.getElementById('mw-content-text').querySelectorAll('ul').length;" in document 1
set nrOfUls to nrOfUls - 1 as number
log nrOfUls
repeat with ws from 1 to nrOfUls
delay loadDelay
set nrOfLis to do JavaScript "document.getElementById('mw-content-text').getElementsByTagName('UL')[" & ws & "].querySelectorAll('li').length;" in document 1
set nrOfLis to nrOfLis - 1 as number
log nrOfLis
repeat with rs from 0 to nrOfLis
delay 0.3
set aShow to do JavaScript "document.getElementById('mw-content-text').getElementsByTagName('UL')[" & ws & "].getElementsByTagName('LI')[" & rs & "].getElementsByTagName('I')[0].getElementsByTagName('A')[0].innerHTML;" in document 1
if aShow is not "" or "missing value" then
copy aShow to end of showsWebList
end if
end repeat
end repeat
end tell
And this works exactly how I want it to. The problem is that it takes 15 minutes until it's done and you gotta have the safari document in front the whole time. So my thought was to pick up the whole code and parse it. Not that easy. This is how my code looks now:
tell application "Safari"
make new document at end of every document
set URL of document 1 to "http://en.wikipedia.org/wiki/List_of_television_programs_by_name"
delay 4
set orgHTML to do JavaScript "document.getElementById('mw-content-text').innerHTML;" in document 1
set orgHTML to orgHTML as text
set readyText to my extractBetween(orgHTML, "<li><i><a ", "</a></i></li>")
log (item 0 of readyText)
set removeArray to my extractBetween(readyText, "href", ">")
set completeArray to {}
repeat with rt from 0 to (count readyText)
repeat with ra from 0 to (count removeArray)
if (item ra of removeArray) is in (item rt of readyText) then
set completeName to trim_line((item rt of readyText), (item ra of removeArray), 1)
set end of completeArray to completeName
end if
end repeat
end repeat
log completeArray
end tell
on extractBetween(SearchText, startText, endText)
set tid to AppleScript's text item delimiters -- save them for later.
set AppleScript's text item delimiters to startText -- find the first one.
set liste to text items of SearchText
set AppleScript's text item delimiters to endText -- find the end one.
set extracts to {}
repeat with subText in liste
if subText contains endText then
copy text item 1 of subText to end of extracts
end if
end repeat
set AppleScript's text item delimiters to tid -- back to original values.
return extracts
end extractBetween
on trim_line(this_text, trim_chars, trim_indicator)
-- 0 = beginning, 1 = end, 2 = both
set x to the length of the trim_chars
-- TRIM BEGINNING
if the trim_indicator is in {0, 2} then
repeat while this_text begins with the trim_chars
try
set this_text to characters (x + 1) thru -1 of this_text as string
on error
-- the text contains nothing but the trim characters
return ""
end try
end repeat
end if
-- TRIM ENDING
if the trim_indicator is in {1, 2} then
repeat while this_text ends with the trim_chars
try
set this_text to characters 1 thru -(x + 1) of this_text as string
on error
-- the text contains nothing but the trim characters
return ""
end try
end repeat
end if
return this_text
end trim_line
Not that smooth and not working. Somehow it seems like I can't get the items out of the list, because it doesn't see it as a list item. Can someone help me out?
Cheers
I would recommend a different approach. DL the source, and then just grab the title between tags. The whole script takes under two seconds. Start with:
property baseURL : "http://en.wikipedia.org/wiki/List_of_television_programs_by_name"
set rawHTML to do shell script "curl '" & baseURL & "'"
set preTag to "\" title=\"" -- " title="
set otid to AppleScript's text item delimiters
set AppleScript's text item delimiters to preTag
set rawList to text items of rawHTML
set nameList to {}
repeat with eachLine in rawList
set theOff to offset of ">" in eachLine
set thisName to text 1 thru (theOff - 2) of eachLine
-- add some error checking here to skip the opening non-title hits, and to fine-tune the precise title string
set nameList to nameList & return & thisName
end repeat
set AppleScript's text item delimiters to otid
return nameList
Add a little error checking, and tweak which preTag and postTag fits best.
I suggest you make use of a specialized 3rd-party tool for this task, which can greatly speed things up.
Here's a solution using the multi-platform web-scraping CLI xidel:
A shell command to demonstrate its brevity and speed (takes less than 1 sec. on my system) - extracts all show names from the page:
xidel -e '//*[#id="mw-content-text"]/ul/li/i/a' https://en.wikipedia.org/wiki/List_of_television_programs_by_name
An equivalent AppleScript snippet - be sure to fill in the path to where you place xidel on your system below:
set targetUrl to "https://en.wikipedia.org/wiki/List_of_television_programs_by_name"
set xPathExpr to "//*[#id=\"mw-content-text\"]/ul/li/i/a"
# Fill in the path to `xidel` on your system here:
set xidelPath to "/path/to/xidel"
# Perform scraping and convert result into an AppleScript list.
set showNames to paragraphs of ¬
(do shell script ¬
quoted form of xidelPath & " -e " & quoted form of xPathExpr & " " & ¬
quoted form of targetUrl)
Here's another solution, use javascript to get the names without any AppleScript loop.
The javascript script takes less than one second to get the names.
tell application "Safari"
make new document at end of every document with properties {URL:"http://en.wikipedia.org/wiki/List_of_television_programs_by_name"}
delay 2 -- in seconds; test for your system
set showsWebList to do JavaScript "var a=new Array();var ul=document.getElementById('mw-content-text').querySelectorAll('UL'); for (var i=1;i<ul.length;i++){li=ul[i].querySelectorAll('LI'); for (var j=0; j< li.length; j++){try {var t=li[j].getElementsByTagName('I')[0].getElementsByTagName('A')[0].innerText; a.push(t)} catch(e) {}}} a;" in document 1
end tell
curl/sed/perl solution:
do shell script "curl 'http://en.wikipedia.org/wiki/List_of_television_programs_by_name' | sed -n '/0-9/,/NewPP/p' | sed -n '/^<li/ s/^.*title=.\\([^\"]*\\).*$/\\1/p' | perl -n -mHTML::Entities -e ' ; print HTML::Entities::decode_entities($_);'"
Here another solution using awk using a very simple script. If the line begins with <li><i> then remove html tags (gsub) and then print it. Then by using every paragraph of the return separated output is converted into a list.
set theURL to "http://en.wikipedia.org/wiki/List_of_television_programs_by_name"
every paragraph of (do shell script "curl " & theURL & " | awk '/^\\<li\\>\\<i\\>/{gsub(\"<[^>]*>\", \"\");print}'")

How to combine spaces with letters

I try to create a string in Cobol with individually letters. Until I try to insert a
Space, everything works. Do you have any Idea, how I could create e.x. the string
" ee ee"
?.
IDENTIFICATION DIVISION.
PROGRAM-ID. EXAMPLE.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 S1 PIC X(10).
PROCEDURE DIVISION.
MAIN-PARAGRAPH.
Perform InsertSpace 2 Times
Perform InsertE 2 Times
Perform InsertSpace 2 Times
Perform InsertE 2 Times
Display S1
* expectation " ee ee"
End-Main
InsertE Section
STRING S1 DELIMITED BY SPACE
'e' DELIMITED BY SIZE
INTO S1
END-STRING
InsertSpace Section
STRING S1 DELIMITED BY SPACE
' ' DELIMITED BY SIZE
INTO S1
END-STRING
If you are trying to implement a process where one character at a time is added onto a
character variable, then something like the following might work a bit better for you:
IDENTIFICATION DIVISION.
PROGRAM-ID. EXAMPLE.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 S1 PIC X(10) VALUE SPACE.
01 S1-SUB PIC S9(4) BINARY VALUE ZERO.
PROCEDURE DIVISION.
PERFORM INSERT-SPACE 2 TIMES
PERFORM INSERT-E 2 TIMES
PERFORM INSERT-SPACE 2 TIMES
PERFORM INSERT-E 2 TIMES
DISPLAY '>' S1 '<'
GOBACK
.
INSERT-SPACE SECTION.
COMPUTE S1-SUB = S1-SUB + 1
MOVE SPACE TO S1 (S1-SUB : 1)
.
INSERT-E SECTION.
COMPUTE S1-SUB = S1-SUB + 1
MOVE 'E' TO S1 (S1-SUB : 1)
.
S1-SUB keeps tract of the current character position and is incremented
each time you PERFORM a section to add another character.
The above program displays: > EE EE <
Notice the trailing spaces? If you do not want these, the appropriate DISPLAY would be:
DISPLAY '>' S1 (1 : S1-SUB) '<'
which will limit the length of the display to only those characters you have explicity put into the variable. COBOL does not support variable length strings so you have to declare some PIC X type variable that can hold the maximum number of characters you want to display and then keep track of how many you have actually "used" and display only that many.
If this is the sort of thing you are looking for, I would also recommend checking
for bounds errors (ie. adding too many characters). That can be done as follows:
INSERT-E SECTION.
COMPUTE S1-SUB = S1-SUB + 1
IF S1-SUB > LENGTH OF S1
PERFORM ERROR-ROUTINE
END-IF
MOVE 'E' TO S1 (S1-SUB : 1)
.
MOVE " ee ee" TO S1
That will do what you want.
It is difficult to be certain, as you don't show what result you do get, and it is unclear what "Until I try to insert a Space, everything works" means, but...
01 S1 PIC X(10) VALUE SPACE.
Where S1 had no VALUE (and presuming you are not using a compiler which sets a default value for a PICture) the DELIMITED BY SPACE will take the whole 10 bytes, the values which a added by the STRING can never appear in the S1 unless it starts with a value of SPACE. With the value of SPACE, your four STRINGs should work. Err... no it won't, because of the SPACE, and the DELIMITED BY SPACE.
You can also use reference-modification, of course:
MOVE " " TO S1 ( 1 : 2 )
MOVE "ee" TO S1 ( 3 : 2 )
MOVE " " TO S1 ( 3 : 2 )
MOVE "ee" TO S1 ( 5 : )
Or, if you don't want to pad the final part of the field to SPACE by default, change the last to ( 5 : 2 ), which will leave bytes nine and 10 of S1 unchanged.
If you can clarify what you want to achieve, and why you think STRING is the verb to use to do it, you may get better answers.

Printing in two columns

We are supposed to form an array of names that occur 108 times. We are supposed to have name 1-54 in a left column and names 55-108 in a right column. After there have been 108 names for one page, we initialize our array and start over again. The output for my code is showing names 1-54 printed and, instead of being on the same page and beside names 1-54, names 55-108 in the right column but after names 1-54. Any thoughts would be greatly appreciated.
Here is some of my code:
PERFORM UNTIL ARE-THERE-MORE-RECORDS = 'NO '
READ NAMELIST-FILE-IN
AT END
MOVE 'NO ' TO ARE-THERE-MORE-RECORDS
NOT AT END
PERFORM 200-PROCESS-ONE-RECORD
END-READ
END-PERFORM
CLOSE NAMELIST-FILE-IN
CLOSE NAMELIST-FILE-OUT
STOP RUN.
200-PROCESS-ONE-RECORD.
ADD 1 TO NAME-SUB
MOVE NAME-IN TO NAME-1 (NAME-SUB)
PERFORM 220-MOVE-RECORDS.
220-MOVE-RECORDS.
IF NAME-SUB <= 54
MOVE NAME-1 (NAME-SUB) TO LEFT-LABEL
MOVE SPACES TO RIGHT-LABEL
END-IF
IF NAME-SUB >= 55
MOVE NAME-1 (NAME-SUB) TO RIGHT-LABEL
MOVE SPACES TO LEFT-LABEL
END-IF
MOVE DETAIL-LINE TO NAMELIST-RECORD-OUT
WRITE NAMELIST-RECORD-OUT
AFTER ADVANCING 1 LINE
IF NAME-SUB >= 108
MOVE SPACES TO DETAIL-LINE
MOVE ZERO TO NAME-SUB
PERFORM 300-WRITE-HEADING
END-IF.
I have coded all the proper WORKING-STORAGE entries to accommodate the information. Do you know if there is something wrong with the way I am writing the detail-line or is it the way I am processing my data?
Your logic is wrong. Lets say (just to make things easy) you have 216 names, you will need to read in 108 of them and store them in your NAME-1 array.
Then you can loop over the 54 lines placing NAME-1[n] into LEFT-LABEL and NAME-1[n+54] into RIGHT-LABEL, Then move your detail-line and write to output; repeating for lines n = 1 <= 54
Now read in your next 108 lines and repeat. So two loops; Read 108 names, print 54 lines.
Obviously you will need to guard for your remainder, ie if you don't have exactly a multiple of 108 names, something like
if n <= name-sub
move NAME-1[n] to LEFT-LABEL
else
move spaces to LEFT-LABEL
endif
if n+54 <= name-sub
move NAME-1[n+54] to RIGHT-LABEL
else
move spaces to RIGHT-LABEL
endif
I realise you will have to set the variables properly (n+54 is not proper cobol) and sorry for the mix of case, but long time ago writing COBOL and used to lower case now. ;)
If I understand correctly, this should be close to what you want
220-MOVE-RECORDS.
IF NAME-SUB >= 108
perform varing i from 1 to 54
MOVE NAME-1 (NAME-SUB) TO LEFT-LABEL
compute ip54 = i + 54
MOVE NAME-1 (ip54) TO RIGHT-LABEL
WRITE NAMELIST-RECORD-OUT
from DETAIL-LINE
AFTER ADVANCING 1 LINE
end-perform
MOVE SPACES TO DETAIL-LINE
MOVE ZERO TO NAME-SUB
PERFORM 300-WRITE-HEADING
END-IF.
Note: many Cobol compilers allow lower case
You should always have error checking for all your IO.
A one-file-in-one-file-out can always look like this:
open input
check status
open output
check status
process file until end
close input
check status
close output
check status
process file
read input
check staus
do what is needed
write output
check status
Better is like this:
open input
check status
open output
check status
*priming read*
process file until end
close input
check status
close output
check status
process file
do what is needed
write output
check status
read input
check staus
The "priming read" deals with the first record on the file (if any). You can neatly handle an "empty file" without having to "confuse" your main logic or having to differentiate between two different types of "end of file" elsewhere. The read now at the end of "process file" removes the somewhat tortuous "AT END/NOT AT END".
For the example, you only need 54 elements in your table. When processing a record for the "right" side of the page, you can take the first from the "left" and do the line immediately.
Use 88s rather than literals for tests.
Don't do your "headings" at the end of a page, as if there are no more records to process, you will have a "blank page" following your headings.
If the write of your print line is in a paragraph, that paragraph can be used check whether a heading is needed, with a "line count" which has an initial value of 54.
With the 108-element approach where you are printing a page-at-a-time, do the headings there, at the top.
The is no need to set things to initial values if the data is never used before it is set to something else.
You've adopted the "minimal full-stop/period" approach to procedure code, which is good - how about putting that necessary final period on a line of its own?
PERFORM 220-MOVE-RECORDS.
becomes
PERFORM 220-MOVE-RECORDS
.
Only use >= or<= when the values can logically exceed the maximum. Yours never can, so use EQUAL TO. Yes, if it exceeds, you get a Big Fat Loop. But that is better than "working" when something unexpected has happened. If you want to test > for exceeding and then failing with a diagnostic message, that's OK. Some compilers allow "bounds checking" of table accesses, if you are using that, you'd not even need the extra check.
It would have been helpful to see your Working Storage definitions as well as the code. It is hard to
understand one without the other.
At any rate, what you are describing is a fairly "standard" sort of problem to which there are
several possible solutions. What follows is an
outline of one possible approach.
Start with a data structure... Working Storage:
01 WS-PAGE-BUFFER.
02 WS-LINE OCCURS 54 TIMES.
03 WS-NAME PIC X(40) OCCURS 2 TIMES.
The above working storage describes one page of output. The page contains 54 lines. Each line contains
two names. Next you need a few counters...
01.
02 WS-LINE-CNTR PIC S9(4) COMP.
02 WS-NAME-CNTR PIC S9(4) COMP.
Two problems to solve:
Filling the page in the proper sequence
Printing the page with appropriate headings/trailers
Something else to keep in mind when solving these problems is that you need to cover
several scenaios with respect to inputs: No input, input fits exactly to some number
of ouput pages and input partly fills an output page. So whatever you do, all of
these situations need to sort themselves out in a "natural" way.
Also, there is generally some sort of pre/post amble stuff
to work out (eg. initializations, open files, close files etc.).
One more thing... Always declare a FILE-STATUS for your Input/Output files to
capture errors and end-of-file conditions. The algorithm below assumes you have
done that (end-of-file status is generally '10')
Skeleton algorithm.
MAINLINE
PERFORM INITIALIZE-PAGE
Open input file (check status etc...)
Open output file (check status etc...)
Read first line from file (check for errors/end of file etc...)
PERFORM UNTIL INPUT-FILE-STATUS NOT = ZERO /* read until eof/error
IF WS-LINE-CNTR = 54 AND WS-NAME-CNT = 2 /* check for full page.
PERFORM OUTPUT-PAGE
END-IF
ADD +1 TO WS-LINE-CNTR
IF WS-LINE-CNTR > 54
MOVE +1 TO WS-LINE-CNTR /* Start next column...
ADD +1 TO WS-NAME-CNTR /* Increment column
END-IF
MOVE input-record TO WS-NAME (WS-LINE-CNTR, WS-NAME-CNTR)
Read next line from input file
END-PERFORM
IF INPUT-FILE-STATUS = '10' AND WS-LINE-CNTR > ZERO
PERFORM OUTPUT-PAGE /* force the last page to print
END-IF
close input file
close output file
GOBACK /* done
.
INITIALIZE-PAGE.
MOVE SPACE TO WS-PAGE-BUFFER /* Blank page (ie. SPACES)
MOVE ZERO TO WS-LINE-CNTR /* Top of page
MOVE +1 TO WS-NAME-CNTR /* First column of page
.
OUTPUT-PAGE.
Ouput page headers...
PERFORM VARYING WS-LINE-CNTR FROM 1 BY 1
UNTIL WS-LINE-CNTR > 54
write WS-LINE (WS-LINE-CNTR) to output file (check status etc...)
END-PERORM
Output page trailers...
PERFORM INITIALIZE-PAGE /* Start a fresh page...
.
I have left plenty of "blank spots" to be filled in and I will admit there are other more
elegant ways to accomplish what you are trying to do, but
this should get you started.

Resources