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

NESTED IF IN COBOL

       IDENTIFICATION DIVISION.
       PROGRAM-ID. FIBONACCI.
       ENVIRONMENT DIVISION.
       DATA DIVISION.
       WORKING-STORAGE SECTION.
       77 A PIC S99 VALUE -1.
       77 B PIC 99 VALUE 1.
       77 C PIC 99 VALUE 1.
       PROCEDURE DIVISION.
       PARA1.
           DISPLAY "ENTER THE VALUE OF A".
           ACCEPT A.
           DISPLAY "ENTER THE VALUE OF B".
           ACCEPT B.
           DISPLAY "ENTER THE VALUE OF C".
           ACCEPT C.
           IF A > B
               IF A > C
                   DISPLAY " A IS GREATER"
               ELSE
                   DISPLAY "C IS GREATER"
           ELSE IF B > C
               DISPLAY "B IS GREATER"
               ELSE DISPLAY "C IS GREATER".
           STOP RUN.
       

GREATER OF 2 NUMBERS

       IDENTIFICATION DIVISION.
       PROGRAM-ID. FIBONACCI.
       ENVIRONMENT DIVISION.
       DATA DIVISION.
       WORKING-STORAGE SECTION.
       77 A PIC S99 VALUE -1.
       77 B PIC 99 VALUE 1.
       77 C PIC 99 VALUE 1.
       PROCEDURE DIVISION.
       PARA1.
           DISPLAY "ENTER THE VALUE OF A".
           ACCEPT A.
           DISPLAY "ENTER THE VALUE OF B".
           ACCEPT B.
           IF A > B
               DISPLAY " A IS GREATER"
           ELSE
               DISPLAY "B IS GREATER"
           STOP RUN.
       

FIBONACCI

       IDENTIFICATION DIVISION.
       PROGRAM-ID. FIBONACCI.
       ENVIRONMENT DIVISION.
       DATA DIVISION.
       WORKING-STORAGE SECTION.
       77 A PIC S99 VALUE -1.
       77 B PIC 99 VALUE 1.
       77 C PIC 99.
       77 N PIC 99.
       77 N1 PIC 99 VALUE 0.
       PROCEDURE DIVISION.
       PARA1.
           DISPLAY "ENTER A NUMBER".
           ACCEPT N.
           PERFORM PARA2 UNTIL N1 = N.
           STOP RUN.
       PARA2.
           COMPUTE C = A + B;
           DISPLAY C.
           MOVE B TO A.
           MOVE C TO B.
           ADD 1 TO N1.

Ledger Report Validation.

       IDENTIFICATION DIVISION.
       PROGRAM-ID. LEDGER.
       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 "LEDIN.TXT".
       01 ACC-REC.
           02 RC PIC X(2).
               88 VALID-RC  VALUE "LM".
           02 ACC-NO.
               03 FNO PIC X(5).
               03 LNO PIC X(3).
           02 ACC-DESC.
               03 FNAME PIC X.
               03 REST-NAME PIC X(19).
           02 ACC-TYPE PIC X.
               88 VALID-ACC-TYPE VALUES ARE
                   'X' '1' '2' '3' '4' '5' '6'.
           02 ACC-BALANCE PIC X(8).
       FD OUTFILE
           LABEL RECORDS ARE STANDARD
           VALUE OF FILE-ID IS "LEDOUT.TXT".
       01 OUTREC PIC X(80).
       WORKING-STORAGE SECTION.
       01 H1.
           05 F PIC X(28) VALUE SPACES.
           05 F PIC X(28) VALUE "LEDGER RECORDS VALIDATION".
       01 H11.
           05 F PIC X(28) VALUE SPACES.
           05 F PIC X(28) VALUE "AUDIT/ERROR LIST".
       01 H2.
           05 F PIC X(2) VALUE "RC".
           05 F PIC X(5) VALUE SPACES.
           05 F PIC X(6) VALUE "NUMBER".
           05 F PIC X(5) VALUE SPACES.
           05 F PIC X(11) VALUE "DESCRIPTION".
           05 F PIC X(5) VALUE SPACES.
           05 F PIC X(5) VALUE "TYPE".
           05 F PIC X(5) VALUE SPACES.
           05 F PIC X(10) VALUE "BALANCE".
           05 F PIC X(5) VALUE SPACES.
           05 F PIC X(15) VALUE "ERROR CODES".
       01 D-REC.
           02 RC PIC X(2).
           02 F PIC X(5) VALUE SPACES.
           02 ACC-NO-O.
               03 FNO-O PIC X(5).
               03 LNO-O PIC X(3).
           02 F PIC X(5) VALUE SPACES.
           02 ACC-DESC-O.
               03 FNAME PIC X.
               03 REST-NAME PIC X(19).
           02 F PIC X(5) VALUE SPACES.
           02 ACC-TYPE PIC X.
           02 F PIC X(5) VALUE SPACES.
           02 ACC-BALANCE-O PIC X(8) VALUE SPACES.
           02 F PIC X(5) VALUE SPACES.
           02 ERR.
               10 ERR-CODE1 PIC X VALUE SPACES.
               10 ERR-CODE2 PIC X VALUE SPACES.
               10 ERR-CODE3 PIC X VALUE SPACES.
               10 ERR-CODE4 PIC X VALUE SPACES.
               10 ERR-CODE5 PIC X VALUE SPACES.
               10 ERR-CODE6 PIC X VALUE SPACES.
       01 BLANK-SPACE PIC X(80) VALUE SPACES.
       77 CHI PIC X VALUE 'Y'.
       77 EOF PIC X VALUE 'N'.
       77 LINEUSED PIC 99 VALUE 0.
       PROCEDURE DIVISION.
       MAIN-PARA.
           OPEN OUTPUT INFILE.
           PERFORM ACCEPT-PARA UNTIL CHI = 'N'.
           CLOSE INFILE.
           OPEN INPUT INFILE OUTPUT OUTFILE.
           PERFORM HEAD-PARA.
           READ INFILE AT END MOVE 'Y' TO EOF.
           PERFORM VALIDATION-PARA UNTIL EOF = 'Y'.
           CLOSE INFILE, OUTFILE.
           STOP RUN.
       ACCEPT-PARA.
           DISPLAY "ENTER THE RECORD CODE".
           ACCEPT RC OF ACC-REC.
           DISPLAY "ENTER THE ACCOUNT NUMBER".
           ACCEPT ACC-NO OF ACC-REC.
           DISPLAY "ENTER THE ACCOUNT DESCRIPTION".
           ACCEPT ACC-DESC OF ACC-REC.
           DISPLAY "ENTER THE ACCOUNT TYPE".
           ACCEPT ACC-TYPE OF ACC-REC.
           DISPLAY "ENTER THE ACCOUNT BALANCE".
           ACCEPT ACC-BALANCE OF ACC-REC.
           WRITE ACC-REC.

           DISPLAY "DO YPU WANT TO CON Y/N".
           ACCEPT CHI.
       HEAD-PARA.
           WRITE OUTREC FROM H1.
           WRITE OUTREC FROM BLANK-SPACE.
           WRITE OUTREC FROM H2.
           ADD 3 TO LINEUSED.
       VALIDATION-PARA.
           IF NOT VALID-RC MOVE 'A' TO ERR-CODE1.
           IF ACC-NO IS EQUAL TO SPACES
           MOVE 'B' TO ERR-CODE2.
           IF ACC-NO OF ACC-REC IS NUMERIC
           MOVE 'C' TO ERR-CODE3.
           IF ACC-DESC OF ACC-REC IS EQUAL TO SPACES
           MOVE 'D' TO ERR-CODE4.
           IF NOT VALID-ACC-TYPE MOVE 'E' TO ERR-CODE5.
           INSPECT ACC-BALANCE
           REPLACING LEADING SPACES BY ZEROS.
           IF ACC-BALANCE IS NOT NUMERIC
           MOVE 'F' TO ERR-CODE6.
           MOVE RC OF ACC-REC TO RC OF D-REC.
           MOVE ACC-NO OF ACC-REC TO ACC-NO-O OF D-REC.
           MOVE ACC-DESC OF ACC-REC TO ACC-DESC-O OF D-REC.
           MOVE ACC-TYPE OF ACC-REC TO ACC-TYPE OF D-REC.
           MOVE ACC-BALANCE OF ACC-REC TO ACC-BALANCE-O OF D-REC.
           WRITE OUTREC FROM D-REC.
           IF LINEUSED > 50
           MOVE 0 TO LINEUSED
           PERFORM HEAD-PARA.
           MOVE SPACES TO ERR-CODE1, ERR-CODE2, ERR-CODE3, ERR-CODE4,
           ERR-CODE5, ERR-CODE6.
           READ INFILE AT END MOVE "Y" TO EOF.


          
          
          

FACTORIAL OF A NUMBER

       IDENTIFICATION DIVISION.
       PROGRAM-ID. FACTORIAL.
       DATA DIVISION.
       WORKING-STORAGE SECTION.
       77 N PIC 9(4).
       77 A PIC S9(4) VALUE 0.
       77 F PIC 9(4) VALUE 1.
       PROCEDURE DIVISION.
       PARA.
           DISPLAY "ENTER A NUMBER.".
           ACCEPT N.
           PERFORM PARA1 UNTIL A = N.
           DISPLAY "THE FACTORIAL IS".
           DISPLAY F.
           STOP RUN.
       PARA1.
           ADD 1 TO A.
           COMPUTE F = F * A.

SWAPING VALUE OF TWO DATA FIELDS

       IDENTIFICATION DIVISION.
       PROGRAM-ID. SWAP.
       DATA DIVISION.
       WORKING-STORAGE SECTION.
       77 A PIC 9(4).
       77 B PIC 9(4).
       77 C PIC 9(4).
       PROCEDURE DIVISION.
       PARA.
           DISPLAY "ENTER THE VALUE OF A".
           ACCEPT A.
           DISPLAY "ENTER THE VALUE OF B".
           ACCEPT B.
           MOVE A TO C.
           MOVE B TO A.
           MOVE C TO B.
           DISPLAY "AFTER SWAP".
           DISPLAY "THE VALUE OF A IS".
           DISPLAY A.
           DISPLAY "THE VALUE OF B IS".
           DISPLAY B.
           STOP RUN.


ADDITION IN COBOL

       IDENTIFICATION DIVISION.
       PROGRAM-ID. ADDITION.
       DATA DIVISION.
       WORKING-STORAGE SECTION.
       77 A PIC 9(4).
       77 B PIC 9(4).
       77 C PIC 9(4).
       PROCEDURE DIVISION.
       PARA.
           DISPLAY "ENTER THE VALUE OF A".
           ACCEPT A.
           DISPLAY "ENTER THE VALUE OF B".
           ACCEPT B.
           COMPUTE C = A + B.
           DISPLAY "THE RESULTANT VALUE IS".
           DISPLAY C.
           STOP RUN.

A SIMPLE PROGRAM

      *ALWAYS START AT COL 8
       IDENTIFICATION DIVISION.
       PROGRAM-ID. SIMPLEPROGRAM.
       DATA DIVISION.
       PROCEDURE DIVISION.
       PARA1.
      *CONTINUE IN COL 12
           DISPLAY "WELCOME TO COBOL".
           STOP RUN.

PRICE LIST

       IDENTIFICATION DIVISION.
       PROGRAM-ID. PRICELIST.
       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 "IN.TXT".
       01 INREC.
           02 ID PIC X(4).
           02 DESC PIC X(20).
           02 PRICE PIC 9(6).
       FD OUTFILE
           LABEL RECORDS ARE STANDARD
           VALUE OF FILE-ID IS "OUT.TXT".
       01 OUTREC PIC X(80).
       WORKING-STORAGE SECTION.
       01 H1.
           02 F PIC X(35) VALUE SPACES.
           02 F PIC X(10) VALUE "PRICE LIST".
       01 H2.
           02 F PIC X(2) VALUE SPACES.
           02 F PIC X(10) VALUE "PRODUCT-ID".
           02 F PIC X(2) VALUE SPACES.
           02 F PIC X(15) VALUE "PRODUCT-DESC".
           02 F PIC X(2) VALUE SPACES.
           02 F PIC X(5) VALUE "PRICE".
       01 H3.
           02 F PIC X(2) VALUE SPACES.
           02 OID PIC X(10) VALUE SPACES.
           02 F PIC X(2) VALUE SPACES.
           02 ODESC PIC X(15) VALUE SPACES.
           02 F PIC X(2) VALUE SPACES.
           02 OPRICE PIC $Z,ZZ,ZZ.99.
       01 H4.
           02 F PIC X(80) VALUE ALL "=".
       01 H5.
           02 F PIC X(20) VALUE SPACES.
           02 F PIC X(20) VALUE "NO.OF RECORDS".
           02 NOR PIC ZZZ.
       01 CH PIC X VALUE "Y".
       01 RC PIC 9(4) VALUE 0.
       PROCEDURE DIVISION.
       PARA.
           OPEN OUTPUT INFILE.
           PERFORM INPARA UNTIL CH = "N".
           CLOSE INFILE.
           OPEN INPUT INFILE OUTPUT OUTFILE.
           PERFORM WRITEPARA.
           PERFORM APARA.
           MOVE RC TO NOR.
           WRITE OUTREC FROM H4.
           WRITE OUTREC FROM H5.
       INPARA.
           DISPLAY " ENTER ID".
           ACCEPT ID.
           DISPLAY " ENTER DESC".
           ACCEPT DESC.
           DISPLAY " ENTER PRICE"
           ACCEPT PRICE.
           ADD 1 TO RC.
           DISPLAY " CONTINUE?"
           ACCEPT CH.
       WRITEPARA.
           WRITE OUTREC FROM H1.
           WRITE OUTREC FROM H4.
           WRITE OUTREC FROM H2.
       APARA.
           READ INFILE AT END GO TO CPARA.
           MOVE ID TO OID.
           MOVE ODESC TO ODESC.
           MOVE PRICE TO OPRICE.
           WRITE OUTREC FROM H3.
           GO TO APARA.
       CPARA.
           CLOSE INFILE OUTFILE.
           STOP RUN.

EARNING REPORT

       IDENTIFICATION DIVISION.
       PROGRAM-ID. 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.
       DATA DIVISION.
       FILE SECTION.
       FD INFILE
            LABEL RECORDS ARE STANDARD
            VALUE OF FILE-ID IS "INN.txt".
       01 INREC.
          02 ENO PIC 9(3).
          02 NAME PIC X(20).
          02 NHW PIC 9(2).
          02 PR PIC 9(2).
       FD OUTFILE
          LABEL RECORDS ARE STANDARD
          VALUE OF FILE-ID IS "OUT.txt".
       01 OUTREC PIC X(80).  
       WORKING-STORAGE SECTION.
       77 N PIC 9(5).
       77 YTD PIC 9(6).


       01 H1.
          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(3) VALUE SPACES.
          02 F PIC X(10) VALUE "EMP-NAME".
          02 F PIC X(6) VALUE SPACES.
          02 F PIC X(5) VALUE "NHW".
          02 F PIC X(6) VALUE SPACES.
          02 F PIC X(10) VALUE "PAY RATE".
          02 F PIC X(6) VALUE SPACES.
          02 F PIC X(7) VALUE "YTDV".
          
       01 H5.
          02 F PIC X(3) VALUE SPACES.
          02 ONO PIC X(6) VALUE SPACES.
          02 F PIC X(6) VALUE SPACES.
          02 ONAME PIC X(10) VALUE SPACES.
          02 F PIC X(6) VALUE SPACES.
          02 ONHW PIC X(6) VALUE SPACES.
          02 F PIC X(6) VALUE SPACES.
          02 OPR PIC X(5) VALUE SPACES.
          02 F PIC X(6) VALUE SPACES.
          02 OYTD PIC Z(6) VALUE SPACES.
       PROCEDURE DIVISION.
       PARA.
           OPEN OUTPUT INFILE.
           DISPLAY " ENTER NO.OF EMPLOYEES".
           ACCEPT N.   
           PERFORM PARA1 N TIMES.
           CLOSE INFILE.
           GO TO PARA3.
       PARA1.
           DISPLAY "ENTER THE NO".
           ACCEPT ENO.
           DISPLAY "ENTER THE NAME".
           ACCEPT NAME.
           DISPLAY "ENTER THE NHW".
           ACCEPT NHW.
           DISPLAY "ENTER THE PR".
           ACCEPT PR.
           WRITE INREC.
       PARA3.
           OPEN INPUT INFILE OUTPUT OUTFILE.
           WRITE OUTREC FROM H1.
           WRITE OUTREC FROM H2.
           WRITE OUTREC FROM H3.
           WRITE OUTREC FROM H4.
       PARA4.
           READ INFILE AT END GO TO CLOSEPARA.
           COMPUTE YTD = NHW * PR.
           MOVE ENO TO ONO.
           MOVE NAME TO ONAME.
           MOVE NHW TO ONHW.
           MOVE PR TO OPR.
           MOVE YTD TO OYTD.
           WRITE OUTREC FROM H5.
           GO TO PARA4.
       CLOSEPARA.
           WRITE OUTREC FROM H2.
             CLOSE INFILE, OUTFILE.
             STOP RUN.

Test Result Report


       IDENTIFICATION DIVISION.
       PROGRAM-ID. TRR.
       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 "IN.TXT".
       01 INREC.
           02 SNO PIC X(5).
           02 SNAME PIC X(15).
           02 QA PIC 9(2).
           02 QM PIC 9(2).
       FD OUTFILE
           LABEL RECORDS ARE STANDARD
           VALUE OF FILE-ID IS "OUT.TXT".
       01 OUTREC PIC X(80).
       WORKING-STORAGE SECTION.
       77 P PIC 9(3)V99.
       77 PC PIC 9(3)V99.
       77 GRADE PIC X(3).
       77 CON PIC X(1).
       01 H1.
           02 F PIC X(25) VALUE SPACES.
           02 F PIC X(25) VALUE "TEST RESULT REPORT".
       01 H2.
           02 F PIC X(7) VALUE "SNAME".
           02 F PIC X(6) VALUE SPACES.
           02 F PIC X(10) VALUE "SNAME".
           02 F PIC X(6) VALUE SPACES.
           02 F PIC X(10) VALUE "QASKED".
           02 F PIC X(6) VALUE SPACES.
           02 F PIC X(10) VALUE "QMISSED".
           02 F PIC X(6) VALUE SPACES.
           02 F PIC X(8) VALUE "PERCENT".
           02 F PIC X(6) VALUE SPACES.
           02 F PIC X(6) VALUE "GRADE".
       01 O-REC.
           02 ONO PIC X(7) VALUE SPACES.
           02 F PIC X(6) VALUE SPACES.
           02 ONAME PIC X(10) VALUE SPACES.
           02 F PIC X(6) VALUE SPACES.
           02 OQA PIC X(10) VALUE SPACES.
           02 F PIC X(6) VALUE SPACES.
           02 OQM PIC X(10) VALUE SPACES.
           02 F PIC X(6) VALUE SPACES.
           02 OPC PIC Z9(3).
           02 F PIC X(6) VALUE SPACES.
           02 OGRADE PIC X(6) VALUE SPACES.       
       01 H4.
           02 F PIC X(80) VALUE ALL "*".
       PROCEDURE DIVISION.
       CON-PARA.
           OPEN OUTPUT INFILE.
       INPUT-PARA.           
           DISPLAY "ENTER THE STU NO"
           ACCEPT SNO.
           DISPLAY "ENTER THE STU NAME"
           ACCEPT SNAME.
           DISPLAY "ENTER THE QASKED"
           ACCEPT QA.
           DISPLAY "ENTER THE QMISSED"
           ACCEPT QM.
           WRITE INREC.
           DISPLAY "Y/N".
           ACCEPT CON.
           PERFORM INPUT-PARA UNTIL CON = "N".
       INCLOSEPARA.
           CLOSE INFILE.
       OUTPUT-PARA.
           OPEN INPUT INFILE OUTPUT OUTFILE.
           WRITE OUTREC FROM H1.
           WRITE OUTREC FROM H4.
           WRITE OUTREC FROM H2.
           WRITE OUTREC FROM H4.
       RESULT-PARA.
           READ INFILE AT END GO TO CLOSE-PARA.
           COMPUTE  P = QA - QM.
           COMPUTE PC = (P / QA) * 100.
           IF PC > 89 AND PC < 101
               MOVE "A" TO GRADE
           ELSE IF PC > 79 AND PC < 91
               MOVE "B" TO GRADE
           ELSE IF PC > 69 AND PC < 81
               MOVE "C" TO GRADE
           ELSE IF PC > 59 AND PC < 71
               MOVE "D" TO GRADE
           ELSE
               MOVE "E" TO GRADE. 
           MOVE SNO TO ONO.
           MOVE SNAME TO ONAME.
           MOVE QA TO OQA.
           MOVE QM TO OQM.
           MOVE PC TO OPC.
           MOVE GRADE TO OGRADE.
           WRITE OUTREC FROM O-REC.
           GO TO RESULT-PARA.
       CLOSE-PARA.
           CLOSE INFILE, OUTFILE.
           STOP RUN.

Related Posts with Thumbnails