000100 IDENTIFICATION DIVISION. 00010013 000200 PROGRAM-ID. TABLE1. 00020014 000300 AUTHOR. SAMUELS. 00030013 000400************************************************************* 00040013 000500* THIS PROGRAM ILLUSTRATES A SIMPLE TABLE HANDLING * 00050018 000600* TECHNIQUE OF PULLING OUT A ITEM FROM A TABLE * 00060013 000700* USES DATA5A --- SUBMIT JCLPRO5A --- * 00070013 000800************************************************************* 00080013 000900 ENVIRONMENT DIVISION. 00090013 001000 INPUT-OUTPUT SECTION. 00100013 001100 FILE-CONTROL. 00110013 001200 SELECT INFILE ASSIGN TO INFOIN. 00120013 001300 SELECT OUTFILE ASSIGN TO REPTOUT. 00130013 001400 DATA DIVISION. 00140013 001500 FILE SECTION. 00150013 001600 FD INFILE 00160013 001700 BLOCK CONTAINS 0 RECORDS 00170013 001800 RECORD CONTAINS 80 CHARACTERS 00180013 001900 RECORDING MODE IS F 00190015 002000 LABEL RECORDS ARE STANDARD 00200013 002100 DATA RECORD IS INREC. 00210013 002200 01 INREC PIC X(80). 00220013 002300 FD OUTFILE 00230013 002400 BLOCK CONTAINS 0 RECORDS 00240013 002500 RECORD CONTAINS 100 CHARACTERS 00250013 002600 RECORDING MODE IS F 00260015 002700 LABEL RECORDS ARE STANDARD 00270013 002800 DATA RECORD IS OUTREC. 00280013 002900 01 OUTREC PIC X(100). 00290013 003000 WORKING-STORAGE SECTION. 00300013 003100 01 SWITCH PIC XXX VALUE SPACES. 00310013 003110 01 HEADER-2. 00311021 003120 05 PIC X. 00312021 003130 05 PIC X(4) VALUE 'NAME'. 00313021 003140 05 PIC X(26) VALUE SPACES. 00314021 003150 05 PIC X(5) VALUE 'GROSS'. 00315021 003160 05 PIC X(20) VALUE SPACES. 00316021 003170 05 MONTH-OUT PIC 99. 00317021 003180 05 PIC X VALUE '/'. 00318021 003190 05 DAY-OUT PIC 99. 00319021 003191 05 PIC X VALUE '/'. 00319121 003192 05 YEAR-OUT PIC 99. 00319221 003200 01 WORK-REC. 00320013 003300 05 NAME-IN PIC X(20). 00330014 003400 05 STATUS-IN PIC 99. 00340014 003500 05 PIC X(58). 00350017 003600 01 DETAIL-LINE. 00360013 003700 05 PIC X(10) VALUE SPACES. 00370014 003800 05 NAME-OUT PIC X(20). 00380014 003900 05 PIC X(20) VALUE SPACES. 00390014 004000 05 DEPT-OUT PIC X(20). 00400014 004100 05 PIC X(30) VALUE SPACES. 00410014 004200 01 DEPARTMENT-VALUES. 00420013 004300 05 PIC X(20) VALUE 'CHEMISTRY'. 00430014 004400 05 PIC X(20) VALUE 'PHYSICS'. 00440020 004500 05 PIC X(20) VALUE 'COMPUTER SCIENCE'. 00450014 004600 05 PIC X(20) VALUE 'PHILOSOPHY'. 00460020 004700 05 PIC X(20) VALUE 'PSYCHOLOGY'. 00470014 004800 05 PIC X(20) VALUE 'MUSIC'. 00480014 004900 05 PIC X(20) VALUE 'ART'. 00490014 005000 05 PIC X(20) VALUE 'FINANCE'. 00500014 005100 05 PIC X(20) VALUE 'LAW'. 00510014 005200 05 PIC X(20) VALUE 'EDUCATION'. 00520014 005300 05 PIC X(20) VALUE 'NURSING'. 00530014 005400 05 PIC X(20) VALUE 'BIOLOGY'. 00540014 005500 05 PIC X(20) VALUE 'ACCOUNTING'. 00550014 005600 05 PIC X(20) VALUE 'MARKETING'. 00560014 005700 05 PIC X(20) VALUE 'ASTRONOMY'. 00570014 005800 01 DEPARTMENT-TABLE REDEFINES DEPARTMENT-VALUES. 00580013 005900 05 DEPARTMENT OCCURS 15 TIMES PIC X(20). 00590014 006000 PROCEDURE DIVISION. 00600013 006100 000-MAINLINE. 00610016 006200 PERFORM 100-BEGIN. 00620013 006300 PERFORM 200-LOOPS UNTIL SWITCH = 'YES'. 00630013 006400 PERFORM 300-ENDER. 00640013 006500 100-BEGIN. 00650013 006600 OPEN INPUT INFILE OUTPUT OUTFILE. 00660013 006700 READ INFILE INTO WORK-REC AT END 00670014 006800 MOVE 'YES' TO SWITCH 00680014 006900 END-READ. 00690014 007000 200-LOOPS. 00700013 007100 MOVE NAME-IN TO NAME-OUT. 00710013 007200 MOVE DEPARTMENT (STATUS-IN) TO DEPT-OUT. 00720013 007300 WRITE OUTREC FROM DETAIL-LINE AFTER 2. 00730013 007400 READ INFILE INTO WORK-REC AT END 00740014 007500 MOVE 'YES' TO SWITCH 00750014 007600 END-READ. 00760014 007700 300-ENDER. 00770013 007800 CLOSE INFILE OUTFILE. 00780013 007900 STOP RUN. 00790013 INPUT FLEETWOOD MAC 14 JOAN FONTAINE 09 GABBY HARTNETT 02 DAGWOOD BUMSTEAD 04 MILT STILTWALKER 12 SARAH BERNHARDT 11 OUTPUT FLEETWOOD MAC MARKETING JOAN FONTAINE LAW GABBY HARTNETT PHYSICS DAGWOOD BUMSTEAD PHILOSOPHY MILT STILTWALKER BIOLOGY SARAH BERNHARDT NURSING