The American Programmer

Programming

Books for Computer Professionals

Privacy

Terms

Home > Programming > COBOL Book > COBOL program chapter 5 The Record Selection Program

The Record Selection Program

Top of Page

5. The Record Selection Program

SELECT1.
Similar to The Simple, Single File Program, #1 above, but writes out only some of the records read. Based on edit criteria, it decides whether to write out a given record or whether to ignore it.

Very useful type of program in the business world. Some similar programs might be the following:

All the salespersons’ sales are on one humungus file. All you need are the salespeople for the Boston district. So you write a program to pick off only the records containing information on Boston people. It will be much easier to work with the smaller file.

Perhaps you need a file that consists of one-tenth the records of the complete file. You would write a program that reads every record, counts them, and writes out only each tenth record.

Here is the program SELECT1:



000200 IDENTIFICATION DIVISION.
000300*  Select records:
000400*  determine if records should be written to the output file
000500 PROGRAM-ID. SELECT1.
000600 ENVIRONMENT DIVISION.
000700 INPUT-OUTPUT SECTION.
000800 FILE-CONTROL.
000900*    INPUT FILE EMP
001000     SELECT INPUT-FILE ASSIGN EMP.
001300*     OUTPUT FILE NORMALLY A DISK/TAPE FILE,
001400*     BUT ASSIGN TO PRINTER IN THIS PROGRAM
001500     SELECT GOOD-FILE ASSIGN GOODFI.
001800
001900 DATA DIVISION.
002000 FILE SECTION.
002100
002200 FD  INPUT-FILE
002300     RECORDING MODE IS F
002600     RECORD CONTAINS 80 CHARACTERS.
002610 01  EMPLOYEE-RECORD.
002620     05  FILLER                        PIC X(8).
002630     05  FILLER                        PIC X(01).
002640     05  ER-EMPLOYEE-NUMBER            PIC X(05).
002650     05  FILLER                        PIC X(01).
002660     05  ER-EMPLOYEE-NAME              PIC X(25).
002670     05  FILLER                        PIC X(01).
002680     05  ER-EMPLOYEE-DEPARTMENT        PIC X(05).
002690     05  FILLER                        PIC X(01).
002700     05  ER-EMPLOYEE-SALARY-CODE       PIC X(02).
002720     05  FILLER                        PIC X(31).
002800
002900 FD  GOOD-FILE
003000     RECORDING MODE IS F
003300     RECORD CONTAINS 80 CHARACTERS.
003400 01  GOOD-RECORD                       PIC X(80).
003500
003600 WORKING-STORAGE SECTION.
003700
003800 01  SW-GOOD-RECORD                 PIC X VALUE 'Y'.
003900
004000 01  FILE-AT-END          PIC X VALUE 'N'.
004100*
005800 01  COUNTERS-AND-ACCUMULATORS.
005900     05  CTR-REJECT-RECORDS            PIC  S9(5)
006000            PACKED-DECIMAL      VALUE 0.
006100     05  CTR-RECORDS-READ               PIC  S9(5)
006200            PACKED-DECIMAL      VALUE 0.
006300     05  CTR-RECORDS-WRITTEN            PIC  S9(5)
006400            PACKED-DECIMAL      VALUE 0.
006500
006600 PROCEDURE DIVISION.
006700     PERFORM INITIALIZATION
006800     PERFORM PROCESS-ALL
006900        UNTIL FILE-AT-END = 'Y'
007000     PERFORM TERMINATION
007100     GOBACK.
007200
007300 INITIALIZATION.
007400     OPEN INPUT INPUT-FILE
007500          OUTPUT GOOD-FILE
007600     PERFORM READ-PAR.
007700
007800 PROCESS-ALL.
007900     MOVE 'Y' TO SW-GOOD-RECORD
008000     PERFORM SELECT-THE-RECORD
008100     IF SW-GOOD-RECORD  = 'Y'
008200     THEN
008300*      THE RECORD IS GOOD, I.E. TO BE SELECTED
008400        PERFORM WRITE-GOOD-RECORD
008500        ADD 1 TO CTR-RECORDS-WRITTEN
008600     ELSE
008700*      THE RECORD IS  NOT GOOD, NOT WRITTEN OUT, SKIPPED
008800       ADD 1 TO CTR-REJECT-RECORDS
008900     END-IF
009000
009100     PERFORM READ-PAR.
009200
009300 WRITE-GOOD-RECORD.
009400     WRITE GOOD-RECORD FROM EMPLOYEE-RECORD.
009500
009600 TERMINATION.
009700*    Suppose no good records were written out
009800*    that would mean either
009900*        your selection criteria were not right
010000*        you have the wrong input file
010100*        it so happens there are no chosen records in input file
010200*  in any case, you want to know about the situation
010300     IF CTR-RECORDS-WRITTEN = 0
010400     THEN
010500         GO TO ERROR-EXIT
010600     END-IF
010700
010800     CLOSE INPUT-FILE
010900           GOOD-FILE.
011000
011100 SELECT-THE-RECORD.
011200*     the value 02000 is hard coded for this example
011300     IF  ER-EMPLOYEE-NUMBER  > '02000'
011400     THEN CONTINUE
011500     ELSE
011600         MOVE 'N' TO SW-GOOD-RECORD
011700     END-IF.
011800
011900 READ-PAR.
012000     READ INPUT-FILE
012100         AT END MOVE 'Y' TO FILE-AT-END
012200     NOT AT END
012300        ADD 1 TO CTR-RECORDS-READ
012400     END-READ.
012500
012600 ERROR-EXIT.
012700     DISPLAY 'THERE WERE NO RECORDS WRITTEN TO THE OUTPUT FILE'
012800     DISPLAY 'PROGRAM ABORTED'
012900     CLOSE INPUT-FILE
013000           GOOD-FILE.
013100     GOBACK.

Here is the input data file EMP: (the next two lines are a column ruler)

         1         2         3         4         5         6
123456789.123456789.123456789.123456789.123456789.123456789.12345678

         01000 PEARLE E GATES           D0001 01
         02000 LED BALOON               D0002 04
         03000 KIT E LITTER             D0005 06
         04000 MOE PEDD                 D0504 01

Here is sample JCL:

//STEP1    EXEC PGM=SELECT1
//STEPLIB DD DSN=your.executable.program.library.goes.here,DISP=SHR
//*OF COURSE, THE NEXT LIBRARY NAME MAY BE DIFFERENT AT YOUR COMPANY
//EMP      DD   DSN=userid.COBBOOK.DATA(EMP),DISP=SHR
//GOODFI   DD   SYSOUT=*
//SYSOUT   DD   SYSOUT=*
//SYSUDUMP DD   SYSOUT=*

Top of Page

Your email and other personal information will not be given to anyone and will be used only to communicate with you about your order. [Books Computer]