Although the 21-day course covered the meat of COBOL, many areas of the language and the use of COBOL in programming have not been touched. This chapter rounds out some of those areas, touching on different topics that are not necessarily related. They are common issues that will come up when you work with COBOL.
Today, you learn about the following topics:
You learned to use tables on Day 16, "Using Look Up and Arrays." In that lesson you created a table for state codes and loaded the table from the state codes file. The table then was used in the program to look up state codes while printing a report on the vendor file.
It also is possible to create tables or arrays in memory that already are filled in with values, rather than loading them from a file.
Today, you improve the appearance of the sales reports created on Bonus Day 1, "Control Breaks," by printing the division, department, and category names on the report. First, a quick review of tables. A table or an array is an area of memory that has been set aside and organized in such a way that it can hold multiple occurrences of the same type of information.
On Day 16, you created a table that looked like Listing B2.1.
007000 01 TABLE-STATE-RECORD OCCURS 50 TIMES 007100 INDEXED BY STATE-INDEX. 007200 05 TABLE-STATE-CODE PIC XX. 007300 05 TABLE-STATE-NAME PIC X(20).
For the sales report, you need a table of division names, a table of department names, and a table of category names. Table B2.1 shows the list of names for these subdivisions.
| Div | Division Name | Dep | Department Name | Cat | Category Name |
| 01 | Athletics | 01 | Exercise | 01 | Weights |
| 02 | Machines | ||||
| 02 | Miscellaneous | 03 | Sunglasses | ||
| 04 | Vitamins | ||||
| 02 | Sporting Goods | 03 | Sport Clothes | 05 | Men's Clothes |
| 06 | Women's Clothes | ||||
| 04 | Equipment | 07 | Tennis | ||
| 08 | Soccer | ||||
| 03 | Camping | 05 | Camp Equipment | 09 | Tents |
| 10 | Sleeping Bags | ||||
| 06 | Camping Clothes | 11 | Clothing | ||
| 12 | Hiking Boots |
Listing B2.2 is a table that is good enough for the divisions.
007000 01 DIVISION-TABLE OCCURS 3 TIMES 007100 INDEXED BY DIVISION-INDEX. 007200 05 DIVISION-NUMBER PIC 99. 007300 05 DIVISION-NAME PIC X(15).
This table could be loaded in the program with a series of commands, as shown in Listing B2.3.
010700 MOVE 1 TO DIVISION-NUMBER(1). 010800 MOVE "ATHLETICS" TO DIVISION-NAME(1). 010900 MOVE 2 TO DIVISION-NUMBER(2). 011000 MOVE "SPORTING GOODS" TO DIVISION-NAME(2). 011100 MOVE 3 TO DIVISION-NUMBER(3). 011200 MOVE "CAMPING" TO DIVISION-NAME(3).
However, the usual method for loading a table is to initialize it directly in working storage when it is defined. This is done by first creating a variable that has all the needed values and space, as shown in Listing B2.4.
007000 01 THE-DIVISIONS. 007100 05 FILLER PIC 99 VALUE 01. 007200 05 FILLER PIC X(15) VALUE "ATHLETICS". 007100 05 FILLER PIC 99 VALUE 02. 007200 05 FILLER PIC X(15) VALUE "SPORTING GOODS". 007100 05 FILLER PIC 99 VALUE 01. 007200 05 FILLER PIC X(15) VALUE "CAMPING".
This variable is then redefined as a table, as shown in Listing B2.5.
007000 01 THE-DIVISIONS. 007100 05 FILLER PIC 99 VALUE 01. 007200 05 FILLER PIC X(15) VALUE "ATHLETICS". 007100 05 FILLER PIC 99 VALUE 02. 007200 05 FILLER PIC X(15) VALUE "SPORTING GOODS". 007100 05 FILLER PIC 99 VALUE 03. 007200 05 FILLER PIC X(15) VALUE "CAMPING". 007300 01 FILLER REDEFINES THE-DIVISIONS. 007400 05 DIVISION-TABLE OCCURS 3 TIMES 007500 INDEXED BY DIVISION-INDEX. 007600 10 DIVISION-NUMBER PIC 99. 007700 10 DIVISION-NAME PIC X(15).
Figure B2.1 is a printer spacing chart for a version of the sales report that includes the name of each division, department, or category. Listing B2.6 is slsrpt03.cbl. It is based on slsrpt01.cbl, but the layout has been modified to accommodate an extra 15-character name for division, department, and category.
Figure B2.1.
Printer layout chart for slsrpt03.cbl.
000100 IDENTIFICATION DIVISION. 000200 PROGRAM-ID. SLSRPT03. 000300*-------------------------------- 000400* Print test sales data 000500*-------------------------------- 000600 ENVIRONMENT DIVISION. 000700 INPUT-OUTPUT SECTION. 000800 FILE-CONTROL. 000900 001000*-------------------------------- 001100* SLSALES.CBL 001200*-------------------------------- 001300 SELECT SALES-FILE 001400 ASSIGN TO "SALES" 001500 ORGANIZATION IS SEQUENTIAL. 001600 001700 SELECT WORK-FILE 001800 ASSIGN TO "WORK" 001900 ORGANIZATION IS SEQUENTIAL. 002000 002100 SELECT SORT-FILE 002200 ASSIGN TO "SORT". 002300 002400 SELECT PRINTER-FILE 002500 ASSIGN TO PRINTER 002600 ORGANIZATION IS LINE SEQUENTIAL. 002700 002800 DATA DIVISION. 002900 FILE SECTION. 003000 003100*-------------------------------- 003200* FDSALES.CBL 003300* Temporary daily sales file. 003400*-------------------------------- 003500 FD SALES-FILE 003600 LABEL RECORDS ARE STANDARD. 003700 01 SALES-RECORD. 003800 05 SALES-STORE PIC 9(2). 003900 05 SALES-DIVISION PIC 9(2). 004000 05 SALES-DEPARTMENT PIC 9(2). 004100 05 SALES-CATEGORY PIC 9(2). 004200 05 SALES-AMOUNT PIC S9(6)V99. 004300 004400 FD WORK-FILE 004500 LABEL RECORDS ARE STANDARD. 004600 01 WORK-RECORD. 004700 05 WORK-STORE PIC 9(2). 004800 05 WORK-DIVISION PIC 9(2). 004900 05 WORK-DEPARTMENT PIC 9(2). 005000 05 WORK-CATEGORY PIC 9(2). 005100 05 WORK-AMOUNT PIC S9(6)V99. 005200 005300 SD SORT-FILE 005400 LABEL RECORDS ARE STANDARD. 005500 01 SORT-RECORD. 005600 05 SORT-STORE PIC 9(2). 005700 05 SORT-DIVISION PIC 9(2). 005800 05 SORT-DEPARTMENT PIC 9(2). 005900 05 SORT-CATEGORY PIC 9(2). 006000 05 SORT-AMOUNT PIC S9(6)V99. 006100 006200 FD PRINTER-FILE 006300 LABEL RECORDS ARE OMITTED. 006400 01 PRINTER-RECORD PIC X(80). 006500 006600 WORKING-STORAGE SECTION. 006700 006800 01 THE-DIVISIONS. 006900 05 FILLER PIC 99 VALUE 01. 007000 05 FILLER PIC X(15) VALUE "ATHLETICS". 007100 05 FILLER PIC 99 VALUE 02. 007200 05 FILLER PIC X(15) VALUE "SPORTING GOODS". 007300 05 FILLER PIC 99 VALUE 03. 007400 05 FILLER PIC X(15) VALUE "CAMPING". 007500 01 FILLER REDEFINES THE-DIVISIONS. 007600 05 DIVISION-TABLE OCCURS 3 TIMES 007700 INDEXED BY DIVISION-INDEX. 007800 10 DIVISION-NUMBER PIC 99. 007900 10 DIVISION-NAME PIC X(15). 008000 008100 01 THE-DEPARTMENTS. 008200 05 FILLER PIC 99 VALUE 01. 008300 05 FILLER PIC X(15) VALUE "EXERCISE". 008400 05 FILLER PIC 99 VALUE 02. 008500 05 FILLER PIC X(15) VALUE "MISCELLANEOUS". 008600 05 FILLER PIC 99 VALUE 03. 008700 05 FILLER PIC X(15) VALUE "SPORT CLOTHES". 008800 05 FILLER PIC 99 VALUE 04. 008900 05 FILLER PIC X(15) VALUE "EQUIPMENT". 009000 05 FILLER PIC 99 VALUE 05. 009100 05 FILLER PIC X(15) VALUE "CAMP EQUIPMENT". 009200 05 FILLER PIC 99 VALUE 06. 009300 05 FILLER PIC X(15) VALUE "CAMPING CLOTHES". 009400 01 FILLER REDEFINES THE-DEPARTMENTS. 009500 05 DEPARTMENT-TABLE OCCURS 6 TIMES 009600 INDEXED BY DEPARTMENT-INDEX. 009700 10 DEPARTMENT-NUMBER PIC 99. 009800 10 DEPARTMENT-NAME PIC X(15). 009900 010000 01 THE-CATEGORIES. 010100 05 FILLER PIC 99 VALUE 01. 010200 05 FILLER PIC X(15) VALUE "WEIGHTS". 010300 05 FILLER PIC 99 VALUE 02. 010400 05 FILLER PIC X(15) VALUE "MACHINES". 010500 05 FILLER PIC 99 VALUE 03. 010600 05 FILLER PIC X(15) VALUE "SUN GLASSES". 010700 05 FILLER PIC 99 VALUE 04. 010800 05 FILLER PIC X(15) VALUE "VITAMINS". 010900 05 FILLER PIC 99 VALUE 05. 011000 05 FILLER PIC X(15) VALUE "MEN'S CLOTHES". 011100 05 FILLER PIC 99 VALUE 06. 011200 05 FILLER PIC X(15) VALUE "WOMEN'S CLOTHES". 011300 05 FILLER PIC 99 VALUE 07. 011400 05 FILLER PIC X(15) VALUE "TENNIS". 011500 05 FILLER PIC 99 VALUE 08. 011600 05 FILLER PIC X(15) VALUE "SOCCER". 011700 05 FILLER PIC 99 VALUE 09. 011800 05 FILLER PIC X(15) VALUE "TENTS". 011900 05 FILLER PIC 99 VALUE 10. 012000 05 FILLER PIC X(15) VALUE "SLEEPING BAGS". 012100 05 FILLER PIC 99 VALUE 11. 012200 05 FILLER PIC X(15) VALUE "CLOTHING". 012300 05 FILLER PIC 99 VALUE 12. 012400 05 FILLER PIC X(15) VALUE "HIKING BOOTS". 012500 01 FILLER REDEFINES THE-CATEGORIES. 012600 05 CATEGORY-TABLE OCCURS 12 TIMES 012700 INDEXED BY CATEGORY-INDEX. 012800 10 CATEGORY-NUMBER PIC 99. 012900 10 CATEGORY-NAME PIC X(15). 013000 013100 77 OK-TO-PROCESS PIC X. 013200 013300 COPY "WSCASE01.CBL". 013400 013500 01 LEGEND-LINE. 013600 05 FILLER PIC X(6) VALUE "STORE:". 013700 05 FILLER PIC X(1) VALUE SPACE. 013800 05 PRINT-STORE PIC Z9. 013900 014000 01 DETAIL-LINE. 014100 05 FILLER PIC X(3) VALUE SPACE. 014200 05 PRINT-DIVISION PIC Z9. 014300 05 FILLER PIC X(4) VALUE SPACE. 014400 05 FILLER PIC X(3) VALUE SPACE. 014500 05 PRINT-DEPARTMENT PIC Z9. 014600 05 FILLER PIC X(6) VALUE SPACE. 014700 05 FILLER PIC X(3) VALUE SPACE. 014800 05 PRINT-CATEGORY PIC Z9. 014900 05 FILLER PIC X(4) VALUE SPACE. 015000 05 PRINT-CATEGORY-NAME PIC X(15). 015100 05 FILLER PIC X(1) VALUE SPACE. 015200 05 PRINT-AMOUNT PIC ZZZ,ZZ9.99-. 015300 015400 01 COLUMN-LINE. 015500 05 FILLER PIC X(8) VALUE "DIVISION". 015600 05 FILLER PIC X(1) VALUE SPACE. 015700 05 FILLER PIC X(10) VALUE "DEPARTMENT". 015800 05 FILLER PIC X(1) VALUE SPACE. 015900 05 FILLER PIC X(8) VALUE "CATEGORY". 016000 05 FILLER PIC X(1) VALUE SPACE. 016100 05 FILLER PIC X(15) VALUE SPACE. 016200 05 FILLER PIC X(5) VALUE SPACE. 016300 05 FILLER PIC X(6) VALUE "AMOUNT". 016400 016500 01 TITLE-LINE. 016600 05 FILLER PIC X(30) VALUE SPACE. 016700 05 FILLER PIC X(12) 016800 VALUE "SALES REPORT". 016900 05 FILLER PIC X(16) VALUE SPACE. 017000 05 FILLER PIC X(5) VALUE "PAGE:". 017100 05 FILLER PIC X(1) VALUE SPACE. 017200 05 PRINT-PAGE-NUMBER PIC ZZZ9. 017300 017400 01 TOTAL-LINE. 017500 05 FILLER PIC X(11) VALUE SPACE. 017600 05 TOTAL-TYPE PIC X(8). 017700 05 FILLER PIC X(1) VALUE SPACE. 017800 05 TOTAL-NUMBER PIC Z9. 017900 05 FILLER PIC X(1) VALUE SPACE. 018000 05 TOTAL-NAME PIC X(15) VALUE SPACE. 018100 05 FILLER PIC X(1) VALUE SPACE. 018200 05 TOTAL-LITERAL PIC X(5) VALUE "TOTAL". 018300 05 FILLER PIC X(1) VALUE SPACE. 018400 05 PRINT-TOTAL PIC ZZZ,ZZ9.99-. 018500 018600 77 GRAND-TOTAL-LITERAL PIC X(8) VALUE " GRAND". 018700 77 STORE-TOTAL-LITERAL PIC X(8) VALUE " STORE". 018800 77 DIVISION-TOTAL-LITERAL PIC X(8) VALUE "DIVISION". 018900 77 DEPARTMENT-TOTAL-LITERAL PIC X(8) VALUE " DEPT". 019000 019100 77 WORK-FILE-AT-END PIC X. 019200 019300 77 LINE-COUNT PIC 999 VALUE ZERO. 019400 77 PAGE-NUMBER PIC 9999 VALUE ZERO. 019500 77 MAXIMUM-LINES PIC 999 VALUE 55. 019600 019700 77 RECORD-COUNT PIC 9999 VALUE ZEROES. 019800 019900* Control break current values for store, division 020000* department. 020100 77 CURRENT-STORE PIC 99. 020200 77 CURRENT-DIVISION PIC 99. 020300 77 CURRENT-DEPARTMENT PIC 99. 020400 020500* Control break accumulators 020600* GRAND TOTAL is the level 1 accumulator for the whole file 020700* STORE TOTAL is the level 2 accumulator 020800* DIVISION TOTAL is the level 3 accumulator 020900* DEPARTMENT TOTAL is the level 4 accumulator. 021000 77 GRAND-TOTAL PIC S9(6)V99. 021100 77 STORE-TOTAL PIC S9(6)V99. 021200 77 DIVISION-TOTAL PIC S9(6)V99. 021300 77 DEPARTMENT-TOTAL PIC S9(6)V99. 021400 021500 PROCEDURE DIVISION. 021600 PROGRAM-BEGIN. 021700 021800 PERFORM OPENING-PROCEDURE. 021900 PERFORM MAIN-PROCESS. 022000 PERFORM CLOSING-PROCEDURE. 022100 022200 PROGRAM-EXIT. 022300 EXIT PROGRAM. 022400 022500 PROGRAM-DONE. 022600 STOP RUN. 022700 022800 OPENING-PROCEDURE. 022900 023000 OPEN OUTPUT PRINTER-FILE. 023100 023200 MAIN-PROCESS. 023300 PERFORM GET-OK-TO-PROCESS. 023400 PERFORM PROCESS-THE-FILE 023500 UNTIL OK-TO-PROCESS = "N". 023600 023700 CLOSING-PROCEDURE. 023800 CLOSE PRINTER-FILE. 023900 024000 GET-OK-TO-PROCESS. 024100 PERFORM ACCEPT-OK-TO-PROCESS. 024200 PERFORM RE-ACCEPT-OK-TO-PROCESS 024300 UNTIL OK-TO-PROCESS = "Y" OR "N". 024400 024500 ACCEPT-OK-TO-PROCESS. 024600 DISPLAY "PRINT SALES REPORT (Y/N)?". 024700 ACCEPT OK-TO-PROCESS. 024800 INSPECT OK-TO-PROCESS 024900 CONVERTING LOWER-ALPHA 025000 TO UPPER-ALPHA. 025100 025200 RE-ACCEPT-OK-TO-PROCESS. 025300 DISPLAY "YOU MUST ENTER YES OR NO". 025400 PERFORM ACCEPT-OK-TO-PROCESS. 025500 025600 PROCESS-THE-FILE. 025700 PERFORM START-THE-FILE. 025800 PERFORM PRINT-ONE-REPORT. 025900 PERFORM END-THE-FILE. 026000 026100* PERFORM GET-OK-TO-PROCESS. 026200 MOVE "N" TO OK-TO-PROCESS. 026300 026400 START-THE-FILE. 026500 PERFORM SORT-DATA-FILE. 026600 OPEN INPUT WORK-FILE. 026700 026800 END-THE-FILE. 026900 CLOSE WORK-FILE. 027000 027100 SORT-DATA-FILE. 027200 SORT SORT-FILE 027300 ON ASCENDING KEY SORT-STORE 027400 ASCENDING KEY SORT-DIVISION 027500 ASCENDING KEY SORT-DEPARTMENT 027600 ASCENDING KEY SORT-CATEGORY 027700 USING SALES-FILE 027800 GIVING WORK-FILE. 027900 028000* LEVEL 1 CONTROL BREAK 028100 PRINT-ONE-REPORT. 028200 PERFORM START-ONE-REPORT. 028300 PERFORM PROCESS-ALL-STORES 028400 UNTIL WORK-FILE-AT-END = "Y". 028500 PERFORM END-ONE-REPORT. 028600 028700 START-ONE-REPORT. 028800 PERFORM READ-FIRST-VALID-WORK. 028900 MOVE ZEROES TO GRAND-TOTAL. 029000 029100 PERFORM START-NEW-REPORT. 029200 029300 START-NEW-REPORT. 029400 MOVE SPACE TO DETAIL-LINE. 029500 MOVE ZEROES TO LINE-COUNT PAGE-NUMBER. 029600 029700 END-ONE-REPORT. 029800 IF RECORD-COUNT = ZEROES 029900 MOVE "NO RECORDS FOUND" TO PRINTER-RECORD 030000 PERFORM WRITE-TO-PRINTER 030100 ELSE 030200 PERFORM PRINT-GRAND-TOTAL. 030300 030400 PERFORM END-LAST-PAGE. 030500 030600 PRINT-GRAND-TOTAL. 030700 MOVE SPACE TO TOTAL-LINE. 030800 MOVE GRAND-TOTAL TO PRINT-TOTAL. 030900 MOVE GRAND-TOTAL-LITERAL TO TOTAL-TYPE. 031000 MOVE "TOTAL" TO TOTAL-LITERAL. 031100 MOVE TOTAL-LINE TO PRINTER-RECORD. 031200 PERFORM WRITE-TO-PRINTER. 031300 PERFORM LINE-FEED 2 TIMES. 031400 MOVE SPACE TO DETAIL-LINE. 031500 031600* LEVEL 2 CONTROL BREAK 031700 PROCESS-ALL-STORES. 031800 PERFORM START-ONE-STORE. 031900 032000 PERFORM PROCESS-ALL-DIVISIONS 032100 UNTIL WORK-FILE-AT-END = "Y" 032200 OR WORK-STORE NOT = CURRENT-STORE. 032300 032400 PERFORM END-ONE-STORE. 032500 032600 START-ONE-STORE. 032700 MOVE WORK-STORE TO CURRENT-STORE. 032800 MOVE ZEROES TO STORE-TOTAL. 032900 MOVE WORK-STORE TO PRINT-STORE. 033000 033100 PERFORM START-NEXT-PAGE. 033200 033300 END-ONE-STORE. 033400 PERFORM PRINT-STORE-TOTAL. 033500 ADD STORE-TOTAL TO GRAND-TOTAL. 033600 033700 PRINT-STORE-TOTAL. 033800 MOVE SPACE TO TOTAL-LINE. 033900 MOVE STORE-TOTAL TO PRINT-TOTAL. 034000 MOVE CURRENT-STORE TO TOTAL-NUMBER. 034100 MOVE STORE-TOTAL-LITERAL TO TOTAL-TYPE. 034200 MOVE "TOTAL" TO TOTAL-LITERAL. 034300 MOVE TOTAL-LINE TO PRINTER-RECORD. 034400 PERFORM WRITE-TO-PRINTER. 034500 PERFORM LINE-FEED. 034600 MOVE SPACE TO DETAIL-LINE. 034700 034800* LEVEL 3 CONTROL BREAK 034900 PROCESS-ALL-DIVISIONS. 035000 PERFORM START-ONE-DIVISION. 035100 035200 PERFORM PROCESS-ALL-DEPARTMENTS 035300 UNTIL WORK-FILE-AT-END = "Y" 035400 OR WORK-STORE NOT = CURRENT-STORE 035500 OR WORK-DIVISION NOT = CURRENT-DIVISION. 035600 035700 PERFORM END-ONE-DIVISION. 035800 035900 START-ONE-DIVISION. 036000 MOVE WORK-DIVISION TO CURRENT-DIVISION. 036100 MOVE ZEROES TO DIVISION-TOTAL. 036200 MOVE WORK-DIVISION TO PRINT-DIVISION. 036300 036400 END-ONE-DIVISION. 036500 PERFORM PRINT-DIVISION-TOTAL. 036600 ADD DIVISION-TOTAL TO STORE-TOTAL. 036700 036800 PRINT-DIVISION-TOTAL. 036900 MOVE SPACE TO TOTAL-LINE. 037000 MOVE DIVISION-TOTAL TO PRINT-TOTAL. 037100 MOVE CURRENT-DIVISION TO TOTAL-NUMBER. 037200 MOVE DIVISION-TOTAL-LITERAL TO TOTAL-TYPE. 037300 MOVE "TOTAL" TO TOTAL-LITERAL. 037400 PERFORM LOAD-DIVISION-NAME. 037500 MOVE TOTAL-LINE TO PRINTER-RECORD. 037600 PERFORM WRITE-TO-PRINTER. 037700 PERFORM LINE-FEED. 037800 MOVE SPACE TO DETAIL-LINE. 037900 038000 LOAD-DIVISION-NAME. 038100 SET DIVISION-INDEX TO 1. 038200 SEARCH DIVISION-TABLE 038300 AT END 038400 MOVE "NOT FOUND" TO TOTAL-NAME 038500 WHEN 038600 DIVISION-NUMBER(DIVISION-INDEX) = 038700 CURRENT-DIVISION 038800 MOVE DIVISION-NAME(DIVISION-INDEX) TO 038900 TOTAL-NAME. 039000 039100* LEVEL 4 CONTROL BREAK 039200 PROCESS-ALL-DEPARTMENTS. 039300 PERFORM START-ONE-DEPARTMENT. 039400 039500 PERFORM PROCESS-ALL-CATEGORIES 039600 UNTIL WORK-FILE-AT-END = "Y" 039700 OR WORK-STORE NOT = CURRENT-STORE 039800 OR WORK-DIVISION NOT = CURRENT-DIVISION 039900 OR WORK-DEPARTMENT NOT = CURRENT-DEPARTMENT. 040000 040100 PERFORM END-ONE-DEPARTMENT. 040200 040300 START-ONE-DEPARTMENT. 040400 MOVE WORK-DEPARTMENT TO CURRENT-DEPARTMENT. 040500 MOVE ZEROES TO DEPARTMENT-TOTAL. 040600 MOVE WORK-DEPARTMENT TO PRINT-DEPARTMENT. 040700 040800 END-ONE-DEPARTMENT. 040900 PERFORM PRINT-DEPARTMENT-TOTAL. 041000 ADD DEPARTMENT-TOTAL TO DIVISION-TOTAL. 041100 041200 PRINT-DEPARTMENT-TOTAL. 041300 MOVE SPACE TO TOTAL-LINE. 041400 MOVE DEPARTMENT-TOTAL TO PRINT-TOTAL. 041500 MOVE CURRENT-DEPARTMENT TO TOTAL-NUMBER. 041600 MOVE DEPARTMENT-TOTAL-LITERAL TO TOTAL-TYPE. 041700 MOVE "TOTAL" TO TOTAL-LITERAL. 041800 PERFORM LOAD-DEPARTMENT-NAME. 041900 MOVE TOTAL-LINE TO PRINTER-RECORD. 042000 PERFORM WRITE-TO-PRINTER. 042100 PERFORM LINE-FEED. 042200 MOVE SPACE TO DETAIL-LINE. 042300 042400 LOAD-DEPARTMENT-NAME. 042500 SET DEPARTMENT-INDEX TO 1. 042600 SEARCH DEPARTMENT-TABLE 042700 AT END 042800 MOVE "NOT FOUND" TO TOTAL-NAME 042900 WHEN 043000 DEPARTMENT-NUMBER(DEPARTMENT-INDEX) = 043100 CURRENT-DEPARTMENT 043200 MOVE DEPARTMENT-NAME(DEPARTMENT-INDEX) TO 043300 TOTAL-NAME. 043400 043500* PROCESS ONE RECORD LEVEL 043600 PROCESS-ALL-CATEGORIES. 043700 PERFORM PROCESS-THIS-CATEGORY. 043800 ADD WORK-AMOUNT TO DEPARTMENT-TOTAL. 043900 ADD 1 TO RECORD-COUNT. 044000 PERFORM READ-NEXT-VALID-WORK. 044100 044200 PROCESS-THIS-CATEGORY. 044300 IF LINE-COUNT > MAXIMUM-LINES 044400 PERFORM START-NEXT-PAGE. 044500 PERFORM PRINT-THE-RECORD. 044600 044700 PRINT-THE-RECORD. 044800 MOVE WORK-CATEGORY TO PRINT-CATEGORY. 044900 045000 PERFORM LOAD-CATEGORY-NAME. 045100 045200 MOVE WORK-AMOUNT TO PRINT-AMOUNT. 045300 045400 MOVE DETAIL-LINE TO PRINTER-RECORD. 045500 PERFORM WRITE-TO-PRINTER. 045600 MOVE SPACE TO DETAIL-LINE. 045700 045800 LOAD-CATEGORY-NAME. 045900 SET CATEGORY-INDEX TO 1. 046000 SEARCH CATEGORY-TABLE 046100 AT END 046200 MOVE "NOT FOUND" TO TOTAL-NAME 046300 WHEN 046400 CATEGORY-NUMBER(CATEGORY-INDEX) = 046500 WORK-CATEGORY 046600 MOVE CATEGORY-NAME(CATEGORY-INDEX) TO 046700 PRINT-CATEGORY-NAME. 046800 046900* PRINTING ROUTINES 047000 WRITE-TO-PRINTER. 047100 WRITE PRINTER-RECORD BEFORE ADVANCING 1. 047200 ADD 1 TO LINE-COUNT. 047300 047400 LINE-FEED. 047500 MOVE SPACE TO PRINTER-RECORD. 047600 PERFORM WRITE-TO-PRINTER. 047700 047800 START-NEXT-PAGE. 047900 PERFORM END-LAST-PAGE. 048000 PERFORM START-NEW-PAGE. 048100 048200 START-NEW-PAGE. 048300 ADD 1 TO PAGE-NUMBER. 048400 MOVE PAGE-NUMBER TO PRINT-PAGE-NUMBER. 048500 MOVE TITLE-LINE TO PRINTER-RECORD. 048600 PERFORM WRITE-TO-PRINTER. 048700 PERFORM LINE-FEED. 048800 MOVE LEGEND-LINE TO PRINTER-RECORD. 048900 PERFORM WRITE-TO-PRINTER. 049000 PERFORM LINE-FEED. 049100 MOVE COLUMN-LINE TO PRINTER-RECORD. 049200 PERFORM WRITE-TO-PRINTER. 049300 PERFORM LINE-FEED. 049400 049500 END-LAST-PAGE. 049600 IF PAGE-NUMBER > 0 049700 PERFORM FORM-FEED. 049800 MOVE ZERO TO LINE-COUNT. 049900 050000 FORM-FEED. 050100 MOVE SPACE TO PRINTER-RECORD. 050200 WRITE PRINTER-RECORD BEFORE ADVANCING PAGE. 050300 050400*-------------------------------- 050500* Read first, read next routines 050600*-------------------------------- 050700 READ-FIRST-VALID-WORK. 050800 PERFORM READ-NEXT-VALID-WORK. 050900 051000 READ-NEXT-VALID-WORK. 051100 PERFORM READ-NEXT-WORK-RECORD. 051200 051300 READ-NEXT-WORK-RECORD. 051400 MOVE "N" TO WORK-FILE-AT-END. 051500 READ WORK-FILE NEXT RECORD 051600 AT END MOVE "Y" TO WORK-FILE-AT-END. 051700
OUTPUT:
SALES REPORT PAGE: 1
STORE: 1
DIVISION DEPARTMENT CATEGORY AMOUNT
1 1 1 WEIGHTS 237.57
2 MACHINES 475.14
DEPT 1 EXERCISE TOTAL 712.71
2 3 SUN GLASSES 712.71
4 VITAMINS 50.28
DEPT 2 MISCELLANEOUS TOTAL 762.99
DIVISION 1 ATHLETICS TOTAL 1,475.70
2 3 5 MEN'S CLOTHES 287.85
6 WOMEN'S CLOTHES 525.42
DEPT 3 SPORT CLOTHES TOTAL 813.27
4 7 TENNIS 762.99
8 SOCCER 100.56
DEPT 4 EQUIPMENT TOTAL 863.55
DIVISION 2 SPORTING GOODS TOTAL 1,676.82
3 5 9 TENTS 338.13
10 SLEEPING BAGS 575.70
DEPT 5 CAMP EQUIPMENT TOTAL 913.83
6 11 CLOTHING 86.73-
12 HIKING BOOTS 150.84
DEPT 6 CAMPING CLOTHES TOTAL 64.11
DIVISION 3 CAMPING TOTAL 977.94
STORE 1 TOTAL 4,130.46
SALES REPORT PAGE: 2
STORE: 2
DIVISION DEPARTMENT CATEGORY AMOUNT
1 1 1 WEIGHTS 388.41
2 MACHINES 625.98
DEPT 1 EXERCISE TOTAL 1,014.39
2 3 SUN GLASSES 36.45-
4 VITAMINS 201.12
DEPT 2 MISCELLANEOUS TOTAL 164.67
DIVISION 1 ATHLETICS TOTAL 1,179.06
2 3 5 MEN'S CLOTHES 438.69
6 WOMEN'S CLOTHES 676.26
DEPT 3 SPORT CLOTHES TOTAL 1,114.95
4 7 TENNIS 13.83
8 SOCCER 251.40
DEPT 4 EQUIPMENT TOTAL 265.23
DIVISION 2 SPORTING GOODS TOTAL 1,380.18
3 5 9 TENTS 488.97
10 SLEEPING BAGS 726.54
DEPT 5 CAMP EQUIPMENT TOTAL 1,215.51
6 11 CLOTHING 64.11
12 HIKING BOOTS 301.68
DEPT 6 CAMPING CLOTHES TOTAL 365.79
DIVISION 3 CAMPING TOTAL 1,581.30
STORE 2 TOTAL 4,140.54
SALES REPORT PAGE: 3
STORE: 3
DIVISION DEPARTMENT CATEGORY AMOUNT
1 1 1 WEIGHTS 539.25
2 MACHINES 776.82
DEPT 1 EXERCISE TOTAL 1,316.07
2 3 SUN GLASSES 114.39
4 VITAMINS 351.96
DEPT 2 MISCELLANEOUS TOTAL 466.35
DIVISION 1 ATHLETICS TOTAL 1,782.42
2 3 5 MEN'S CLOTHES 589.53
6 WOMEN'S CLOTHES 72.90-
DEPT 3 SPORT CLOTHES TOTAL 516.63
4 7 TENNIS 164.67
8 SOCCER 402.24
DEPT 4 EQUIPMENT TOTAL 566.91
DIVISION 2 SPORTING GOODS TOTAL 1,083.54
3 5 9 TENTS 639.81
10 SLEEPING BAGS 22.62-
DEPT 5 CAMP EQUIPMENT TOTAL 617.19
6 11 CLOTHING 214.95
12 HIKING BOOTS 452.52
DEPT 6 CAMPING CLOTHES TOTAL 667.47
DIVISION 3 CAMPING TOTAL 1,284.66
STORE 3 TOTAL 4,150.62
SALES REPORT PAGE: 4
STORE: 4
DIVISION DEPARTMENT CATEGORY AMOUNT
1 1 1 WEIGHTS 690.09
2 MACHINES 27.66
DEPT 1 EXERCISE TOTAL 717.75
2 3 SUN GLASSES 265.23
4 VITAMINS 502.80
DEPT 2 MISCELLANEOUS TOTAL 768.03
DIVISION 1 ATHLETICS TOTAL 1,485.78
2 3 5 MEN'S CLOTHES 740.37
6 WOMEN'S CLOTHES 77.94
DEPT 3 SPORT CLOTHES TOTAL 818.31
4 7 TENNIS 315.51
8 SOCCER 553.08
DEPT 4 EQUIPMENT TOTAL 868.59
DIVISION 2 SPORTING GOODS TOTAL 1,686.90
3 5 9 TENTS 790.65
10 SLEEPING BAGS 128.22
DEPT 5 CAMP EQUIPMENT TOTAL 918.87
6 11 CLOTHING 365.79
12 HIKING BOOTS 603.36
DEPT 6 CAMPING CLOTHES TOTAL 969.15
DIVISION 3 CAMPING TOTAL 1,888.02
STORE 4 TOTAL 5,060.70
SALES REPORT PAGE: 5
STORE: 5
DIVISION DEPARTMENT CATEGORY AMOUNT
1 1 1 WEIGHTS 59.07-
2 MACHINES 178.50
DEPT 1 EXERCISE TOTAL 119.43
2 3 SUN GLASSES 416.07
4 VITAMINS 653.64
DEPT 2 MISCELLANEOUS TOTAL 1,069.71
DIVISION 1 ATHLETICS TOTAL 1,189.14
2 3 5 MEN'S CLOTHES 8.79-
6 WOMEN'S CLOTHES 228.78
DEPT 3 SPORT CLOTHES TOTAL 219.99
4 7 TENNIS 466.35
8 SOCCER 703.92
DEPT 4 EQUIPMENT TOTAL 1,170.27
DIVISION 2 SPORTING GOODS TOTAL 1,390.26
3 5 9 TENTS 41.49
10 SLEEPING BAGS 279.06
DEPT 5 CAMP EQUIPMENT TOTAL 320.55
6 11 CLOTHING 516.63
12 HIKING BOOTS 754.20
DEPT 6 CAMPING CLOTHES TOTAL 1,270.83
DIVISION 3 CAMPING TOTAL 1,591.38
STORE 5 TOTAL 4,170.78
SALES REPORT PAGE: 6
STORE: 6
DIVISION DEPARTMENT CATEGORY AMOUNT
1 1 1 WEIGHTS 91.77
2 MACHINES 329.34
DEPT 1 EXERCISE TOTAL 421.11
2 3 SUN GLASSES 566.91
4 VITAMINS 95.52-
DEPT 2 MISCELLANEOUS TOTAL 471.39
DIVISION 1 ATHLETICS TOTAL 892.50
2 3 5 MEN'S CLOTHES 142.05
6 WOMEN'S CLOTHES 379.62
DEPT 3 SPORT CLOTHES TOTAL 521.67
4 7 TENNIS 617.19
8 SOCCER 45.24-
DEPT 4 EQUIPMENT TOTAL 571.95
DIVISION 2 SPORTING GOODS TOTAL 1,093.62
3 5 9 TENTS 192.33
10 SLEEPING BAGS 429.90
DEPT 5 CAMP EQUIPMENT TOTAL 622.23
6 11 CLOTHING 667.47
12 HIKING BOOTS 5.04
DEPT 6 CAMPING CLOTHES TOTAL 672.51
DIVISION 3 CAMPING TOTAL 1,294.74
STORE 6 TOTAL 3,280.86
GRAND TOTAL 24,933.96
ANALYSIS: The tables for THE-DIVISIONS, THE-DEPARTMENTS, and THE-CATEGORIES are defined at lines 006800, 008100, and 010000, respectively.
The division name is loaded in the END-ONE-DIVISION as part of PRINT-DIVISION-TOTAL at line 036800. This paragraph performs LOAD-DIVISION-NAME at line 037400. LOAD-DIVISION-NAME at line 038000 uses the SEARCH verb to locate the division name using the CURRENT-DIVISION.
The department name is loaded using similar logic in the END-ONE-DEPARTMENT as part of PRINT-DEPARTMENT-TOTAL at line 041200. This paragraph performs LOAD-DEPARTMENT-NAME at line 042400. LOAD-DEPARTMENT-NAME at line 042400 uses the SEARCH verb to locate the department name using the CURRENT-DEPARTMENT.
The category name is loaded in the detail printing as part of PRINT-THE-RECORD at line 044700. This paragraph performs LOAD-CATEGORY-NAME at line 045000. LOAD-CATEGORY-NAME at line 045800 uses the SEARCH verb to locate the category name using the CURRENT-CATEGORY.
Code, compile, and run slsrpt03.cbl to see these internal tables being used to fill in the names.
The STRING verb can be used to combine several fields into one by appending the input fields end to end.
New Term: The action of appending fields one behind the other into a single field is called concatenation.
In Figure B2.2, 30 bytes have been used to define three variables, each containing a ten-character portion of a name.
Figure B2.2.
Three separate name fields.
The data definition for the fields described in Figure B2.2 is illustrated in Listing B2.7.
000900 01 THE-NAME 001000 05 LAST-NAME PIC X(10). 001100 05 FIRST-NAME PIC X(10). 001200 05 MIDDLE-NAME PIC X(10).
If these fields were printed by moving them to print fields, as shown in Listing B2.8, the resulting printed name would contain all the extra spaces at the end of each name.
001300 01 DETAIL-LINE. 001400 05 PRINT-FIRST PIC X(10). 001500 05 FILLER PIC X(1). 001600 05 PRINT-MIDDLE PIC X(10). 001700 05 FILLER PIC X(1). 001800 05 PRINT-LAST PIC X(10). ....... 010300 MOVE SPACE TO DETAIL-LINE. 010400 MOVE FIRST-NAME TO PRINT-FIRST. 010500 MOVE MIDDLE-NAME TO PRINT-MIDDLE. 010600 MOVE LAST-NAME TO PRINT-MIDDLE. 010700 PERFORM PRINT-DETAIL-LINE.
OUTPUT:
JOHN PAUL JONES
A better approach is to use the STRING verb. This can be used to concatenate all three fields, ignoring the spaces in each field. A STRING verb will combine two or more fields into a destination field. The input fields may be truncated by a value used to specify that the STRING action is to stop at a specific character. The input field may also be included by its full length. This is the STRING syntax:
STRING
value
DELIMITED BY delimiter
value
DELIMITED BY delimiter
INTO variable.
The following is an example:
STRING
FIRST-NAME
DELIMITED BY SPACE
LAST-NAME
DELIMITED BY SPACE
INTO FULL-NAME.
The output of the code fragment in Listing B2.9 is better, but now we have eliminated all spaces.
001300 01 DETAIL-LINE. 001400 05 PRINT-WHOLE-NAME PIC X(30). ....... 010300 MOVE SPACE TO DETAIL-LINE. 010400 STRING 010500 FIRST-NAME DELIMITED BY SPACE 010600 MIDDLE-NAME DELIMITED BY SPACE 010700 LAST-NAME DELIMITED BY SPACE 010800 INTO PRINT-WHOLE-NAME. 010900 PERFORM PRINT-DETAIL-LINE.
OUTPUT:
JOHNPAULJONES
ANALYSIS: The STRING must add spaces to break the fields apart. PRINT-WHOLE-NAME is increased to accommodate a name that fills all 30 spaces and also needs the two extra spaces to separate the names. In Listing B2.10 at lines 010600 and 010800, a space is inserted between each field.
001300 01 DETAIL-LINE. 001400 05 PRINT-WHOLE-NAME PIC X(32). ....... 010300 MOVE SPACE TO DETAIL-LINE. 010400 STRING 010500 FIRST-NAME DELIMITED BY SPACE 010600 " " DELIMITED BY SIZE 010700 MIDDLE-NAME DELIMITED BY SPACE 010800 " " DELIMITED BY SIZE 010900 LAST-NAME DELIMITED BY SPACE 011000 INTO PRINT-WHOLE-NAME. 011100 PERFORM PRINT-DETAIL-LINE.
OUTPUT:
JOHN PAUL JONES
The STRING verb frequently is used to format names to print envelopes and for other mailing list activities.
As indicated by the name, the UNSTRING verb does the opposite of the STRING verb, enabling you to break a single field on a specific character into several separate fields. It is used less often than the STRING verb. The following is the UNSTRING syntax:
UNSTRING variable
DELIMITED BY [ALL] delimiter
[ OR [ALL] delimiter ]
INTO variable . . .
Here is an example:
UNSTRING INPUT-DATA
DELIMITED BY SPACE
INTO FIRST-NAME
LAST-NAME
UNSTRING can be used to make data entry seem more natural and then break the results into separate fields. Listing B2.11 is an example of using UNSTRING.
001100 01 INPUT-DATA PIC X(50). 001200 001300 01 FORMATTED-NAME. 001400 05 FIRST-NAME PIC X(25). 001500 05 LAST-NAME PIC X(25). ...... 010700 DISPLAY "ENTER FIRST AND LAST NAMES". 010800 DISPLAY "WITH A SPACE BETWEEN THE NAMES". 010900 ACCEPT INPUT-DATA. 011000 MOVE SPACE TO FORMATTED-NAME. 011100 UNSTRING INPUT-DATA 011200 DELIMITED BY ALL SPACE 011300 INTO FIRST-NAME 011400 LAST-NAME. 011500
The INSPECT verb, which you used to convert lowercase to uppercase, has two other formats.
INSPECT can be used to count characters in a field. In the following example, SLASH-COUNTER (if it starts with a zero value) will contain the number of / characters that appear in DATE-FIELD. Here is the syntax:
INSPECT variable
TALLYING counter
FOR [ALL] character
and the example:
INSPECT DATE-FIELD
TALLYING SLASH-COUNTER
FOR ALL "/"
The second version of INSPECT is more useful. INSPECT can be used to convert a single character in much the same way it is used to convert multiple characters. Multiple characters are converted by using INSPECT CONVERTING; a single character is converted by using INSPECT REPLACING. This is the syntax:
INSPECT variable REPLACING [ALL] character BY character.
and the example:
INSPECT FORMATTED-DATE
REPLACING ALL
"/" BY "-"
This version can be used to change formatting characters after a value has been moved into an edited field. In Listing B2.12, the date is changed to display with dashes instead of slashes.
000900 01 FORMATTED-DATE PIC Z9/99/9999. 001000 01 DATE-MMDDCCYY PIC 9(8). ...... 010100 MOVE 02141995 TO DATE-MMDDCCYY. 010200 MOVE DATE-MMDDCCYY TO FORMATTED-DATE. 010300 DISPLAY FORMATTED-DATE. 010400 INSPECT FORMATTED-DATE 010500 REPLACING ALL "\" BY "-". 010600 DISPLAY FORMATTED-DATE.
OUTPUT: The output of Listing B2.12 illustrates the date format, before and after the INSPECT is used to change the formatting characters:
2/14/1995 2-14-1995
The CALL verb is used to execute one COBOL program from within another. In Day 18, "Calling Other Programs," you used the CALL verb to build a menu that executed different programs. In those and subsequent examples, there was no way for the called and calling program to share information. The DATA DIVISION of both the called and calling program were separate from each other, and neither program could access variables in the other program.
It is possible to CALL a program and pass it a variable from the calling program with this syntax:
CALL "TIMEDIT"
USING variable
[variable . . ]
The following is an example:
CALL "TIMEDIT"
USING TIME-HHMMSS
FORMATTED-TIME
ZERO-TIME-IS-OK
The calling program, the program that passes the value to another program, contains the definition of the data to be passed in WORKING-STORAGE just like any other data item. The variable can be shared by the calling and called program, but the variable really exists only in the DATA DIVISION of the calling program. The USING phrase in CALL USING is really a signal to the compiler that a value must be passed to let the called program know where the variables exist in the calling program.
The called program must receive the value. The definition of the data item in a called program is a bit more complicated. Variables that exist in a calling program but are used in a called program are defined in a special section of the DATA DIVISION in the called program. This is the LINKAGE SECTION, and an example is shown starting at line 002100 in Listing B2.13.
001000 DATA DIVISION. 001100 FILE SECTION. 001200 001300 WORKING-STORAGE SECTION. 001400 001500 77 VALID-TIME-FLAG PIC X. 001600 88 TIME-IS-INVALID VALUE "N". 001700 88 TIME-IS-ZERO VALUE "0". 001800 88 TIME-IS-VALID VALUE "Y". 001900 88 TIME-IS-OK VALUES "Y" "0". 002000 002100 LINKAGE SECTION. 002200*-------------------------------- 002300* Fields passed for TIME routines. 002400*-------------------------------- 002500 77 FORMATTED-TIME PIC Z9/99/99. 002600 002700 01 TIME-HHMMSS PIC 9(6). 002800 01 FILLER REDEFINES TIME-HHMMSS. 002900 05 TIME-HH PIC 99. 003000 05 TIME-MM PIC 99. 003100 05 TIME-SS PIC 99. 003200 003300 77 ZERO-TIME-IS-OK PIC X VALUE "N". 003400
ANALYSIS: The LINKAGE SECTION starts at line 002100. It contains a description of the data that is expected to be passed by the calling program. The LINKAGE SECTION is used by the called program as a description of the variables that are passed by the calling program. However, variables defined in the LINKAGE SECTION do not exist in the called program; they exist in the calling program.
For example, at line 002700, TIME-HHMMSS is defined as a PIC 9(6). This indicates that 6 bytes of data that are passed by the calling program are to be treated as a PIC 9(6) in the called program. The called program will use the name TIME-HHMMSS as the name of these 6 bytes. These 6 bytes could be passed to a called program that used the value to format a formatted time for display, or to be printed at the top of a report along with the date to indicate the date and time that report was run.
One other thing that a called program must do is name the variables that are passed from the calling program in the order in which they are passed. This is taken care of by adding USING to the PROCEDURE DIVISION of a called program, as shown in Listing B2.14.
003500 PROCEDURE DIVISION 003600 USING TIME-HHMMSS FORMATTED-TIME 003700 ZERO-TIME-IS-OK. 003800
ANALYSIS: At lines 003500-003700, the PROCEDURE DIVISION is extended by adding a USING list. The USING list in the called program must match, in sequence, the variables passed in the CALL USING list of the calling program.
Listing B2.15 is a program to enter time values and display them. Instead of doing the data entry and validation in the program, it calls another program to do this.
000100 IDENTIFICATION DIVISION. 000200 PROGRAM-ID. TIME02. 000300*-------------------------------- 000400* Testing Time Entry and handling 000500*-------------------------------- 000600 ENVIRONMENT DIVISION. 000700 INPUT-OUTPUT SECTION. 000800 FILE-CONTROL. 000900 001000 DATA DIVISION. 001100 FILE SECTION. 001200 001300 WORKING-STORAGE SECTION. 001400 001500 77 ANY-TIME PIC 9(6) VALUE ZEROES. 001600 001700 77 ANY-FORMATTED PIC X(8). 001800 001900 77 FORMATTED-TIME PIC Z9/99/99. 002000 002100 77 THE-TIME PIC 9(6). 002200 002300 77 ZERO-IS-OK PIC X VALUE "N". 002400 002500 PROCEDURE DIVISION. 002600 PROGRAM-BEGIN. 002700 PERFORM OPENING-PROCEDURE. 002800 PERFORM MAIN-PROCESS. 002900 PERFORM CLOSING-PROCEDURE. 003000 003100 PROGRAM-EXIT. 003200 EXIT PROGRAM. 003300 003400 PROGRAM-DONE. 003500 STOP RUN. 003600 003700 OPENING-PROCEDURE. 003800 003900 CLOSING-PROCEDURE. 004000 004100 MAIN-PROCESS. 004200 PERFORM GET-ANY-TIME. 004300 PERFORM DISPLAY-AND-GET-ANY-TIME 004400 UNTIL ANY-TIME = 000001. 004500 004600 GET-ANY-TIME. 004700 MOVE "Y" TO ZERO-IS-OK. 004800 PERFORM GET-THE-TIME. 004900 MOVE THE-TIME TO ANY-TIME. 005000 MOVE FORMATTED-TIME TO ANY-FORMATTED. 005100 005200 GET-THE-TIME. 005300 CALL "TIMEDIT" USING 005400 THE-TIME FORMATTED-TIME 005500 ZERO-IS-OK. 005600 005700 DISPLAY-AND-GET-ANY-TIME. 005800 PERFORM DISPLAY-THE-TIME. 005900 PERFORM GET-ANY-TIME. 006000 006100 DISPLAY-THE-TIME. 006200 DISPLAY "ANY TIME IS " ANY-FORMATTED. 006300
ANALYSIS: The time02.cbl program calls timedit.cbl to do the data entry and testing of the field. The two programs must pass three values back and forth between the called and calling program.
The first is a field that will hold the time as a six-digit number when the data entry is completed. This field is filled in by timedit.cbl during the data entry process. The second field is a formatted version of the time. This field also is filled in by timedit.cbl and returned to time02.cbl. The third field is filled by time02.cbl and is a flag indicating whether timedit.cbl should accept a time entry of zeroes.
These variables are all defined in the WORKING-STORAGE section of time02.cbl at lines 001900, 002100, and 002300. The values are passed to timedit.cbl at lines 005300-005500.
Listing B2.16 is the called program. It has a LINKAGE SECTION in the DATA DIVISION.
000100 IDENTIFICATION DIVISION. 000200 PROGRAM-ID. TIMEDIT. 000300*-------------------------------- 000400* TIME ENTRY AND VALIDATION SUB PROGRAM 000500*-------------------------------- 000600 ENVIRONMENT DIVISION. 000700 INPUT-OUTPUT SECTION. 000800 FILE-CONTROL. 000900 001000 DATA DIVISION. 001100 FILE SECTION. 001200 001300 WORKING-STORAGE SECTION. 001400 001500 77 VALID-TIME-FLAG PIC X. 001600 88 TIME-IS-INVALID VALUE "N". 001700 88 TIME-IS-ZERO VALUE "0". 001800 88 TIME-IS-VALID VALUE "Y". 001900 88 TIME-IS-OK VALUES "Y" "0". 002000 002100 LINKAGE SECTION. 002200*-------------------------------- 002300* Fields passed for TIME routines. 002400*-------------------------------- 002500 77 FORMATTED-TIME PIC Z9/99/99. 002600 002700 01 TIME-HHMMSS PIC 9(6). 002800 01 FILLER REDEFINES TIME-HHMMSS. 002900 05 TIME-HH PIC 99. 003000 05 TIME-MM PIC 99. 003100 05 TIME-SS PIC 99. 003200 003300 77 ZERO-TIME-IS-OK PIC X VALUE "N". 003400 003500 PROCEDURE DIVISION 003600 USING TIME-HHMMSS FORMATTED-TIME 003700 ZERO-TIME-IS-OK. 003800 003900 PROGRAM-BEGIN. 004000 PERFORM OPENING-PROCEDURE. 004100 PERFORM MAIN-PROCESS. 004200 PERFORM CLOSING-PROCEDURE. 004300 004400 PROGRAM-EXIT. 004500 EXIT PROGRAM. 004600 004700 PROGRAM-DONE. 004800 STOP RUN. 004900 005000 OPENING-PROCEDURE. 005100 005200 CLOSING-PROCEDURE. 005300 005400 MAIN-PROCESS. 005500 PERFORM GET-A-TIME. 005600 005700 GET-A-TIME. 005800 PERFORM ACCEPT-A-TIME. 005900 PERFORM RE-ACCEPT-A-TIME 006000 UNTIL TIME-IS-OK. 006100 006200 ACCEPT-A-TIME. 006300 DISPLAY "ENTER A TIME (HH:MM:SS)". 006400 006500 ACCEPT FORMATTED-TIME. 006600 006700 PERFORM EDIT-CHECK-TIME. 006800 006900 RE-ACCEPT-A-TIME. 007000 DISPLAY "INVALID TIME". 007100 007200 PERFORM ACCEPT-A-TIME. 007300 007400 EDIT-CHECK-TIME. 007500 PERFORM EDIT-TIME. 007600 PERFORM CHECK-TIME. 007700 PERFORM FORMAT-THE-TIME. 007800 007900 EDIT-TIME. 008000 MOVE FORMATTED-TIME TO TIME-HHMMSS. 008100 008200 CHECK-TIME. 008300 MOVE "Y" TO VALID-TIME-FLAG. 008400 IF TIME-HHMMSS = ZEROES 008500 IF ZERO-TIME-IS-OK = "Y" 008600 MOVE "0" TO VALID-TIME-FLAG 008700 ELSE 008800 MOVE "N" TO VALID-TIME-FLAG 008900 ELSE 009000 IF TIME-HH > 24 009100 MOVE "N" TO VALID-TIME-FLAG 009200 ELSE 009300 IF TIME-MM > 59 009400 MOVE "N" TO VALID-TIME-FLAG 009500 ELSE 009600 IF TIME-SS > 59 009700 MOVE "N" TO VALID-TIME-FLAG 009800 ELSE 009900 IF TIME-HHMMSS > 240000 010000 MOVE "N" TO VALID-TIME-FLAG. 010100 010200 FORMAT-THE-TIME. 010300 MOVE TIME-HHMMSS TO FORMATTED-TIME. 010400 INSPECT FORMATTED-TIME 010500 REPLACING ALL "/" BY ":". 010600
OUTPUT:
The output of the combined time02.cbl and timedit.cbl shows the two programs working together. Each line of output is marked to indicate which program is doing the work:
ENTER A TIME (HH:MM:SS) timedit.cbl 111495 user entry still in timedit.cbl INVALID TIME error message from timedit.cbl ENTER A TIME (HH:MM:SS) still in timedit.cbl 111435 user tries again in timedit.cbl ANY TIME IS 11:14:35 displayed in time02.cbl ENTER A TIME (HH:MM:SS) back in timedit.cbl
ANALYSIS: The entries in the LINKAGE SECTION at lines 002500, 002700, and 003300 describe three variables that are expected to be passed from the calling program. The variables don't have to have the same names, but they must be the same size (same number of bytes).
After the "shape" of the variables is described in the LINKAGE SECTION, the PROCEDURE DIVISION at lines 003500-003700 lists the values that are passed from the calling program.
If you compare this list with lines 005300-005500 in time02.cbl, Listing B2.15, you will find that the variables match in length.
The first variable is a 6-byte field called THE-TIME in time02.cbl and TIME-HHMMSS in timedit.cbl. The second variable is an 8-byte edited field called FORMATTED-TIME in both programs. The third field is a single byte called ZERO-IS-OK in time02.cbl and ZERO-TIME-IS-OK in timedit.cbl.
The timedit.cbl program is a fairly straightforward program that accepts data entry of a time field and checks whether it is valid. If the passed flag indicates that a zero entry is OK, the program allows the user to enter zeroes; otherwise, it forces an entry of a valid time in the range of 000001-240000.
One notable piece of code appears at lines 010300-010500 and uses the INSPECT REPLACING verb to convert the slashes (/) in the formatted field to colons (:), which are more appropriate for time formatting (for example, 11:14:29).
Code and compile time02.cbl and timedit.cbl and link them if necessary. Run time02.cbl and see that the called program timedit.cbl is correctly entering and validating the time fields. Enter a value of 1 for the time to stop the program.
Usually, the ACCEPT verb is used to receive input keyboard information into a field. The ACCEPT verb has an implied KEYBOARD as the device from which information is being accepted:
ACCEPT INPUT-DATA [FROM KEYBOARD].
You also may accept data from the computer's internal system clock. This clock provides at least two pieces of information that you might want in a program: today's date and the current time. To extract the date, you must ACCEPT FROM DATE. To extract the time, ACCEPT FROM TIME. Use this syntax:
ACCEPT variable
FROM DATE
ACCEPT variable
FROM TIME
The following is an example:
ACCEPT TODAYS-DATE
FROM DATE
ACCEPT THE-TIME
FROM TIME.
The variable used for today's date must be defined as a PIC 9(6), and the date is returned in YYMMDD format. Another mechanism has been developed for 8-digit dates as the year 2000 approaches. The variable for the time must be a PIC 9(8), and the value returned is hours, minutes, seconds, and hundredths of seconds. The time used is a 24-hour clock, so 3:56 PM would be returned as 15560000.
System date and time can be used to identify the run date and time of a report, as shown in Listing B2.17, a code fragment that could be used in a report program.
000100 IDENTIFICATION DIVISION. 000200 PROGRAM-ID. SLSRPT04. 000300*-------------------------------- 000400* Print test sales data 000500*-------------------------------- 000600 ENVIRONMENT DIVISION. 000700 INPUT-OUTPUT SECTION. 000800 FILE-CONTROL. 000900 001000*-------------------------------- 001100* SLSALES.CBL 001200*-------------------------------- 001300 SELECT SALES-FILE 001400 ASSIGN TO "SALES" 001500 ORGANIZATION IS SEQUENTIAL. 001600 001700 SELECT WORK-FILE 001800 ASSIGN TO "WORK" 001900 ORGANIZATION IS SEQUENTIAL. 002000 002100 SELECT SORT-FILE 002200 ASSIGN TO "SORT". 002300 002400 SELECT PRINTER-FILE 002500 ASSIGN TO PRINTER 002600 ORGANIZATION IS LINE SEQUENTIAL. 002700 002800 DATA DIVISION. 002900 FILE SECTION. 003000 003100*-------------------------------- 003200* FDSALES.CBL 003300* Temporary daily sales file. 003400*-------------------------------- 003500 FD SALES-FILE 003600 LABEL RECORDS ARE STANDARD. 003700 01 SALES-RECORD. 003800 05 SALES-STORE PIC 9(2). 003900 05 SALES-DIVISION PIC 9(2). 004000 05 SALES-DEPARTMENT PIC 9(2). 004100 05 SALES-CATEGORY PIC 9(2). 004200 05 SALES-AMOUNT PIC S9(6)V99. 004300 004400 FD WORK-FILE 004500 LABEL RECORDS ARE STANDARD. 004600 01 WORK-RECORD. 004700 05 WORK-STORE PIC 9(2). 004800 05 WORK-DIVISION PIC 9(2). 004900 05 WORK-DEPARTMENT PIC 9(2). 005000 05 WORK-CATEGORY PIC 9(2). 005100 05 WORK-AMOUNT PIC S9(6)V99. 005200 005300 SD SORT-FILE 005400 LABEL RECORDS ARE STANDARD. 005500 01 SORT-RECORD. 005600 05 SORT-STORE PIC 9(2). 005700 05 SORT-DIVISION PIC 9(2). 005800 05 SORT-DEPARTMENT PIC 9(2). 005900 05 SORT-CATEGORY PIC 9(2). 006000 05 SORT-AMOUNT PIC S9(6)V99. 006100 006200 FD PRINTER-FILE 006300 LABEL RECORDS ARE OMITTED. 006400 01 PRINTER-RECORD PIC X(80). 006500 006600 WORKING-STORAGE SECTION. 006700 006800 01 THE-DIVISIONS. 006900 05 FILLER PIC 99 VALUE 01. 007000 05 FILLER PIC X(15) VALUE "ATHLETICS". 007100 05 FILLER PIC 99 VALUE 02. 007200 05 FILLER PIC X(15) VALUE "SPORTING GOODS". 007300 05 FILLER PIC 99 VALUE 03. 007400 05 FILLER PIC X(15) VALUE "CAMPING". 007500 01 FILLER REDEFINES THE-DIVISIONS. 007600 05 DIVISION-TABLE OCCURS 3 TIMES 007700 INDEXED BY DIVISION-INDEX. 007800 10 DIVISION-NUMBER PIC 99. 007900 10 DIVISION-NAME PIC X(15). 008000 008100 01 THE-DEPARTMENTS. 008200 05 FILLER PIC 99 VALUE 01. 008300 05 FILLER PIC X(15) VALUE "EXERCISE". 008400 05 FILLER PIC 99 VALUE 02. 008500 05 FILLER PIC X(15) VALUE "MISCELLANEOUS". 008600 05 FILLER PIC 99 VALUE 03. 008700 05 FILLER PIC X(15) VALUE "SPORT CLOTHES". 008800 05 FILLER PIC 99 VALUE 04. 008900 05 FILLER PIC X(15) VALUE "EQUIPMENT". 009000 05 FILLER PIC 99 VALUE 05. 009100 05 FILLER PIC X(15) VALUE "CAMP EQUIPMENT". 009200 05 FILLER PIC 99 VALUE 06. 009300 05 FILLER PIC X(15) VALUE "CAMPING CLOTHES". 009400 01 FILLER REDEFINES THE-DEPARTMENTS. 009500 05 DEPARTMENT-TABLE OCCURS 6 TIMES 009600 INDEXED BY DEPARTMENT-INDEX. 009700 10 DEPARTMENT-NUMBER PIC 99. 009800 10 DEPARTMENT-NAME PIC X(15). 009900 010000 01 THE-CATEGORIES. 010100 05 FILLER PIC 99 VALUE 01. 010200 05 FILLER PIC X(15) VALUE "WEIGHTS". 010300 05 FILLER PIC 99 VALUE 02. 010400 05 FILLER PIC X(15) VALUE "MACHINES". 010500 05 FILLER PIC 99 VALUE 03. 010600 05 FILLER PIC X(15) VALUE "SUN GLASSES". 010700 05 FILLER PIC 99 VALUE 04. 010800 05 FILLER PIC X(15) VALUE "VITAMINS". 010900 05 FILLER PIC 99 VALUE 05. 011000 05 FILLER PIC X(15) VALUE "MEN'S CLOTHES". 011100 05 FILLER PIC 99 VALUE 06. 011200 05 FILLER PIC X(15) VALUE "WOMEN'S CLOTHES". 011300 05 FILLER PIC 99 VALUE 07. 011400 05 FILLER PIC X(15) VALUE "TENNIS". 011500 05 FILLER PIC 99 VALUE 08. 011600 05 FILLER PIC X(15) VALUE "SOCCER". 011700 05 FILLER PIC 99 VALUE 09. 011800 05 FILLER PIC X(15) VALUE "TENTS". 011900 05 FILLER PIC 99 VALUE 10. 012000 05 FILLER PIC X(15) VALUE "SLEEPING BAGS". 012100 05 FILLER PIC 99 VALUE 11. 012200 05 FILLER PIC X(15) VALUE "CLOTHING". 012300 05 FILLER PIC 99 VALUE 12. 012400 05 FILLER PIC X(15) VALUE "HIKING BOOTS". 012500 01 FILLER REDEFINES THE-CATEGORIES. 012600 05 CATEGORY-TABLE OCCURS 12 TIMES 012700 INDEXED BY CATEGORY-INDEX. 012800 10 CATEGORY-NUMBER PIC 99. 012900 10 CATEGORY-NAME PIC X(15). 013000 013100 77 OK-TO-PROCESS PIC X. 013200 013300 COPY "WSCASE01.CBL". 013400 013500 01 LEGEND-LINE. 013600 05 FILLER PIC X(6) VALUE "STORE:". 013700 05 FILLER PIC X(1) VALUE SPACE. 013800 05 PRINT-STORE PIC Z9. 013900 014000 01 DETAIL-LINE. 014100 05 FILLER PIC X(3) VALUE SPACE. 014200 05 PRINT-DIVISION PIC Z9. 014300 05 FILLER PIC X(4) VALUE SPACE. 014400 05 FILLER PIC X(3) VALUE SPACE. 014500 05 PRINT-DEPARTMENT PIC Z9. 014600 05 FILLER PIC X(6) VALUE SPACE. 014700 05 FILLER PIC X(3) VALUE SPACE. 014800 05 PRINT-CATEGORY PIC Z9. 014900 05 FILLER PIC X(4) VALUE SPACE. 015000 05 PRINT-CATEGORY-NAME PIC X(15). 015100 05 FILLER PIC X(1) VALUE SPACE. 015200 05 PRINT-AMOUNT PIC ZZZ,ZZ9.99-. 015300 015400 01 COLUMN-LINE. 015500 05 FILLER PIC X(8) VALUE "DIVISION". 015600 05 FILLER PIC X(1) VALUE SPACE. 015700 05 FILLER PIC X(10) VALUE "DEPARTMENT". 015800 05 FILLER PIC X(1) VALUE SPACE. 015900 05 FILLER PIC X(8) VALUE "CATEGORY". 016000 05 FILLER PIC X(1) VALUE SPACE. 016100 05 FILLER PIC X(15) VALUE SPACE. 016200 05 FILLER PIC X(5) VALUE SPACE. 016300 05 FILLER PIC X(6) VALUE "AMOUNT". 016400 016500 01 TITLE-LINE. 016600 05 FILLER PIC X(4) VALUE "RUN:". 016700 05 FORMATTED-RUN-DATE PIC X(10). 016800 05 FILLER PIC X(4) VALUE " AT ". 016900 05 FORMATTED-RUN-TIME PIC X(8). 017000 05 FILLER PIC X(10) VALUE SPACE. 017100 05 FILLER PIC X(12) 017200 VALUE "SALES REPORT". 017300 05 FILLER PIC X(10) VALUE SPACE. 017400 05 FILLER PIC X(5) VALUE "PAGE:". 017500 05 FILLER PIC X(1) VALUE SPACE. 017600 05 PRINT-PAGE-NUMBER PIC ZZZ9. 017700 017800 01 TOTAL-LINE. 017900 05 FILLER PIC X(11) VALUE SPACE. 018000 05 TOTAL-TYPE PIC X(8). 018100 05 FILLER PIC X(1) VALUE SPACE. 018200 05 TOTAL-NUMBER PIC Z9. 018300 05 FILLER PIC X(1) VALUE SPACE. 018400 05 TOTAL-NAME PIC X(15) VALUE SPACE. 018500 05 FILLER PIC X(1) VALUE SPACE. 018600 05 TOTAL-LITERAL PIC X(5) VALUE "TOTAL". 018700 05 FILLER PIC X(1) VALUE SPACE. 018800 05 PRINT-TOTAL PIC ZZZ,ZZ9.99-. 018900 019000 77 GRAND-TOTAL-LITERAL PIC X(8) VALUE " GRAND". 019100 77 STORE-TOTAL-LITERAL PIC X(8) VALUE " STORE". 019200 77 DIVISION-TOTAL-LITERAL PIC X(8) VALUE "DIVISION". 019300 77 DEPARTMENT-TOTAL-LITERAL PIC X(8) VALUE " DEPT". 019400 019500 77 WORK-FILE-AT-END PIC X. 019600 019700 77 LINE-COUNT PIC 999 VALUE ZERO. 019800 77 PAGE-NUMBER PIC 9999 VALUE ZERO. 019900 77 MAXIMUM-LINES PIC 999 VALUE 55. 020000 020100 77 RECORD-COUNT PIC 9999 VALUE ZEROES. 020200 020300* Control break current values for store, division 020400* department. 020500 77 CURRENT-STORE PIC 99. 020600 77 CURRENT-DIVISION PIC 99. 020700 77 CURRENT-DEPARTMENT PIC 99. 020800 020900* Control break accumulators 021000* GRAND TOTAL is the level 1 accumulator for the whole file 021100* STORE TOTAL is the level 2 accumulator 021200* DIVISION TOTAL is the level 3 accumulator 021300* DEPARTMENT TOTAL is the level 4 accumulator. 021400 77 GRAND-TOTAL PIC S9(6)V99. 021500 77 STORE-TOTAL PIC S9(6)V99. 021600 77 DIVISION-TOTAL PIC S9(6)V99. 021700 77 DEPARTMENT-TOTAL PIC S9(6)V99. 021800 021900* System date and time 022000 77 RUN-DATE PIC 9(6). 022100 77 RUN-TIME PIC 9(8). 022200 022300*-------------------------------- 022400* Fields for date routines. 022500*-------------------------------- 022600 77 FORMATTED-DATE PIC Z9/99/9999. 022700 77 DATE-MMDDCCYY PIC 9(8). 022800 01 DATE-CCYYMMDD PIC 9(8). 022900 01 FILLER REDEFINES DATE-CCYYMMDD. 023000 05 DATE-CC PIC 99. 023100 05 DATE-YY PIC 99. 023200 05 DATE-MM PIC 99. 023300 05 DATE-DD PIC 99. 023400 023500*-------------------------------- 023600* Fields for TIME routines. 023700*-------------------------------- 023800 77 FORMATTED-TIME PIC Z9/99/99. 023900 024000 01 TIME-HHMMSS PIC 9(6). 024100 01 FILLER REDEFINES TIME-HHMMSS. 024200 05 TIME-HH PIC 99. 024300 05 TIME-MM PIC 99. 024400 05 TIME-SS PIC 99. 024500 024600 PROCEDURE DIVISION. 024700 PROGRAM-BEGIN. 024800 024900 PERFORM OPENING-PROCEDURE. 025000 PERFORM MAIN-PROCESS. 025100 PERFORM CLOSING-PROCEDURE. 025200 025300 PROGRAM-EXIT. 025400 EXIT PROGRAM. 025500 025600 PROGRAM-DONE. 025700 STOP RUN. 025800 025900 OPENING-PROCEDURE. 026000 026100 OPEN OUTPUT PRINTER-FILE. 026200 026300 MAIN-PROCESS. 026400 PERFORM GET-OK-TO-PROCESS. 026500 PERFORM PROCESS-THE-FILE 026600 UNTIL OK-TO-PROCESS = "N". 026700 026800 CLOSING-PROCEDURE. 026900 CLOSE PRINTER-FILE. 027000 027100 GET-OK-TO-PROCESS. 027200 PERFORM ACCEPT-OK-TO-PROCESS. 027300 PERFORM RE-ACCEPT-OK-TO-PROCESS 027400 UNTIL OK-TO-PROCESS = "Y" OR "N". 027500 027600 ACCEPT-OK-TO-PROCESS. 027700 DISPLAY "PRINT SALES REPORT (Y/N)?". 027800 ACCEPT OK-TO-PROCESS. 027900 INSPECT OK-TO-PROCESS 028000 CONVERTING LOWER-ALPHA 028100 TO UPPER-ALPHA. 028200 028300 RE-ACCEPT-OK-TO-PROCESS. 028400 DISPLAY "YOU MUST ENTER YES OR NO". 028500 PERFORM ACCEPT-OK-TO-PROCESS. 028600 028700 PROCESS-THE-FILE. 028800 PERFORM START-THE-FILE. 028900 PERFORM PRINT-ONE-REPORT. 029000 PERFORM END-THE-FILE. 029100 029200* PERFORM GET-OK-TO-PROCESS. 029300 MOVE "N" TO OK-TO-PROCESS. 029400 029500 START-THE-FILE. 029600 PERFORM SORT-DATA-FILE. 029700 OPEN INPUT WORK-FILE. 029800 029900 END-THE-FILE. 030000 CLOSE WORK-FILE. 030100 030200 SORT-DATA-FILE. 030300 SORT SORT-FILE 030400 ON ASCENDING KEY SORT-STORE 030500 ASCENDING KEY SORT-DIVISION 030600 ASCENDING KEY SORT-DEPARTMENT 030700 ASCENDING KEY SORT-CATEGORY 030800 USING SALES-FILE 030900 GIVING WORK-FILE. 031000 031100* LEVEL 1 CONTROL BREAK 031200 PRINT-ONE-REPORT. 031300 PERFORM START-ONE-REPORT. 031400 PERFORM PROCESS-ALL-STORES 031500 UNTIL WORK-FILE-AT-END = "Y". 031600 PERFORM END-ONE-REPORT. 031700 031800 START-ONE-REPORT. 031900 PERFORM READ-FIRST-VALID-WORK. 032000 MOVE ZEROES TO GRAND-TOTAL. 032100 032200 PERFORM START-NEW-REPORT. 032300 032400 START-NEW-REPORT. 032500 MOVE SPACE TO DETAIL-LINE. 032600 MOVE ZEROES TO LINE-COUNT PAGE-NUMBER. 032700 032800 ACCEPT RUN-DATE FROM DATE. 032900 MOVE RUN-DATE TO DATE-CCYYMMDD. 033000 IF DATE-YY > 90 033100 MOVE 19 TO DATE-CC 033200 ELSE 033300 MOVE 20 TO DATE-CC. 033400 033500 PERFORM FORMAT-THE-DATE. 033600 MOVE FORMATTED-DATE TO FORMATTED-RUN-DATE. 033700 033800 ACCEPT RUN-TIME FROM TIME. 033900 COMPUTE TIME-HHMMSS = RUN-TIME / 100. 034000 PERFORM FORMAT-THE-TIME. 034100 MOVE FORMATTED-TIME TO FORMATTED-RUN-TIME. 034200 034300 034400 END-ONE-REPORT. 034500 IF RECORD-COUNT = ZEROES 034600 MOVE "NO RECORDS FOUND" TO PRINTER-RECORD 034700 PERFORM WRITE-TO-PRINTER 034800 ELSE 034900 PERFORM PRINT-GRAND-TOTAL. 035000 035100 PERFORM END-LAST-PAGE. 035200 035300 PRINT-GRAND-TOTAL. 035400 MOVE SPACE TO TOTAL-LINE. 035500 MOVE GRAND-TOTAL TO PRINT-TOTAL. 035600 MOVE GRAND-TOTAL-LITERAL TO TOTAL-TYPE. 035700 MOVE "TOTAL" TO TOTAL-LITERAL. 035800 MOVE TOTAL-LINE TO PRINTER-RECORD. 035900 PERFORM WRITE-TO-PRINTER. 036000 PERFORM LINE-FEED 2 TIMES. 036100 MOVE SPACE TO DETAIL-LINE. 036200 036300* LEVEL 2 CONTROL BREAK 036400 PROCESS-ALL-STORES. 036500 PERFORM START-ONE-STORE. 036600 036700 PERFORM PROCESS-ALL-DIVISIONS 036800 UNTIL WORK-FILE-AT-END = "Y" 036900 OR WORK-STORE NOT = CURRENT-STORE. 037000 037100 PERFORM END-ONE-STORE. 037200 037300 START-ONE-STORE. 037400 MOVE WORK-STORE TO CURRENT-STORE. 037500 MOVE ZEROES TO STORE-TOTAL. 037600 MOVE WORK-STORE TO PRINT-STORE. 037700 037800 PERFORM START-NEXT-PAGE. 037900 038000 END-ONE-STORE. 038100 PERFORM PRINT-STORE-TOTAL. 038200 ADD STORE-TOTAL TO GRAND-TOTAL. 038300 038400 PRINT-STORE-TOTAL. 038500 MOVE SPACE TO TOTAL-LINE. 038600 MOVE STORE-TOTAL TO PRINT-TOTAL. 038700 MOVE CURRENT-STORE TO TOTAL-NUMBER. 038800 MOVE STORE-TOTAL-LITERAL TO TOTAL-TYPE. 038900 MOVE "TOTAL" TO TOTAL-LITERAL. 039000 MOVE TOTAL-LINE TO PRINTER-RECORD. 039100 PERFORM WRITE-TO-PRINTER. 039200 PERFORM LINE-FEED. 039300 MOVE SPACE TO DETAIL-LINE. 039400 039500* LEVEL 3 CONTROL BREAK 039600 PROCESS-ALL-DIVISIONS. 039700 PERFORM START-ONE-DIVISION. 039800 039900 PERFORM PROCESS-ALL-DEPARTMENTS 040000 UNTIL WORK-FILE-AT-END = "Y" 040100 OR WORK-STORE NOT = CURRENT-STORE 040200 OR WORK-DIVISION NOT = CURRENT-DIVISION. 040300 040400 PERFORM END-ONE-DIVISION. 040500 040600 START-ONE-DIVISION. 040700 MOVE WORK-DIVISION TO CURRENT-DIVISION. 040800 MOVE ZEROES TO DIVISION-TOTAL. 040900 MOVE WORK-DIVISION TO PRINT-DIVISION. 041000 041100 END-ONE-DIVISION. 041200 PERFORM PRINT-DIVISION-TOTAL. 041300 ADD DIVISION-TOTAL TO STORE-TOTAL. 041400 041500 PRINT-DIVISION-TOTAL. 041600 MOVE SPACE TO TOTAL-LINE. 041700 MOVE DIVISION-TOTAL TO PRINT-TOTAL. 041800 MOVE CURRENT-DIVISION TO TOTAL-NUMBER. 041900 MOVE DIVISION-TOTAL-LITERAL TO TOTAL-TYPE. 042000 MOVE "TOTAL" TO TOTAL-LITERAL. 042100 PERFORM LOAD-DIVISION-NAME. 042200 MOVE TOTAL-LINE TO PRINTER-RECORD. 042300 PERFORM WRITE-TO-PRINTER. 042400 PERFORM LINE-FEED. 042500 MOVE SPACE TO DETAIL-LINE. 042600 042700 LOAD-DIVISION-NAME. 042800 SET DIVISION-INDEX TO 1. 042900 SEARCH DIVISION-TABLE 043000 AT END 043100 MOVE "NOT FOUND" TO TOTAL-NAME 043200 WHEN 043300 DIVISION-NUMBER(DIVISION-INDEX) = 043400 CURRENT-DIVISION 043500 MOVE DIVISION-NAME(DIVISION-INDEX) TO 043600 TOTAL-NAME. 043700 043800* LEVEL 4 CONTROL BREAK 043900 PROCESS-ALL-DEPARTMENTS. 044000 PERFORM START-ONE-DEPARTMENT. 044100 044200 PERFORM PROCESS-ALL-CATEGORIES 044300 UNTIL WORK-FILE-AT-END = "Y" 044400 OR WORK-STORE NOT = CURRENT-STORE 044500 OR WORK-DIVISION NOT = CURRENT-DIVISION 044600 OR WORK-DEPARTMENT NOT = CURRENT-DEPARTMENT. 044700 044800 PERFORM END-ONE-DEPARTMENT. 044900 045000 START-ONE-DEPARTMENT. 045100 MOVE WORK-DEPARTMENT TO CURRENT-DEPARTMENT. 045200 MOVE ZEROES TO DEPARTMENT-TOTAL. 045300 MOVE WORK-DEPARTMENT TO PRINT-DEPARTMENT. 045400 045500 END-ONE-DEPARTMENT. 045600 PERFORM PRINT-DEPARTMENT-TOTAL. 045700 ADD DEPARTMENT-TOTAL TO DIVISION-TOTAL. 045800 045900 PRINT-DEPARTMENT-TOTAL. 046000 MOVE SPACE TO TOTAL-LINE. 046100 MOVE DEPARTMENT-TOTAL TO PRINT-TOTAL. 046200 MOVE CURRENT-DEPARTMENT TO TOTAL-NUMBER. 046300 MOVE DEPARTMENT-TOTAL-LITERAL TO TOTAL-TYPE. 046400 MOVE "TOTAL" TO TOTAL-LITERAL. 046500 PERFORM LOAD-DEPARTMENT-NAME. 046600 MOVE TOTAL-LINE TO PRINTER-RECORD. 046700 PERFORM WRITE-TO-PRINTER. 046800 PERFORM LINE-FEED. 046900 MOVE SPACE TO DETAIL-LINE. 047000 047100 LOAD-DEPARTMENT-NAME. 047200 SET DEPARTMENT-INDEX TO 1. 047300 SEARCH DEPARTMENT-TABLE 047400 AT END 047500 MOVE "NOT FOUND" TO TOTAL-NAME 047600 WHEN 047700 DEPARTMENT-NUMBER(DEPARTMENT-INDEX) = 047800 CURRENT-DEPARTMENT 047900 MOVE DEPARTMENT-NAME(DEPARTMENT-INDEX) TO 048000 TOTAL-NAME. 048100 048200* PROCESS ONE RECORD LEVEL 048300 PROCESS-ALL-CATEGORIES. 048400 PERFORM PROCESS-THIS-CATEGORY. 048500 ADD WORK-AMOUNT TO DEPARTMENT-TOTAL. 048600 ADD 1 TO RECORD-COUNT. 048700 PERFORM READ-NEXT-VALID-WORK. 048800 048900 PROCESS-THIS-CATEGORY. 049000 IF LINE-COUNT > MAXIMUM-LINES 049100 PERFORM START-NEXT-PAGE. 049200 PERFORM PRINT-THE-RECORD. 049300 049400 PRINT-THE-RECORD. 049500 MOVE WORK-CATEGORY TO PRINT-CATEGORY. 049600 049700 PERFORM LOAD-CATEGORY-NAME. 049800 049900 MOVE WORK-AMOUNT TO PRINT-AMOUNT. 050000 050100 MOVE DETAIL-LINE TO PRINTER-RECORD. 050200 PERFORM WRITE-TO-PRINTER. 050300 MOVE SPACE TO DETAIL-LINE. 050400 050500 LOAD-CATEGORY-NAME. 050600 SET CATEGORY-INDEX TO 1. 050700 SEARCH CATEGORY-TABLE 050800 AT END 050900 MOVE "NOT FOUND" TO TOTAL-NAME 051000 WHEN 051100 CATEGORY-NUMBER(CATEGORY-INDEX) = 051200 WORK-CATEGORY 051300 MOVE CATEGORY-NAME(CATEGORY-INDEX) TO 051400 PRINT-CATEGORY-NAME. 051500 051600* PRINTING ROUTINES 051700 WRITE-TO-PRINTER. 051800 WRITE PRINTER-RECORD BEFORE ADVANCING 1. 051900 ADD 1 TO LINE-COUNT. 052000 052100 LINE-FEED. 052200 MOVE SPACE TO PRINTER-RECORD. 052300 PERFORM WRITE-TO-PRINTER. 052400 052500 START-NEXT-PAGE. 052600 PERFORM END-LAST-PAGE. 052700 PERFORM START-NEW-PAGE. 052800 052900 START-NEW-PAGE. 053000 ADD 1 TO PAGE-NUMBER. 053100 MOVE PAGE-NUMBER TO PRINT-PAGE-NUMBER. 053200 MOVE TITLE-LINE TO PRINTER-RECORD. 053300 PERFORM WRITE-TO-PRINTER. 053400 PERFORM LINE-FEED. 053500 MOVE LEGEND-LINE TO PRINTER-RECORD. 053600 PERFORM WRITE-TO-PRINTER. 053700 PERFORM LINE-FEED. 053800 MOVE COLUMN-LINE TO PRINTER-RECORD. 053900 PERFORM WRITE-TO-PRINTER. 054000 PERFORM LINE-FEED. 054100 054200 END-LAST-PAGE. 054300 IF PAGE-NUMBER > 0 054400 PERFORM FORM-FEED. 054500 MOVE ZERO TO LINE-COUNT. 054600 054700 FORM-FEED. 054800 MOVE SPACE TO PRINTER-RECORD. 054900 WRITE PRINTER-RECORD BEFORE ADVANCING PAGE. 055000 055100*-------------------------------- 055200* Read first, read next routines 055300*-------------------------------- 055400 READ-FIRST-VALID-WORK. 055500 PERFORM READ-NEXT-VALID-WORK. 055600 055700 READ-NEXT-VALID-WORK. 055800 PERFORM READ-NEXT-WORK-RECORD. 055900 056000 READ-NEXT-WORK-RECORD. 056100 MOVE "N" TO WORK-FILE-AT-END. 056200 READ WORK-FILE NEXT RECORD 056300 AT END MOVE "Y" TO WORK-FILE-AT-END. 056400 056500* Date and time routines 056600 FORMAT-THE-DATE. 056700 PERFORM CONVERT-TO-MMDDCCYY. 056800 MOVE DATE-MMDDCCYY TO FORMATTED-DATE. 056900 057000 CONVERT-TO-MMDDCCYY. 057100 COMPUTE DATE-MMDDCCYY = 057200 DATE-CCYYMMDD * 10000.0001. 057300 057400 FORMAT-THE-TIME. 057500 MOVE TIME-HHMMSS TO FORMATTED-TIME. 057600 INSPECT FORMATTED-TIME 057700 REPLACING ALL "/" BY ":". 057800
OUTPUT:
The output of slsrpt04.cbl shows a run date and time printed at the top of the report with each title line:
RUN: 2/19/1997 AT 17:14:59 SALES REPORT PAGE: 1
STORE: 1
DIVISION DEPARTMENT CATEGORY AMOUNT
1 1 1 WEIGHTS 237.57
2 MACHINES 475.14
DEPT 1 EXERCISE TOTAL 712.71
2 3 SUN GLASSES 712.71
4 VITAMINS 50.28
DEPT 2 MISCELLANEOUS TOTAL 762.99
DIVISION 1 ATHLETICS TOTAL 1,475.70
2 3 5 MEN'S CLOTHES 287.85
6 WOMEN'S CLOTHES 525.42
DEPT 3 SPORT CLOTHES TOTAL 813.27
4 7 TENNIS 762.99
8 SOCCER 100.56
DEPT 4 EQUIPMENT TOTAL 863.55
DIVISION 2 SPORTING GOODS TOTAL 1,676.82
3 5 9 TENTS 338.13
10 SLEEPING BAGS 575.70
DEPT 5 CAMP EQUIPMENT TOTAL 913.83
6 11 CLOTHING 86.73-
12 HIKING BOOTS 150.84
DEPT 6 CAMPING CLOTHES TOTAL 64.11
DIVISION 3 CAMPING TOTAL 977.94
STORE 1 TOTAL 4,130.46
RUN: 2/19/1997 AT 17:14:59 SALES REPORT PAGE: 2
STORE: 2
DIVISION DEPARTMENT CATEGORY AMOUNT
1 1 1 WEIGHTS 388.41
2 MACHINES 625.98
DEPT 1 EXERCISE TOTAL 1,014.39
2 3 SUN GLASSES 36.45-
4 VITAMINS 201.12
DEPT 2 MISCELLANEOUS TOTAL 164.67
DIVISION 1 ATHLETICS TOTAL 1,179.06
2 3 5 MEN'S CLOTHES 438.69
6 WOMEN'S CLOTHES 676.26
DEPT 3 SPORT CLOTHES TOTAL 1,114.95
4 7 TENNIS 13.83
8 SOCCER 251.40
DEPT 4 EQUIPMENT TOTAL 265.23
DIVISION 2 SPORTING GOODS TOTAL 1,380.18
3 5 9 TENTS 488.97
10 SLEEPING BAGS 726.54
DEPT 5 CAMP EQUIPMENT TOTAL 1,215.51
6 11 CLOTHING 64.11
12 HIKING BOOTS 301.68
DEPT 6 CAMPING CLOTHES TOTAL 365.79
DIVISION 3 CAMPING TOTAL 1,581.30
STORE 2 TOTAL 4,140.54
RUN: 2/19/1997 AT 17:14:59 SALES REPORT PAGE: 3
STORE: 3
DIVISION DEPARTMENT CATEGORY AMOUNT
1 1 1 WEIGHTS 539.25
2 MACHINES 776.82
DEPT 1 EXERCISE TOTAL 1,316.07
2 3 SUN GLASSES 114.39
4 VITAMINS 351.96
DEPT 2 MISCELLANEOUS TOTAL 466.35
DIVISION 1 ATHLETICS TOTAL 1,782.42
2 3 5 MEN'S CLOTHES 589.53
6 WOMEN'S CLOTHES 72.90-
DEPT 3 SPORT CLOTHES TOTAL 516.63
4 7 TENNIS 164.67
8 SOCCER 402.24
DEPT 4 EQUIPMENT TOTAL 566.91
DIVISION 2 SPORTING GOODS TOTAL 1,083.54
3 5 9 TENTS 639.81
10 SLEEPING BAGS 22.62-
DEPT 5 CAMP EQUIPMENT TOTAL 617.19
6 11 CLOTHING 214.95
12 HIKING BOOTS 452.52
DEPT 6 CAMPING CLOTHES TOTAL 667.47
DIVISION 3 CAMPING TOTAL 1,284.66
STORE 3 TOTAL 4,150.62
RUN: 2/19/1997 AT 17:14:59 SALES REPORT PAGE: 4
STORE: 4
DIVISION DEPARTMENT CATEGORY AMOUNT
1 1 1 WEIGHTS 690.09
2 MACHINES 27.66
DEPT 1 EXERCISE TOTAL 717.75
2 3 SUN GLASSES 265.23
4 VITAMINS 502.80
DEPT 2 MISCELLANEOUS TOTAL 768.03
DIVISION 1 ATHLETICS TOTAL 1,485.78
2 3 5 MEN'S CLOTHES 740.37
6 WOMEN'S CLOTHES 77.94
DEPT 3 SPORT CLOTHES TOTAL 818.31
4 7 TENNIS 315.51
8 SOCCER 553.08
DEPT 4 EQUIPMENT TOTAL 868.59
DIVISION 2 SPORTING GOODS TOTAL 1,686.90
3 5 9 TENTS 790.65
10 SLEEPING BAGS 128.22
DEPT 5 CAMP EQUIPMENT TOTAL 918.87
6 11 CLOTHING 365.79
12 HIKING BOOTS 603.36
DEPT 6 CAMPING CLOTHES TOTAL 969.15
DIVISION 3 CAMPING TOTAL 1,888.02
STORE 4 TOTAL 5,060.70
RUN: 2/19/1997 AT 17:14:59 SALES REPORT PAGE: 5
STORE: 5
DIVISION DEPARTMENT CATEGORY AMOUNT
1 1 1 WEIGHTS 59.07-
2 MACHINES 178.50
DEPT 1 EXERCISE TOTAL 119.43
2 3 SUN GLASSES 416.07
4 VITAMINS 653.64
DEPT 2 MISCELLANEOUS TOTAL 1,069.71
DIVISION 1 ATHLETICS TOTAL 1,189.14
2 3 5 MEN'S CLOTHES 8.79-
6 WOMEN'S CLOTHES 228.78
DEPT 3 SPORT CLOTHES TOTAL 219.99
4 7 TENNIS 466.35
8 SOCCER 703.92
DEPT 4 EQUIPMENT TOTAL 1,170.27
DIVISION 2 SPORTING GOODS TOTAL 1,390.26
3 5 9 TENTS 41.49
10 SLEEPING BAGS 279.06
DEPT 5 CAMP EQUIPMENT TOTAL 320.55
6 11 CLOTHING 516.63
12 HIKING BOOTS 754.20
DEPT 6 CAMPING CLOTHES TOTAL 1,270.83
DIVISION 3 CAMPING TOTAL 1,591.38
STORE 5 TOTAL 4,170.78
RUN: 2/19/1997 AT 17:14:59 SALES REPORT PAGE: 6
STORE: 6
DIVISION DEPARTMENT CATEGORY AMOUNT
1 1 1 WEIGHTS 91.77
2 MACHINES 329.34
DEPT 1 EXERCISE TOTAL 421.11
2 3 SUN GLASSES 566.91
4 VITAMINS 95.52-
DEPT 2 MISCELLANEOUS TOTAL 471.39
DIVISION 1 ATHLETICS TOTAL 892.50
2 3 5 MEN'S CLOTHES 142.05
6 WOMEN'S CLOTHES 379.62
DEPT 3 SPORT CLOTHES TOTAL 521.67
4 7 TENNIS 617.19
8 SOCCER 45.24-
DEPT 4 EQUIPMENT TOTAL 571.95
DIVISION 2 SPORTING GOODS TOTAL 1,093.62
3 5 9 TENTS 192.33
10 SLEEPING BAGS 429.90
DEPT 5 CAMP EQUIPMENT TOTAL 622.23
6 11 CLOTHING 667.47
12 HIKING BOOTS 5.04
DEPT 6 CAMPING CLOTHES TOTAL 672.51
DIVISION 3 CAMPING TOTAL 1,294.74
STORE 6 TOTAL 3,280.86
GRAND TOTAL 24,933.96
ANALYSIS: At lines 016500-017600, TITLE-LINE has been modified to allow room for a run date and time.
Variables for extracting the date and time and formatting them are defined at lines 021900-024400. The extraction and formatting of the date and time are done in START-NEW-REPORT, which begins at line 032400.
At lines 032800 and 032900, RUN-DATE is accepted from DATE and moved to DATE-CCYYMMDD.
Because you accept the current date, the year portion of the date will come back as 94. When the year turns over, it will return as 95, and so on up to 1999. In the year 2000, the year portion of the date will come back as 00, then 01, and so on. The effect of this is that we have to assume that any year from 94 through 99 is 1994 through 1999. Sometime when the century turns, the years will start coming back as 00, 01, and so on. If the year is greater than 90, then the first two digits must be 19; otherwise, they are set to 20. This logic appears at lines 033000-033300. The date is formatted at line 033500 and then moved into the title line at line 033600. Of course, in about 110 years this program won't work correctly.
At line 033800, RUN-TIME is accepted from TIME. This time had hundredths that are not needed, so it is computed into TIME-HHMMSS by dividing it by 100. At lines 034000 and 034100, the time is formatted and moved into the title line.
Lines 056500-057700 contain the routines for formatting the date and time.
Numbers are stored in COBOL in several different ways. The methods used were chosen as compromises between speed of calculation and saving space in memory.
In all the programs you have worked on so far, you have used a type of storage called zoned. This is the default storage for a number in COBOL:
01 A-NUMBER PIC S9(5)V99.
This definition creates zoned numeric storage. Each digit in the number uses one byte of storage; the sign and decimal point do not use any space.
The decimal point is saved in the PIC, and the sign is saved by combining it with the first or last digit of the number. The first or last digit in a zoned field actually is a code that represents both the digit value and the sign. The field is 7 bytes long.
The other main type of storage used in COBOL is called computational. The most common form of computational storage is COMPUTATIONAL-3 or COMP-3. This is so common that it frequently is just called "comp" by programmers, even though different COBOL versions require that it be called COMP-3. In some versions of COBOL, it is the only version of computational storage that is supported.
Computational storage comes in many different types, and is used to squeeze more than one digit into a byte. Just as the sign and a digit of a zoned field are encoded into a single byte, computational takes this encoding even further.
A COMP-3 field is created by adding COMP-3 after the picture:
01 A-NUMBER PIC S9(5)V99 COMP-3.
In versions of COBOL that support only COMPUTATIONAL-3, you might be required only to add COMP after the picture:
01 A-NUMBER PIC S9(5)V99 COMP.
ACUCOBOL, Micro Focus Personal COBOL, LPI COBOL, and VAX COBOL all require that the field be named COMP-3.
A computational field can be treated like any other numeric field in all respects. The only difference in a computational field is the number of bytes used for the storage of a number.
You should know how to determine the size of a COMP-3 field for counting record lengths and table sizes. The digits and sign of a COMP-3 field are stored two to a byte. If the picture does not contain a sign, a sign is still created for the storage.
The steps for calculating the size of a COMP-3 field are simple:
Step 3 is used because a byte cannot be split. If the total number of digits and sign equals 7, the number would be stored in 3 1/2 bytes, except that a byte cannot be split. Rounding up to an even number always makes the result divisible by 2. Table B2.2 shows the steps for calculating the size of a PIC 9(8) COMP-3 definition.
| Step | Function | Result |
| Beginning total number of digits | 8 | |
| Add 1 for the sign (even though not in PIC) | + | 1 |
| Calculate the result | = | 9 |
| Round up to the next even number | + | 1 |
| Calculate the new result | = | 10 |
| Divide by 2 | / | 2 |
| The number of bytes used by ANOTHER-NUMBER | = | 5 |
Computational storage is frequently used to reduce the size of a file. The size of accounting files that contain many numeric fields can be drastically reduced by converting zone numeric fields to computational fields.
Paragraph numbering is not required by the COBOL language, but it is a style that is used so commonly that you should see an example of it to be familiar with it.
The basic idea of paragraph numbering is that the program is a series of layers. The top layer performs one or more routines in the next lower layer, the second layer performs one or more routines in the next lower layer, and so on. The paragraphs in each layer are given related paragraph numbers and are kept together in the source code file to make reading and analyzing easier. The numbers help to keep the paragraphs together physically on the page, and help to indicate the relationships between various routines quickly.
Listing B2.18 is an example of a numbered paragraph listing. It was created by using slsprt04.cbl as the base and renaming it slsrpt05.cbl. Note that the general-purpose routines starting at line 051600 are not numbered. They could be left unnumbered or given general-purpose numbers to indicate that they are utility routines, such as G000-WRITE-TO-PRINTER (G for general routine) or P000-WRITE-TO-PRINTER (P for print routine).
000100 IDENTIFICATION DIVISION. 000200 PROGRAM-ID. SLSRPT05. 000300*-------------------------------- 000400* Print test sales data 000500*-------------------------------- 000600 ENVIRONMENT DIVISION. 000700 INPUT-OUTPUT SECTION. 000800 FILE-CONTROL. 000900 001000*-------------------------------- 001100* SLSALES.CBL 001200*-------------------------------- 001300 SELECT SALES-FILE 001400 ASSIGN TO "SALES" 001500 ORGANIZATION IS SEQUENTIAL. 001600 001700 SELECT WORK-FILE 001800 ASSIGN TO "WORK" 001900 ORGANIZATION IS SEQUENTIAL. 002000 002100 SELECT SORT-FILE 002200 ASSIGN TO "SORT". 002300 002400 SELECT PRINTER-FILE 002500 ASSIGN TO PRINTER 002600 ORGANIZATION IS LINE SEQUENTIAL. 002700 002800 DATA DIVISION. 002900 FILE SECTION. 003000 003100*-------------------------------- 003200* FDSALES.CBL 003300* Temporary daily sales file. 003400*-------------------------------- 003500 FD SALES-FILE 003600 LABEL RECORDS ARE STANDARD. 003700 01 SALES-RECORD. 003800 05 SALES-STORE PIC 9(2). 003900 05 SALES-DIVISION PIC 9(2). 004000 05 SALES-DEPARTMENT PIC 9(2). 004100 05 SALES-CATEGORY PIC 9(2). 004200 05 SALES-AMOUNT PIC S9(6)V99. 004300 004400 FD WORK-FILE 004500 LABEL RECORDS ARE STANDARD. 004600 01 WORK-RECORD. 004700 05 WORK-STORE PIC 9(2). 004800 05 WORK-DIVISION PIC 9(2). 004900 05 WORK-DEPARTMENT PIC 9(2). 005000 05 WORK-CATEGORY PIC 9(2). 005100 05 WORK-AMOUNT PIC S9(6)V99. 005200 005300 SD SORT-FILE 005400 LABEL RECORDS ARE STANDARD. 005500 01 SORT-RECORD. 005600 05 SORT-STORE PIC 9(2). 005700 05 SORT-DIVISION PIC 9(2). 005800 05 SORT-DEPARTMENT PIC 9(2). 005900 05 SORT-CATEGORY PIC 9(2). 006000 05 SORT-AMOUNT PIC S9(6)V99. 006100 006200 FD PRINTER-FILE 006300 LABEL RECORDS ARE OMITTED. 006400 01 PRINTER-RECORD PIC X(80). 006500 006600 WORKING-STORAGE SECTION. 006700 006800 01 THE-DIVISIONS. 006900 05 FILLER PIC 99 VALUE 01. 007000 05 FILLER PIC X(15) VALUE "ATHLETICS". 007100 05 FILLER PIC 99 VALUE 02. 007200 05 FILLER PIC X(15) VALUE "SPORTING GOODS". 007300 05 FILLER PIC 99 VALUE 03. 007400 05 FILLER PIC X(15) VALUE "CAMPING". 007500 01 FILLER REDEFINES THE-DIVISIONS. 007600 05 DIVISION-TABLE OCCURS 3 TIMES 007700 INDEXED BY DIVISION-INDEX. 007800 10 DIVISION-NUMBER PIC 99. 007900 10 DIVISION-NAME PIC X(15). 008000 008100 01 THE-DEPARTMENTS. 008200 05 FILLER PIC 99 VALUE 01. 008300 05 FILLER PIC X(15) VALUE "EXERCISE". 008400 05 FILLER PIC 99 VALUE 02. 008500 05 FILLER PIC X(15) VALUE "MISCELLANEOUS". 008600 05 FILLER PIC 99 VALUE 03. 008700 05 FILLER PIC X(15) VALUE "SPORT CLOTHES". 008800 05 FILLER PIC 99 VALUE 04. 008900 05 FILLER PIC X(15) VALUE "EQUIPMENT". 009000 05 FILLER PIC 99 VALUE 05. 009100 05 FILLER PIC X(15) VALUE "CAMP EQUIPMENT". 009200 05 FILLER PIC 99 VALUE 06. 009300 05 FILLER PIC X(15) VALUE "CAMPING CLOTHES". 009400 01 FILLER REDEFINES THE-DEPARTMENTS. 009500 05 DEPARTMENT-TABLE OCCURS 6 TIMES 009600 INDEXED BY DEPARTMENT-INDEX. 009700 10 DEPARTMENT-NUMBER PIC 99. 009800 10 DEPARTMENT-NAME PIC X(15). 009900 010000 01 THE-CATEGORIES. 010100 05 FILLER PIC 99 VALUE 01. 010200 05 FILLER PIC X(15) VALUE "WEIGHTS". 010300 05 FILLER PIC 99 VALUE 02. 010400 05 FILLER PIC X(15) VALUE "MACHINES". 010500 05 FILLER PIC 99 VALUE 03. 010600 05 FILLER PIC X(15) VALUE "SUN GLASSES". 010700 05 FILLER PIC 99 VALUE 04. 010800 05 FILLER PIC X(15) VALUE "VITAMINS". 010900 05 FILLER PIC 99 VALUE 05. 011000 05 FILLER PIC X(15) VALUE "MEN'S CLOTHES". 011100 05 FILLER PIC 99 VALUE 06. 011200 05 FILLER PIC X(15) VALUE "WOMEN'S CLOTHES". 011300 05 FILLER PIC 99 VALUE 07. 011400 05 FILLER PIC X(15) VALUE "TENNIS". 011500 05 FILLER PIC 99 VALUE 08. 011600 05 FILLER PIC X(15) VALUE "SOCCER". 011700 05 FILLER PIC 99 VALUE 09. 011800 05 FILLER PIC X(15) VALUE "TENTS". 011900 05 FILLER PIC 99 VALUE 10. 012000 05 FILLER PIC X(15) VALUE "SLEEPING BAGS". 012100 05 FILLER PIC 99 VALUE 11. 012200 05 FILLER PIC X(15) VALUE "CLOTHING". 012300 05 FILLER PIC 99 VALUE 12. 012400 05 FILLER PIC X(15) VALUE "HIKING BOOTS". 012500 01 FILLER REDEFINES THE-CATEGORIES. 012600 05 CATEGORY-TABLE OCCURS 12 TIMES 012700 INDEXED BY CATEGORY-INDEX. 012800 10 CATEGORY-NUMBER PIC 99. 012900 10 CATEGORY-NAME PIC X(15). 013000 013100 77 OK-TO-PROCESS PIC X. 013200 013300 COPY "WSCASE01.CBL". 013400 013500 01 LEGEND-LINE. 013600 05 FILLER PIC X(6) VALUE "STORE:". 013700 05 FILLER PIC X(1) VALUE SPACE. 013800 05 PRINT-STORE PIC Z9. 013900 014000 01 DETAIL-LINE. 014100 05 FILLER PIC X(3) VALUE SPACE. 014200 05 PRINT-DIVISION PIC Z9. 014300 05 FILLER PIC X(4) VALUE SPACE. 014400 05 FILLER PIC X(3) VALUE SPACE. 014500 05 PRINT-DEPARTMENT PIC Z9. 014600 05 FILLER PIC X(6) VALUE SPACE. 014700 05 FILLER PIC X(3) VALUE SPACE. 014800 05 PRINT-CATEGORY PIC Z9. 014900 05 FILLER PIC X(4) VALUE SPACE. 015000 05 PRINT-CATEGORY-NAME PIC X(15). 015100 05 FILLER PIC X(1) VALUE SPACE. 015200 05 PRINT-AMOUNT PIC ZZZ,ZZ9.99-. 015300 015400 01 COLUMN-LINE. 015500 05 FILLER PIC X(8) VALUE "DIVISION". 015600 05 FILLER PIC X(1) VALUE SPACE. 015700 05 FILLER PIC X(10) VALUE "DEPARTMENT". 015800 05 FILLER PIC X(1) VALUE SPACE. 015900 05 FILLER PIC X(8) VALUE "CATEGORY". 016000 05 FILLER PIC X(1) VALUE SPACE. 016100 05 FILLER PIC X(15) VALUE SPACE. 016200 05 FILLER PIC X(5) VALUE SPACE. 016300 05 FILLER PIC X(6) VALUE "AMOUNT". 016400 016500 01 TITLE-LINE. 016600 05 FILLER PIC X(4) VALUE "RUN:". 016700 05 FORMATTED-RUN-DATE PIC X(10). 016800 05 FILLER PIC X(4) VALUE " AT ". 016900 05 FORMATTED-RUN-TIME PIC X(8). 017000 05 FILLER PIC X(10) VALUE SPACE. 017100 05 FILLER PIC X(12) 017200 VALUE "SALES REPORT". 017300 05 FILLER PIC X(10) VALUE SPACE. 017400 05 FILLER PIC X(5) VALUE "PAGE:". 017500 05 FILLER PIC X(1) VALUE SPACE. 017600 05 PRINT-PAGE-NUMBER PIC ZZZ9. 017700 017800 01 TOTAL-LINE. 017900 05 FILLER PIC X(11) VALUE SPACE. 018000 05 TOTAL-TYPE PIC X(8). 018100 05 FILLER PIC X(1) VALUE SPACE. 018200 05 TOTAL-NUMBER PIC Z9. 018300 05 FILLER PIC X(1) VALUE SPACE. 018400 05 TOTAL-NAME PIC X(15) VALUE SPACE. 018500 05 FILLER PIC X(1) VALUE SPACE. 018600 05 TOTAL-LITERAL PIC X(5) VALUE "TOTAL". 018700 05 FILLER PIC X(1) VALUE SPACE. 018800 05 PRINT-TOTAL PIC ZZZ,ZZ9.99-. 018900 019000 77 GRAND-TOTAL-LITERAL PIC X(8) VALUE " GRAND". 019100 77 STORE-TOTAL-LITERAL PIC X(8) VALUE " STORE". 019200 77 DIVISION-TOTAL-LITERAL PIC X(8) VALUE "DIVISION". 019300 77 DEPARTMENT-TOTAL-LITERAL PIC X(8) VALUE " DEPT". 019400 019500 77 WORK-FILE-AT-END PIC X. 019600 019700 77 LINE-COUNT PIC 999 VALUE ZERO. 019800 77 PAGE-NUMBER PIC 9999 VALUE ZERO. 019900 77 MAXIMUM-LINES PIC 999 VALUE 55. 020000 020100 77 RECORD-COUNT PIC 9999 VALUE ZEROES. 020200 020300* Control break current values for store, division 020400* department. 020500 77 CURRENT-STORE PIC 99. 020600 77 CURRENT-DIVISION PIC 99. 020700 77 CURRENT-DEPARTMENT PIC 99. 020800 020900* Control break accumulators 021000* GRAND TOTAL is the level 1 accumulator for the whole file 021100* STORE TOTAL is the level 2 accumulator 021200* DIVISION TOTAL is the level 3 accumulator 021300* DEPARTMENT TOTAL is the level 4 accumulator. 021400 77 GRAND-TOTAL PIC S9(6)V99. 021500 77 STORE-TOTAL PIC S9(6)V99. 021600 77 DIVISION-TOTAL PIC S9(6)V99. 021700 77 DEPARTMENT-TOTAL PIC S9(6)V99. 021800 021900* System date and time 022000 77 RUN-DATE PIC 9(6). 022100 77 RUN-TIME PIC 9(8). 022200 022300*-------------------------------- 022400* Fields for date routines. 022500*-------------------------------- 022600 77 FORMATTED-DATE PIC Z9/99/9999. 022700 77 DATE-MMDDCCYY PIC 9(8). 022800 01 DATE-CCYYMMDD PIC 9(8). 022900 01 FILLER REDEFINES DATE-CCYYMMDD. 023000 05 DATE-CC PIC 99. 023100 05 DATE-YY PIC 99. 023200 05 DATE-MM PIC 99. 023300 05 DATE-DD PIC 99. 023400 023500*-------------------------------- 023600* Fields for TIME routines. 023700*-------------------------------- 023800 77 FORMATTED-TIME PIC Z9/99/99. 023900 024000 01 TIME-HHMMSS PIC 9(6). 024100 01 FILLER REDEFINES TIME-HHMMSS. 024200 05 TIME-HH PIC 99. 024300 05 TIME-MM PIC 99. 024400 05 TIME-SS PIC 99. 024500 024600 PROCEDURE DIVISION. 024700 1000-PROGRAM-BEGIN. 024800 024900 PERFORM 1300-OPENING-PROCEDURE. 025000 PERFORM 2000-MAIN-PROCESS. 025100 PERFORM 1400-CLOSING-PROCEDURE. 025200 025300 1100-PROGRAM-EXIT. 025400 EXIT PROGRAM. 025500 025600 1200-PROGRAM-DONE. 025700 STOP RUN. 025800 025900 1300-OPENING-PROCEDURE. 026000 026100 OPEN OUTPUT PRINTER-FILE. 026200 026300 1400-CLOSING-PROCEDURE. 026400 CLOSE PRINTER-FILE. 026500 026600 2000-MAIN-PROCESS. 026700 PERFORM 2100-GET-OK-TO-PROCESS. 026800 PERFORM 3000-PROCESS-THE-FILE 026900 UNTIL OK-TO-PROCESS = "N". 027000 027100 2100-GET-OK-TO-PROCESS. 027200 PERFORM 2110-ACCEPT-OK-TO-PROCESS. 027300 PERFORM 2120-RE-ACCEPT-OK-TO-PROCESS 027400 UNTIL OK-TO-PROCESS = "Y" OR "N". 027500 027600 2110-ACCEPT-OK-TO-PROCESS. 027700 DISPLAY "PRINT SALES REPORT (Y/N)?". 027800 ACCEPT OK-TO-PROCESS. 027900 INSPECT OK-TO-PROCESS 028000 CONVERTING LOWER-ALPHA 028100 TO UPPER-ALPHA. 028200 028300 2120-RE-ACCEPT-OK-TO-PROCESS. 028400 DISPLAY "YOU MUST ENTER YES OR NO". 028500 PERFORM 2110-ACCEPT-OK-TO-PROCESS. 028600 028700 3000-PROCESS-THE-FILE. 028800 PERFORM 3100-START-THE-FILE. 028900 PERFORM 4000-PRINT-ONE-REPORT. 029000 PERFORM 3200-END-THE-FILE. 029100 029200 MOVE "N" TO OK-TO-PROCESS. 029300 029400 3100-START-THE-FILE. 029500 PERFORM 3110-SORT-DATA-FILE. 029600 OPEN INPUT WORK-FILE. 029700 029800 3110-SORT-DATA-FILE. 029900 SORT SORT-FILE 030000 ON ASCENDING KEY SORT-STORE 030100 ASCENDING KEY SORT-DIVISION 030200 ASCENDING KEY SORT-DEPARTMENT 030300 ASCENDING KEY SORT-CATEGORY 030400 USING SALES-FILE 030500 GIVING WORK-FILE. 030600 030700 3200-END-THE-FILE. 030800 CLOSE WORK-FILE. 030900 031000* LEVEL 1 CONTROL BREAK 031100 4000-PRINT-ONE-REPORT. 031200 PERFORM 4100-START-ONE-REPORT. 031300 PERFORM 5000-PROCESS-ALL-STORES 031400 UNTIL WORK-FILE-AT-END = "Y". 031500 PERFORM 4200-END-ONE-REPORT. 031600 031700 4100-START-ONE-REPORT. 031800 PERFORM READ-FIRST-VALID-WORK. 031900 MOVE ZEROES TO GRAND-TOTAL. 032000 032100 PERFORM 4110-START-NEW-REPORT. 032200 032300 4110-START-NEW-REPORT. 032400 MOVE SPACE TO DETAIL-LINE. 032500 MOVE ZEROES TO LINE-COUNT PAGE-NUMBER. 032600 032700 ACCEPT RUN-DATE FROM DATE. 032800 MOVE RUN-DATE TO DATE-CCYYMMDD. 032900 IF DATE-YY > 90 033000 MOVE 19 TO DATE-CC 033100 ELSE 033200 MOVE 20 TO DATE-CC. 033300 033400 PERFORM FORMAT-THE-DATE. 033500 MOVE FORMATTED-DATE TO FORMATTED-RUN-DATE. 033600 033700 ACCEPT RUN-TIME FROM TIME. 033800 COMPUTE TIME-HHMMSS = RUN-TIME / 100. 033900 PERFORM FORMAT-THE-TIME. 034000 MOVE FORMATTED-TIME TO FORMATTED-RUN-TIME. 034100 034200 034300 4200-END-ONE-REPORT. 034400 IF RECORD-COUNT = ZEROES 034500 MOVE "NO RECORDS FOUND" TO PRINTER-RECORD 034600 PERFORM WRITE-TO-PRINTER 034700 ELSE 034800 PERFORM 4210-PRINT-GRAND-TOTAL. 034900 035000 PERFORM END-LAST-PAGE. 035100 035200 4210-PRINT-GRAND-TOTAL. 035300 MOVE SPACE TO TOTAL-LINE. 035400 MOVE GRAND-TOTAL TO PRINT-TOTAL. 035500 MOVE GRAND-TOTAL-LITERAL TO TOTAL-TYPE. 035600 MOVE "TOTAL" TO TOTAL-LITERAL. 035700 MOVE TOTAL-LINE TO PRINTER-RECORD. 035800 PERFORM WRITE-TO-PRINTER. 035900 PERFORM LINE-FEED 2 TIMES. 036000 MOVE SPACE TO DETAIL-LINE. 036100 036200* LEVEL 2 CONTROL BREAK 036300 5000-PROCESS-ALL-STORES. 036400 PERFORM 5100-START-ONE-STORE. 036500 036600 PERFORM 6000-PROCESS-ALL-DIVISIONS 036700 UNTIL WORK-FILE-AT-END = "Y" 036800 OR WORK-STORE NOT = CURRENT-STORE. 036900 037000 PERFORM 5200-END-ONE-STORE. 037100 037200 5100-START-ONE-STORE. 037300 MOVE WORK-STORE TO CURRENT-STORE. 037400 MOVE ZEROES TO STORE-TOTAL. 037500 MOVE WORK-STORE TO PRINT-STORE. 037600 037700 PERFORM START-NEXT-PAGE. 037800 037900 5200-END-ONE-STORE. 038000 PERFORM 5210-PRINT-STORE-TOTAL. 038100 ADD STORE-TOTAL TO GRAND-TOTAL. 038200 038300 5210-PRINT-STORE-TOTAL. 038400 MOVE SPACE TO TOTAL-LINE. 038500 MOVE STORE-TOTAL TO PRINT-TOTAL. 038600 MOVE CURRENT-STORE TO TOTAL-NUMBER. 038700 MOVE STORE-TOTAL-LITERAL TO TOTAL-TYPE. 038800 MOVE "TOTAL" TO TOTAL-LITERAL. 038900 MOVE TOTAL-LINE TO PRINTER-RECORD. 039000 PERFORM WRITE-TO-PRINTER. 039100 PERFORM LINE-FEED. 039200 MOVE SPACE TO DETAIL-LINE. 039300 039400* LEVEL 3 CONTROL BREAK 039500 6000-PROCESS-ALL-DIVISIONS. 039600 PERFORM 6100-START-ONE-DIVISION. 039700 039800 PERFORM 7000-PROCESS-ALL-DEPARTMENTS 039900 UNTIL WORK-FILE-AT-END = "Y" 040000 OR WORK-STORE NOT = CURRENT-STORE 040100 OR WORK-DIVISION NOT = CURRENT-DIVISION. 040200 040300 PERFORM 6200-END-ONE-DIVISION. 040400 040500 6100-START-ONE-DIVISION. 040600 MOVE WORK-DIVISION TO CURRENT-DIVISION. 040700 MOVE ZEROES TO DIVISION-TOTAL. 040800 MOVE WORK-DIVISION TO PRINT-DIVISION. 040900 041000 6200-END-ONE-DIVISION. 041100 PERFORM 6210-PRINT-DIVISION-TOTAL. 041200 ADD DIVISION-TOTAL TO STORE-TOTAL. 041300 041400 6210-PRINT-DIVISION-TOTAL. 041500 MOVE SPACE TO TOTAL-LINE. 041600 MOVE DIVISION-TOTAL TO PRINT-TOTAL. 041700 MOVE CURRENT-DIVISION TO TOTAL-NUMBER. 041800 MOVE DIVISION-TOTAL-LITERAL TO TOTAL-TYPE. 041900 MOVE "TOTAL" TO TOTAL-LITERAL. 042000 PERFORM 6220-LOAD-DIVISION-NAME. 042100 MOVE TOTAL-LINE TO PRINTER-RECORD. 042200 PERFORM WRITE-TO-PRINTER. 042300 PERFORM LINE-FEED. 042400 MOVE SPACE TO DETAIL-LINE. 042500 042600 6220-LOAD-DIVISION-NAME. 042700 SET DIVISION-INDEX TO 1. 042800 SEARCH DIVISION-TABLE 042900 AT END 043000 MOVE "NOT FOUND" TO TOTAL-NAME 043100 WHEN 043200 DIVISION-NUMBER(DIVISION-INDEX) = 043300 CURRENT-DIVISION 043400 MOVE DIVISION-NAME(DIVISION-INDEX) TO 043500 TOTAL-NAME. 043600 043700* LEVEL 4 CONTROL BREAK 043800 7000-PROCESS-ALL-DEPARTMENTS. 043900 PERFORM 7100-START-ONE-DEPARTMENT. 044000 044100 PERFORM 8000-PROCESS-ALL-CATEGORIES 044200 UNTIL WORK-FILE-AT-END = "Y" 044300 OR WORK-STORE NOT = CURRENT-STORE 044400 OR WORK-DIVISION NOT = CURRENT-DIVISION 044500 OR WORK-DEPARTMENT NOT = CURRENT-DEPARTMENT. 044600 044700 PERFORM 7200-END-ONE-DEPARTMENT. 044800 044900 7100-START-ONE-DEPARTMENT. 045000 MOVE WORK-DEPARTMENT TO CURRENT-DEPARTMENT. 045100 MOVE ZEROES TO DEPARTMENT-TOTAL. 045200 MOVE WORK-DEPARTMENT TO PRINT-DEPARTMENT. 045300 045400 7200-END-ONE-DEPARTMENT. 045500 PERFORM 7210-PRINT-DEPARTMENT-TOTAL. 045600 ADD DEPARTMENT-TOTAL TO DIVISION-TOTAL. 045700 045800 7210-PRINT-DEPARTMENT-TOTAL. 045900 MOVE SPACE TO TOTAL-LINE. 046000 MOVE DEPARTMENT-TOTAL TO PRINT-TOTAL. 046100 MOVE CURRENT-DEPARTMENT TO TOTAL-NUMBER. 046200 MOVE DEPARTMENT-TOTAL-LITERAL TO TOTAL-TYPE. 046300 MOVE "TOTAL" TO TOTAL-LITERAL. 046400 PERFORM LOAD-DEPARTMENT-NAME. 046500 MOVE TOTAL-LINE TO PRINTER-RECORD. 046600 PERFORM WRITE-TO-PRINTER. 046700 PERFORM LINE-FEED. 046800 MOVE SPACE TO DETAIL-LINE. 046900 047000 LOAD-DEPARTMENT-NAME. 047100 SET DEPARTMENT-INDEX TO 1. 047200 SEARCH DEPARTMENT-TABLE 047300 AT END 047400 MOVE "NOT FOUND" TO TOTAL-NAME 047500 WHEN 047600 DEPARTMENT-NUMBER(DEPARTMENT-INDEX) = 047700 CURRENT-DEPARTMENT 047800 MOVE DEPARTMENT-NAME(DEPARTMENT-INDEX) TO 047900 TOTAL-NAME. 048000 048100* PROCESS ONE RECORD LEVEL 048200 8000-PROCESS-ALL-CATEGORIES. 048300 PERFORM 8100-PROCESS-THIS-CATEGORY. 048400 ADD WORK-AMOUNT TO DEPARTMENT-TOTAL. 048500 ADD 1 TO RECORD-COUNT. 048600 PERFORM READ-NEXT-VALID-WORK. 048700 048800 8100-PROCESS-THIS-CATEGORY. 048900 IF LINE-COUNT > MAXIMUM-LINES 049000 PERFORM START-NEXT-PAGE. 049100 PERFORM 8110-PRINT-THE-RECORD. 049200 049300 8110-PRINT-THE-RECORD. 049400 MOVE WORK-CATEGORY TO PRINT-CATEGORY. 049500 049600 PERFORM 8120-LOAD-CATEGORY-NAME. 049700 049800 MOVE WORK-AMOUNT TO PRINT-AMOUNT. 049900 050000 MOVE DETAIL-LINE TO PRINTER-RECORD. 050100 PERFORM WRITE-TO-PRINTER. 050200 MOVE SPACE TO DETAIL-LINE. 050300 050400 8120-LOAD-CATEGORY-NAME. 050500 SET CATEGORY-INDEX TO 1. 050600 SEARCH CATEGORY-TABLE 050700 AT END 050800 MOVE "NOT FOUND" TO TOTAL-NAME 050900 WHEN 051000 CATEGORY-NUMBER(CATEGORY-INDEX) = 051100 WORK-CATEGORY 051200 MOVE CATEGORY-NAME(CATEGORY-INDEX) TO 051300 PRINT-CATEGORY-NAME. 051400 051500* PRINTING ROUTINES 051600 WRITE-TO-PRINTER. 051700 WRITE PRINTER-RECORD BEFORE ADVANCING 1. 051800 ADD 1 TO LINE-COUNT. 051900 052000 LINE-FEED. 052100 MOVE SPACE TO PRINTER-RECORD. 052200 PERFORM WRITE-TO-PRINTER. 052300 052400 START-NEXT-PAGE. 052500 PERFORM END-LAST-PAGE. 052600 PERFORM START-NEW-PAGE. 052700 052800 START-NEW-PAGE. 052900 ADD 1 TO PAGE-NUMBER. 053000 MOVE PAGE-NUMBER TO PRINT-PAGE-NUMBER. 053100 MOVE TITLE-LINE TO PRINTER-RECORD. 053200 PERFORM WRITE-TO-PRINTER. 053300 PERFORM LINE-FEED. 053400 MOVE LEGEND-LINE TO PRINTER-RECORD. 053500 PERFORM WRITE-TO-PRINTER. 053600 PERFORM LINE-FEED. 053700 MOVE COLUMN-LINE TO PRINTER-RECORD. 053800 PERFORM WRITE-TO-PRINTER. 053900 PERFORM LINE-FEED. 054000 054100 END-LAST-PAGE. 054200 IF PAGE-NUMBER > 0 054300 PERFORM FORM-FEED. 054400 MOVE ZERO TO LINE-COUNT. 054500 054600 FORM-FEED. 054700 MOVE SPACE TO PRINTER-RECORD. 054800 WRITE PRINTER-RECORD BEFORE ADVANCING PAGE. 054900 055000*-------------------------------- 055100* Read first, read next routines 055200*-------------------------------- 055300 READ-FIRST-VALID-WORK. 055400 PERFORM READ-NEXT-VALID-WORK. 055500 055600 READ-NEXT-VALID-WORK. 055700 PERFORM READ-NEXT-WORK-RECORD. 055800 055900 READ-NEXT-WORK-RECORD. 056000 MOVE "N" TO WORK-FILE-AT-END. 056100 READ WORK-FILE NEXT RECORD 056200 AT END MOVE "Y" TO WORK-FILE-AT-END. 056300 056400* Date and time routines 056500 FORMAT-THE-DATE. 056600 PERFORM CONVERT-TO-MMDDCCYY. 056700 MOVE DATE-MMDDCCYY TO FORMATTED-DATE. 056800 056900 CONVERT-TO-MMDDCCYY. 057000 COMPUTE DATE-MMDDCCYY = 057100 DATE-CCYYMMDD * 10000.0001. 057200 057300 FORMAT-THE-TIME. 057400 MOVE TIME-HHMMSS TO FORMATTED-TIME. 057500 INSPECT FORMATTED-TIME 057600 REPLACING ALL "/" BY ":". 057700
Although data names should be unique within a program, there is a way around this--using a qualified data name that became available in the COBOL-74 standard. Data names do not need to be unique, as long as the name exists within a hierarchy of names in such a way that the name can be made unique by reference to one or more of the higher-level names. Use this syntax:
QUALIFIED NAMES
01 a-structure-name
05 variable-1 picture
05 variable-2 picture
01 another-structure
05 variable-1 picture
05 variable-2 picture
statement variable-1
of another-structure
The following is an example:
01 STORE-TOTALS
05 SALES-AMT PIC S9(5)V99
05 TAX-AMT PIC S9(3)V99.
01 GRAND-TOTALS
05 SALES-AMT PIC S9(5)V99
05 TAX-AMT PIC S9(3)V99.
ADD SALES-AMT OF STORE-TOTALS
TO SALES-AMT OF GRAND-TOTALS
ADD TAX-AMT OF STORE-TOTALS
TO TAX-AMT OF GRAND-TOTALS.
Listing B2.19 shows slsprt06.cbl, based on slsrpt04.cbl.
000100 IDENTIFICATION DIVISION. 000200 PROGRAM-ID. SLSRPT06. 000300*-------------------------------- 000400* Print test sales data 000500* Uses qualified data names. 000600*-------------------------------- 000700 ENVIRONMENT DIVISION. 000800 INPUT-OUTPUT SECTION. 000900 FILE-CONTROL. 001000 001100*-------------------------------- 001200* SLSALES.CBL 001300*-------------------------------- 001400 SELECT SALES-FILE 001500 ASSIGN TO "SALES" 001600 ORGANIZATION IS SEQUENTIAL. 001700 001800 SELECT WORK-FILE 001900 ASSIGN TO "WORK" 002000 ORGANIZATION IS SEQUENTIAL. 002100 002200 SELECT SORT-FILE 002300 ASSIGN TO "SORT". 002400 002500 SELECT PRINTER-FILE 002600 ASSIGN TO PRINTER 002700 ORGANIZATION IS LINE SEQUENTIAL. 002800 002900 DATA DIVISION. 003000 FILE SECTION. 003100 003200*-------------------------------- 003300* FDSALES.CBL 003400* Temporary daily sales file. 003500*-------------------------------- 003600 FD SALES-FILE 003700 LABEL RECORDS ARE STANDARD. 003800 01 SALES-RECORD. 003900 05 SALES-STORE PIC 9(2). 004000 05 SALES-DIVISION PIC 9(2). 004100 05 SALES-DEPARTMENT PIC 9(2). 004200 05 SALES-CATEGORY PIC 9(2). 004300 05 SALES-AMOUNT PIC S9(6)V99. 004400 004500 FD WORK-FILE 004600 LABEL RECORDS ARE STANDARD. 004700 01 WORK-RECORD. 004800 05 SALES-STORE PIC 9(2). 004900 05 SALES-DIVISION PIC 9(2). 005000 05 SALES-DEPARTMENT PIC 9(2). 005100 05 SALES-CATEGORY PIC 9(2). 005200 05 SALES-AMOUNT PIC S9(6)V99. 005300 005400 SD SORT-FILE 005500 LABEL RECORDS ARE STANDARD. 005600 01 SORT-RECORD. 005700 05 SALES-STORE PIC 9(2). 005800 05 SALES-DIVISION PIC 9(2). 005900 05 SALES-DEPARTMENT PIC 9(2). 006000 05 SALES-CATEGORY PIC 9(2). 006100 05 SALES-AMOUNT PIC S9(6)V99. 006200 006300 FD PRINTER-FILE 006400 LABEL RECORDS ARE OMITTED. 006500 01 PRINTER-RECORD PIC X(80). 006600 006700 WORKING-STORAGE SECTION. 006800 006900 01 THE-DIVISIONS. 007000 05 FILLER PIC 99 VALUE 01. 007100 05 FILLER PIC X(15) VALUE "ATHLETICS". 007200 05 FILLER PIC 99 VALUE 02. 007300 05 FILLER PIC X(15) VALUE "SPORTING GOODS". 007400 05 FILLER PIC 99 VALUE 03. 007500 05 FILLER PIC X(15) VALUE "CAMPING". 007600 01 FILLER REDEFINES THE-DIVISIONS. 007700 05 DIVISION-TABLE OCCURS 3 TIMES 007800 INDEXED BY DIVISION-INDEX. 007900 10 DIVISION-NUMBER PIC 99. 008000 10 DIVISION-NAME PIC X(15). 008100 008200 01 THE-DEPARTMENTS. 008300 05 FILLER PIC 99 VALUE 01. 008400 05 FILLER PIC X(15) VALUE "EXERCISE". 008500 05 FILLER PIC 99 VALUE 02. 008600 05 FILLER PIC X(15) VALUE "MISCELLANEOUS". 008700 05 FILLER PIC 99 VALUE 03. 008800 05 FILLER PIC X(15) VALUE "SPORT CLOTHES". 008900 05 FILLER PIC 99 VALUE 04. 009000 05 FILLER PIC X(15) VALUE "EQUIPMENT". 009100 05 FILLER PIC 99 VALUE 05. 009200 05 FILLER PIC X(15) VALUE "CAMP EQUIPMENT". 009300 05 FILLER PIC 99 VALUE 06. 009400 05 FILLER PIC X(15) VALUE "CAMPING CLOTHES". 009500 01 FILLER REDEFINES THE-DEPARTMENTS. 009600 05 DEPARTMENT-TABLE OCCURS 6 TIMES 009700 INDEXED BY DEPARTMENT-INDEX. 009800 10 DEPARTMENT-NUMBER PIC 99. 009900 10 DEPARTMENT-NAME PIC X(15). 010000 010100 01 THE-CATEGORIES. 010200 05 FILLER PIC 99 VALUE 01. 010300 05 FILLER PIC X(15) VALUE "WEIGHTS". 010400 05 FILLER PIC 99 VALUE 02. 010500 05 FILLER PIC X(15) VALUE "MACHINES". 010600 05 FILLER PIC 99 VALUE 03. 010700 05 FILLER PIC X(15) VALUE "SUN GLASSES". 010800 05 FILLER PIC 99 VALUE 04. 010900 05 FILLER PIC X(15) VALUE "VITAMINS". 011000 05 FILLER PIC 99 VALUE 05. 011100 05 FILLER PIC X(15) VALUE "MEN'S CLOTHES". 011200 05 FILLER PIC 99 VALUE 06. 011300 05 FILLER PIC X(15) VALUE "WOMEN'S CLOTHES". 011400 05 FILLER PIC 99 VALUE 07. 011500 05 FILLER PIC X(15) VALUE "TENNIS". 011600 05 FILLER PIC 99 VALUE 08. 011700 05 FILLER PIC X(15) VALUE "SOCCER". 011800 05 FILLER PIC 99 VALUE 09. 011900 05 FILLER PIC X(15) VALUE "TENTS". 012000 05 FILLER PIC 99 VALUE 10. 012100 05 FILLER PIC X(15) VALUE "SLEEPING BAGS". 012200 05 FILLER PIC 99 VALUE 11. 012300 05 FILLER PIC X(15) VALUE "CLOTHING". 012400 05 FILLER PIC 99 VALUE 12. 012500 05 FILLER PIC X(15) VALUE "HIKING BOOTS". 012600 01 FILLER REDEFINES THE-CATEGORIES. 012700 05 CATEGORY-TABLE OCCURS 12 TIMES 012800 INDEXED BY CATEGORY-INDEX. 012900 10 CATEGORY-NUMBER PIC 99. 013000 10 CATEGORY-NAME PIC X(15). 013100 013200 77 OK-TO-PROCESS PIC X. 013300 013400 COPY "WSCASE01.CBL". 013500 013600 01 LEGEND-LINE. 013700 05 FILLER PIC X(6) VALUE "STORE:". 013800 05 FILLER PIC X(1) VALUE SPACE. 013900 05 PRINT-STORE PIC Z9. 014000 014100 01 DETAIL-LINE. 014200 05 FILLER PIC X(3) VALUE SPACE. 014300 05 PRINT-DIVISION PIC Z9. 014400 05 FILLER PIC X(4) VALUE SPACE. 014500 05 FILLER PIC X(3) VALUE SPACE. 014600 05 PRINT-DEPARTMENT PIC Z9. 014700 05 FILLER PIC X(6) VALUE SPACE. 014800 05 FILLER PIC X(3) VALUE SPACE. 014900 05 PRINT-CATEGORY PIC Z9. 015000 05 FILLER PIC X(4) VALUE SPACE. 015100 05 PRINT-CATEGORY-NAME PIC X(15). 015200 05 FILLER PIC X(1) VALUE SPACE. 015300 05 PRINT-AMOUNT PIC ZZZ,ZZ9.99-. 015400 015500 01 COLUMN-LINE. 015600 05 FILLER PIC X(8) VALUE "DIVISION". 015700 05 FILLER PIC X(1) VALUE SPACE. 015800 05 FILLER PIC X(10) VALUE "DEPARTMENT". 015900 05 FILLER PIC X(1) VALUE SPACE. 016000 05 FILLER PIC X(8) VALUE "CATEGORY". 016100 05 FILLER PIC X(1) VALUE SPACE. 016200 05 FILLER PIC X(15) VALUE SPACE. 016300 05 FILLER PIC X(5) VALUE SPACE. 016400 05 FILLER PIC X(6) VALUE "AMOUNT". 016500 016600 01 TITLE-LINE. 016700 05 FILLER PIC X(4) VALUE "RUN:". 016800 05 FORMATTED-RUN-DATE PIC X(10). 016900 05 FILLER PIC X(4) VALUE " AT ". 017000 05 FORMATTED-RUN-TIME PIC X(8). 017100 05 FILLER PIC X(10) VALUE SPACE. 017200 05 FILLER PIC X(12) 017300 VALUE "SALES REPORT". 017400 05 FILLER PIC X(10) VALUE SPACE. 017500 05 FILLER PIC X(5) VALUE "PAGE:". 017600 05 FILLER PIC X(1) VALUE SPACE. 017700 05 PRINT-PAGE-NUMBER PIC ZZZ9. 017800 017900 01 TOTAL-LINE. 018000 05 FILLER PIC X(11) VALUE SPACE. 018100 05 TOTAL-TYPE PIC X(8). 018200 05 FILLER PIC X(1) VALUE SPACE. 018300 05 TOTAL-NUMBER PIC Z9. 018400 05 FILLER PIC X(1) VALUE SPACE. 018500 05 TOTAL-NAME PIC X(15) VALUE SPACE. 018600 05 FILLER PIC X(1) VALUE SPACE. 018700 05 TOTAL-LITERAL PIC X(5) VALUE "TOTAL". 018800 05 FILLER PIC X(1) VALUE SPACE. 018900 05 PRINT-TOTAL PIC ZZZ,ZZ9.99-. 019000 019100 77 GRAND-TOTAL-LITERAL PIC X(8) VALUE " GRAND". 019200 77 STORE-TOTAL-LITERAL PIC X(8) VALUE " STORE". 019300 77 DIVISION-TOTAL-LITERAL PIC X(8) VALUE "DIVISION". 019400 77 DEPARTMENT-TOTAL-LITERAL PIC X(8) VALUE " DEPT". 019500 019600 77 WORK-FILE-AT-END PIC X. 019700 019800 77 LINE-COUNT PIC 999 VALUE ZERO. 019900 77 PAGE-NUMBER PIC 9999 VALUE ZERO. 020000 77 MAXIMUM-LINES PIC 999 VALUE 55. 020100 020200 77 RECORD-COUNT PIC 9999 VALUE ZEROES. 020300 020400* Control break current values for store, division 020500* department. 020600 77 CURRENT-STORE PIC 99. 020700 77 CURRENT-DIVISION PIC 99. 020800 77 CURRENT-DEPARTMENT PIC 99. 020900 021000* Control break accumulators 021100* GRAND TOTAL is the level 1 accumulator for the whole file 021200* STORE TOTAL is the level 2 accumulator 021300* DIVISION TOTAL is the level 3 accumulator 021400* DEPARTMENT TOTAL is the level 4 accumulator. 021500 77 GRAND-TOTAL PIC S9(6)V99. 021600 77 STORE-TOTAL PIC S9(6)V99. 021700 77 DIVISION-TOTAL PIC S9(6)V99. 021800 77 DEPARTMENT-TOTAL PIC S9(6)V99. 021900 022000* System date and time 022100 77 RUN-DATE PIC 9(6). 022200 77 RUN-TIME PIC 9(8). 022300 022400*-------------------------------- 022500* Fields for date routines. 022600*-------------------------------- 022700 77 FORMATTED-DATE PIC Z9/99/9999. 022800 77 DATE-MMDDCCYY PIC 9(8). 022900 01 DATE-CCYYMMDD PIC 9(8). 023000 01 FILLER REDEFINES DATE-CCYYMMDD. 023100 05 DATE-CC PIC 99. 023200 05 DATE-YY PIC 99. 023300 05 DATE-MM PIC 99. 023400 05 DATE-DD PIC 99. 023500 023600*-------------------------------- 023700* Fields for TIME routines. 023800*-------------------------------- 023900 77 FORMATTED-TIME PIC Z9/99/99. 024000 024100 01 TIME-HHMMSS PIC 9(6). 024200 01 FILLER REDEFINES TIME-HHMMSS. 024300 05 TIME-HH PIC 99. 024400 05 TIME-MM PIC 99. 024500 05 TIME-SS PIC 99. 024600 024700 PROCEDURE DIVISION. 024800 PROGRAM-BEGIN. 024900 025000 PERFORM OPENING-PROCEDURE. 025100 PERFORM MAIN-PROCESS. 025200 PERFORM CLOSING-PROCEDURE. 025300 025400 PROGRAM-EXIT. 025500 EXIT PROGRAM. 025600 025700 PROGRAM-DONE. 025800 STOP RUN. 025900 026000 OPENING-PROCEDURE. 026100 026200 OPEN OUTPUT PRINTER-FILE. 026300 026400 MAIN-PROCESS. 026500 PERFORM GET-OK-TO-PROCESS. 026600 PERFORM PROCESS-THE-FILE 026700 UNTIL OK-TO-PROCESS = "N". 026800 026900 CLOSING-PROCEDURE. 027000 CLOSE PRINTER-FILE. 027100 027200 GET-OK-TO-PROCESS. 027300 PERFORM ACCEPT-OK-TO-PROCESS. 027400 PERFORM RE-ACCEPT-OK-TO-PROCESS 027500 UNTIL OK-TO-PROCESS = "Y" OR "N". 027600 027700 ACCEPT-OK-TO-PROCESS. 027800 DISPLAY "PRINT SALES REPORT (Y/N)?". 027900 ACCEPT OK-TO-PROCESS. 028000 INSPECT OK-TO-PROCESS 028100 CONVERTING LOWER-ALPHA 028200 TO UPPER-ALPHA. 028300 028400 RE-ACCEPT-OK-TO-PROCESS. 028500 DISPLAY "YOU MUST ENTER YES OR NO". 028600 PERFORM ACCEPT-OK-TO-PROCESS. 028700 028800 PROCESS-THE-FILE. 028900 PERFORM START-THE-FILE. 029000 PERFORM PRINT-ONE-REPORT. 029100 PERFORM END-THE-FILE. 029200 029300* PERFORM GET-OK-TO-PROCESS. 029400 MOVE "N" TO OK-TO-PROCESS. 029500 029600 START-THE-FILE. 029700 PERFORM SORT-DATA-FILE. 029800 OPEN INPUT WORK-FILE. 029900 030000 END-THE-FILE. 030100 CLOSE WORK-FILE. 030200 030300 SORT-DATA-FILE. 030400 SORT SORT-FILE 030500 ON ASCENDING KEY SALES-STORE OF SORT-RECORD 030600 ASCENDING KEY SALES-DIVISION OF SORT-RECORD 030700 ASCENDING KEY SALES-DEPARTMENT OF SORT-RECORD 030800 ASCENDING KEY SALES-CATEGORY OF SORT-RECORD 030900 USING SALES-FILE 031000 GIVING WORK-FILE. 031100 031200* LEVEL 1 CONTROL BREAK 031300 PRINT-ONE-REPORT. 031400 PERFORM START-ONE-REPORT. 031500 PERFORM PROCESS-ALL-STORES 031600 UNTIL WORK-FILE-AT-END = "Y". 031700 PERFORM END-ONE-REPORT. 031800 031900 START-ONE-REPORT. 032000 PERFORM READ-FIRST-VALID-WORK. 032100 MOVE ZEROES TO GRAND-TOTAL. 032200 032300 PERFORM START-NEW-REPORT. 032400 032500 START-NEW-REPORT. 032600 MOVE SPACE TO DETAIL-LINE. 032700 MOVE ZEROES TO LINE-COUNT PAGE-NUMBER. 032800 032900 ACCEPT RUN-DATE FROM DATE. 033000 MOVE RUN-DATE TO DATE-CCYYMMDD. 033100 IF DATE-YY > 90 033200 MOVE 19 TO DATE-CC 033300 ELSE 033400 MOVE 20 TO DATE-CC. 033500 033600 PERFORM FORMAT-THE-DATE. 033700 MOVE FORMATTED-DATE TO FORMATTED-RUN-DATE. 033800 033900 ACCEPT RUN-TIME FROM TIME. 034000 COMPUTE TIME-HHMMSS = RUN-TIME / 100. 034100 PERFORM FORMAT-THE-TIME. 034200 MOVE FORMATTED-TIME TO FORMATTED-RUN-TIME. 034300 034400 034500 END-ONE-REPORT. 034600 IF RECORD-COUNT = ZEROES 034700 MOVE "NO RECORDS FOUND" TO PRINTER-RECORD 034800 PERFORM WRITE-TO-PRINTER 034900 ELSE 035000 PERFORM PRINT-GRAND-TOTAL. 035100 035200 PERFORM END-LAST-PAGE. 035300 035400 PRINT-GRAND-TOTAL. 035500 MOVE SPACE TO TOTAL-LINE. 035600 MOVE GRAND-TOTAL TO PRINT-TOTAL. 035700 MOVE GRAND-TOTAL-LITERAL TO TOTAL-TYPE. 035800 MOVE "TOTAL" TO TOTAL-LITERAL. 035900 MOVE TOTAL-LINE TO PRINTER-RECORD. 036000 PERFORM WRITE-TO-PRINTER. 036100 PERFORM LINE-FEED 2 TIMES. 036200 MOVE SPACE TO DETAIL-LINE. 036300 036400* LEVEL 2 CONTROL BREAK 036500 PROCESS-ALL-STORES. 036600 PERFORM START-ONE-STORE. 036700 036800 PERFORM PROCESS-ALL-DIVISIONS 036900 UNTIL WORK-FILE-AT-END = "Y" 037000 OR SALES-STORE OF WORK-RECORD 037100 NOT = CURRENT-STORE. 037200 037300 PERFORM END-ONE-STORE. 037400 037500 START-ONE-STORE. 037600 MOVE SALES-STORE OF WORK-RECORD TO CURRENT-STORE. 037700 MOVE ZEROES TO STORE-TOTAL. 037800 MOVE SALES-STORE OF WORK-RECORD TO PRINT-STORE. 037900 038000 PERFORM START-NEXT-PAGE. 038100 038200 END-ONE-STORE. 038300 PERFORM PRINT-STORE-TOTAL. 038400 ADD STORE-TOTAL TO GRAND-TOTAL. 038500 038600 PRINT-STORE-TOTAL. 038700 MOVE SPACE TO TOTAL-LINE. 038800 MOVE STORE-TOTAL TO PRINT-TOTAL. 038900 MOVE CURRENT-STORE TO TOTAL-NUMBER. 039000 MOVE STORE-TOTAL-LITERAL TO TOTAL-TYPE. 039100 MOVE "TOTAL" TO TOTAL-LITERAL. 039200 MOVE TOTAL-LINE TO PRINTER-RECORD. 039300 PERFORM WRITE-TO-PRINTER. 039400 PERFORM LINE-FEED. 039500 MOVE SPACE TO DETAIL-LINE. 039600 039700* LEVEL 3 CONTROL BREAK 039800 PROCESS-ALL-DIVISIONS. 039900 PERFORM START-ONE-DIVISION. 040000 040100 PERFORM PROCESS-ALL-DEPARTMENTS 040200 UNTIL WORK-FILE-AT-END = "Y" 040300 OR SALES-STORE OF WORK-RECORD 040400 NOT = CURRENT-STORE 040500 OR SALES-DIVISION OF WORK-RECORD 040600 NOT = CURRENT-DIVISION. 040700 040800 PERFORM END-ONE-DIVISION. 040900 041000 START-ONE-DIVISION. 041100 MOVE SALES-DIVISION OF WORK-RECORD TO CURRENT-DIVISION. 041200 MOVE ZEROES TO DIVISION-TOTAL. 041300 MOVE SALES-DIVISION OF WORK-RECORD TO PRINT-DIVISION. 041400 041500 END-ONE-DIVISION. 041600 PERFORM PRINT-DIVISION-TOTAL. 041700 ADD DIVISION-TOTAL TO STORE-TOTAL. 041800 041900 PRINT-DIVISION-TOTAL. 042000 MOVE SPACE TO TOTAL-LINE. 042100 MOVE DIVISION-TOTAL TO PRINT-TOTAL. 042200 MOVE CURRENT-DIVISION TO TOTAL-NUMBER. 042300 MOVE DIVISION-TOTAL-LITERAL TO TOTAL-TYPE. 042400 MOVE "TOTAL" TO TOTAL-LITERAL. 042500 PERFORM LOAD-DIVISION-NAME. 042600 MOVE TOTAL-LINE TO PRINTER-RECORD. 042700 PERFORM WRITE-TO-PRINTER. 042800 PERFORM LINE-FEED. 042900 MOVE SPACE TO DETAIL-LINE. 043000 043100 LOAD-DIVISION-NAME. 043200 SET DIVISION-INDEX TO 1. 043300 SEARCH DIVISION-TABLE 043400 AT END 043500 MOVE "NOT FOUND" TO TOTAL-NAME 043600 WHEN 043700 DIVISION-NUMBER(DIVISION-INDEX) = 043800 CURRENT-DIVISION 043900 MOVE DIVISION-NAME(DIVISION-INDEX) TO 044000 TOTAL-NAME. 044100 044200* LEVEL 4 CONTROL BREAK 044300 PROCESS-ALL-DEPARTMENTS. 044400 PERFORM START-ONE-DEPARTMENT. 044500 044600 PERFORM PROCESS-ALL-CATEGORIES 044700 UNTIL WORK-FILE-AT-END = "Y" 044800 OR SALES-STORE OF WORK-RECORD 044900 NOT = CURRENT-STORE 045000 OR SALES-DIVISION OF WORK-RECORD 045100 NOT = CURRENT-DIVISION 045200 OR SALES-DEPARTMENT OF WORK-RECORD 045300 NOT = CURRENT-DEPARTMENT. 045400 045500 PERFORM END-ONE-DEPARTMENT. 045600 045700 START-ONE-DEPARTMENT. 045800 MOVE SALES-DEPARTMENT OF WORK-RECORD 045900 TO CURRENT-DEPARTMENT. 046000 MOVE ZEROES TO DEPARTMENT-TOTAL. 046100 MOVE SALES-DEPARTMENT OF WORK-RECORD 046200 TO PRINT-DEPARTMENT. 046300 046400 END-ONE-DEPARTMENT. 046500 PERFORM PRINT-DEPARTMENT-TOTAL. 046600 ADD DEPARTMENT-TOTAL TO DIVISION-TOTAL. 046700 046800 PRINT-DEPARTMENT-TOTAL. 046900 MOVE SPACE TO TOTAL-LINE. 047000 MOVE DEPARTMENT-TOTAL TO PRINT-TOTAL. 047100 MOVE CURRENT-DEPARTMENT TO TOTAL-NUMBER. 047200 MOVE DEPARTMENT-TOTAL-LITERAL TO TOTAL-TYPE. 047300 MOVE "TOTAL" TO TOTAL-LITERAL. 047400 PERFORM LOAD-DEPARTMENT-NAME. 047500 MOVE TOTAL-LINE TO PRINTER-RECORD. 047600 PERFORM WRITE-TO-PRINTER. 047700 PERFORM LINE-FEED. 047800 MOVE SPACE TO DETAIL-LINE. 047900 048000 LOAD-DEPARTMENT-NAME. 048100 SET DEPARTMENT-INDEX TO 1. 048200 SEARCH DEPARTMENT-TABLE 048300 AT END 048400 MOVE "NOT FOUND" TO TOTAL-NAME 048500 WHEN 048600 DEPARTMENT-NUMBER(DEPARTMENT-INDEX) = 048700 CURRENT-DEPARTMENT 048800 MOVE DEPARTMENT-NAME(DEPARTMENT-INDEX) TO 048900 TOTAL-NAME. 049000 049100* PROCESS ONE RECORD LEVEL 049200 PROCESS-ALL-CATEGORIES. 049300 PERFORM PROCESS-THIS-CATEGORY. 049400 ADD SALES-AMOUNT OF WORK-RECORD 049500 TO DEPARTMENT-TOTAL. 049600 ADD 1 TO RECORD-COUNT. 049700 PERFORM READ-NEXT-VALID-WORK. 049800 049900 PROCESS-THIS-CATEGORY. 050000 IF LINE-COUNT > MAXIMUM-LINES 050100 PERFORM START-NEXT-PAGE. 050200 PERFORM PRINT-THE-RECORD. 050300 050400 PRINT-THE-RECORD. 050500 MOVE SALES-CATEGORY OF WORK-RECORD 050600 TO PRINT-CATEGORY. 050700 050800 PERFORM LOAD-CATEGORY-NAME. 050900 051000 MOVE SALES-AMOUNT OF WORK-RECORD 051100 TO PRINT-AMOUNT. 051200 051300 MOVE DETAIL-LINE TO PRINTER-RECORD. 051400 PERFORM WRITE-TO-PRINTER. 051500 MOVE SPACE TO DETAIL-LINE. 051600 051700 LOAD-CATEGORY-NAME. 051800 SET CATEGORY-INDEX TO 1. 051900 SEARCH CATEGORY-TABLE 052000 AT END 052100 MOVE "NOT FOUND" TO TOTAL-NAME 052200 WHEN 052300 CATEGORY-NUMBER(CATEGORY-INDEX) = 052400 SALES-CATEGORY OF WORK-RECORD 052500 MOVE CATEGORY-NAME(CATEGORY-INDEX) TO 052600 PRINT-CATEGORY-NAME. 052700 052800* PRINTING ROUTINES 052900 WRITE-TO-PRINTER. 053000 WRITE PRINTER-RECORD BEFORE ADVANCING 1. 053100 ADD 1 TO LINE-COUNT. 053200 053300 LINE-FEED. 053400 MOVE SPACE TO PRINTER-RECORD. 053500 PERFORM WRITE-TO-PRINTER. 053600 053700 START-NEXT-PAGE. 053800 PERFORM END-LAST-PAGE. 053900 PERFORM START-NEW-PAGE. 054000 054100 START-NEW-PAGE. 054200 ADD 1 TO PAGE-NUMBER. 054300 MOVE PAGE-NUMBER TO PRINT-PAGE-NUMBER. 054400 MOVE TITLE-LINE TO PRINTER-RECORD. 054500 PERFORM WRITE-TO-PRINTER. 054600 PERFORM LINE-FEED. 054700 MOVE LEGEND-LINE TO PRINTER-RECORD. 054800 PERFORM WRITE-TO-PRINTER. 054900 PERFORM LINE-FEED. 055000 MOVE COLUMN-LINE TO PRINTER-RECORD. 055100 PERFORM WRITE-TO-PRINTER. 055200 PERFORM LINE-FEED. 055300 055400 END-LAST-PAGE. 055500 IF PAGE-NUMBER > 0 055600 PERFORM FORM-FEED. 055700 MOVE ZERO TO LINE-COUNT. 055800 055900 FORM-FEED. 056000 MOVE SPACE TO PRINTER-RECORD. 056100 WRITE PRINTER-RECORD BEFORE ADVANCING PAGE. 056200 056300*-------------------------------- 056400* Read first, read next routines 056500*-------------------------------- 056600 READ-FIRST-VALID-WORK. 056700 PERFORM READ-NEXT-VALID-WORK. 056800 056900 READ-NEXT-VALID-WORK. 057000 PERFORM READ-NEXT-WORK-RECORD. 057100 057200 READ-NEXT-WORK-RECORD. 057300 MOVE "N" TO WORK-FILE-AT-END. 057400 READ WORK-FILE NEXT RECORD 057500 AT END MOVE "Y" TO WORK-FILE-AT-END. 057600 057700* Date and time routines 057800 FORMAT-THE-DATE. 057900 PERFORM CONVERT-TO-MMDDCCYY. 058000 MOVE DATE-MMDDCCYY TO FORMATTED-DATE. 058100 058200 CONVERT-TO-MMDDCCYY. 058300 COMPUTE DATE-MMDDCCYY = 058400 DATE-CCYYMMDD * 10000.0001. 058500 058600 FORMAT-THE-TIME. 058700 MOVE TIME-HHMMSS TO FORMATTED-TIME. 058800 INSPECT FORMATTED-TIME 058900 REPLACING ALL "/" BY ":". 059000
ANALYSIS: Rather than using different names for each of the fields in the three records used by the program, all the fields are given the same names (see lines 003900-004300, 004800-005200, and 005700-006100). This apparent naming conflict can be resolved by referring to the field with a qualifier OF RECORD-NAME. Throughout the program, qualifiers are added to the names of the fields to clarify which field is meant.
At lines 030500-030800, all the sort fields are qualified by adding OF SORT-RECORD after the field name. All the fields in the WORK-RECORD are qualified by adding OF WORK-RECORD. Some examples of this are at lines 037600, 037800, 040300-0406000, 044800-045300, and 052400. There are many other examples in the program.
Code, compile, and run slsrpt06.cbl, and satisfy yourself that it runs with the same result as slsrpt04.cbl. Then edit the file and remove one of the OF WORK-RECORD phrases from any variable. Attempt to compile the program and you should receive an error such as "Qualifier needed" or "Ambiguous reference to variable." Micro Focus Personal COBOL produces the error "User-name not unique."
The use of qualified variables makes it possible to use MOVE to move more than one field at a time. In Listing B2.20, the DETAIL-LINE has been defined using the same data names as some of the fields in the SALES-RECORD.
003600 FD SALES-FILE 003700 LABEL RECORDS ARE STANDARD. 003800 01 SALES-RECORD. 003900 05 SALES-STORE PIC 9(2). 004000 05 SALES-DIVISION PIC 9(2). 004100 05 SALES-DEPARTMENT PIC 9(2). 004200 05 SALES-CATEGORY PIC 9(2). 004300 05 SALES-AMOUNT PIC S9(6)V99. ...... 014100 01 DETAIL-LINE. 014200 05 FILLER PIC X(3) VALUE SPACE. 014300 05 SALES-DIVISION PIC Z9. 014400 05 FILLER PIC X(4) VALUE SPACE. 014500 05 FILLER PIC X(3) VALUE SPACE. 014600 05 SALES-DEPARTMENT PIC Z9. 014700 05 FILLER PIC X(6) VALUE SPACE. 014800 05 FILLER PIC X(3) VALUE SPACE. 014900 05 SALES-CATEGORY PIC Z9. 015000 05 FILLER PIC X(4) VALUE SPACE. 015300 05 SALES-AMOUNT PIC ZZZ,ZZ9.99-. ...... 020100 MOVE CORRESPONDING SALES-RECORD TO DETAIL-LINE.
ANALYSIS: At line 020100, the MOVE CORRESPONDING will cause fields in the SALES-RECORD that have the same name as fields in the DETAIL-LINE to be moved one by one to corresponding fields in the detail line. These moves happen as if each field were moved individually.
SALES-DIVISION, SALES-DEPARTMENT, SALES-CATEGORY, and SALES-AMOUNT will be moved. SALES-STORE will not be moved because there is no corresponding field in the DETAIL-LINE.
When an alphanumeric value is too long to fit on a single line, it may be continued on the next line by using a continuation character. In Listing B2.21, the columns have been included. The message must be continued to the end of Area B (column 72) and ends without a closing quote. The next line begins with a hyphen (-) in column 7 to indicate that the previous quoted string is being continued. The rest of the message starts with a quote and continues as long as is necessary to complete the message. Lines can be continued over more than one line if necessary.
000500 01 LONG-MESSAGE PIC X(80) VALUE "This is an incredibly long 000600- "message that will take more than one line to define".
Today, you learned about some common issues that will come up when you work with COBOL, including these basics:
000500 01 LONG-MESSAGE PIC X(200) VALUE "This is an incredibly lon 000600- "g message that will take more than one line to define. In fa 000700- "ct this now extends over several lines."
001300 01 DETAIL-LINE. 001400 05 PRINT-WHOLE-NAME PIC X(32). ....... 010300 MOVE SPACE TO DETAIL-LINE. 010400 STRING 010500 LAST-NAME DELIMITED BY SPACE 010600 "," DELIMITED BY SIZE 010700 " " DELIMITED BY SIZE 010800 FIRST-NAME DELIMITED BY SPACE 010900 " " DELIMITED BY SIZE 011000 MIDDLE-NAME DELIMITED BY SPACE 011100 INTO PRINT-WHOLE-NAME. 011200 PERFORM PRINT-DETAIL-LINE.
001100 01 INPUT-DATA PIC X(50). 001200 001300 01 FORMATTED-NAME. 001400 05 FIRST-NAME PIC X(25). 001500 05 LAST-NAME PIC X(25). ...... 010700 DISPLAY "ENTER FIRST AND LAST NAMES". 010800 DISPLAY "WITH A SPACE BETWEEN THE NAMES". 010900 ACCEPT INPUT-DATA. 011000 MOVE SPACE TO FORMATTED-NAME. 011100 UNSTRING INPUT-DATA 011200 DELIMITED BY ALL SPACE 011300 INTO FIRST-NAME 011400 LAST-NAME. 011500
Write a program named yesorno.cbl that can be called, and that will ask the user to answer yes or no.
Hint: This program should only have to be passed one field, a single PIC X that is filled in by the program. You should be able to pattern this on timedit.cbl. Appendix A, "Answers," includes a short program that can be used to test your program.
© Copyright, Macmillan Computer Publishing. All rights reserved.