Showing posts with label COBOL Programs. Show all posts
Showing posts with label COBOL Programs. Show all posts

SORTING


       IDENTIFICATION DIVISION.
       PROGRAM-ID. SORT ER.
       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.
           SELECT OUTFILE1 ASSIGN TO DISK
           ORGANIZATION IS LINE SEQUENTIAL.
           SELECT SORTFILE ASSIGN TO DISK
           ORGANIZATION IS LINE SEQUENTIAL.
       DATA DIVISION.
       FILE SECTION.
       FD INFILE
           LABEL RECORDS ARE STANDARD
           VALUE OF FILE-ID IS "ERINN.TXT".
       01 INREC.
           02 ENO PIC 9(3).
           02 ENAME PIC X(20).
           02 NHW PIC 9(2).
           02 PR PIC 9(2).
       FD OUTFILE
           LABEL RECORDS ARE STANDARD
           VALUE OF FILE-ID IS "EROUT.TXT".
       01 OUTREC.
           02 ENO1 PIC 9(3).
           02 ENAME1 PIC X(20).
           02 NHW1 PIC 9(2).
           02 PR1 PIC 9(2).
       SD SORTFILE
           DATA RECORD IS SORTREC.
       01 SORTREC.
           02 SENO PIC 9(3).
           02 SENAME PIC X(20).
           02 SNHW PIC 9(2).
           02 SPR PIC 9(2).
       FD OUTFILE1
           LABEL RECORDS ARE STANDARD
           VALUE OF FILE-ID IS "EROUT1.TXT".
       01 OUTREC1 PIC X(80).

       WORKING-STORAGE SECTION.
           77 CH PIC X(1).
           77 YTD PIC 9(6).
           77 EOF PIC X VALUE 'N'.
       01 H1.
           02 F PIC X(3) VALUE SPACES.
           02 F PIC X(13) VALUE "SALARY REPORT".
       01 H2.
           02 F PIC X(3) VALUE SPACES.
           02 F PIC X(79) VALUE ALL " ".
       01 H3.
           02 F PIC X(90) VALUE ALL " ".
       01 H4.
           02 F PIC X(3) VALUE SPACES.
           02 F PIC X(7) VALUE "EMP NO".
           02 F PIC X(4) VALUE SPACES.
           02 F PIC X(8) VALUE "EMP NAME".
           02 F PIC X(3) VALUE SPACES.
           02 F PIC X(4) VALUE "NHW".
           02 F PIC X(4) VALUE SPACES.
           02 F PIC X(10) VALUE "PAY RATE".
           02 F PIC X(3) VALUE SPACES.
           02 F PIC X(4) VALUE "YTDV".
       01 H5.
           02 F PIC X(13) VALUE SPACES.
           02 ONO PIC 9(3).
           02 F PIC X(4) VALUE SPACES.
           02 ONAME PIC X(20) VALUE SPACES.
           02 F PIC X(4) VALUE SPACES.
           02 ONHW PIC 9(3).
           02 F PIC X(4) VALUE SPACES.
           02 OPR PIC 9(10).
           02 F PIC X(4) VALUE SPACES.
           02 OYTD PIC Z(6).
       01 H6.
           02 F PIC X(4) VALUE SPACES.
           02 F PIC X(10) VALUE "TOTAL YTD".
           02 OTYTD PIC 9(7).
       77 TYTD PIC 9(7).
       PROCEDURE DIVISION.
       MAIN-PARA.
           OPEN OUTPUT INFILE.
           PERFORM INPUT-PARA UNTIL CH = 'N'.
           CLOSE INFILE.
           PERFORM SORT-PARA.
           OPEN INPUT OUTFILE OUTPUT OUTFILE1.
           WRITE OUTREC1 FROM H1.
           WRITE OUTREC1 FROM H2.
           WRITE OUTREC1 FROM H3.
           WRITE OUTREC1 FROM H4.
           READ OUTFILE AT END MOVE 'Y' TO EOF.
           PERFORM READ-PARA UNTIL EOF = 'Y'.
           WRITE OUTREC1 FROM H2.
           MOVE TYTD TO OTYTD.
           WRITE OUTREC1 FROM H6.
           CLOSE OUTFILE, OUTFILE1.
           STOP RUN.
       INPUT-PARA.
           DISPLAY "ENTER THE EMP NO".
           ACCEPT ENO.
           DISPLAY "ENTER THE EMP NAME".
           ACCEPT ENAME.
           DISPLAY "ENTER THE NO.OF HOURS WORKED".
           ACCEPT NHW.
           DISPLAY "ENTER THE PAY RATE".
           ACCEPT PR.
           WRITE INREC.
           DISPLAY "DO YOU WANT TO CONTINUE (Y/N).
           ACCEPT CH.
           MOVE 0 TO TYTD.
       SORT-PARA.
           SORT SORTFILE ON ASCENDING KEY
           SENO USING INFILE GIVING OUTFILE.
       READ-PARA.
           COMPUTE YTD = NHW1 * PR1.
           COMPUTE TYTD = TYTD + YTD.
           MOVE ENO1 TO ONO.
           MOVE ENAME1 TO ONAME.
           MOVE NHW1 TO ONHW.
           MOVE PR1 TO OPR.
           MOVE YTD TO OYTD.
           WRITE OUTREC1 FROM H5.
           READ OUTFILE AT END MOVE 'Y' TO EOF.
Posted by No comments:
Labels: ,

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.

Posted by No comments:
Labels: ,

ACCOUNT BALANCE REPORT


       IDENTIFICATION DIVISION.
       PROGRAM-ID. ACCOUNTBAL.
       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 "ACCIN.TXT".
       01 INREC.
           02 ACCNO PIC X(3).
           02 ACCDESC PIC X(10).
           02 ACCBAL PIC S9(8)V9(2). 
       FD OUTFILE
           LABEL RECORDS ARE STANDARD
           VALUE OF FILE-ID IS "ACCOUT.TXT".
       01 OUTREC PIC X(80).
       WORKING-STORAGE SECTION.
       01 DETAIL-LINE.
           02 F PIC X(3) VALUE SPACES.
           02 OACCNO PIC X(3).
           02 F PIC X(3) VALUE SPACES.
           02 OACCDESC PIC X(10).
           02 F PIC X(3) VALUE SPACES.
          02 OACCBAL PIC Z(7)9.99CR.
       01 CURRENT-ACCNO PIC X(3).
       01 ACC-BALANCE PIC S9(8)V9(2) VALUE ZERO.
       01 END-OF-FILE-SWITCH PIC X VALUE 'N'.
          88 END-OF-FILE VALUE 'Y'.
       01 SUB-TOTAL-LINE.
           02 F PIC X(5) VALUE SPACES.
          02 F PIC X(10) VALUE "TOTAL FOR".
          02 SUB-TOTAL PIC X(3).
          02 F PIC X(23) VALUE ":".
          02 SUB-TOTAL-BALANCE PIC $$,$$$,$$9.99CR.
       77 CH PIC X(1).


     PROCEDURE DIVISION.
     MAIN-PARA.
         OPEN OUTPUT INFILE.
         PERFORM INPUT-PARA UNTIL CH = 'N'.
          CLOSE INFILE.
         PERFORM INITIALIZATION-ROUTINE.
         PERFORM THE-LOOP UNTIL END-OF-FILE.
         PERFORM EOJ-ROUTINE.
         STOP RUN.
     INPUT-PARA.
         DISPLAY "ENTER THE ACC NUMBER".
          ACCEPT ACCNO.
         DISPLAY "ENTER ACC DESCRIPTION".
         ACCEPT ACCDESC.
         DISPLAY "ENTER ACC BALANCE".
         ACCEPT ACCBAL.
          WRITE INREC.
          DISPLAY "DO YOU WANT TO CONTINUE (Y/N)".
          ACCEPT CH.
     INITIALIZATION-ROUTINE.
         OPEN INPUT INFILE OUTPUT OUTFILE.
         READ INFILE AT END MOVE 'Y' TO END-OF-FILE-SWITCH.
         MOVE ACCNO TO CURRENT-ACCNO.
     THE-LOOP.
         IF ACCNO NOT = CURRENT-ACCNO PERFORM CONTROL-BREAK.
         MOVE ACCNO TO OACCNO.
         MOVE ACCDESC TO OACCDESC.
         MOVE ACCBAL TO OACCBAL.
         WRITE OUTREC FROM DETAIL-LINE.
         ADD ACCBAL TO ACC-BALANCE.
         MOVE ACCNO TO CURRENT-ACCNO.
         READ INFILE AT END MOVE 'Y' TO END-OF-FILE-SWITCH.
     EOJ-ROUTINE.
        PERFORM CONTROL-BREAK.
        CLOSE INFILE, OUTFILE.
     CONTROL-BREAK.
         MOVE ACC-BALANCE TO SUB-TOTAL-BALANCE.
         MOVE CURRENT-ACCNO TO SUB-TOTAL.
         WRITE OUTREC FROM SUB-TOTAL-LINE.
         MOVE ZERO TO ACC-BALANCE.

Posted by No comments:
Labels: ,
Subscribe to: Posts (Atom)
Related Posts with Thumbnails