DEPT NAME LOOK UP


       IDENTIFICATION DIVISION.
       PROGRAM-ID. DEPTNAME.
       ENVIRONMENT DIVISION.
       INPUT-OUTPUT SECTION.
       FILE-CONTROL.
           SELECT INFILE ASSIGN TO DISK
           ORGANIZATION IS LINE SEQUENTIAL.
           SELECT OUTFILE ASSIGN TO DISK
           ORGANIZATION IS LINE SEQUENTIAL.
       DATA DIVISION.
       FILE SECTION.
       FD INFILE
           LABEL RECORDS ARE STANDARD
           VALUE OF FILE-ID IS "DEPTINN.TXT".
       01 INREC.
           02 DNO PIC 9(4).
           02 ENO PIC 9(9).
           02 LNA PIC X(12).
           02 FNA PIC X(9).
       FD OUTFILE
           LABEL RECORDS ARE STANDARD
           VALUE OF FILE-ID IS "DEPTOUT.TXT".
       01 OUTREC PIC X(80).
       WORKING-STORAGE SECTION.
       77 CH PIC X.      
       77 DNA PIC X(26).
       77 EOF PIC X VALUE 'N'.
       01 DEPT-DATA.
           02 F PIC X(30) VALUE "1000 ADMINISTRATION".
           02 F PIC X(30) VALUE "2000 PURCHASING".
           02 F PIC X(30) VALUE "3000 PERSONNEL".
           02 F PIC X(30) VALUE "4000 ADVERTISING ".
           02 F PIC X(30) VALUE "5000 PUBLIC RELATIONS".
           02 F PIC X(30) VALUE "6000 TRAINING".
           02 F PIC X(30) VALUE "7000 RESEARCH DEVELOPMENT".
           02 F PIC X(30) VALUE "8000 FINANCE".
           02 F PIC X(30) VALUE "9000 DATA PROCESSING".
           02 F PIC X(30) VALUE "1100 MANUFACTURING".
       01 DEPT-TABLE REDEFINES DEPT-DATA.
           02 DNAME-ENTRY OCCURS 10 TIMES INDEXED BY A.
               03 DEPTNO PIC 9(4).
               03 DEPTNA PIC X(26).
       01 H1.
           02 F PIC X(29) VALUE SPACES.
           02 F PIC X(23) VALUE "DEPARTMENT NAME LOOK UP".
     
       01 H2.
           02 F PIC X(29) VALUE SPACES.
           02 F PIC X(23) VALUE ALL "*".
       01 H3.
           02 F PIC X(3) VALUE SPACES.
           02 F PIC X(8) VALUE "EMP NO". 
           02 F PIC X(3) VALUE SPACES.
           02 F PIC X(12) VALUE "FIRST NAME".
           02 F PIC X(3) VALUE SPACES.
           02 F PIC X(12) VALUE "LAST NAME".
           02 F PIC X(3) VALUE SPACES.
           02 F PIC X(9) VALUE "DEPT NO.".
           02 F PIC X(3) VALUE SPACES.
           02 F PIC X(15) VALUE "DEPARTMENT NAME".
       01 H4.        
           02 F PIC X(3) VALUE SPACES.
           02 OENO PIC 9(9).
           02 F PIC X(3) VALUE SPACES.
           02 OFNA PIC X(9).
           02 F PIC X(3) VALUE SPACES.
           02 OLNA PIC X(12).
           02 F PIC X(3) VALUE SPACES.
           02 ODNO PIC 9(4).
           02 F PIC X(3) VALUE SPACES.
           02 ODNA PIC X(26).
           02 F PIC X(3) VALUE SPACES.
       PROCEDURE DIVISION.
       MAIN-PARA.          
           OPEN OUTPUT INFILE.
           PERFORM INPUT-PARA UNTIL CH = 'N'
           CLOSE INFILE.
           OPEN INPUT INFILE OUTPUT OUTFILE.
           WRITE OUTREC FROM H1.
           WRITE OUTREC FROM H2.
           WRITE OUTREC FROM H3.
           READ INFILE AT END MOVE 'Y' TO EOF.
           PERFORM P2 UNTIL EOF = 'Y'.
           CLOSE INFILE, OUTFILE.
           STOP RUN.                
        
       INPUT-PARA.                   
           DISPLAY "EMPLOYEE NO".
           ACCEPT ENO.
           DISPLAY "LAST NAME".
           ACCEPT LNA.
           DISPLAY "FIRST NAME".
           ACCEPT FNA.
           DISPLAY "DEPARTMENT NO".
           ACCEPT DNO.
           WRITE INREC.
           DISPLAY "DO YOU WANT TO CONTINUE (Y/N)".
           ACCEPT CH.
       P2.
        
           SET A TO 1.
           SEARCH DNAME-ENTRY AT END
           MOVE "NO SUCH DEPTNO" TO DNA WHEN DNO = DEPTNO (A)
           MOVE DEPTNA (A) TO DNA.
           PERFORM MOVE-PARA.
           READ INFILE AT END MOVE 'Y' TO EOF.
         
       MOVE-PARA.
           MOVE ENO TO OENO.
           MOVE LNA TO OLNA.
           MOVE FNA TO OFNA.
           MOVE DNO TO ODNO.
           MOVE DNA TO ODNA.
           WRITE OUTREC FROM H4.

No comments:

Related Posts with Thumbnails