7.1 Program to find sum of two numbers.
IDENTIFICATION DIVISION.
PROGRAM-ID. SUM2NO.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 NUM1 PIC 99 VALUE 0 .
01 NUM2 PIC 99 VALUE 0.
01 SUM2 PIC 999 VALUE 0.
PROCEDURE DIVISION.
G0000-MAIN-PARA .
ACCEPT NUM1 .
ACCEPT NUM2 .
COMPUTE SUM2 = NUM1 + NUM2.
DISPLAY SUM2.
STOP RUN.
7.2 Program to illustrate the use of arithmetic verbs.
IDENTIFICATION DIVISION.
PROGRAM-ID. ARITVERB.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 A PIC 99 VALUE 0 .
01 B PIC 99 VALUE 0.
01 SUMRES PIC 999 VALUE 0.
01 DIFFRES PIC 99 VALUE 0.
01 MULRES PIC 999 VALUE 0.
01 DIVRES PIC 99.9 VALUE 0.
PROCEDURE DIVISION.
G0000-MAIN-PARA .
ACCEPT A .
ACCEPT B .
ADD A, B GIVING SUMRES.
SUBTRACT A FROM B GIVING DIFFRES.
MULTIPLY A BY B GIVING MULRES.
DIVIDE A BY B GIVING DIVRES.
DISPLAY SUMRES.
DISPLAY DIFFRES.
DISPLAY MULRES.
DISPLAY DIVRES.
STOP RUN.
7.3 Program to find the maximum of three numbers.
IDENTIFICATION DIVISION.
PROGRAM-ID. MAX3NOS.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 A PIC 9(2).
01 B PIC 9(2).
01 C PIC 9(2).
01 MAXI PIC 9(2).
PROCEDURE DIVISION.
G0000-MAIN-PARA .
ACCEPT A.
ACCEPT B.
ACCEPT C.
MOVE A TO MAXI.
IF (B > MAXI)
MOVE B TO MAXI
END-IF.
IF (C > MAXI)
MOVE C TO MAXI
END-IF.
DISPLAY ?THE MAXIMUM OF THREE NOS ? , MAXI.
STOP RUN.
7. 4 Program to find the Total, Percentage and Grade for a student using evaluate verb.
IDENTIFICATION DIVISION.
PROGRAM-ID. GRADE.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 SUBJ-1 PIC 9(3).
01 SUBJ-2 PIC 9(3).
01 SUBJ-3 PIC 9(3).
01 TOT PIC 9(3).
01 PER PIC 9(3)V99.
01 GRAD PIC A.
01 OPER PIC 9(3).99.
PROCEDURE DIVISION.
G0000-MAIN-PARA .
PERFORM G1000-ACCEPT-PARA.
PERFORM G2000-COMPUTE-PARA.
PERFORM G3000-DISPLAY-PARA.
STOP RUN.
G1000-ACCEPT-PARA.
ACCEPT SUB-1.
ACCEPT SUB-2.
ACCEPT SUB-3.
G2000-COMPUTE-PARA.
COMPUTE TOT = SUB-1 + SUB-2 + SUB-3.
COMPUTE PER = TOT / 3.
EVALUATE TRUE
WHEN PER >= 80 MOVE ?A? TO GRAD
WHEN PER >= 70 MOVE ?B? TO GRAD
WHEN PER >= 60 MOVE ?C? TO GRAD
WHEN PER >= 50 MOVE ?D? TO GRAD
WHEN OTHER MOVE ?E? TO GRAD
END-EVALUATE.
G3000-DISPLAY-PARA.
DISPLAY ?THE TOTAL MARKS ? , TOTAL.
MOVE PER TO OPER.
DISPLAY ?PERCENTAGE (%) : ? , OPER.
DISPLAY ?GRADE ? , GRAD.
7.5 Program to find the sum and average of 10 numbers.
IDENTIFICATION DIVISION.
PROGRAM-ID. SUMAVG.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 NUMS.
05 NUM PIC 99 OCCURS 10 TIMES .
01 NSUM PIC 9(3).
01 AVG PIC 9(2).99.
01 I PIC 9(2) VALUE 1.
PROCEDURE DIVISION.
G0000-MAIN-PARA .
PERFORM G1000-PROCESS-PARA 10 TIMES.
PERFORM G2000-DISPLAY-PARA.
STOP RUN.
G1000-PROCESS-PARA.
DISPLAY ?ENTER THE NUMBER : ?
ACCEPT NUM (I) .
COMPUTE NSUM = NSUM + NUM (I).
COMPUTE I = I + 1.
G2000-DISPLAY-PARA.
DISPLAY ?THE SUM TOTAL ? , NSUM.
COMPUT AVG = NSUM / 10.
DISPLAY ?AVERAGE : ? , AVG.
7.6 Program to ADD two 2 X 2 matrices.
IDENTIFICATION DIVISION.
PROGRAM-ID. MATADD.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 MATA.
05 ROWA OCCURS 2 TIMES .
10 COLA PIC 9 OCCURS 2 TIMES .
01 MATB.
05 ROWB OCCURS 2 TIMES .
10 COLB PIC 9 OCCURS 2 TIMES .
01 MATC.
05 ROWC OCCURS 2 TIMES .
10 COLC PIC 99 VALUE ZEROS OCCURS 2 TIMES .
01 I PIC 9 VALUE 1.
01 J PIC 9 VALUE 1.
PROCEDURE DIVISION.
G0000-MAIN-PARA .
PERFORM G1000-PROCESS-PARA VARYING I FROM 1 BY 1
UNTIL I > 2 AFTER J FROM 1 BY 1 UNTIL J > 2.
PERFORM G2000-DISPLAY-PARA.
STOP RUN.
G1000-PROCESS-PARA.
ACCEPT COLA (I J) .
ACCEPT COLB (I J) .
COMPUTE COLC (I J) = COLA (I J) + COLB (I J).
G2000-DISPLAY-PARA.
DISPLAY ? MATRIX1?.
DISPLAY COLA (1 1) ? ? COLA (1 2).
DISPLAY COLA (1 1) ? ? COLA (1 2).
DISPLAY ? MATRIX2?.
DISPLAY COLB (1 1) ? ? COLB (1 2).
DISPLAY COLB (1 1) ? ? COLB (1 2).
DISPLAY ?SUM MATRIX?.
DISPLAY COLC (1 1) ? ? COLC (1 2)
DISPLAY COLC (1 1) ? ? COLC (1 2)
7.7 Program to retrieve information about a particular employee stored in table using search verb.
IDENTIFICATION DIVISION.
PROGRAM-ID. EMPSER.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 EMPINFO.
05 EMP OCCURS 5 TIMES INDEXED BY I.
10 EMPNO PIC 9(5).
10 EMPNAME PIC X(20).
01 WS-EMPNO PIC 9(5).
PROCEDURE DIVISION.
G0000-MAIN-PARA.
SET I TO 1.
PERFORM G1000-PROCESS-PARA 5 TIMES.
PERFORM G2000-SEARCH-PARA.
STOP RUN.
G1000-PROCESS-PARA.
ACCEPT EMPNO (I) .
ACCEPT EMPNAME (I).
ACCEPT EMPSAL (I).
SET I UP BY 1.
G2000-DISPLAY-PARA.
ACCEPT WS-EMPNUM.
SET I TO 1.
SEARCH EMP
AT END MOVE 0 TO WS-EMPNO
WHEN WS-EMPNO=EMPNO (I)
DISPLAY ?FOUND?, EMPNO (I) EMPNAME (I).
IF WS-EMPNO=0
DISPLAY ?NOT FOUND?
END-IF.
7.8 Program to update a sequential file.
IDENTIFICATION DIVISION.
PROGRAM-ID. SEQFUPD.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL
SELECT STUDFILE ASSIGN TO STUDDD.
DATA DIVISION.
FILE SECTION.
FD STUDFILE.
01 FS-STUD-REC.
05 FS-REGNO PIC X(5).
05 FS-NAME PIC A(15).
05 FS-AGE PIC 99.
05 FILLER PIC X(58).
WORKING-STORAGE SECTION.
01 CHOICE PIC X(1) VALUE ?Y?.
01 WS-STUD-REC.
05 WS-REGNO PIC X(5).
05 WS-NAME PIC A(15).
05 WS-AGE PIC 99.
05 FILLER PIC X(58).
01 WS-U-REGNO PIC X(5).
01 WS-U-NAME PIC A(15).
01 WS-U-AGE PIC 99.
01 RECORD-FOUND PIC X VALUE ?N?.
01 EOF PIC X VALUE ?N?.
PROCEDURE DIVISION.
G0000-MAIN-PARA .
OPEN I-O STUDFILE.
PERFORM G1000-ACCEPT-PARA.
PERFORM G2000-PROCESS-PARA UNTIL RECORD-FOUND = ?Y?.
CLOSE STUDFILE.
STOP RUN.
G1000-ACCEPT-PARA.
ACCEPT WS-U-REGNO.
ACCEPT WS-U-NAME.
ACCEPT WS-U-AGE.
G2000-PROCESS-PARA.
PERFORM G3000-READ-PARA.
IF EOF = ?N?
IF WS-U-REGNO = WS-REGNO MOVE ?Y? TO RECORD-FOUND
PERFORM G4000-UPDATE-PARA
END-IF
END-IF.
G3000-READ-PARA.
READ STUDFILE INTO WS-STUD-REC AT END MOVE ?Y? TO EOF.
G4000-UPDATE-PARA.
MOVE WS-U-REGNO TO WS-REGNO.
MOVE WS-U-NAME TO WS-NAME.
MOVE WS-U-AGE TO WS-AGE.
REWRITE FS-STUD-REC FROM WS-STUD-REC.
7.9 Program to add record in a Index Sequential file.
IDENTIFICATION DIVISION.
PROGRAM-ID. INDXADD.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL
SELECT STUDFILE ASSIGN TO STUDDD
ORGANIZATION IS INDEXED
ACCESS MODE IS RANDOM
RECORD KEY IS FS-REGNO.
DATA DIVISION.
FILE SECTION.
FD STUDFILE.
01 FS-STUD-REC.
05 FS-REGNO PIC X(5).
05 FS-NAME PIC A(15).
05 FS-AGE PIC 99.
05 FILLER PIC X(58).
WORKING-STORAGE SECTION.
01 EOF PIC X(1) VALUE ?N?.
01 WS-STUD-REC.
05 WS-REGNO PIC X(5).
05 WS-NAME PIC A(15).
05 WS-AGE PIC 99.
05 FILLER PIC X(58).
PROCEDURE DIVISION.
G0000-MAIN-PARA .
PERFORM G1000-OPEN-PARA.
PERFORM G2000-INPUT-PARA .
PERFORM G3000-INSERT-PARA .
PERFORM G4000-CLOSE-PARA .
STOP RUN.
G1000-OPEN-PARA.
OPEN I-O STUDFILE.
G2000-INPUT-PARA.
ACCEPT WS-REGNO.
ACCEPT WS-NAME.
ACCEPT WS-AGE.
G3000-INSERT-PARA.
WRITE FS-STUD-REC FROM WS-STUD-REC
INVALID KEY DISPLAY ?INVALID RECORD?
NOT INVALID KEY DISPLAY ?INSERTED RECORD?
END-WRITE.
G4000-CLOSE-PARA
CLOSE STUDFILE.
7. 10 Program to DELETE record in a Index Sequential file.
IDENTIFICATION DIVISION.
PROGRAM-ID. INDXDEL.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL
SELECT STUDFILE ASSIGN TO STUDDD
ORGANIZATION IS INDEXED
ACCESS MODE IS RANDOM
RECORD KEY IS REGNO.
DATA DIVISION.
FILE SECTION.
FD STUDFILE.
01 STUD-REC.
05 REGNO PIC X(5).
05 NAME PIC A(15).
05 AGE PIC 99.
05 FILLER PIC X(58).
WORKING-STORAGE SECTION.
01 EOF PIC X VALUE ?N?.
01 WS-STUD-REC X(22).
01 WS-REGNO PIC X(5).
01 WS-D-REGNO PIC X(5).
01 RECORD-FOUND PIC X VALUE ?N?
PROCEDURE DIVISION.
G0000-MAIN-PARA .
PERFORM G1000-OPEN-PARA.
PERFORM G2000-INPUT-PARA .
PERFORM G3000-PROCESS-PARA UNTIL RECORD-FOUND = ?Y? .
PERFORM G6000-CLOSE-PARA .
STOP RUN.
G1000-OPEN-PARA.
OPEN I-O STUDFILE.
G2000-INPUT-PARA.
ACCEPT WS-D-REGNO.
G3000-PROCESS-PARA.
PERFORM G4000-READ-PARA.
IF EOF = ?N?
IF WS-D-REGNO = WS-REGNO MOVE ?Y? TO RECORD-FOUND
PERFORM G5000-DELETE-PARA
END-IF
END-IF.
G4000-READ-PARA.
READ STUDFILE INTO WS-STUD-REC AT END MOVE ?Y? TO EOF.
MOVE REGNO TO WS-REGNO.
G5000-DELETE-PARA
DELETE STUDFILE RECORD.
G6000-CLOSE-PARA
CLOSE STUDFILE.
7. 11 Program to create and display a RELATIVE file.
IDENTIFICATION DIVISION.
PROGRAM-ID. RELFILCR.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL
SELECT STUDFILE ASSIGN TO STUDDD
ORGANIZATION IS RELATIVE
ACCESS MODE IS RANDOM
RELATIVE KEY IS RNO.
DATA DIVISION.
FILE SECTION.
FD STUDFILE.
01 STUD-REC.
05 REGNO PIC X(5).
05 NAME PIC A(15).
05 AGE PIC 99.
05 FILLER PIC X(58).
WORKING-STORAGE SECTION.
01 EOF PIC X VALUE ?N?.
01 RNO PIC 999.
01 I PIC 999.
01 WS-STUD-REC.
05 WSREGNO PIC X(5).
05 WSNAME PIC A(15).
05 WSAGE PIC 99.
01 RECORD-FOUND PIC X VALUE ?N?
PROCEDURE DIVISION.
G0000-MAIN-PARA .
PERFORM G1000-OPEN-PARA.
PERFORM G2000-INPUT-PARA VARYING I FROM 1 BY 1 UNTIL I > 2.
PERFORM G3000-DISPLAY-PARA UNTIL EOF = ?Y? .
PERFORM G6000-CLOSE-PARA .
STOP RUN.
G1000-OPEN-PARA.
OPEN OUTPUT STUDFILE.
CLOSE STUDFILE.
OPEN I-O STUDFILE.
G2000-INPUT-PARA.
ACCEPT WSREGNO.
ACCEPT WSNAME.
ACCEPT WSAGE.
MOVE I TO RNO.
WRITE STUD-REC FROM WS-STUD-REC
INVALID KEY DISPLAY ?ERROR IN INSERTING?.
G3000-DISPLAY-PARA.
READ STUDFILE NEXT RECORD INTO WS-STUD-REC
AT END MOVE ?Y? TO EOF.
DISPLAY WS-STUD-REC.
G6000-CLOSE-PARA
CLOSE STUDFILE.
7.12 Program to illustrate subroutine.Subroutine is used to add two numbers and pass the value to the called program.
Calling Program.
IDENTIFICATION DIVISION.
PROGRAM-ID. MAINPRG.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 NUM1 PIC 99 VALUE 0 .
01 NUM2 PIC 99 VALUE 0..
01 SUM2 PIC 999 VALUE 0.
PROCEDURE DIVISION.
G0000-MAIN-PARA .
ACCEPT NUM1 .
ACCEPT NUM2 .
CALL ?SUMPRG? USING NUM1, NUM2, SUM2.
DISPLAY SUM2.
STOP RUN.
Called program ? SUMPRG.
IDENTIFICATION DIVISION.
PROGRAM-ID. SUMPRG.
DATA DIVISION.
LINKAGE SECTION.
01 N1 PIC 99 .
01 N2 PIC 99 .
01 S2 PIC 999.
PROCEDURE DIVISION USING N1, N2, S2.
G0000-MAIN-PARA .
COMPUTE S2 = N1+ N2.
EXIT PROGRAM.
IDENTIFICATION DIVISION.
PROGRAM-ID. MEAN.
AUTHOR. LOGICAL EXTENSIONS.
**** Demonstrates how to construct a basic subprogram that
* will be CALLed by another
**** This subprogram accepts two integers (X and Y) and
* returns either their arithmetic or geometric mean,
* depending on the value of the parameter T:
* T = A -> Arithmetic mean
* G -> Geometric mean
* If T = any other value, 0 is returned
DATA DIVISION.
LINKAGE SECTION.
01 T PIC X.
01 X PIC 9(05).
01 Y PIC 9(05).
01 Z PIC 9(05)V9(5).
PROCEDURE DIVISION USING T, X, Y, Z.
000-MAIN.
EVALUATE T
WHEN 'A'
COMPUTE Z = (X + Y) / 2
WHEN 'G'
COMPUTE Z = (X * Y) ** 0.5
WHEN OTHER
MOVE 0 TO Z
END-EVALUATE.
EXIT PROGRAM.
7.13 CREATING AN INDEXED FILE WITH ALTERNATE RECORD KEYS EXAMPLE.
IDENTIFICATION DIVISION.
PROGRAM-ID. CRALTEX.
AUTHOR. LOGICAL EXTENSIONS.
DATE-WRITTEN. 980301.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT SEQ-MASTER-FILE
ASSIGN TO DISK 'C:\COBOL\TESTDATA\OLDMAST1.TXT'
ORGANIZATION IS LINE SEQUENTIAL.
* The SELECT for the indexed filed must include the
* ORGANIZATION IS INDEXED and RECORD KEY IS clauses.
* Since the file is being created, it will be ACCESSed
* (written) SEQUENTIALY. Here an ALTERNATE RECORD KEY
* has been specified, which may be duplicated.
SELECT NDX-MASTER-FILE
ASSIGN TO DISK 'C:\COBOL\TESTDATA\ALTMAST.NDX'
ORGANIZATION IS INDEXED
ACCESS IS SEQUENTIAL
RECORD KEY IS MASTER-PN
ALTERNATE RECORD KEY IS MASTER-NOMEN
WITH DUPLICATES.
DATA DIVISION.
FILE SECTION.
* No fields are defined for the sequential file being read
FD SEQ-MASTER-FILE.
01 SEQ-MASTER-REC PIC X(36).
* At least the field(s) used as RECORD KEY and ALTERNATE
* RECORD KEY(S) must be defined for the indexed file
FD NDX-MASTER-FILE.
01 NDX-MASTER-REC.
05 MASTER-PN PIC X(09).
05 PIC X(12).
05 MASTER-NOMEN PIC X(15).
WORKING-STORAGE SECTION.
01 EOF-INDICATOR PIC X(01) VALUE "N".
88 EOF VALUE "Y".
PROCEDURE DIVISION.
000-MAIN-LINE.
* Both sequential and indexed files are opened normally
OPEN INPUT SEQ-MASTER-FILE
OUTPUT NDX-MASTER-FILE.
* The sequential input file is read normally until EOF
* is encountered. 100-WRITE-NDX-MASTER is performed
* to write the record to the new indexed output file.
PERFORM UNTIL EOF
MOVE SPACES TO SEQ-MASTER-REC
READ SEQ-MASTER-FILE
AT END
SET EOF TO TRUE
NOT AT END
PERFORM 100-WRITE-NDX-MASTER
END-READ
END-PERFORM.
* Both files are closed normally after all records have been
* read and written.
CLOSE SEQ-MASTER-FILE
NDX-MASTER-FILE.
STOP RUN.
100-WRITE-NDX-MASTER.
* The input record is first moved to the output area
MOVE SEQ-MASTER-REC TO NDX-MASTER-REC.
* And then written to the indexed output file. Note that in
* writing to an indexed file whose ACCESS IS SEQUENTIAL, an
* error will occur if the RECORD KEY (from the input file)
* is out of sequence--an INVALID KEY condition is used to
* specify the action to be taken in this case. The END-WRITE
* terminator can be used in COBOL-85.
WRITE NDX-MASTER-REC
INVALID KEY DISPLAY "INVALID REC" MASTER-PN
END-WRITE.
7.14 Sorting Arrays.
IDENTIFICATION DIVISION.
PROGRAM-ID. ARRSORT.
DATE-COMPILED. 95/01/03 modified 99/01/12.
******************************************************************
* *
* SORTING ARRAYS EXAMPLES *
* *
* This program demonstrates how to implement bubble and *
* Shell sorts. A sequential payroll file is read, and a *
* report of average salaries by territory is produced. *
* The report is in descending order of average salary. *
* *
******************************************************************
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT IN-FILE
ASSIGN TO DISK 'C:\COBOL\TESTDATA\PAYROLL.TXT'
ORGANIZATION IS LINE SEQUENTIAL.
SELECT OUT-FILE
ASSIGN TO PRINTER 'C:\COBOL\OUTPUT\ARRSRT.TXT'.
DATA DIVISION.
FILE SECTION.
FD IN-FILE.
01 IN-REC.
05 PIC X(25).
05 TERR-IN PIC 99.
05 PIC XX.
05 ANNSAL-IN PIC 9(6).
05 PIC X(45).
FD OUT-FILE.
01 OUT-REC PIC X(80).
WORKING-STORAGE SECTION.
**** This is the main accumulator array, in which the group-item
* TERRITORY has nine occurrences. The subscript is J.
01 SALARY-ACCUMULATOR.
05 TERRITORY OCCURS 9 TIMES.
10 TERR-NBR PIC 99.
10 NBR-EMPS PIC 9(3).
10 SALARY PIC 9(9).
05 J PIC 99.
**** Data items used in the array sorts
01 SORT-CONTROL-VARS.
05 TOPPER PIC 99.
05 PASS PIC 99.
05 GAP PIC 99.
05 K PIC 99.
05 SWAP-SPACE PIC X(14).
05 ALLDONE-FLAG PIC 9.
88 NOT-ALLDONE VALUE 0.
88 ALLDONE VALUE 1.
01 EOF-INDICATOR PIC 9 VALUE 0.
88 EOF VALUE 1.
01 RPT-HEADER.
05 PIC X(38) VALUE " AVERAGE SALARY LISTING ".
05 DATE-OUT PIC 99/99/99.
01 COL-HEADER.
05 PIC X(80) VALUE " TERRITORY NBR EMPLOYEES AVERAGE SALARY".
01 DETAIL-LINE.
05 PIC X(8) VALUE SPACES.
05 TERR-OUT PIC 99.
05 PIC X(11) VALUE SPACES.
05 NBR-EMPS-OUT PIC ZZ9.
05 PIC X(12) VALUE SPACES.
05 AVG-SAL-OUT PIC ZZ9,999.
PROCEDURE DIVISION.
000-MAIN-LINE.
**** Controls top-level program execution; note that record
* processing is simple, and all performed in the NOT-AT-END
* clause of the READ statement
PERFORM 100-INITIALIZE.
PERFORM UNTIL EOF
READ IN-FILE
AT END
SET EOF TO TRUE
NOT AT END
ADD 1 TO NBR-EMPS (TERR-IN)
ADD ANNSAL-IN TO SALARY (TERR-IN)
END-READ
END-PERFORM.
PERFORM 900-EOJ.
STOP RUN.
100-INITIALIZE.
**** All start-up functions
OPEN INPUT IN-FILE
OUTPUT OUT-FILE.
ACCEPT DATE-OUT FROM DATE.
* Set accumulator initial values
INITIALIZE SALARY-ACCUMULATOR.
PERFORM VARYING J FROM 1 BY 1 UNTIL J > 9
MOVE J TO TERR-NBR (J)
END-PERFORM.
500-BUBBLE-SORT.
**** Sorts the TERRITORY array into descending order of avg salary
* using a bubble sort algorithm
SET NOT-ALLDONE TO TRUE
PERFORM VARYING PASS FROM 1 BY 1 UNTIL PASS > 9 OR ALLDONE
SET ALLDONE TO TRUE
SUBTRACT PASS FROM 9 GIVING TOPPER
PERFORM VARYING J FROM 1 BY 1 UNTIL J > TOPPER
COMPUTE K = J + 1
IF SALARY (J) < SALARY (K)
MOVE TERRITORY (J) TO SWAP-SPACE
MOVE TERRITORY (K) TO TERRITORY (J)
MOVE SWAP-SPACE TO TERRITORY (K)
SET NOT-ALLDONE TO TRUE
END-IF
END-PERFORM
END-PERFORM.
600-SHELL-SORT.
**** Sorts the TERRITORY array into descending order of avg salary
* using a Shell sort algorithm
COMPUTE GAP = 9 / 2.
PERFORM UNTIL GAP = 0
SET NOT-ALLDONE TO TRUE
PERFORM UNTIL ALLDONE
SET ALLDONE TO TRUE
PERFORM VARYING J FROM 1 BY 1 UNTIL J > (9 - GAP)
COMPUTE K = J + GAP
IF SALARY (J) < SALARY (K)
MOVE TERRITORY (J) TO SWAP-SPACE
MOVE TERRITORY (K) TO TERRITORY (J)
MOVE SWAP-SPACE TO TERRITORY (K)
SET NOT-ALLDONE TO TRUE
END-IF
END-PERFORM
END-PERFORM
DIVIDE 2 INTO GAP
END-PERFORM.
900-EOJ.
**** Calculate average salary, sort and print the report
* Calculate average salaries
PERFORM VARYING J FROM 1 BY 1 UNTIL J > 9
COMPUTE SALARY (J) ROUNDED = SALARY (J) / NBR-EMPS (J)
ON SIZE ERROR MOVE 0 TO SALARY (J)
END-COMPUTE
END-PERFORM.
* First sort it -- can use 500-BUBBLE-SORT or 600-SHELL-SORT
* comment-out the one you don't want
PERFORM 500-BUBBLE-SORT.
* PERFORM 600-SHELL-SORT.
* Now write headers and print detail
WRITE OUT-REC FROM RPT-HEADER AFTER PAGE.
WRITE OUT-REC FROM COL-HEADER AFTER 2.
PERFORM VARYING J FROM 1 BY 1 UNTIL J > 9
MOVE TERR-NBR (J) TO TERR-OUT
MOVE NBR-EMPS (J) TO NBR-EMPS-OUT
MOVE SALARY (J) TO AVG-SAL-OUT
WRITE OUT-REC FROM DETAIL-LINE AFTER 2
END-PERFORM.
CLOSE IN-FILE, OUT-FILE.
7. 15 Control Break Processing ? 1
IDENTIFICATION DIVISION.
PROGRAM-ID. CTRLBRK1.
DATE-COMPILED.
******************************************************************
* *
* SAMPLE SINGLE CONTROL BREAK PROGRAM *
* *
* The program creates a departmental sales report using a *
* control break procedure. *
* *
******************************************************************
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT SALES-IN
ASSIGN TO DISK 'CBK1.TXT'
ORGANIZATION IS LINE SEQUENTIAL.
SELECT PRINT-OUT
ASSIGN TO 'CTRLBRK1.RPT'.
DATA DIVISION.
FILE SECTION.
FD SALES-IN.
01 SALES-REC-IN.
05 DEPT-IN PIC 99.
05 SLSNO-IN PIC 9(5).
05 AMT-OF-SALES-IN PIC 9(4)V99.
05 PIC X(67).
FD PRINT-OUT.
01 PRINT-REC PIC X(80).
/
WORKING-STORAGE SECTION.
01 WORK-AREAS.
05 EOF-INDICATOR PIC 9 VALUE 0.
88 EOF VALUE 1.
05 WS-HOLD-DEPT PIC 99 VALUE 0.
05 WS-DEPT-TOTAL PIC 9(5)V99 VALUE 0.
05 WS-GRAND-TOTAL PIC 9(7)V99 VALUE 0.
05 MAXLINES PIC 99 VALUE 48.
05 WS-LINE-CT PIC 99 VALUE 0.
05 WS-PAGE-CT PIC 99 VALUE 0.
01 REPORT-HEADER.
05 PIC X(34) VALUE
'MONTHLY STATUS REPORT AS OF '.
05 DATE-OUT PIC 99/99/99.
05 PIC X(28) VALUE
' PAGE '.
05 PAGE-NBR-OUT PIC Z9.
01 COLUMN-HEADER.
05 PIC X(42) VALUE
'DEPT SALESPERSON NO AMT OF SALES'.
01 DETAIL-LINE.
05 PIC X VALUE SPACE.
05 DL-DEPT-OUT PIC 99.
05 PIC X(11) VALUE SPACE.
05 DL-SLSNO-OUT PIC 9(5).
05 PIC X(13) VALUE SPACE.
05 DL-AMT-OF-SALES-OUT PIC ZZ,ZZ9.99.
01 DEPT-TOTAL-LINE.
05 PIC X(62) VALUE
' *DEPARTMENT T
- 'OTAL: '.
05 DEPT-TOTAL-OUT PIC $$$,$$$.99.
/
PROCEDURE DIVISION.
000-MAINLINE.
PERFORM 100-INITIALIZE
PERFORM 200-DETAIL-RTN
UNTIL EOF
PERFORM 900-TERMINATE
STOP RUN.
100-INITIALIZE.
** All beginning of job functions
OPEN INPUT SALES-IN
OUTPUT PRINT-OUT
ACCEPT DATE-OUT FROM DATE
PERFORM 400-HEADING-RTN
** Read the first record and set control break variable
PERFORM 240-READ-NEXT-REC
MOVE DEPT-IN TO WS-HOLD-DEPT.
200-DETAIL-RTN.
** First check for control break
IF DEPT-IN NOT = WS-HOLD-DEPT
PERFORM 300-CONTROL-BREAK
END-IF
** Set up detail line and write it
MOVE DEPT-IN TO DL-DEPT-OUT
MOVE SLSNO-IN TO DL-SLSNO-OUT
MOVE AMT-OF-SALES-IN TO DL-AMT-OF-SALES-OUT
MOVE DETAIL-LINE TO PRINT-REC
PERFORM 250-WRITE-A-LINE
** Accumulate totals and get next record
ADD AMT-OF-SALES-IN TO WS-DEPT-TOTAL
PERFORM 240-READ-NEXT-REC.
240-READ-NEXT-REC.
** Reads next record from input file
READ SALES-IN
AT END SET EOF TO TRUE
END-READ.
/
250-WRITE-A-LINE.
** Output a report detail or total line
IF WS-LINE-CT > MAXLINES
PERFORM 400-HEADING-RTN
MOVE 4 TO WS-LINE-CT
END-IF
WRITE PRINT-REC AFTER 2
ADD 2 TO WS-LINE-CT.
300-CONTROL-BREAK.
** Prints totals for department, resets accumulators
MOVE WS-DEPT-TOTAL TO DEPT-TOTAL-OUT
MOVE DEPT-TOTAL-LINE TO PRINT-REC
PERFORM 250-WRITE-A-LINE
** If more records to process, reset dept total and ctrl break
IF NOT EOF
MOVE 0 TO WS-DEPT-TOTAL
MOVE DEPT-IN TO WS-HOLD-DEPT
END-IF.
400-HEADING-RTN.
** Update page counter and print page headers
ADD 1 TO WS-PAGE-CT
MOVE WS-PAGE-CT TO PAGE-NBR-OUT
WRITE PRINT-REC FROM REPORT-HEADER AFTER PAGE
WRITE PRINT-REC FROM COLUMN-HEADER AFTER 2.
900-TERMINATE.
** Perform control break to get last dept total
PERFORM 300-CONTROL-BREAK
CLOSE SALES-IN
PRINT-OUT.
7. 16 Control Break Processing ? 2
IDENTIFICATION DIVISION.
PROGRAM-ID. CTRLBRK2.
DATE-COMPILED.
******************************************************************
* *
* SAMPLE MULTI-CONTROL BREAK PROGRAM *
* *
* This program reads a sequential file of populations by *
* county within states, and produces a printed report. *
* *
******************************************************************
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT REGISTRATION-MASTER
ASSIGN TO 'C:\COBOL\TESTDATA\CBK2.TXT'
ORGANIZATION IS LINE SEQUENTIAL.
SELECT REGISTRATION-REPORT
ASSIGN TO 'C:\COBOL\OUTPUT\CTRLBRK2.RPT'.
DATA DIVISION.
FILE SECTION.
FD REGISTRATION-MASTER.
01 REG-REC.
05 ST-NO-IN PIC XX.
05 CO-NO-IN PIC XX.
05 DIST-NO-IN PIC XX.
05 REG-IN PIC 9(6).
FD REGISTRATION-REPORT.
01 REPORT-REC PIC X(50).
WORKING-STORAGE SECTION.
01 EOF-INDICATOR PIC 9 VALUE 0.
88 EOF VALUE 1.
01 WS-LINE-CT PIC 99 VALUE 0.
01 MAXLINES PIC 99 VALUE 55.
01 WS-CO-HOLD PIC XX.
01 WS-CO-TOT PIC 9(7) VALUE 0.
01 WS-ST-HOLD PIC XX.
01 WS-ST-TOT PIC 9(8) VALUE 0.
01 WS-FIN-TOT PIC 9(9) VALUE 0.
01 HDR-1.
05 PIC X(27) VALUE
'REGISTRATION REPORT '.
05 DATE-OUT PIC 99/99/99.
05 PIC X(13) VALUE
' PAGE '.
05 HL-PAGE-NO PIC 99 VALUE 0.
01 HDR-2.
05 PIC X(29) VALUE
'COUNTY NO REGISTRATION'.
01 CO-TOT-LINE.
05 PIC X(3) VALUE SPACE.
05 CO-NO-OUT PIC XX.
05 PIC X(14) VALUE SPACE.
05 CO-TOT-OUT PIC ZZ,ZZZ,ZZ9.
01 ST-TOT-LINE.
05 PIC X(14) VALUE
' * STATE '.
05 ST-NO-OUT PIC XX.
05 PIC X(14) VALUE
' REGISTRATION '.
05 ST-TOT-OUT PIC ZZZ,ZZZ,ZZ9.
01 TOTAL-LINE.
05 PIC X(30) VALUE
' ** TOTAL US REGISTRATION '.
05 FIN-TOT-OUT PIC ZZZ,ZZZ,ZZ9.
/
PROCEDURE DIVISION.
000-MAINLINE.
PERFORM 100-INITIALIZE
PERFORM 300-CALC-MODULE
UNTIL EOF
PERFORM 900-TERMINATE
STOP RUN.
100-INITIALIZE.
** All beginning of job functions
OPEN INPUT REGISTRATION-MASTER
OUTPUT REGISTRATION-REPORT
ACCEPT DATE-OUT FROM DATE
PERFORM 200-HDR-MODULE
** Read first record and set control break variables
PERFORM 600-READ-MODULE
MOVE CO-NO-IN TO WS-CO-HOLD
MOVE ST-NO-IN TO WS-ST-HOLD.
200-HDR-MODULE.
** Print report headers
ADD 1 TO HL-PAGE-NO
WRITE REPORT-REC FROM HDR-1 AFTER PAGE
WRITE REPORT-REC FROM HDR-2 AFTER 2
MOVE SPACES TO REPORT-REC
WRITE REPORT-REC AFTER 1
MOVE 5 TO WS-LINE-CT.
300-CALC-MODULE.
** First check for control break (major then minor)
IF ST-NO-IN NOT = WS-ST-HOLD
PERFORM 400-STATE-BREAK
ELSE
IF CO-NO-IN NOT = WS-CO-HOLD
PERFORM 450-COUNTY-BREAK
END-IF
END-IF
** Add to county total and read next record
ADD REG-IN TO WS-CO-TOT
PERFORM 600-READ-MODULE.
400-STATE-BREAK.
** First force minor (county) control break
PERFORM 450-COUNTY-BREAK
** Set up state total line and print it
MOVE WS-ST-TOT TO ST-TOT-OUT
MOVE WS-ST-HOLD TO ST-NO-OUT
** See if there's enough room to print and write totals
IF WS-LINE-CT > (MAXLINES - 3)
PERFORM 200-HDR-MODULE
END-IF
WRITE REPORT-REC FROM ST-TOT-LINE AFTER 2
MOVE SPACES TO REPORT-REC
WRITE REPORT-REC AFTER 1
ADD 3 TO WS-LINE-CT
** Add to grand total, reset state total and control break var
ADD WS-ST-TOT TO WS-FIN-TOT
MOVE 0 TO WS-ST-TOT
MOVE ST-NO-IN TO WS-ST-HOLD.
450-COUNTY-BREAK.
** Set up county total line
MOVE WS-CO-TOT TO CO-TOT-OUT
MOVE WS-CO-HOLD TO CO-NO-OUT
** Check for space on page and print it
IF WS-LINE-CT > MAXLINES
PERFORM 200-HDR-MODULE
END-IF
WRITE REPORT-REC FROM CO-TOT-LINE AFTER 1
ADD 1 TO WS-LINE-CT
** Add to state total, reset county total and control break var
ADD WS-CO-TOT TO WS-ST-TOT
MOVE 0 TO WS-CO-TOT
MOVE CO-NO-IN TO WS-CO-HOLD.
600-READ-MODULE.
READ REGISTRATION-MASTER
AT END SET EOF TO TRUE
END-READ.
900-TERMINATE.
** First force major control break
PERFORM 400-STATE-BREAK
** Set up and print final totals, close files
MOVE WS-FIN-TOT TO FIN-TOT-OUT
IF WS-LINE-CT > (MAXLINES - 2)
PERFORM 200-HDR-MODULE
END-IF
WRITE REPORT-REC FROM TOTAL-LINE AFTER 2
CLOSE REGISTRATION-MASTER
REGISTRATION-REPORT.
7.17 Merging
IDENTIFICATION DIVISION.
PROGRAM-ID. MERGEX.
AUTHOR. LOGICAL EXTENSIONS.
DATE-WRITTEN. 970213
990209 rev 1.0
000218 rev 2.0 for FCCJ MF.
DATE-COMPILED.
**** This program demonstrates the use of the COBOL MERGE
* to combine two transaction files for subsequent update
* processing.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
*** Each file to be merged (there must be at least 2) are
* selected in FILE-CONTROL, as well as the resulting output
* file and a merge "work file"
FILE-CONTROL.
SELECT RECEIPT-TRANS-FILE
ASSIGN TO DISK "C:\COBOL\TESTDATA\RTRANS.TXT"
ORGANIZATION IS LINE SEQUENTIAL.
SELECT SHIP-TRANS-FILE
ASSIGN TO DISK "C:\COBOL\TESTDATA\STRANS.TXT"
ORGANIZATION IS LINE SEQUENTIAL.
SELECT MERGED-TRANS-FILE
ASSIGN TO DISK "C:\COBOL\OUTPUT\MTRANS.TXT"
ORGANIZATION IS LINE SEQUENTIAL.
SELECT WORK-FILE
ASSIGN TO DISK.
DATA DIVISION.
FILE SECTION.
*** The files to be merged should have the same record lengths
* and the key field must be in the same position in each
* file. Fields do not have to be defined, however.
FD RECEIPT-TRANS-FILE.
01 RECEIPT-TRANS-REC PIC X(22).
FD SHIP-TRANS-FILE.
01 SHIP-TRANS-REC PIC X(22).
*** The resulting file has the same record length
FD MERGED-TRANS-FILE.
01 MERGED-TRANS-REC PIC X(22).
*** The only fields that need to be defined for the work file
* are those in the KEY IS clause in the MERGE statement.
SD WORK-FILE.
01 WORK-REC.
05 W-TRANS-CODE PIC X(01).
05 W-TRANS-PN PIC X(09).
05 PIC X(12).
PROCEDURE DIVISION.
000-MAIN-LINE.
MERGE WORK-FILE
ON ASCENDING KEY W-TRANS-PN
W-TRANS-CODE
USING RECEIPT-TRANS-FILE
SHIP-TRANS-FILE
GIVING MERGED-TRANS-FILE.
STOP RUN.
7.18 Manipulating Characters & String.
IDENTIFICATION DIVISION.
PROGRAM-ID. TXTMANEX.
AUTHOR. LOGICAL EXTENSIONS.
DATE-WRITTEN. 970330.
**** This program demonstrates some of the common uses of the
* text manipulation statements STRING, UNSTRING and INSPECT
DATA DIVISION.
WORKING-STORAGE SECTION.
**** The customer record defined below simulates how the
* customer data might be internally stored. Initial values
* are assigned only for demonstration purposes. Actual
* data would most likely be read from a file.
**** Note that some group items must be REDEFINED, since a group
* item can't be moved to an edited item (like some in
* DISPLAY-REC than contain the 'B' formatter in their PICs).
01 CUSTOMER-REC.
05 ACCT-NBR.
10 ACCT-LN-4 PIC X(4) VALUE "SMYT".
10 ACCT-FN-1 PIC X VALUE "V".
10 ACCT-MI-1 PIC X VALUE "Q".
10 ACCT-DT-4 PIC X(4) VALUE "8911".
05 WHOLE-ACCT-NBR
REDEFINES ACCT-NBR PIC X(10).
05 NAME-DATA.
10 LAST-NAME PIC X(16) VALUE "Smythe".
10 FIRST-NAME PIC X(12) VALUE "Valerie".
10 MID-INIT PIC X VALUE "Q".
05 HOME-ADDRESS.
10 ADDR-LINE-1 PIC X(30) VALUE "111 Main St.".
10 ADDR-LINE-2.
15 CITY PIC X(20) VALUE "Doublewide".
15 ST PIC XX VALUE "FL".
15 ZIP.
20 ZIP-1 PIC X(5) VALUE "33303".
20 ZIP-2 PIC X(4) VALUE "9876".
05 PHONE.
10 AREA-CODE PIC X(3) VALUE "813".
10 P-NUMBER.
15 FIRST3 PIC X(3) VALUE "555".
15 LAST4 PIC X(4) VALUE "1234".
05 WHOLE-PHONE
REDEFINES PHONE PIC X(10).
05 OPEN-DATE PIC 9(6) VALUE 891112.
05 LAST-TRAN PIC 9(6) VALUE 940809.
05 CREDIT-LIMIT PIC 9(5) VALUE 8000.
** The format below defines each line of the record for
* screen display. Note the use of 'B' as a field separator
* in some lines, which is used for subsequent manipulation
* with the STRING statement.
01 DISPLAY-REC.
05 LINE-1-OUT.
10 PIC X(12) VALUE "ACCT NBR:".
10 ACCT-NBR-OUT PIC X(6)BX(4).
05 LINE-2-OUT.
10 PIC X(12) VALUE "NAME:".
10 NAME-OUT PIC X(32).
05 LINE-3-OUT.
10 PIC X(12) VALUE "PHONE: ".
10 PHONE-OUT PIC BXXXBBXXXBXXXX.
05 LINE-4-OUT.
10 PIC X(12) VALUE "ADDRESS:".
10 ADDRESS-OUT PIC X(62).
05 LINE-5-OUT.
10 PIC X(12) VALUE "ACCT DATA:".
10 PIC X(08) VALUE "OPENED: ".
10 OPEN-DATE-OUT PIC XX/XX/XX.
10 PIC X(10) VALUE " LAST: ".
10 LAST-TRAN-OUT PIC XX/XX/XX.
10 PIC X(11) VALUE " LIMIT: ".
10 CREDIT-LIMIT-OUT PIC $ZZ,ZZ9.
** The formats below are used to hold the data input from an
* ACCEPT statement before it is validated and placed in the
* corresponding record field.
01 INPUT-REC.
05 NAME-IN PIC X(32).
05 PHONE-IN PIC X(12).
05 ADDR-LINE-1-IN PIC X(30).
05 ADDR-LINE-2-IN PIC X(30).
05 ZIP-IN PIC X(10).
** Various screen handling and data validation variables:
01 SEP-LINE PIC X(64) VALUE
"--------------------------------------------------------
- --------""."
01 ACTION PIC X.
01 PAUSER PIC X.
01 NUM-FIELDS-INPUT PIC 9.
01 CHAR-CNT PIC 99.
01 FIELD-LENGTH-COUNTERS.
05 CNT-1 PIC 99.
05 CNT-2 PIC 99.
05 CNT-3 PIC 99.
01 EDIT-CHECK PIC 9.
88 EDIT-OK VALUE 1.
88 EDIT-NOT-OK VALUE 0.
PROCEDURE DIVISION.
000-MAIN-LINE.
PERFORM 100-MAIN-MENU.
PERFORM UNTIL ACTION = 3
IF ACTION = 1
PERFORM 200-DISPLAY-REC
ELSE
IF ACTION = 2
PERFORM 300-NEW-CUSTOMER
END-IF
END-IF
PERFORM 100-MAIN-MENU
END-PERFORM.
STOP RUN.
100-MAIN-MENU.
** Display the main menu and get the user's choice
DISPLAY SPACES.
DISPLAY SPACES.
DISPLAY "********* MAIN MENU **********".
DISPLAY SPACES.
DISPLAY " 1 - Display current record".
DISPLAY " 2 - Construct new record".
DISPLAY " 3 - Exit program".
DISPLAY SPACES.
DISPLAY "******************************".
DISPLAY SPACES.
DISPLAY " Enter option number -> "
WITH NO ADVANCING.
ACCEPT ACTION.
200-DISPLAY-REC.
** Format and display each line of output, wait for keypress
PERFORM 210-ACCT-NBR-MANIP THRU
240-ADDRESS-MANIP.
DISPLAY SPACES.
DISPLAY LINE-1-OUT.
DISPLAY SEP-LINE.
DISPLAY LINE-2-OUT.
DISPLAY LINE-3-OUT.
DISPLAY LINE-4-OUT.
DISPLAY SEP-LINE.
MOVE OPEN-DATE TO OPEN-DATE-OUT.
MOVE LAST-TRAN TO LAST-TRAN-OUT.
MOVE CREDIT-LIMIT TO CREDIT-LIMIT-OUT.
DISPLAY LINE-5-OUT.
DISPLAY SPACES.
DISPLAY "Press any key to continue ..."
WITH NO ADVANCING.
ACCEPT PAUSER.
210-ACCT-NBR-MANIP.
MOVE WHOLE-ACCT-NBR TO ACCT-NBR-OUT.
INSPECT ACCT-NBR-OUT
REPLACING ALL SPACES BY "-".
220-NAME-MANIP.
STRING FIRST-NAME DELIMITED BY SPACE
SPACE
MID-INIT DELIMITED BY SIZE
.
LAST-NAME DELIMITED BY SIZE
INTO NAME-OUT.
230-PHONE-MANIP.
MOVE WHOLE-PHONE TO PHONE-OUT.
INSPECT PHONE-OUT REPLACING FIRST SPACE BY "(".
INSPECT PHONE-OUT REPLACING FIRST SPACE BY ")".
INSPECT PHONE-OUT REPLACING FIRST SPACE BY "-"
AFTER INITIAL SPACE.
240-ADDRESS-MANIP.
STRING ADDR-LINE-1 DELIMITED BY " "
,
CITY DELIMITED BY " "
,
ST DELIMITED BY SIZE
SPACE
ZIP-1 DELIMITED BY SIZE
-
ZIP-2 DELIMITED BY SIZE
INTO ADDRESS-OUT.
300-NEW-CUSTOMER.
DISPLAY SPACES.
DISPLAY SPACES.
DISPLAY "Enter new customer record data:".
DISPLAY SEP-LINE.
** Get all customer information:
PERFORM 310-GET-NAME.
PERFORM 320-GET-PHONE.
PERFORM 330-GET-ADDRESS.
** Construct default record fields:
ACCEPT OPEN-DATE FROM DATE.
ACCEPT LAST-TRAN FROM DATE.
MOVE 1000 TO CREDIT-LIMIT.
** Build the account number:
MOVE LAST-NAME (1:4) TO ACCT-LN-4.
MOVE FIRST-NAME (1:1) TO ACCT-FN-1.
MOVE MID-INIT (1:1) TO ACCT-MI-1.
MOVE OPEN-DATE (1:4) TO ACCT-DT-4.
** Fill in spaces in account number with "Z"'s, and
* set all alphabetics to uppercase
INSPECT ACCT-NBR CONVERTING
abcdefghijklmnopqrstuvwxyz
TO "ZABCDEFGHIJKLMNOPQRSTUVWXYZ".
310-GET-NAME.
SET EDIT-NOT-OK TO TRUE.
PERFORM UNTIL EDIT-OK
DISPLAY "NAME: [Firstname M. Lastname ]"
DISPLAY " "
WITH NO ADVANCING
ACCEPT NAME-IN
UNSTRING NAME-IN DELIMITED BY SPACE OR ". "
INTO FIRST-NAME COUNT IN CNT-1
MID-INIT COUNT IN CNT-2
LAST-NAME COUNT IN CNT-3
END-UNSTRING
IF (CNT-1 = 0) OR (CNT-2 = 0) OR (CNT-3 = 0)
DISPLAY SPACES
DISPLAY "** You must enter complete name!"
DISPLAY SPACES
ELSE
SET EDIT-OK TO TRUE
END-IF
END-PERFORM.
320-GET-PHONE.
SET EDIT-NOT-OK TO TRUE.
PERFORM UNTIL EDIT-OK
DISPLAY "PHONE: [###-###-####]"
DISPLAY " "
WITH NO ADVANCING
ACCEPT PHONE-IN
UNSTRING PHONE-IN DELIMITED BY "-"
INTO AREA-CODE COUNT IN CNT-1
FIRST3 COUNT IN CNT-2
LAST4 COUNT IN CNT-3
END-UNSTRING
IF (CNT-1 NOT = 3) OR (CNT-2 NOT = 3) OR (CNT-3 NOT = 4)
OR WHOLE-PHONE NOT NUMERIC
DISPLAY SPACES
DISPLAY "** Not a valid phone number!"
DISPLAY SPACES
ELSE
SET EDIT-OK TO TRUE
END-IF
END-PERFORM.
330-GET-ADDRESS.
PERFORM 332-GET-STREET.
PERFORM 334-GET-CITY-ST.
PERFORM 336-GET-ZIP.
332-GET-STREET.
** First get the street address, validate only that something
* has been entered
SET EDIT-NOT-OK TO TRUE.
PERFORM UNTIL EDIT-OK
DISPLAY "ADDRESS1: [Street address or PO Box #]"
DISPLAY " "
WITH NO ADVANCING
ACCEPT ADDR-LINE-1-IN
MOVE ZERO TO CHAR-CNT
INSPECT ADDR-LINE-1-IN
TALLYING CHAR-CNT FOR CHARACTERS
BEFORE INITIAL SPACE
IF CHAR-CNT = 0
DISPLAY SPACES
DISPLAY "** Must include a street address!"
DISPLAY SPACES
ELSE
MOVE ADDR-LINE-1-IN TO ADDR-LINE-1
SET EDIT-OK TO TRUE
END-IF
END-PERFORM.
334-GET-CITY-ST.
** Now get city and state; make sure both are entered, and
* convert state to all uppercase
SET EDIT-NOT-OK TO TRUE
PERFORM UNTIL EDIT-OK
DISPLAY "CITY/ST: [City name, ST ]"
DISPLAY " "
WITH NO ADVANCING
ACCEPT ADDR-LINE-2-IN
MOVE 0 TO NUM-FIELDS-INPUT
UNSTRING ADDR-LINE-2-IN DELIMITED BY ", " OR " "
INTO CITY
ST
TALLYING NUM-FIELDS-INPUT
END-UNSTRING
IF NUM-FIELDS-INPUT NOT = 2
DISPLAY SPACES
DISPLAY "** Must include both city and state!"
DISPLAY SPACES
ELSE
SET EDIT-OK TO TRUE
END-IF
INSPECT ST CONVERTING
abcdefghijklmnopqrstuvwxyz
TO "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
END-PERFORM.
336-GET-ZIP.
** And finally, get ZIP; validate first 5 characters to be
* numeric, last 4 to be numeric only if entered.
SET EDIT-NOT-OK TO TRUE
PERFORM UNTIL EDIT-OK
DISPLAY "ZIP CODE: [#####-####]"
DISPLAY " "
WITH NO ADVANCING
ACCEPT ZIP-IN
MOVE 0 TO NUM-FIELDS-INPUT
UNSTRING ZIP-IN DELIMITED BY "-" OR " "
INTO ZIP-1 COUNT IN CNT-1
ZIP-2 COUNT IN CNT-2
TALLYING NUM-FIELDS-INPUT
END-UNSTRING
IF (CNT-1 NOT = 5 OR ZIP-1 NOT NUMERIC)
OR (NUM-FIELDS-INPUT = 2
AND (CNT-2 NOT = 4 OR ZIP-2 NOT NUMERIC))
DISPLAY SPACES
DISPLAY "** Invalid zip code!"
DISPLAY SPACES
ELSE
SET EDIT-OK TO TRUE
END-IF
IF NUM-FIELDS-INPUT = 1
MOVE ZEROS TO ZIP-2
END-IF
END-PERFORM.
7. 19 Sequential File Update
IDENTIFICATION DIVISION.
PROGRAM-ID. SEQUPEX.
DATE-COMPILED.
**** This program demonstrates the simple updating of a
* sequential master file from a transaction file. Both
* files must be sorted in the same order of a shared key
* field - in this case, part number. Only one transaction
* per master record is allowed (change unit price). The
* unit price from the transaction file is written to the
* new master file.
* Created: 960104 (sjd)
* Modified: 990121 (sjd)
* 010206 (sjd) for FCCJ MF-COBOL
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT OLD-MASTER
ASSIGN TO 'C:\COBOL\TESTDATA\OLDMAST1.TXT'
ORGANIZATION IS LINE SEQUENTIAL.
SELECT NEW-MASTER
ASSIGN TO 'C:\COBOL\TESTDATA\NEWMAST1.TXT'
ORGANIZATION IS LINE SEQUENTIAL.
SELECT TRANS-FILE
ASSIGN TO 'C:\COBOL\TESTDATA\PTRANS1.TXT'
ORGANIZATION IS LINE SEQUENTIAL.
SELECT CONTROL-FILE
ASSIGN TO 'C:\COBOL\OUTPUT\SEQUPEX.RPT'.
DATA DIVISION.
FILE SECTION.
FD OLD-MASTER.
01 OLD-MASTER-REC.
05 OM-PN PIC X(09).
05 OM-QTY PIC 9(05).
05 OM-UP PIC 9(05)V99.
05 OM-NOMEN PIC X(15).
FD NEW-MASTER.
01 NEW-MASTER-REC.
05 NM-PN PIC X(09).
05 NM-QTY PIC 9(05).
05 NM-UP PIC 9(05)V99.
05 NM-NOMEN PIC X(15).
FD TRANS-FILE.
01 TRANS-REC.
05 TF-CODE PIC 9(01).
05 TF-PN PIC X(09).
05 TF-QTY PIC 9(05).
05 TF-UP PIC 9(05)V99.
FD CONTROL-FILE.
01 CONTROL-REC PIC X(80).
PROCEDURE DIVISION.
0000-MAINLINE.
PERFORM 1000-INITIALIZE
PERFORM 5000-UPDATE-RTN
UNTIL OM-PN = HIGH-VALUES
AND TF-PN = HIGH-VALUES
PERFORM 9000-EOJ
STOP RUN.
1000-INITIALIZE.
OPEN INPUT OLD-MASTER, TRANS-FILE
OUTPUT NEW-MASTER, CONTROL-FILE
PERFORM 3000-READ-MASTER
PERFORM 4000-READ-TRANS.
3000-READ-MASTER.
READ OLD-MASTER
AT END MOVE HIGH-VALUES TO OM-PN
END-READ.
4000-READ-TRANS.
READ TRANS-FILE
AT END MOVE HIGH-VALUES TO TF-PN
END-READ.
5000-UPDATE-RTN.
EVALUATE TRUE
WHEN OM-PN = TF-PN
PERFORM 5200-REGULAR-UPDATE
WHEN OM-PN < TF-PN
PERFORM 5400-NO-UPDATE
WHEN OTHER
PERFORM 5600-BAD-TRANS
END-EVALUATE.
5200-REGULAR-UPDATE.
MOVE OLD-MASTER-REC TO NEW-MASTER-REC
MOVE TF-UP TO NM-UP
WRITE NEW-MASTER-REC
PERFORM 3000-READ-MASTER
PERFORM 4000-READ-TRANS.
5400-NO-UPDATE.
WRITE NEW-MASTER-REC FROM OLD-MASTER-REC
PERFORM 3000-READ-MASTER.
5600-BAD-TRANS.
WRITE CONTROL-REC FROM TRANS-REC
PERFORM 4000-READ-TRANS.
9000-EOJ.
CLOSE OLD-MASTER, NEW-MASTER, TRANS-FILE, CONTROL-FILE.
7.20 Sort ? 1
IDENTIFICATION DIVISION.
PROGRAM-ID. SORTOPEX.
AUTHOR. LOGICAL EXTENSIONS.
DATE-WRITTEN. 970201
**** This program demonstrates the use of the COBOL SORT
* facility using an OUTPUT PROCEDURE. Here the only
* validation is making sure the TRANS-PN field in the
* output record is not blank (NOT = SPACES).
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT UNSORTED-TRANS-FILE
ASSIGN TO "C:\COBOL\TESTDATA\SORT1.TXT"
ORGANIZATION IS LINE SEQUENTIAL.
SELECT SORTED-TRANS-FILE
ASSIGN TO "C:\COBOL\TESTDATA\SORTOUT.TXT"
ORGANIZATION IS LINE SEQUENTIAL.
SELECT SORT-FILE
ASSIGN TO DISK.
DATA DIVISION.
FILE SECTION.
FD UNSORTED-TRANS-FILE.
01 UNSORTED-TRANS-REC PIC X(22).
FD SORTED-TRANS-FILE.
01 SORTED-TRANS-REC PIC X(22).
SD SORT-FILE.
01 SORT-REC.
05 S-TRANS-CODE PIC X(01).
05 S-TRANS-PN PIC X(09).
05 PIC X(12).
WORKING-STORAGE SECTION.
01 EOF-INDICATOR PIC X(01) VALUE "N".
88 EOF VALUE "Y".
PROCEDURE DIVISION.
000-MAIN-LINE.
SORT SORT-FILE
ON ASCENDING KEY
S-TRANS-PN
S-TRANS-CODE
USING UNSORTED-TRANS-FILE
OUTPUT PROCEDURE IS 100-TEST-TRANS.
STOP RUN.
100-TEST-TRANS.
OPEN OUTPUT SORTED-TRANS-FILE.
PERFORM WITH TEST AFTER
UNTIL EOF OR S-TRANS-PN NOT = SPACES
RETURN SORT-FILE
AT END SET EOF TO TRUE
END-RETURN
END-PERFORM.
PERFORM UNTIL EOF
WRITE SORTED-TRANS-REC FROM SORT-REC
RETURN SORT-FILE
AT END SET EOF TO TRUE
END-RETURN
END-PERFORM.
CLOSE SORTED-TRANS-FILE.
IDENTIFICATION DIVISION.
PROGRAM-ID. SORTEX.
AUTHOR. LOGICAL EXTENSIONS.
DATE-WRITTEN. 970201
**** This program demonstrates the use of the COBOL SORT
* facility.
*
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT UNSORTED-TRANS-FILE
ASSIGN TO "C:\COBOL\TESTDATA\SORT1.TXT"
ORGANIZATION IS LINE SEQUENTIAL.
SELECT SORTED-TRANS-FILE
ASSIGN TO "C:\COBOL\OUTPUT\SORTOUT.TXT"
ORGANIZATION IS LINE SEQUENTIAL.
SELECT SORT-FILE
ASSIGN TO DISK.
SELECT PRINT-FILE
ASSIGN TO "C:\COBOL\OUTPUT\SORTEX.RPT".
DATA DIVISION.
FILE SECTION.
FD UNSORTED-TRANS-FILE.
01 UNSORTED-TRANS-REC PIC X(22).
FD SORTED-TRANS-FILE.
01 SORTED-TRANS-REC PIC X(22).
SD SORT-FILE.
01 SORT-REC.
05 S-TRANS-CODE PIC X(01).
05 S-TRANS-PN PIC X(09).
05 PIC X(12).
FD PRINT-FILE.
01 PRINT-REC PIC X(80).
WORKING-STORAGE SECTION.
01 EOF-INDICATORS.
05 UTF PIC 9 VALUE 0.
88 UTF-EOF VALUE 1.
05 STF PIC 9 VALUE 0.
88 STF-EOF VALUE 1.
PROCEDURE DIVISION.
000-MAINLINE.
SORT SORT-FILE
ON ASCENDING KEY
S-TRANS-PN
S-TRANS-CODE
USING UNSORTED-TRANS-FILE
GIVING SORTED-TRANS-FILE.
PERFORM 100-PRINT-UNSORTED.
PERFORM 200-PRINT-SORTED.
STOP RUN.
100-PRINT-UNSORTED.
OPEN INPUT UNSORTED-TRANS-FILE
OUTPUT PRINT-FILE.
MOVE "UNSORTED TRANSACTIONS" TO PRINT-REC.
WRITE PRINT-REC AFTER PAGE.
PERFORM UNTIL UTF-EOF
MOVE SPACES TO PRINT-REC
READ UNSORTED-TRANS-FILE INTO PRINT-REC
AT END
SET UTF-EOF TO TRUE
NOT AT END
WRITE PRINT-REC AFTER 1
END-READ
END-PERFORM.
CLOSE UNSORTED-TRANS-FILE.
200-PRINT-SORTED.
OPEN INPUT SORTED-TRANS-FILE.
MOVE "SORTED TRANSACTIONS" TO PRINT-REC.
WRITE PRINT-REC AFTER 3.
PERFORM UNTIL STF-EOF
MOVE SPACES TO PRINT-REC
READ SORTED-TRANS-FILE INTO PRINT-REC
AT END SET STF-EOF TO TRUE
NOT AT END
WRITE PRINT-REC AFTER 1
END-READ
END-PERFORM.
CLOSE SORTED-TRANS-FILE, PRINT-FILE.
7.21 Selection Structures
IDENTIFICATION DIVISION.
PROGRAM-ID. REORDER.
AUTHOR. SJ DIFRANCO.
DATE-WRITTEN. 97/10/28
updated 98/09/30
updated 00/10/25.
* SELECTION STRUCTURE DEMO
*
* This program demonstrates how to implement selection
* structures, including condition names in COBOL. It
* processes a master inventory file to determine the
* items in a reorder position -- those whose onhand plus
* on order quantity is less than the low limit. Items
* under inventory or management review are not considered,
* nor are substitute nor inactive items.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT INVENTORY-FILE
ASSIGN TO "C:\COBOL\TESTDATA\INVMAST.TXT"
ORGANIZATION IS LINE SEQUENTIAL.
SELECT PRINT-FILE
ASSIGN TO "C:\COBOL\OUTPUT\REORDER.RPT".
DATA DIVISION.
FILE SECTION.
FD INVENTORY-FILE
RECORD CONTAINS 78 CHARACTERS.
01 INVENTORY-REC.
05 IN-PART-NUMBER PIC X(9).
05 PIC XX.
05 IN-UNIT-PRICE PIC 9(5)V99.
05 PIC X(27).
05 IN-RECORD-TYPE PIC 9.
88 INACTIVE-ITEM VALUE 0.
88 PRIME-PART-NBR VALUE 1.
88 SUBSTITUTE-PART-NBR VALUE 2.
05 PIC X(9).
05 IN-QTY-OH PIC 9(5).
05 IN-QTY-DUE PIC 9(5).
05 IN-HI-LIMIT PIC 9(5).
05 IN-LOW-LIMIT PIC 9(5).
05 IN-FLAGS.
10 IN-SPEC-INT-FLAG PIC 9.
88 SPECIAL-INTEREST VALUE 1.
10 IN-INVENTORY-FLAG PIC 9.
88 UNDER-INVENTORY VALUE 1.
10 IN-MGT-REVEIW-FLAG PIC 9.
88 UNDER-REVIEW VALUE 1.
FD PRINT-FILE.
01 PRINT-REC PIC X(80).
WORKING-STORAGE SECTION.
01 ACCUMULATORS.
05 A-ITEMS-PROCESSED PIC 9(5).
05 A-ITEMS-REVIEWED PIC 9(5).
05 A-ITEMS-ORDERED PIC 9(5).
05 A-TOTAL-ORDER-COST PIC 9(9)V99.
05 A-NOT-PRIME-PART PIC 9(5).
05 A-UNDER-INVENTORY PIC 9(5).
05 A-UNDER-REVIEW PIC 9(5).
05 A-LINE-COUNT PIC 99.
05 A-PAGE-COUNT PIC 99.
01 CONSTANTS.
05 C-MAX-LINES PIC 99 VALUE 50.
01 FLAGS.
05 F-MORE-RECS PIC 9 VALUE 0.
88 EOF VALUE 1.
01 PRINT-LINES.
05 P-PH1.
10 PIC X(60) VALUE
LOGEX INVENTORY REORDER REPORT.
10 P-RUN-DATE-PH1 PIC 99/99/99.
10 PIC X(4) VALUE SPACES.
10 PIC X(5) VALUE "PAGE".
10 P-PAGE-NUMBER-PH1 PIC 999.
05 P-CH1 PIC X(80) VALUE
"PART NBR U/P OH DUE HIGH LOW
- ORDER ORDER $ INT""."
05 P-DL1.
10 P-PART-NUMBER-DL1 PIC X(9).
10 PIC XX.
10 P-UNIT-PRICE-DL1 PIC ZZ,ZZ9.99.
10 PIC XX.
10 P-QTY-OH-DL1 PIC ZZ,ZZ9.
10 PIC XX.
10 P-QTY-DUE-DL1 PIC ZZ,ZZ9.
10 PIC XX.
10 P-HI-LIMIT-DL1 PIC ZZ,ZZ9.
10 PIC XX.
10 P-LOW-LIMIT-DL1 PIC ZZ,ZZ9.
10 PIC XXX.
10 P-ORDER-QTY-DL1 PIC ZZ,ZZ9.
10 PIC XXX.
10 P-ORDER-COST-DL1 PIC ZZZ,ZZ9.99
BLANK WHEN ZERO.
10 PIC XXX.
10 P-SPEC-INT-DL1 PIC X(3).
05 P-TL1 PIC X(80) VALUE
"********************************* END OF REPORT ****
- ****************************""."
05 P-TL2.
10 PIC X(65) VALUE
* TOTAL INVENTORY ITEMS PROCESSED.
10 P-ITEMS-PROCESSED-TL2 PIC ZZ,ZZ9.
05 P-TL3.
10 PIC X(65) VALUE
* TOTAL INVENTORY ITEMS EXCLUDED.
10 P-ITEMS-EXCLUDED-TL3 PIC ZZ,ZZ9.
05 P-TL3A.
10 PIC X(54) VALUE
NOT PRIME PART.
10 P-NOT-PRIME-PART-TL3A PIC ZZ,ZZ9.
05 P-TL3B.
10 PIC X(54) VALUE
UNDER INVENTORY.
10 P-UNDER-INVENTORY-TL3B PIC ZZ,ZZ9.
05 P-TL3C.
10 PIC X(54) VALUE
UNDER MGT REVIEW.
10 P-UNDER-REVIEW-TL3C PIC ZZ,ZZ9.
05 P-TL4.
10 PIC X(65) VALUE
* TOTAL INVENTORY ITEMS REVIEWED FOR REORDER.
10 P-ITEMS-REVIEWED-TL4 PIC ZZ,ZZ9.
05 P-TL5.
10 PIC X(65) VALUE
* TOTAL INVENTORY ITEMS REORDERED.
10 P-ITEMS-ORDERED-TL5 PIC ZZ,ZZ9.
05 P-TL6.
10 PIC X(62) VALUE
* TOTAL INVENTORY REORDER COST.
10 P-TOTAL-ORDER-COST-TL6 PIC $,$$$,$$9.99.
01 WORK-AREA.
05 W-ORDER-QTY PIC 9(5).
05 W-ORDER-COST PIC 9(6)V99.
PROCEDURE DIVISION.
0000-MAINLINE.
******************************************************************
PERFORM 1000-INITIALIZE
PERFORM UNTIL EOF
READ INVENTORY-FILE
AT END SET EOF TO TRUE
NOT AT END PERFORM 2000-PROCESS
END-READ
END-PERFORM
PERFORM 9000-TERMINATE
STOP RUN.
1000-INITIALIZE.
******************************************************************
* All beginning of job functions
* Called from: 0000-MAIN-LINE
INITIALIZE ACCUMULATORS
MOVE SPACES TO P-DL1
ACCEPT P-RUN-DATE-PH1 FROM DATE
OPEN INPUT INVENTORY-FILE
OUTPUT PRINT-FILE
PERFORM 1100-PRINT-HEADINGS.
1100-PRINT-HEADINGS.
******************************************************************
* Print page and column headers
* Called from: 1000-INITIALIZE
* 2200-PRINT-DETAIL
ADD 1 TO A-PAGE-COUNT
MOVE A-PAGE-COUNT TO P-PAGE-NUMBER-PH1
WRITE PRINT-REC FROM P-PH1 AFTER PAGE
WRITE PRINT-REC FROM P-CH1 AFTER 3
MOVE SPACES TO PRINT-REC
WRITE PRINT-REC AFTER 1
MOVE 6 TO A-LINE-COUNT.
2000-PROCESS.
******************************************************************
* Record processing routine
* Called from: 0000-MAINLINE
ADD 1 TO A-ITEMS-PROCESSED
* Check to exclude items from reorder consideration
IF PRIME-PART-NBR
AND NOT UNDER-INVENTORY
AND NOT UNDER-REVIEW
ADD 1 TO A-ITEMS-REVIEWED
PERFORM 2100-REORDER-ROUTINE
* Compute order cost for item, accumulate and print
MULTIPLY IN-UNIT-PRICE BY W-ORDER-QTY
GIVING W-ORDER-COST
ADD W-ORDER-COST TO A-TOTAL-ORDER-COST
PERFORM 2200-PRINT-DETAIL
ELSE
* Determine reason not considered
EVALUATE TRUE
WHEN NOT PRIME-PART-NBR
ADD 1 TO A-NOT-PRIME-PART
WHEN UNDER-INVENTORY
ADD 1 TO A-UNDER-INVENTORY
WHEN UNDER-REVIEW
ADD 1 TO A-UNDER-REVIEW
END-EVALUATE
END-IF.
2100-REORDER-ROUTINE.
******************************************************************
* Determines quantity of item to be ordered, if any
* Called from: 2000-PROCESS
* Check if in reorder range
IF IN-LOW-LIMIT > (IN-QTY-OH + IN-QTY-DUE)
ADD 1 TO A-ITEMS-ORDERED
COMPUTE W-ORDER-QTY =
IN-HI-LIMIT - IN-QTY-OH - IN-QTY-DUE
END-COMPUTE
ELSE
MOVE ZERO TO W-ORDER-QTY
END-IF.
2200-PRINT-DETAIL.
******************************************************************
* Formats detail line for printing
* Called from: 2000-PROCESS
* Set up formatted detail line
MOVE IN-PART-NUMBER TO P-PART-NUMBER-DL1
MOVE IN-UNIT-PRICE TO P-UNIT-PRICE-DL1
MOVE IN-QTY-OH TO P-QTY-OH-DL1
MOVE IN-QTY-DUE TO P-QTY-DUE-DL1
MOVE IN-HI-LIMIT TO P-HI-LIMIT-DL1
MOVE IN-LOW-LIMIT TO P-LOW-LIMIT-DL1
MOVE W-ORDER-QTY TO P-ORDER-QTY-DL1
MOVE W-ORDER-COST TO P-ORDER-COST-DL1
* If special interest item, show asterisks
IF SPECIAL-INTEREST
MOVE "***" TO P-SPEC-INT-DL1
ELSE
MOVE SPACES TO P-SPEC-INT-DL1
END-IF
* Paginate and print
IF A-LINE-COUNT > C-MAX-LINES
PERFORM 1100-PRINT-HEADINGS
END-IF
WRITE PRINT-REC FROM P-DL1 AFTER 1
ADD 1 TO A-LINE-COUNT.
9000-TERMINATE.
******************************************************************
* End-of-job processing
* Called from: 0000-MAINLINE
WRITE PRINT-REC FROM P-TL1 AFTER 2
PERFORM 9100-PRINT-TOTALS
CLOSE INVENTORY-FILE
PRINT-FILE.
9100-PRINT-TOTALS.
******************************************************************
* Prints end of job totals
* Called from: 9000-TERMINATE
MOVE A-ITEMS-PROCESSED TO P-ITEMS-PROCESSED-TL2
MOVE A-ITEMS-REVIEWED TO P-ITEMS-REVIEWED-TL4
MOVE A-ITEMS-ORDERED TO P-ITEMS-ORDERED-TL5
MOVE A-TOTAL-ORDER-COST TO P-TOTAL-ORDER-COST-TL6
MOVE A-NOT-PRIME-PART TO P-NOT-PRIME-PART-TL3A
MOVE A-UNDER-INVENTORY TO P-UNDER-INVENTORY-TL3B
MOVE A-UNDER-REVIEW TO P-UNDER-REVIEW-TL3C
ADD A-NOT-PRIME-PART
A-UNDER-INVENTORY
A-UNDER-REVIEW
GIVING P-ITEMS-EXCLUDED-TL3
ADD 1 TO P-PAGE-NUMBER-PH1
WRITE PRINT-REC FROM P-PH1 AFTER PAGE
WRITE PRINT-REC FROM P-TL2 AFTER 5
WRITE PRINT-REC FROM P-TL3 AFTER 2
WRITE PRINT-REC FROM P-TL3A AFTER 2
WRITE PRINT-REC FROM P-TL3B AFTER 1
WRITE PRINT-REC FROM P-TL3C AFTER 1
WRITE PRINT-REC FROM P-TL4 AFTER 2
WRITE PRINT-REC FROM P-TL5 AFTER 2
WRITE PRINT-REC FROM P-TL6 AFTER 2.
7.22 Array
IDENTIFICATION DIVISION.
PROGRAM-ID. ARRAY1.
*
* SINGLE-LEVEL ARRAY EXAMPLE
*
* This program demonstrates the use of arrays to compute
* monthly average, high, and low temperatures from a file
* containing hourly temperature date. The use of OCCURS
* and REDEFINES is demonstrated.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT TEMP-FILE
ASSIGN TO DISK 'C:\COBOL\TESTDATA\TEMP94MF.TXT'
ORGANIZATION IS LINE SEQUENTIAL.
SELECT PRINT-FILE
ASSIGN TO DISK 'C:\COBOL\OUTPUT\ARRAY1.RPT'.
DATA DIVISION.
FILE SECTION.
** This is the input record definition. It includes an
* array definition: there are 24 occurrences of the the
* elementary data-item TEMP. The array will be accessed
* by the index X
FD TEMP-FILE
RECORD CONTAINS 78 CHARACTERS.
01 TEMP-REC.
05 TDATE.
10 TMONTH PIC 99.
88 VALID-MONTH VALUE 1 THRU 12.
10 TDAY PIC 99.
10 TYEAR PIC 99.
05 TEMP-DATA.
10 TEMP OCCURS 24 TIMES
INDEXED BY X PIC S999.
FD PRINT-FILE.
01 PRINT-REC PIC X(60).
WORKING-STORAGE SECTION.
** Main accumulator array
01 ACCUMULATORS.
05 MONTH-TOTALS OCCURS 12 TIMES.
10 M-TEMP PIC S9(06).
10 M-COUNT PIC 999.
10 M-HIGH PIC S9(03).
10 M-LOW PIC S9(03).
01 J PIC 99.
01 EOF-INDICATOR PIC 9 VALUE 0.
88 EOF VALUE 1.
** An internal table to hold month name abbreviations
01 MONTH-NAMES.
05 MONTH-NAME-DATA PIC X(36) VALUE
'JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC'.
05 M-NAME REDEFINES MONTH-NAME-DATA
OCCURS 12 TIMES PIC X(03).
01 RH1.
05 PIC X(40) VALUE
' YEARLY TEMPERATURE SUMMARY REPORT FOR '.
05 REPORT-YEAR-RH.
10 REPORT-CENTURY PIC 99.
10 REPORT-DECADE PIC 99.
01 CH1 PIC X(60) VALUE
'MON AVG HIGH LOW MON AVG HIGH LOW'.
01 CH2 PIC X(60) VALUE
'--- --- ---- --- --- --- ---- ---'.
01 DL1.
05 MONTH-DL-1 PIC X(03).
05 PIC X VALUE SPACES.
05 AVG-TEMP-DL-1 PIC ---9.
05 PIC XX VALUE SPACES.
05 HIGH-TEMP-DL-1 PIC ---9.
05 PIC XX VALUE SPACES.
05 LOW-TEMP-DL-1 PIC ---9.
05 PIC X(06) VALUE SPACES.
05 MONTH-DL-2 PIC X(03).
05 PIC X VALUE SPACES.
05 AVG-TEMP-DL-2 PIC ---9.
05 PIC XX VALUE SPACES.
05 HIGH-TEMP-DL-2 PIC ---9.
05 PIC XX VALUE SPACES.
05 LOW-TEMP-DL-2 PIC ---9.
01 TL1.
05 PIC X(17) VALUE
'RECORDS READ: '.
05 RECORDS-READ-TL PIC 999.
01 TL2.
05 PIC X(17) VALUE
'RECORDS USED: '.
05 RECORDS-USED-TL PIC 999.
PROCEDURE DIVISION.
000-MAINLINE.
PERFORM 100-INITIALIZE
PERFORM UNTIL EOF
READ TEMP-FILE
AT END SET EOF TO TRUE
NOT AT END PERFORM 200-PROCESS-REC
END-READ
END-PERFORM.
PERFORM 900-EOJ
STOP RUN.
100-INITIALIZE.
** Initialize the monthly temperature array and rec counters
MOVE ZEROS TO ACCUMULATORS
PERFORM VARYING J FROM 1 BY 1 UNTIL J > 12
MOVE 999 TO M-LOW (J)
MOVE -999 TO M-HIGH (J)
END-PERFORM
MOVE ZERO TO RECORDS-READ-TL, RECORDS-USED-TL
** Obtain report year from console
DISPLAY 'ENTER REPORT YEAR: '
ACCEPT REPORT-YEAR-RH
OPEN INPUT TEMP-FILE.
200-PROCESS-REC.
** Increment record counter, then validate and process
ADD 1 TO RECORDS-READ-TL
IF TYEAR = REPORT-DECADE AND VALID-MONTH
ADD 1 TO RECORDS-USED-TL
PERFORM 210-DAILY-TEMP-COMP
END-IF.
210-DAILY-TEMP-COMP.
** Reset daily temp counter, add each hourly temp to it,
* and check for new monthly high or low
PERFORM VARYING X FROM 1 BY 1 UNTIL X > 24
IF TEMP (X) IS NUMERIC
ADD 1 TO M-COUNT (TMONTH)
ADD TEMP (X) TO M-TEMP (TMONTH)
IF TEMP (X) > M-HIGH (TMONTH)
MOVE TEMP (X) TO M-HIGH (TMONTH)
END-IF
IF TEMP (X) < M-LOW (TMONTH)
MOVE TEMP (X) TO M-LOW (TMONTH)
END-IF
END-IF
END-PERFORM.
900-EOJ.
CLOSE TEMP-FILE
OPEN OUTPUT PRINT-FILE
PERFORM 910-REPORT-HEADS
PERFORM 920-DETAIL-LINES
PERFORM 930-TOTAL-LINES
CLOSE PRINT-FILE.
910-REPORT-HEADS.
WRITE PRINT-REC FROM RH1 AFTER PAGE
WRITE PRINT-REC FROM CH1 AFTER 4
WRITE PRINT-REC FROM CH2 AFTER 1
MOVE SPACES TO PRINT-REC
WRITE PRINT-REC AFTER 1.
920-DETAIL-LINES.
** Use iteration to process accumulator array
PERFORM VARYING J FROM 1 BY 1 UNTIL J > 6
** Format first column of detail line
MOVE M-NAME (J) TO MONTH-DL-1
COMPUTE AVG-TEMP-DL-1 ROUNDED =
M-TEMP (J) / M-COUNT (J)
ON SIZE ERROR MOVE ZERO TO AVG-TEMP-DL-1
END-COMPUTE
MOVE M-HIGH (J) TO HIGH-TEMP-DL-1
MOVE M-LOW (J) TO LOW-TEMP-DL-1
** Format second column of detail line
MOVE M-NAME (J + 6) TO MONTH-DL-2
COMPUTE AVG-TEMP-DL-2 ROUNDED =
M-TEMP (J + 6) / M-COUNT (J + 6)
ON SIZE ERROR MOVE ZERO TO AVG-TEMP-DL-2
END-COMPUTE
MOVE M-HIGH (J + 6) TO HIGH-TEMP-DL-2
MOVE M-LOW (J + 6) TO LOW-TEMP-DL-2
WRITE PRINT-REC FROM DL1 AFTER 1
END-PERFORM.
930-TOTAL-LINES.
WRITE PRINT-REC FROM TL1 AFTER 3
WRITE PRINT-REC FROM TL2 AFTER 1.
7.23 Multiple Array
IDENTIFICATION DIVISION.
PROGRAM-ID. MARRAY2.
AUTHOR. LOGICAL-EXTENSIONS.
**** This program shows how to use a two-level array to hold
* data. The program reads a file of hourly temperatures for
* a series of dates, and computes and displays the date and
* average temperature for each date.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT TEMP-FILE
ASSIGN TO DISK 'C:\COBOL\TESTDATA\TEMPS96.TXT'
ORGANIZATION IS LINE SEQUENTIAL.
DATA DIVISION.
FILE SECTION.
**** Each record holds a 8-character date (YY/MM/DD) followed by
* 24 signed, three-digit hourly temperatures; the temperatures
* are treated as four-character alpha-numerics in the FD below
FD TEMP-FILE.
01 TEMP-REC.
05 DATE-IN PIC X(08).
05 TEMPS-IN PIC X(96).
WORKING-STORAGE SECTION.
01 ARRAY-AREA.
05 DAY-DATA OCCURS 500 TIMES
INDEXED BY J.
10 TEMP-DATE PIC X(08).
10 HOUR-DATA OCCURS 24 TIMES
INDEXED BY K PIC S999
SIGN IS LEADING SEPARATE.
01 NBR-OF-DAYS PIC 999 VALUE 0.
01 AVG-TEMP PIC S9(04)
SIGN IS LEADING SEPARATE.
01 EOF-INDICATOR PIC X VALUE 'N'.
88 EOF VALUE 'Y'.
/
PROCEDURE DIVISION.
000-MAIN-LINE.
PERFORM 100-READ-ARRAY.
PERFORM 200-CALC-TEMP.
STOP RUN.
100-READ-ARRAY.
**** Input temperature array data
OPEN INPUT TEMP-FILE
PERFORM VARYING J FROM 1 BY 1
UNTIL J > 500 OR EOF
READ TEMP-FILE
AT END
SET EOF TO TRUE
NOT AT END
MOVE TEMP-REC TO DAY-DATA (J)
ADD 1 TO NBR-OF-DAYS
END-READ
END-PERFORM
CLOSE TEMP-FILE.
200-CALC-TEMP.
**** Since array is doubly-subscripted, will use a nested
* PERFORM to compute average for each day
PERFORM VARYING J FROM 1 BY 1 UNTIL J > NBR-OF-DAYS
MOVE 0 TO AVG-TEMP
PERFORM VARYING K FROM 1 BY 1 UNTIL K > 24
ADD HOUR-DATA (J, K) TO AVG-TEMP
END-PERFORM
COMPUTE AVG-TEMP = AVG-TEMP / 24
DISPLAY 'AVG TEMP FOR ', TEMP-DATE (J), ' IS ', AVG-TEMP
END-PERFORM.
7. 24 Indexed File
IDENTIFICATION DIVISION.
PROGRAM-ID. ACCINDEX.
AUTHOR. LOGICAL EXTENSIONS.
DATE-COMPILED.
* This program demonstrates how to access an indexed
* file randomly by specifying the record key of the
* desired record.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
* The SELECT must include the ORGANIZATION IS INDEXED,
* ACCESS IS RANDOM and RECORD KEY IS clauses.
SELECT NDX-MASTER-FILE
ASSIGN TO DISK 'C:\COBOL\TESTDATA\NDXMAST.NDX'
ORGANIZATION IS INDEXED
ACCESS IS RANDOM
RECORD KEY IS MASTER-PN.
DATA DIVISION.
FILE SECTION.
* At least the data element(s) used as RECORD KEY must
* be defined for the indexed file being accessed.
FD NDX-MASTER-FILE.
01 NDX-MASTER-REC.
05 MASTER-PN PIC X(09).
05 PIC X(12).
05 NOMENCLATURE PIC X(15).
PROCEDURE DIVISION.
000-MAIN-LINE.
* The file is opened normally for input
OPEN INPUT NDX-MASTER-FILE.
* Do a "priming read" and then loop until users enters
* QUIT for the part number
PERFORM 100-GET-NEXT-REQ.
PERFORM UNTIL MASTER-PN = "QUIT"
* The READ statement will access and input the record whose
* record key matches that in MASTER-PN. An INVALID KEY is
* executed if no matching record is found. A NOT INVALID KEY
* indicates a matching record key was found in the index
* table, and the record input to the input buffer.
READ NDX-MASTER-FILE
INVALID KEY
DISPLAY "RECORD NOT FOUND"
NOT INVALID KEY
DISPLAY "NOMENCLATURE: ", NOMENCLATURE
END-READ
PERFORM 100-GET-NEXT-REQ
END-PERFORM.
CLOSE NDX-MASTER-FILE.
STOP RUN.
100-GET-NEXT-REQ.
* This routine simply provides a prompt and accepts a part
* number from the console, which is placed in the MASTER-PN
* data item for the next READ.
DISPLAY "ENTER PART NUMBER:".
ACCEPT MASTER-PN.
7. 25 Declaratives.
IDENTIFICATION DIVISION.
PROGRAM-ID. FSTATEX.
AUTHOR. LOGICAL EXTENSIONS.
* This program demonstrates how to use the FILE STATUS
* clause to obtain more detailed information about I-O
* errors on an indexed file. In addition, the program
* implements a separate error-handling routine that
* takes the place of the INVALID KEY clause in a WRITE
* to the indexed file.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT SEQ-MASTER-FILE
ASSIGN TO DISK 'C:\COBOL\TESTDATA\BADMAST1.TXT'
ORGANIZATION IS LINE SEQUENTIAL.
* The FILE STATUS IS ... clause is added to the SELECT
* statement for the indexed file. This will cause the
* two-character status code resulting from an I-O
* operation on this file to be placed in the variable
* specified (which must be declared in WORKING-STORAGE).
SELECT NDX-MASTER-FILE
ASSIGN TO DISK 'C:\COBOL\OUTPUT\TEMP.NDX'
ORGANIZATION IS INDEXED
ACCESS IS SEQUENTIAL
RECORD KEY IS MASTER-PN
FILE STATUS IS NDX-STATUS.
DATA DIVISION.
FILE SECTION.
FD SEQ-MASTER-FILE.
01 SEQ-MASTER-REC PIC X(21).
FD NDX-MASTER-FILE.
01 NDX-MASTER-REC.
05 MASTER-PN PIC X(09).
05 PIC X(12).
WORKING-STORAGE SECTION.
01 EOF-INDICATOR PIC X(01) VALUE "N".
88 EOF VALUE "Y".
* There must be a variable declared that matches that
* specified in the FILE STATUS IS ... clause.
01 NDX-STATUS PIC X(02).
PROCEDURE DIVISION.
* An file error handling routine must be set up at the
* beginning of the PROCEDURE DIVISION in the DECLARATIVES
* segment, which consists of one or more SECTIONS, each
* with one or more paragraphs. Each section will handle
* I-O errors for the file specified.
DECLARATIVES.
A000-IO-ERROR-HANDLING SECTION.
USE AFTER ERROR PROCEDURE ON NDX-MASTER-FILE.
A100-CHECK-STATUS.
* This is the only paragraph in our error handling section,
* invoked when an INVALID KEY clause would have been executed.
EVALUATE NDX-STATUS
WHEN "21"
DISPLAY "** KEY OUT OF SEQUENCE: " MASTER-PN
WHEN "22"
DISPLAY "** DUPLICATE PRIMARY KEY: " MASTER-PN
WHEN OTHER
DISPLAY "** OTHER IO ERROR WRITING: " MASTER-PN
CLOSE SEQ-MASTER-FILE, NDX-MASTER-FILE
STOP RUN
END-EVALUATE.
* The DELACRATIVES segment must end with the following:
END DECLARATIVES.
* If a section header is used, the rest of the PROCEDURE
* DIVISION must be divided into sections.
B000-REGULAR-PROCESSING SECTION.
B100-MAIN-LINE.
OPEN INPUT SEQ-MASTER-FILE
OUTPUT NDX-MASTER-FILE
* The sequential input file is read normally until EOF
* is encountered. If not at EOF, the record is written
* to the indexed file. No INVALID KEY clause is required,
* because all error conditions for this file will be
* handled by the A100-ERROR-HANDLING SECTION.
PERFORM UNTIL EOF
READ SEQ-MASTER-FILE INTO NDX-MASTER-REC
AT END
SET EOF TO TRUE
NOT AT END
WRITE NDX-MASTER-REC
END-READ
END-PERFORM
CLOSE SEQ-MASTER-FILE, NDX-MASTER-FILE
STOP RUN.
This page contains an abbreviated COBOL syntax reference for the most commonly used COBOL verbs, listed in alphabetical order.
Conventions used in COBOL-85 Syntax Reference
UPPER-CASE
[ X ]
{ X } ...
{ X | Y }
arithExp-#
cName-#
cndExp-#
Id-#
lit-#
fName-#
ImpStmt-#
iName-#
libName-#
mName-#
pName-#
recName-#
tName-#
ACCEPT id-1 [ FROM { mName-1 | DATE | DAY | DAY-OF-WEEK | TIME } ]
ADD { id-1 | lit-1 } ... TO id-2 [ ROUNDED ] ...
[ ON SIZE ERROR impstmt-1 ]
[ NOT ON SIZE ERROR impstmt-2 ]
[ END-ADD ]
ADD { id-1 | lit-1 } ... TO { id-2 | lit-2 }
GIVING lit-3 [ ROUNDED ] ...
[ ON SIZE ERROR impStmt-1 ]
[ NOT ON SIZE ERROR impStmt-2 ]
[ END-ADD ]
CALL { id-1 | lit-1 }
[ USING { [ BY REFERENCE ] id-2 ... | BY CONTENT id-2 ... } ... ]
[ ON OVERFLOW impStmt-1 ]
[ END-CALL ]
CLOSE fName-1 ...
COMPUTE id-1 [ ROUNDED ] = arithExp-1
[ ON SIZE ERROR impstmt-1 ]
[ NOT ON SIZE ERROR impstmt-2 ]
[ END-COMPUTE ]
COPY tName-1 [ { OF | IN } libName-1 ]
[ REPLACING { { ==pText-1== | id-1 | lit-1 }
BY { ==pText-2 | id-2 | lit-2 } } ... ]
DELETE fName-1 RECORD
[ INVALID KEY impStmt-1 ]
[ NOT INVALID KEY impStmt-2 ]
[ END-DELETE ]
DISPLAY { id-1 | lit-1 } ... [ UPON mName-1 ] [ WITH NO ADVANCING ]
DIVIDE { id-1 | lit-1 } { INTO | BY } { id-2 | lit-2 }
GIVING id-3 [ ROUNDED ]
[ REMAINDER id-4 ]
[ ON SIZE ERROR impStmt-1 ]
[ NOT ON SIZE ERROR impStmt-2 ]
[ END-DIVIDE ]
DIVIDE { id-1 | lit-1 } INTO id-2 [ ROUNDED ]
[ ON SIZE ERROR impStmt-1 ]
[ NOT ON SIZE ERROR impStmt-2 ]
[ END-DIVIDE ]
EVALUATE { id-1 | lit-1 | arithExp-1 | TRUE | FALSE }
[ ALSO { id-2 | lit-2 | arithExp-2 | TRUE | FALSE } ]
{ WHEN
{ ANY | cndExp-1 | TRUE | FALSE |
[ NOT ] { id-3 | lit-3 | arithExp-3 }
[ THRU { id-4 | lit-4 | arithExp-4 } ] }
[ ALSO { ANY | cndExp-2 | TRUE | FALSE |
[ NOT ] { id-5 | lit-5 | arithExp-5 }
[ THRU { id-6 | lit-6 | arithExp-6 } ] } ] ...
impStmt-1 ... } ...
[ WHEN OTHER impStmt-2 ... ]
[ END-EVALUATE ]
IF cndExp-1 [ THEN ]
{ stmt-1 ... | NEXT SENTENCE }
[ ELSE
{ stmt-2 ... | NEXT SENTENCE } ]
[ END-IF ]
INITIALIZE id-1 ...
INSPECT id-1 REPLACING
{ CHARACTERS BY { id-2 | lit-1 }
[ { BEFORE | AFTER } INITIAL { id-3 | lit-2 } ] ... |
{ ALL | LEADING | FIRST } { id-3 | lit-2 } BY { id-4 | lit-3 }
[ { BEFORE | AFTER } INITIAL { id-5 | lit-4 } ] ... } ... } ...
INSPECT id-1 TALLYING { id-2 FOR
{ CHARACTERS
[ { BEFORE | AFTER } INITIAL { id-3 | lit-1 } ] ... |
{ ALL | LEADING } { { id-4 | lit-2 }
[ { BEFORE | AFTER } INITIAL { id-5 | lit-3 } ] ... } ... } ... } ...
[ REPLACING
{ CHARACTERS BY { id-6 | lit-4 }
[ { BEFORE | AFTER } INITIAL { id-7 | lit-5 } ] ... |
{ ALL | LEADING | FIRST } { id-7 | lit-4 } BY { id-8 | lit-5 }
[ { BEFORE | AFTER } INITIAL { id-9 | lit-6 } ] ... } ... } ... ]
INSPECT id-1 CONVERTING { id-2 | lit-1 } TO { id-3 | lit-2 }
[ { BEFORE | AFTER } INITIAL { id-4 | lit-3 } ] ...
MERGE fName-1 { ON { ASCENDING | DESCENDING } KEY id-1 ... } ...
[ COLLATING SEQUENCE IS { ASCII | EBCDIC } ]
USING fName-2 fName-3 ...
{ OUTPUT PROCEDURE IS pName-1 [ THRU pName-2 ] |
GIVING fName-4 ... }
MOVE { id-1 | lit-1 } TO id-2 ...
MULTIPLY { id-1 | lit-1 } BY id-2 [ ROUNDED ] ...
[ ON SIZE ERROR impStmt-1 ... ]
[ NOT ON SIZE ERROR impStmt-2 ... ]
[ END-MULTIPLY ]
MULTIPLY { id-1 | lit-1 } BY { id-2 | lit-2 }
GIVING id-3 [ ROUNDED ] ...
[ ON SIZE ERROR impStmt-1 ... ]
[ NOT ON SIZE ERROR impStmt-2 ... ]
[ END-MULTIPLY ]
OPEN { INPUT fName-1 ... |
OUTPUT fName-2 ... |
I-O fName-3 ... |
EXTEND fName-4 ...} ...
PERFORM [ pName-1 [ THRU pName-2 ] ]
{ { id-1 | lit-1 } TIMES |
[ WITH TEST { BEFORE | AFTER } ]
[ VARYING { id-1 | iName-1 }
FROM { id-2 | iName-2 | lit-1 } BY { id-3 | lit-2 } ]
UNTIL cndExp-1 }
[ anyStmt-1 ... END-PERFORM ]
READ fName-1 [ NEXT ] [ INTO id-1 ]
[ AT END impStmt-1 ... ]
[ NOT AT END impStmt-2 ... ]
[ END-READ ]
READ fName-1 [ INTO id-1 ]
[ KEY IS id-2 ]
[ INVALID KEY impStmt-1 ... ]
[ NOT INVALID KEY impStmt-2 ... ]
[ END-READ ]
RELEASE recName-1 [ FROM id-2 ]
RETURN fName-1 [ INTO id-1 ]
AT END impStmt-1 ...
[ NOT AT END impStmt-2 ... ]
[ END-RETURN ]
REWRITE recName-1 [ FROM id-1 ]
REWRITE recName-1 [ FROM id-1 ]
[ INVALID KEY impStmt-1 ... ]
[ NOT INVALID KEY impStmt-2 ... ]
[ END-REWRITE ]
SEARCH id-1 [ VARYING { id-2 | iName-1 }
[ AT END impStmt-1 ... ]
{ WHEN cndExp-1 { impStmt-2 ... | NEXT SENTENCE } } ...
[ END-SEARCH ]
SEARCH ALL id-1
[ AT END impStmt-1 ... ]
WHEN { id-2 = { id-3 | lit-1 | arithExp-1 } | cndExp-1 }
[ AND { id-4 = { id-5 | lit-2 | arithExp-2 } | cndExp-2 } ] ...
{ impStmt-2 ... | NEXT SENTENCE }
[ END-SEARCH ]
SELECT fname-1
ASSIGN TO { libName-1 | mName-1 }
[ ORGANIZATION IS { SEQUENTIAL | INDEXED | DYNAMIC | LINE SEQUENTIAL } ]
[ ACCESS [ MODE IS ] { SEQUENTIAL | RANDOM | DYNAMIC } ]
[ RECORD KEY IS id-1 ]
[ ALTERNATE RECORD KEY IS id-2 ]
[ FILE STATUS IS id-3 ]
SET { iName-1 | id-1 } ... TO { iName-2 | id-2 | lit-1 }
SET iName-1 ... { UP | DOWN } BY { id-1 | lit-1 }
SET cName-1 ... TO TRUE
SORT fName-1
{ ON { ASCENDING | DESCENDING } KEY { id-1 } ... } ...
[ WITH DUPLICATES IN ORDER ]
[ COLLATING SEQUENCE IS { ASCII | EBCDIC } ]
{ INPUT PROCEDURE IS pName-1 [ THRU pName-2 ] |
USING { fName-2 } ... }
{ OUTPUT PROCEDURE IS pName-3 [ THRU pName-4 ] |
GIVING { fName-3 } ... }
START fName-1
[ KEY IS { = | > | NOT = } id-1 }
[ INVALID KEY { impStmt-1 } ... ]
[ NOT INVALID KEY { impStmt-2 } ... ]
[ END-START ]
STOP { RUN | lit-1 }
STRING { { id-1 | lit-1 } ... DELIMITED BY { id-2 | lit-2 | SIZE } } ...
INTO id-3
[ WITH POINTER id-4 ]
[ ON OVERFLOW impStmt-1 ... ]
[ NOT ON OVERFLOW impStmt-2 ... ]
[ END-STRING ]
SUBTRACT { id-1 | lit-1 } ... FROM { id-2 [ ROUNDED ] } ...
[ ON SIZE ERROR impStmt-1 ... ]
[ NOT ON SIZE ERROR impStmt-2 ... ]
[ END-SUBTRACT ]
SUBTRACT { id-1 | lit-1 } ... FROM { id-2 | lit-2 }
GIVING { id-3 [ ROUNDED ] } ...
[ ON SIZE ERROR impStmt-1 ... ]
[ NOT ON SIZE ERROR impStmt-2 ... ]
[ END-SUBTRACT ]
UNSTRING id-1
[ DELIMINTED BY [ ALL ] { id-2 | lit-1 }
[ OR [ ALL ] { id-3 | lit-2 } ] ... ]
INTO { id-4
[ DELIMITER IN id-5 ]
[ COUNT IN id-6 ] } ...
[ WITH POINTER id-7 ]
[ TALLYING IN id-8 ]
[ ON OVERFLOW impStmt1 ... ]
[ NOT ON OVERFLOW impStmt2 ... ]
[ END-UNSTRING ]
WRITE recName-1 [ FROM id-1 ]
[ { BEFORE | AFTER } ADVANCING { { id-1 | lit-1 } | PAGE } ]
[ END-WRITE ]
WRITE recName-1 [ FROM id-1 ]
[ INVALID KEY impStmt-1 ... ]
[ NOT INVALID KEY impStmt-2 ... ]
[ END-WRITE ]
Wednesday, December 15, 2010
COBOL PROGRAMMING STANDARDS
6.1 COBOL and Advanced COBOL Programming
This page defines the standards your program source code must meet. See the sample program for examples of the implementation of these standards.
6.2 General Coding Standards
6.3 IDENTIFICATION Division
6.4 ENVIRONMENT Division
6.5 DATA Division
Level numbers
Use descriptive, distinctive data item names, prefixed and suffixed as described below.
Do not initialize elementary items except for constants and constant values used to print/display; explicitly initialize other data items in the PROCEDURE DIVISION.
Group all data items under 01 levels in the following order:
6.8 PROCEDURE Division
Organization
Print Output
This page defines the standards your program source code must meet. See the sample program for examples of the implementation of these standards.
6.2 General Coding Standards
- Source code should be all UPPER-CASE except for comments.
- Use proper indentation; set tab stops to every 4 columns (8, 12, 16, ...).
- Separate the logical sections of source code with blank lines to make it easier to read.
6.3 IDENTIFICATION Division
- The PROGRAM-ID should be the source code filename (8 characters maximum, no extension).
- AUTHOR should be your name.
- Use the DATE-WRITTEN paragraph with the date you turned in the program, in the form YYYY-MM-DD.
- Include a comments with at least these headings:
- FUNCTION. Brief statement of the function of the program.
- INPUT FILES. Logical and physical filenames and the sort sequence (sort fields and sort order: ASC for ascending, DESC for descending, or UNSORTED) for each input file.
- OUTPUT FILES. Logical and physical filenames, and the sort sequence of each output file.
- PRINT OUTPUT. Brief description of each report generated. Note: consider all print-image output to be printed output, even if it is directed to a disk file for later printing).
6.4 ENVIRONMENT Division
- In the FILE-CONTROL paragraph of the INPUT-OUTPUT SECTION, SELECT files in the same order in which they are referenced in your program.
- ASSIGN files using direct, complete physical filenames (drive:\path\filename.ext)
Level numbers
- Leave a blank line before each 01 level number
- Use level numbers in increments of 5 (05, 10, 15, ...)
- Indent each higher level number to next tab stop; align like level numbers to same tab stop
- Data type of data item should agree with its primary usage; it should be alphanumeric unless used for computation, subscripting, or edited-numeric output
- PIC clauses should all be aligned to same tab stop regardless of level
- Logical file names should be descriptive and be suffixed -FILE.
- File descriptions (FDs) should appear in the same order as in the FILE-CONTROL paragraph.
- Use the RECORD CONTAINS clause in all FDs.
- Record names (the 01-level entry on an FD) should be the same as the logical file name, with the suffix -REC.
- Data items under the 01 level should have a 2-character prefix associating the item with its record.
Use descriptive, distinctive data item names, prefixed and suffixed as described below.
Do not initialize elementary items except for constants and constant values used to print/display; explicitly initialize other data items in the PROCEDURE DIVISION.
Group all data items under 01 levels in the following order:
- 01 ACCUMULATORS. (prefix A-)
- 01 CONSTANTS. (prefix C-)
- 01 FLAGS. (prefix F-)
- 01 PRINT-LINES. (prefix P-, and suffix as below)
- -PHn for page header line n
- -CHn for column header line n
- -DLn for detail line n
- -TLn for total line n
- -JCn for job control line n)
- 01 TABLES. (prefix T-)
- 01 WORK-AREAS. (prefix W-)
6.8 PROCEDURE Division
Organization
- Use meaningful paragraph names, each prefixed with an ascending four-digit number, with gaps sufficient to allow for program maintenance.
- If organized into sections, prefix the names with ascending, single alphabetic character followed by 4 zeros, e.g.: A0000-ERROR-HANDLING SECTION. Paragraph names will be prefixed with the letter corresponding to the section and ascending 4-digit numbers.
- Each paragraph must start with a comment listing the paragraphs from which it is PERFORMed, its purpose (if not obvious from the paragraph name) and an explanation of the logic if not straight-forward.
- The first paragraph should control the flow of program execution (the "driver"); it should be named 0000-MAINLINE.
- PERFORM each paragraph except 0000-MAINLINE; program control should not "fall through" to the next paragraph.
- Each paragraph must be a functionally independent unit of code with one entrance and one exit.
- A paragraph cannot consist of a single PERFORM statement; it should be no longer than 15 statements (excluding comments).
- Start each statement on a new line; indent the second and succeeding lines of a multiple line statement to the next tab stop.
- Start clauses on a separate line, and indent them within a statement.
- Leave a blank line before every selection and iteration structure.
- Align the word TO in a sequence of MOVE statements.
- Code literals only when the value will never need to be changed, and when its meaning is obvious.
- Use scope terminators (END-IF, END-READ, etc.) unless the statement contains no clauses; align the terminator to the same tab stop as the statement it terminates.
- Use parentheses in compound IFs and COMPUTEs for clarity.
- Avoid use of PERFORM ... THRU, GO TO, and MOVE CORRESPONDING.
- Comment liberally if the code is not straight-forward, but avoid useless comments.
- Every printed report must have a page heading on each page that includes:
- Report title
- Run date in the form YY/MM/DD
- Page number
- Unless otherwise specified, use these report formatting standards:
- 50-column print width
- 40 total print lines per page
- Page header on line 1 followed by two blank lines, column header(s) followed by one blank line, then single-spaced detail lines
COBOL Compiler options
| SSRANGE Checks subscripts and indexes each time they are used during execution. RES ? Resident Library routines will be dynamically loaded at execution time, unless COBPACK is available. DYNAM ? Dynamic Routines are loaded into storage as required. With DYNAM then RES automatically goes into effect. RENT ? Reentrant Compiler generates reentrant object code, which can then run in, or address any part of, the private area or extended private area. The following COBOL programs must be reentrant - Programs running under CICS. - Programs to be preloaded with IMS - Program to be executed above 16mb - Programs to be loaded and deleted by non-COBOL program.
|
Subscribe to:
Posts (Atom)