Wednesday, December 15, 2010

Finding the factorial using a subroutine

       IDENTIFICATION DIVISION.
       PROGRAM-ID FACTFIND-MAIN.
       DATA DIVISION.
       WORKING-STORAGE SECTION.
       77 N PIC 99.
       77 FACT PIC 9(6).
       77 EDFACT PIC Z(5)9.
       PROCEDURE DIVISION.
       MAIN-PARA.
           DISPLAY "Enter a number : ".
           ACCEPT N.
           CALL "PRO0102.COB" USING N FACT.
           MOVE FACT TO EDFACT.
           DISPLAY "Factorial of " N "is: " EDFACT.
           STOP RUN.

Subroutine with file name PRO0102.COB
       IDENTIFICATION DIVISION.
       PROGRAM-ID FACTFIND-SUB.
       DATA DIVISION.
       WORKING-STORAGE SECTION.
       77 I PIC 99.
       LINKAGE SECTION.
       77 N1 PIC 9(2).
       77 FACT1 PIC 9(6).
       PROCEDURE DIVISION USING N1 FACT1.
       MAIN-PARA.
           MOVE 1 TO FACT1.
           PERFORM FIND VARYING I FROM 2 BY 1 UNTIL I > N1.
           EXIT PROGRAM.
       FIND.
           MULTIPLY I BY FACT1.

Matrix addition and subtraction

       IDENTIFICATION DIVISION.
       PROGRAM-ID.
       ENVIRONMENT DIVISION.
       DATA DIVISION.
       WORKING-STORAGE SECTION.
       01 MATRIX.
         02 MAT OCCURS 10 TIMES.
           03 A PIC 9(4) OCCURS 10 TIMES.
           03 B PIC 9(4) OCCURS 10 TIMES.
           03 C PIC 9(4) OCCURS 10 TIMES.
           03 D PIC 9(4) OCCURS 10 TIMES.
       77 M PIC 9(3).
       77 N PIC 9(3).
       77 I PIC 9(3).
       77 J PIC 9(3).
       77 EMAT PIC -ZZZ9.
       PROCEDURE DIVISION.
       MAIN-PARA.
           DISPLAY "Enter the matrix dimensions".
           ACCEPT M.
           ACCEPT N.
           DISPLAY "Enter the fist matrix element".
           PERFORM READ-MAT1-PARA VARYING I FROM 1 BY 1 UNTIL I > M
                 AFTER J FROM 1 BY 1 UNTIL J > N.
           DISPLAY "Enter the second matrix element".
           PERFORM READ-MAT2-PARA VARYING I FROM 1 BY 1 UNTIL I > M
                 AFTER J FROM 1 BY 1 UNTIL J > N.
           DISPLAY (1 1) ERASE.
           PERFORM MAT-ADD-PARA VARYING I FROM 1 BY 1 UNTIL I > M
                 AFTER J FROM 1 BY 1 UNTIL J > N.
          PERFORM MAT-SUB-PARA VARYING I FROM 1 BY 1 UNTIL I > M
                 AFTER J FROM 1 BY 1 UNTIL J > N.
           PERFORM MAT-DIS-PARA VARYING I FROM 1 BY 1 UNTIL I > M
                 AFTER J FROM 1 BY 1 UNTIL J > N.
           STOP RUN.
       READ-MAT1-PARA.
           ACCEPT A(I J).
       READ-MAT2-PARA.
           ACCEPT B(I J).
       MAT-ADD-PARA.
           COMPUTE C(I J) = A(I J) + B(I J).
       MAT-SUB-PARA.
           COMPUTE D(I J) = A(I J) - B(I J).
       MAT-DIS-PARA.
           COMPUTE COL = J * 7 - 2.
           COMPUTE LIN = I + 4.
           MOVE A(I J) TO EMAT.
           DISPLAY (LIN, COL) EMAT.
           COMPUTE COL = J * 7 + 23.
           MOVE B(I J) TO EMAT.
           DISPLAY (LIN, COL) EMAT.
           COMPUTE COL = J * 7 - 2.
           COMPUTE LIN = I + 11.
           MOVE C(I J) TO EMAT.
           DISPLAY (LIN, COL) EMAT.
           COMPUTE COL = J * 7 + 23.
           MOVE D(I J) TO EMAT.
           DISPLAY (LIN, COL) EMAT.
         

Subroutine to recalculate the B-pay as per the following. If the jobcode is 1 then add 100. If it is 2 add 750 else add 500.

Identification Division.
       Program-ID.
       Environment Division.
       Data Division.
       Working-Storage Section.
       01  Emp-Data.
           02 Empno PIC X(6).
           02 Name PIC A(20).
           02 JobCode PIC 9.
           02 B-Pay PIC 9(6).
       77 BP-Plus-Bonus PIC 9(6).
       Procedure Division.
       Main-Para.
           Display "Enter Employee Number :".
           Accept Empno.
           Display "Enter Employee Name : ".
           Accept Name.
           Display "Enter Job Code (1/2/any): ".
           Accept JobCode.
           Display "Enter Basic Salary :".
           Accept B-Pay.
           CALL "PRO112.COB" USING B-Pay JobCode BP-Plus-Bonus.
           Display (1, 1) Erase.
           Display "Employee Number       : " Empno.
           Display "Employee Name         : " Name.
           Display "Employee Job Code     : " JobCode.
           Display "Employee Basic Salary : " B-Pay.
           Display "B-Pay with bonus      : " BP-Plus-Bonus.
           STOP RUN.

Subroutine file name : PRO112.COB

       Identification Division.
       Program-ID. BONUS-CAL.
       Environment Division.
       Data Division.
       LINKAGE SECTION.
       77 JOBCODE1 PIC 9.
       77 BPAY PIC 9(6).
       77 BONUS PIC 9(6).
       PROCEDURE DIVISION USING BPAY JOBCODE1 BONUS.
       MAIN-PARA.
           IF JOBCODE1 = 1
              ADD BPAY 1000 GIVING BONUS
           ELSE
              IF JOBCODE1 = 2
                 ADD BPAY 750 GIVING BONUS
              ELSE
                 ADD BPAY 500 GIVING BONUS.
           EXIT PROGRAM.

Saturday, November 27, 2010

Program to merge two files

The Blind Side IDENTIFICATION DIVISION.
       PROGRAM-ID. MERGE-SEQFILES.
       ENVIRONMENT DIVISION.
       INPUT-OUTPUT SECTION.
       FILE-CONTROL.
           SELECT INFILE1 ASSIGN TO DISK
           ORGANIZATION IS LINE SEQUENTIAL.
           SELECT INFILE2 ASSIGN TO DISK
           ORGANIZATION IS LINE SEQUENTIAL.
           SELECT OUTFILE ASSIGN TO DISK
           ORGANIZATION IS LINE SEQUENTIAL.
           SELECT WFILE ASSIGN TO DISK.   
       DATA DIVISION.
       FILE SECTION.
       FD INFILE1
      LABEL RECORDS ARE STANDARD
           VALUE OF FILE-ID IS "STD1.DAT".
       01 FILE1-REC.
          02 RNO PIC X(5).
          02 SN PIC X(15).
          02 CL PIC X(4).
          02 MARKS PIC 9(3).
       FD INFILE2
      LABEL RECORDS ARE STANDARD
           VALUE OF FILE-ID IS "STD2.DAT".
       01 FILE2-REC.
           02 RNO PIC X(5).
           02 SN PIC X(15).
           02 CL PIC X(4).
           02 MARKS PIC 9(3).
       FD OUTFILE
      LABEL RECORDS ARE STANDARD
           VALUE OF FILE-ID IS "MRGSTD.DAT".
       01 OUT-REC PIC X(27).
       SD WFILE.
       01 S-REC.
           02 SRNO PIC X(5).
           02 SSN PIC X(15).
           02 SCL PIC X(4).
           02 SMARKS PIC 9(3).
       PROCEDURE DIVISION.
       MAIN-PARA.
           MERGE WFILE ON ASCENDING KEY SSN

Program to Sort

Pen Cam with DVR/Digital Camera - Black (4GB)      IDENTIFICATION DIVISION.
       PROGRAM-ID.
       ENVIRONMENT DIVISION.
       INPUT-OUTPUT SECTION.
       FILE-CONTROL.
           SELECT FILE1 ASSIGN TO DISK
           ORGANIZATION IS LINE SEQUENTIAL.
           SELECT FILE2 ASSIGN TO DISK
           ORGANIZATION IS LINE SEQUENTIAL.
           SELECT WFILE ASSIGN TO DISK.
       DATA DIVISION.
       FILE SECTION.
       FD FILE1
           LABEL RECORDS ARE STANDARD
           VALUE OF FILE-ID "STUD.DAT".
       01 FILE1-REC.
           02 RNO PIC 9(5).
           02 SN PIC X(20).
           02 CL PIC X(5).
           02 MARKS PIC 9(3).
       FD FILE2
           LABEL RECORDS ARE STANDARD
           VALUE OF FILE-ID "STRSTD.DAT".
       01 FILE2-REC PIC X(33).
       SD WFILE.
       01 S-REC.
           02 SRNO PIC 9(5).
           02 SSN PIC X(20).
           02 SCL PIC X(5).
           02 SMARKS PIC 9(3).
       PROCEDURE DIVISION.
       MAIN-PARA.
           SORT WFILE ON ASCENDING KEY SRNO
                USING FILE1 GIVING FILE2.
           STOP RUN.
         

Tuesday, November 23, 2010

Sorting

Decision Points       IDENTIFICATION DIVISION.
       PROGRAM-ID.
       ENVIRONMENT DIVISION.
       INPUT-OUTPUT SECTION.
       FILE-CONTROL.
           SELECT FILE1 ASSIGN TO DISK
           ORGANIZATION IS LINE SEQUENTIAL.
           SELECT FILE2 ASSIGN TO DISK
           ORGANIZATION IS LINE SEQUENTIAL.
           SELECT WFILE ASSIGN TO DISK.
       DATA DIVISION.
       FILE SECTION.
       FD FILE1
           LABEL RECORDS ARE STANDARD
           VALUE OF FILE-ID "STUD.DAT".
       01 FILE1-REC.
           02 RNO PIC 9(5).
           02 SN PIC X(20).
           02 CL PIC X(5).
           02 MARKS PIC 9(3).
       FD FILE2
           LABEL RECORDS ARE STANDARD
           VALUE OF FILE-ID "STRSTD.DAT".
       01 FILE2-REC PIC X(33).
       SD WFILE.
       01 S-REC.
           02 SRNO PIC 9(5).
           02 SSN PIC X(20).
           02 SCL PIC X(5).
           02 SMARKS PIC 9(3).
       PROCEDURE DIVISION.
       MAIN-PARA.
           SORT WFILE ON ASCENDING KEY SRNO
                USING FILE1 GIVING FILE2.
           STOP RUN.
         

Relative file creation

The Gift
       IDENTIFICATION DIVISION.
       PROGRAM-ID.
       ENVIRONMENT DIVISION.
       INPUT-OUTPUT SECTION.
       FILE-CONTROL.
           SELECT SFILE ASSIGN TO DISK
           ORGANIZATION IS RELATIVE
           ACCESS MODE IS RANDOM
           RECORD KEY SNO.
       DATA DIVISION.
       FILE SECTION.
       FD SFILE
      LABEL RECORDS ARE STANDARD
    VALUE OF FILE-ID IS "STD.REL".
       01 SREC.
   02 SNM PIC X(10).
   02 M PIC 9(3).
       WORKING-STORAGE SECTION.
       77 SNO PIC 9(5).
       77 CH PIC X VALUE SPACE.
       PROCEDURE DIVISION.
       MAIN-PARA.
           OPEN OUTPUT SFILE.
           PERFORM READ-DATA UNTIL CH = "N" OR "n".
           CLOSE SFILE.
           STOP RUN.
       READ-DATA.
           DISPLAY "ENTER REGISTRATION NUMBER: ".
           ACCEPT SNO.
           DISPLAY "ENTER STUDENT NAME: ".
           ACCEPT SNM.
           DISPLAY "ENTER MARKS SCORED: ".
           ACCEPT M.
           WRITE SREC INVALID KEY DISPLAY "INVALID DATA.".
           DISPLAY "CONTINUE (Y/N).".
           ACCEPT CH.

Indexfile creation

The Confession: A Novel
      IDENTIFICATION DIVISION.
       PROGRAM-ID.  index.
       ENVIRONMENT DIVISION.
       INPUT-OUTPUT SECTION.
       FILE-CONTROL.
           SELECT STDFILE ASSIGN TO DISK
           ORGANIZATION IS INDEXED
           ACCESS MODE IS SEQUENTIAL
           RECORD KEY SNO.
       DATA DIVISION.
       FILE SECTION.
       FD STDFILE
      LABEL RECORDS ARE STANDARD
    VALUE OF FILE-ID IS "STD.DAT".      
  01 STDREC.
      02 SNO PIC 9(5).
      02 SNM PIC X(10).
      02 M PIC 9(3).
       WORKING-STORAGE SECTION.
       77 CH PIC X VALUE SPACE.
       PROCEDURE DIVISION.
       MAIN-PARA.
           OPEN OUTPUT STDFILE.
           PERFORM READ-DATA UNTIL CH = "N" OR "n".
           CLOSE STDFILE.
           STOP RUN.
       READ-DATA.
      /     MOVE SPACE TO CH.
           DISPLAY "ENTER STUDENT NUMBER: ".
           ACCEPT SNO.
           DISPLAY "ENTER STUDENT NAME: ".
           ACCEPT SNM.
           DISPLAY "ENTER MARKS SCORED: ".
           ACCEPT M.
           WRITE STDREC INVALID KEY
  DISPLAY " INVALID DATA ".
           DISPLAY "CONTINUE (Y/N)".
           ACCEPT CH.

Sequential file creation

Murach's Mainframe COBOL       IDENTIFICATION DIVISION.
       PROGRAM-ID.  seq.
       ENVIRONMENT DIVISION.
       INPUT-OUTPUT SECTION.
       FILE-CONTROL.
           SELECT STUDENT ASSIGN TO  DISK
           ORGANIZATION IS LINE SEQUENTIAL.
       DATA DIVISION.
       FILE SECTION.
       FD STUDENT
         LABEL RECORDS ARE STANDARD VALUE OF FILE-ID "STD.DAT".
       01 STD-REC.
          02 REG-NO PIC 9(5).
          02 STD-NAME PIC X(20).
       WORKING-STORAGE SECTION.
       77 OPTION PIC X VALUE "Y".
       77 ANS PIC X VALUE SPACES.
       PROCEDURE DIVISION.
       MAIN-PARA.
           OPEN OUTPUT STUDENT.
           PERFORM ACC-PARA UNTIL OPTION = "n" OR "N".
           CLOSE STUDENT.
           STOP RUN.
       ACC-PARA.
           DISPLAY (1 1) ERASE.
           DISPLAY (6 10) "Enter registration Number: ".
           ACCEPT (6 35) REG-NO.
           DISPLAY (8 10) "Enter student name :".
           ACCEPT (8 35) STD-NAME.
           DISPLAY (10 10) "Is this data OK? :".
           ACCEPT (10 35) ANS.
           IF ANS = "Y" OR "y" WRITE STD-REC.
           DISPLAY (12 10) "Do you want to continue? :".
           ACCEPT (12 35) OPTION.

Prime number

Sams Teach Yourself COBOL in 24 Hours       Identification Division.
       Program-ID.
       Environment Division.
       Data Division.
       Working-Storage Section.
       77 Min PIC 9(4).
       77 Max PIC 9(4).
       77 I PIC 9(4).
       77 J PIC 9(4).
       77 K PIC 9(4).
       77 Counter PIC 9(4).
       77 Rem PIC 9(3)
       Procedure division.
       Main-Para.
           Display "Enter Minimum Value (m) : ".
           Accept Min.
           Display "Enter Maximum Number (n) : ".
           Accept Max.
           IF Min > Max
               DISPLAY "Lower limit greater than Upper"
               STOP RUN.
           DISPLAY "Prime numbers between " Min " and " Max " are :".
           Perform para-1 Varying I From Min BY 1 Until I > Max.
           DISPLAY "Program is terminated."
           Stop Run.
       Para-1.
           Compute Counter = 0.
           Perform Para-2 Varying J From 2 BY 1 Until J > (I / 2).
           If Counter = 0
               Display I.
       Para-2.
           Divide I BY J Giving K Remainder Rem.
           IF Rem = 0
               Compute Counter = Counter + 1.

Find the largest and the largest position

       Identification Division.
       Program-ID.
       Environment Division.
       Data Division.
       Working-Storage Section.
       77 Max PIC 9(4) Value 0.
       77 N PIC 9(4).
       77 Pos PIC 99 Value 0.
       77 LargePos PIC 99 Value 0.
       77 Choice PIC A.
       Procedure division.
       Main-Para.
           Perform Para-1 Until Choice = "N" OR Choice = "n".
           Display "Largest Number is " Max.
           Display "Largest Number Position : " LargePos.
           Stop Run.
       Para-1.
           Display "Enter A number : "
           Accept N.
           Compute Pos = Pos + 1.
           IF N > Max
               Compute Max = N
               Compute LargePos = Pos.
           Display "Do You want to enter any Value (Y/N) : "
           Accept Choice.

Fabonacci series between a given number

COBOL for the 21st Century                                  COBOL for Dummies                  Sams Teach Yourself COBOL in 21 Days (3rd Edition)
      IDENTIFICATION DIVISION.
       PROGRAM-ID.
       ENVIRONMENT DIVISION.
       DATA DIVISION.
       WORKING-STORAGE SECTION.
       77 M PIC 9(3).
       77 N PIC 9(3).
       77 A PIC 9(3) VALUE 0.
       77 B PIC 9(3) VALUE 1.
       77 C PIC 9(3) VALUE 0.
       PROCEDURE DIVISION.
       MAIN-PARA.
           DISPLAY "Enter initial value ".
           ACCEPT M.
           DISPLAY "Enter Final value ".
           ACCEPT N.
           DISPLAY SPACE.
           DISPLAY "Fibonacci series between " M " and " N " is ".
           PERFORM INITIAL-PARA UNTIL C > M.
           PERFORM ACTUAL-PARA UNTIL C = N OR > N.
           STOP RUN.

Program to find sum of the digits of a number

    Murach's CICS for the COBOL Programmer    Murach's Structured COBOL     Micro Focus Visual Object Cobol 32 Bit 
    Identification Division.
       Program-ID.
       Environment Division.
       Data Division.
       Working-Storage Section.
       77 Sum PIC 9(4) Value 0.
       77 N PIC 9(6).
       77 Temp PIC 9(6).
       77 Rem PIC 9.
       Procedure division.
       Main-Para.
           Display "Enter Number (Maximum 6 digits) :".
           Accept N.
           Move N To Temp.
           Perform Para-1 Until N = 0.
           Display "Sum of the digit of " Temp " digit number " Sum.
           Stop Run.
       Para-1.
           Divide N BY 10 Giving N Remainder Rem.
           Compute Sum = Sum + Rem.

Program to implement the editing characters

      
      IDENTIFICATION DIVISION.              IBM 1401 Programming Systems
       PROGRAM-ID.
       ENVIRONMENT DIVISION.
       DATA DIVISION.
       WORKING-STORAGE SECTION.
       77 IDNUM PIC S9(6)V99.
       77 ID1 PIC Z(6)V99.
       77 ID2 PIC 9(6).99.
       77 ID3 PIC 9,99,999.99.
       77 ID4 PIC 99/99/99.
       77 ID5 PIC +9(6).99.
       77 ID6 PIC -9(6).99.
       77 ID7 PIC *****9.99.
       77 ID8 PIC 9(6)V99DB.
       77 ID9 PIC 9(6)V99CR.
       77 ID10 PIC $9(6).99.
       77 ID11 PIC ZZZZ99.99.
       77 ID12 PIC 99B99B99.     
       77 ID13 PIC 99999.00.
       77 IDNAME PIC X(20).
       77 IDN1 PIC XBXBX(18).
       77 IDN2 PIC X0X0X(18).
       77 IDN3 PIC X/X/X(18).
       PROCEDURE DIVISION.
       MAIN-PARA.
           DISPLAY (1 10) "NUMERIC DATA EDITING".
           DISPLAY (2 20) "Enter a number : ".
           ACCEPT (2 35) IDNUM.
           MOVE IDNUM TO ID1 ID2 ID3 ID4 ID5 ID6 ID7 ID8 ID9 ID10
                         ID11 ID12 ID13.
           DISPLAY (4 10) " Enter number is " IDNUM.
           DISPLAY (5 10) "Z(6)V99     : " ID1.
           DISPLAY (5 40) "9(6).99   : " ID2.
           DISPLAY (6 10) "9,99,999.99 : " ID3.
           DISPLAY (6 40) "99/99/99  : " ID4.
           DISPLAY (7 10) "+9(6).99    : " ID5.
           DISPLAY (7 40) "-9(6).99  : " ID6.
           DISPLAY (8 10) "*****9.99   : " ID7.
           DISPLAY (8 40) "9(6)V99DB : " ID8.
           DISPLAY (9 10) "9(6)V99CR   : " ID9.
           DISPLAY (9 40) "$9(6).99  : " ID10.
           DISPLAY (10 10) "ZZZZ99.99   : " ID11.
           DISPLAY (10 40) "99B99B99  : " ID12.
           DISPLAY (11 10) "99999.00    : " ID13.
           DISPLAY (13 10) "Non Numeric Data Editing".
           DISPLAY (14 10) "Enter Name : "
           ACCEPT (14 40) IDNAME.
           MOVE IDNAME TO IDN1 IDN2 IDN3.
           DISPLAY (16 10) "XBXBX(8) : " IDN1.
           DISPLAY (17 10) "X0X0X(4) : " IDN2.
           DISPLAY (18 10) "X/X/X(5) : " IDN3.
           STOP RUN.

Program to validate the date

                                        IDENTIFICATION DIVISION.                              
       PROGRAM-ID.
       ENVIRONMENT DIVISION.
       DATA DIVISION.
       WORKING-STORAGE SECTION.
       01 DATE1.
           02 YEAR PIC 9(4).
           02 MONTH PIC 9(2).
           02 DAY1 PIC 9(2).
       77 ANS PIC 9(4).
       77 REM PIC 9.
       PROCEDURE DIVISION.
       MAIN-PARA.
           DISPLAY "Enter date (yyyymmdd : ".
           ACCEPT DATE1.
           IF (DAY1<1 OR >31) OR (MONTH<1 OR >12) OR (YEAR<0)
               PERFORM INVALID-PARA.
           IF MONTH=2
               DIVIDE YEAR  BY 4 GIVING ANS REMAINDER REM
               IF ((REM NOT =0) AND (DAY1>28)) OR
                            ((REM = 0) AND (DAY1 > 29))
                   PERFORM INVALID-PARA.
           PERFORM VARIFY-PARA.
          VARIFY-PARA.
           IF (MONTH=4 OR 6 OR 9 OR 11) AND (DAY1>30)
               PERFORM INVALID-PARA
           ELSE
               DISPLAY "Given date is a valid date."
               PERFORM STOP-PARA.
           INVALID-PARA.
              DISPLAY "Given date is a invalid.".
              PERFORM STOP-PARA.
           STOP-PARA.
           STOP RUN.

Program to find reverse of a number.

    A Simplified Guide to Structured COBOL Programming                                                     
      Identification Division.
       Program-ID. reverse.
       Environment Division.
       Data Division.
       Working-Storage Section.
       77 N PIC 9(6).
       77 Temp PIC 9(6).
       77 Rem PIC 9.
       77 Rev PIC 9(6) Value Zeros.
       Procedure division.
       Main-Para.
           Display "Enter Number (Maximum 6 digits) : ".
           Accept N.
           Move N TO Temp.
           Perform Para-1 Until N = 0.
           Display "Reverse of " Temp " is " Rev.
           Stop Run.
       Para-1.
           Divide N BY 10 Giving N Remainder Rem.
           Compute Rev = Rev * 10 + Rem.

Program to convert time given in second to hr ,min and second

        Identification Division.
       Program-ID. conversion.
       Environment Division.
       Data Division.
       Working-Storage Section.
       77 Sec PIC 9(6).
       77 Min PIC 9(6).
       77 Hr PIC 9(6).
       Procedure division.
       Main-Para.
           Display "Enter Seconds : ".
           Accept Sec.
           Divide Sec BY 60 Giving Min Remainder Sec.
           Divide Min BY 60 Giving Hr Remainder Min.
           Display "Hourse : ", Hr.
           Display "Minutes : ", Min.
           Display "Seconds : ", Sec.
           Stop Run