COBOL lol.

XanoNov 11, 2010, 5:55 pm · #1

Yeah I'm just gonna randomly update this with cobol programs I write. Pretty interesting stuff, im actually getting kinda good at it lately. here's a recent program i wrote.

This one is just a simple control-break procedure.

Code: IDENTIFICATION DIVISION.
PROGRAM-ID. CH10PROG.
AUTHOR. BEN MAERE.
*Pass-Em State College has student records with the following
*format:
*
*SSNO - STUDENT NAME - CLASS - SCHOOL - GPA 9V99 - CREDITS EARNED
*1-9 10-30 31 32 33-35 36-38
* 1 - Freshman - 1 - Business
* 2 - Sophomore | 3 - Junior 2 - Liberal Arts
* 4 - Senior 3 - Engineering
*
*Assume records are in sequence by class within school.
*Print a summary report of the average GPA for each class within
*each school. Print each school's statistics on a seperate page.

ENVIRONMENT DIVISION.
FILE-CONTROL.
SELECT STUDENT-IN ASSIGN TO "CH10.DAT"
ORGANIZATION IS LINE SEQUENTIAL.
SELECT GPA-OUT ASSIGN TO "CH10-OUTPUT.DAT"
ORGANIZATION IS LINE SEQUENTIAL.

DATA DIVISION.
FD STUDENT-IN.
01 STUDENT-RECORD.
88 ENDOFFILE VALUES HIGH-VALUES.
05 SSNO PIC X(9).
05 STUDENT-NAME PIC X(20).
05 SCHOOL-NO PIC X.
05 CLASS-NO PIC X.
05 GPA PIC 9V99.
05 CREDITS-EARNED PIC X(3).
FD GPA-OUT.
01 GPA-REPORT PIC X(40).
WORKING-STORAGE SECTION.
01 STORED-CLASS PIC X VALUE "0".
01 STORED-SCHOOL PIC X VALUE "0".
01 ADD-GPA-VALUES PIC 9999V99 VALUE 0.
01 AVERAGE-GPA PIC 9V99 VALUE 0.
01 RECORD-COUNT PIC 99 VALUE 0.
01 GPA-INTERNAL.
05 HEAD-VALUE PIC X(20).
05 TAIL-VALUE PIC 9.99.

PROCEDURE DIVISION.
001-MAIN.
* opens all files and starts program.
OPEN INPUT STUDENT-IN
OUTPUT GPA-OUT

* Perform start procedure to set initial variables.
PERFORM 002-STARTPROC

* start the read perform that calls 003-CONTROLBREAK
PERFORM UNTIL ENDOFFILE
READ STUDENT-IN
AT END SET ENDOFFILE TO TRUE
NOT AT END PERFORM 003-CONTROLBREAK
END-READ
END-PERFORM

* closes all open files and ends program.
CLOSE STUDENT-IN
GPA-OUT
STOP RUN.

002-STARTPROC.
READ STUDENT-IN
AT END SET ENDOFFILE TO TRUE
END-READ
MOVE SCHOOL-NO TO STORED-SCHOOL
MOVE CLASS-NO TO STORED-CLASS
MOVE "SCHOOL: BUSINESS" TO GPA-REPORT
WRITE GPA-REPORT AFTER ADVANCING 1 LINES
MOVE "CLASS AVERAGE GPA" TO GPA-REPORT
WRITE GPA-REPORT AFTER ADVANCING 2 LINES.
PERFORM 003-CONTROLBREAK.

003-CONTROLBREAK.
* next two lines check both school and class.
IF SCHOOL-NO EQUAL STORED-SCHOOL THEN
IF CLASS-NO EQUAL STORED-CLASS
COMPUTE RECORD-COUNT = RECORD-COUNT + 1
COMPUTE ADD-GPA-VALUES = ADD-GPA-VALUES + GPA
ELSE
COMPUTE RECORD-COUNT = RECORD-COUNT + 1
COMPUTE AVERAGE-GPA = ADD-GPA-VALUES / RECORD-COUNT

EVALUATE STORED-CLASS
WHEN "1"
MOVE "FRESHMAN " TO HEAD-VALUE
MOVE AVERAGE-GPA TO TAIL-VALUE
MOVE GPA-INTERNAL TO GPA-REPORT
WRITE GPA-REPORT AFTER ADVANCING 1 LINES
WHEN "2"
MOVE "SOPHOMORE " TO HEAD-VALUE
MOVE AVERAGE-GPA TO TAIL-VALUE
MOVE GPA-INTERNAL TO GPA-REPORT
WRITE GPA-REPORT AFTER ADVANCING 1 LINES
WHEN "3"
MOVE "JUNIOR " TO HEAD-VALUE
MOVE AVERAGE-GPA TO TAIL-VALUE
MOVE GPA-INTERNAL TO GPA-REPORT
WRITE GPA-REPORT AFTER ADVANCING 1 LINES
END-EVALUATE

MOVE ZEROES TO ADD-GPA-VALUES
MOVE CLASS-NO TO STORED-CLASS
MOVE ZEROES TO RECORD-COUNT
COMPUTE ADD-GPA-VALUES = ADD-GPA-VALUES + GPA
* Not checking for class-no on school else
* if the file was sorted, there is no need to do so.
ELSE
COMPUTE RECORD-COUNT = RECORD-COUNT + 1
COMPUTE AVERAGE-GPA = ADD-GPA-VALUES / RECORD-COUNT
MOVE "SENIOR " TO HEAD-VALUE
MOVE AVERAGE-GPA TO TAIL-VALUE
MOVE GPA-INTERNAL TO GPA-REPORT
WRITE GPA-REPORT AFTER ADVANCING 1 LINES
SET AVERAGE-GPA TO ZERO
MOVE SCHOOL-NO TO STORED-SCHOOL
MOVE CLASS-NO TO STORED-CLASS

IF STORED-SCHOOL EQUAL "2"
MOVE "SCHOOL: LIBERAL ARTS" TO GPA-REPORT
WRITE GPA-REPORT AFTER ADVANCING PAGE
MOVE "CLASS AVERAGE GPA" TO GPA-REPORT
WRITE GPA-REPORT AFTER ADVANCING 2 LINES
ELSE IF STORED-SCHOOL EQUAL "3"
MOVE "SCHOOL: ENGINEERING" TO GPA-REPORT
WRITE GPA-REPORT AFTER ADVANCING PAGE
MOVE "CLASS AVERAGE GPA" TO GPA-REPORT
WRITE GPA-REPORT AFTER ADVANCING 2 LINES
END-IF
END-IF.
This one is a simple sort on two fields.
Code: IDENTIFICATION DIVISION.
PROGRAM-ID. CH14-PROGRAM.
AUTHOR. BEN MAERE.
* WRITE A PROGRAM TO SORT A FILE INTO STUDENT-NAME SEQUENCE
* WITHIN CLASS-NO SEQUENCE, WHERE CLASS-NO IS NOT PART OF THE
* INPUT BUT IS CALCULATED USING THE NO-OF-CREDITS FIELD.

* DEFINED FILE ENVIRONMENTS HERE
* STUDENT-IN IS THE INITIAL DATA FILE
* SORT-FILE IS THE TEMP FILE (USED ACTUAL FILE FOR DEBUGGING)
* STUDENT-OUT IS THE OUTPUT (OF COURSE)
ENVIRONMENT DIVISION.
FILE-CONTROL.
SELECT STUDENT-IN ASSIGN TO "CH1407.DAT"
ORGANIZATION IS LINE SEQUENTIAL.
SELECT SORT-FILE ASSIGN TO "CH1407-SORT.TMP".
SELECT STUDENT-OUT ASSIGN TO "CH1407-OUTPUT.DAT"
ORGANIZATION IS LINE SEQUENTIAL.

* DEFINE VARIABLES AND FILE STRUCTURES, ETC.
DATA DIVISION.
FILE SECTION.
* INPUT FILE LAYOUT DEFINED HERE, INCLUDING 88 LEVELS
FD STUDENT-IN.
01 STUDENT-RECORD.
88 ENDOFFILE VALUE HIGH-VALUES.
05 STUDENT-NO PIC X(5).
05 STUDENT-NAME PIC X(45).
05 STUDENT-CREDITS PIC 9(3).
88 FRESHMAN VALUE 000 THROUGH 029.
88 SOPHOMORE VALUE 030 THROUGH 059.
88 JUNIOR VALUE 060 THROUGH 089.
88 SENIOR VALUE 090 THROUGH 999.
* SORT FILE CONTAINS CLASS-NO AND NO-OF-CREDITS
SD SORT-FILE.
01 SORT-DATA.
05 SORT-NO PIC X(5).
05 SORT-NAME PIC X(45).
05 SORT-CREDITS PIC 9(3).
05 SORT-CLASS-NO PIC 9(1).
* OUTPUT FILE NEXT, FOR EASE OF LAYOUT
FD STUDENT-OUT.
01 STUDENT-OUTPUT.
05 OUT-NO PIC X(5).
05 OUT-NAME PIC X(45).
05 OUT-CLASS-NO PIC 9(4).

PROCEDURE DIVISION.
* INITIAL STARTUP PROCEDURE
001-MAIN.
SORT SORT-FILE
ON ASCENDING KEY SORT-CLASS-NO
ON ASCENDING KEY SORT-NAME
INPUT PROCEDURE 002-READ-FILE
GIVING STUDENT-OUT
STOP RUN.

* INPUT PROCEDURE STARTS HERE, USED TO CALC CLASS-NO
002-READ-FILE.
* OPEN FILE
OPEN INPUT STUDENT-IN
* START PERFORM UNTIL THAT READS DATA FOR SORT
PERFORM UNTIL ENDOFFILE
READ STUDENT-IN
AT END SET ENDOFFILE TO TRUE
* DID THIS LINE TO HELP IMPROVE CODE READABILITY
NOT AT END PERFORM 003-CLASS-NO
END-READ
END-PERFORM
* CLOSE FILE
CLOSE STUDENT-IN.

003-CLASS-NO.
MOVE STUDENT-RECORD TO SORT-DATA
EVALUATE TRUE
WHEN FRESHMAN MOVE 1 TO SORT-CLASS-NO
WHEN SOPHOMORE MOVE 2 TO SORT-CLASS-NO
WHEN JUNIOR MOVE 3 TO SORT-CLASS-NO
WHEN SENIOR MOVE 4 TO SORT-CLASS-NO
END-EVALUATE
RELEASE SORT-DATA.

seishukuNov 11, 2010, 9:44 pm · #2

I've been modifying Quake2 lately, continuing what I started way back when the source was released. cheesy

XanoNov 11, 2010, 10:15 pm · #3

blah now im onto arrays and tables in cobol....im not enjoying this one, i gave up for the night, i think working on cobol code from 8 AM until 4 PM fried my brain today.

DjayS12Nov 11, 2010, 11:38 pm · #4

lol my programming knowledge extend to the Ti-83 calculator.

I'm completely lost.

And I'm sure most of the members are too!

tommyNov 11, 2010, 11:43 pm · #5

^^^and so am I... I am very good with R language... a program for statistical analysis but I guess I would be the only one using that here too...

XanoNov 12, 2010, 11:28 am · #6

lol tommy, i deal with SPSS quite often, along with a number of other statistics based programs, ive HEARD of that, but have NO clue what it is. All i do is fix the programs when they break Wink

MaxpowNov 12, 2010, 10:22 pm · #7

So u gaize are like hakerz or somefing?

tommyNov 12, 2010, 11:07 pm · #8

Not really, I wish I could be an hacker, so I would like to be able to get my way around computer a little more...

The R program is a code based statistic program that is free and everyone can contribute by making functions and posting them for free all around the world... get to do a lot of crazy stuff for free.... but you've got to learn how to use it

DjayS12Nov 12, 2010, 11:39 pm · #9

Ok so my windows movie maker doesn't work? how do I fix it? Tongue

of course I'm kidding lol.. altho it doesn't work for real Sad

xxstreetbikesxxNov 13, 2010, 12:26 am · #10

lol. sounds interesting..

D-sport S12Nov 13, 2010, 2:09 am · #11

I somewhat understand it. It reminds me of what im doing in school but not really at the same time lol

WankelMonkeyNov 13, 2010, 5:36 am · #12

Blech!! COBOL does not look fun at all! I prefer me some Python! :-p

XanoNov 13, 2010, 2:47 pm · #13

Wrote another one. This one is basic input/data validation techniques, outputs to a nice pretty file.

Code: IDENTIFICATION DIVISION.
PROGRAM-ID. CH11PROG.
AUTHOR. BEN MAERE.

ENVIRONMENT DIVISION.
* NO SORT, SO NO SORT FILE SELECT.
FILE-CONTROL.
SELECT CUSTOMER-IN ASSIGN TO "CH1101.DAT"
ORGANIZATION IS LINE SEQUENTIAL.
SELECT ERROR-OUT ASSIGN TO "CH1101-ERROR.DAT"
ORGANIZATION IS LINE SEQUENTIAL.

DATA DIVISION.
* CUSTOMER INPUT FILE.
FD CUSTOMER-IN.
01 CUSTOMER-DATA.
88 ENDOFFILE VALUE HIGH-VALUES.
05 CUST-NO PIC 9(3).
88 CUST-NO-VALID VALUES 101 THRU 972.
05 CUST-NAME PIC X(27).
05 MAX-CREDIT PIC 9(5).
05 CREDIT-RATING PIC X(2).
05 TOTAL-BAL-DUE PIC 9(5).
* ERROR OUTPUT FILE.
FD ERROR-OUT.
01 ERROR-DATA PIC X(65).
WORKING-STORAGE SECTION.
* ERROR- ITEMS ARE TEMPORARY AND WILL BE USED TO OUTPUT ERROR-OUT
01 ERROR-BODY.
05 ERROR-BUFFER PIC X(10) VALUE " - ERROR: ".
05 ERROR-VALUE PIC X(55).
01 DATA-HEADER-1.
05 PIC X(6) VALUE "Cust. ".
05 PIC X(31) VALUE SPACES.
05 PIC X(11) VALUE "Max. Credit".
05 PIC X(8) VALUE " Credit ".
05 PIC X(9) VALUE " Balance ".
01 DATA-HEADER-2.
05 PIC X(6) VALUE "Number".
05 PIC X(31) VALUE " Cust. Name".
05 PIC X(11) VALUE " Allowed ".
05 PIC X(8) VALUE " Score ".
05 PIC X(9) VALUE " Due ".
01 DATA-BODY.
05 PIC X(2) VALUE SPACES.
05 DATA-NO PIC 9(3).
05 PIC X(3) VALUE SPACES.
05 DATA-NAME PIC X(27).
05 PIC X(5) VALUE SPACES.
05 DATA-CRED PIC 9(5).
05 PIC X(6) VALUE SPACES.
05 DATA-RATE PIC X(2).
05 PIC X(5) VALUE SPACES.
05 DATA-BAL PIC 9(5).
* END OF VARIOUS LINE STYLES
01 RECORD-COUNT PIC 9(3) VALUE 0.
01 ERROR-COUNT PIC 9(3) VALUE 0.
01 WRITE-COUNT PIC 9 VALUE 0.
01 HEADER-COUNT PIC 9 VALUE 0.

PROCEDURE DIVISION.
001-MAIN.
* OPEN THE FILES.
OPEN INPUT CUSTOMER-IN
OUTPUT ERROR-OUT

* START THE READ LOOP
PERFORM UNTIL ENDOFFILE
READ CUSTOMER-IN
AT END SET ENDOFFILE TO TRUE
NOT AT END PERFORM 002-VALIDATE
END-READ
END-PERFORM

* WRITE FINAL COUNTS OF HOW MANY ERRORS AND RECORDS
MOVE "RECORDS: " TO ERROR-BUFFER
MOVE RECORD-COUNT TO ERROR-VALUE
MOVE ERROR-BODY TO ERROR-DATA
WRITE ERROR-DATA AFTER ADVANCING 3 LINES
MOVE " ERRORS: " TO ERROR-BUFFER
MOVE ERROR-COUNT TO ERROR-VALUE
MOVE ERROR-BODY TO ERROR-DATA
WRITE ERROR-DATA AFTER ADVANCING 1 LINES

* CLOSE THE FILES.
CLOSE CUSTOMER-IN
ERROR-OUT
STOP RUN.

002-VALIDATE.
SET WRITE-COUNT TO 0
COMPUTE RECORD-COUNT = RECORD-COUNT + 1
* CHECK VALID CUSTOMER NUMBER
IF NOT CUST-NO-VALID
COMPUTE ERROR-COUNT = ERROR-COUNT + 1
IF WRITE-COUNT < 1
PERFORM 003-WRITEDATA
END-IF
MOVE "Invalid customer number." TO ERROR-VALUE
MOVE ERROR-BODY TO ERROR-DATA
WRITE ERROR-DATA AFTER ADVANCING 1 LINES
END-IF
* CHECK THAT CUST-NAME ISNT BLANK
IF CUST-NAME = SPACES
COMPUTE ERROR-COUNT = ERROR-COUNT + 1
IF WRITE-COUNT < 1
PERFORM 003-WRITEDATA
END-IF
MOVE "Blank customer name field." TO ERROR-VALUE
MOVE ERROR-BODY TO ERROR-DATA
WRITE ERROR-DATA AFTER ADVANCING 1 LINES
END-IF
* CHECK THAT TOTAL BALANCE IS NOT MORE THAN MAX CREDIT
IF MAX-CREDIT < TOTAL-BAL-DUE
COMPUTE ERROR-COUNT = ERROR-COUNT + 1
IF WRITE-COUNT < 1
PERFORM 003-WRITEDATA
END-IF
MOVE "Balance due greater than Maximum Credit."
TO ERROR-VALUE
MOVE ERROR-BODY TO ERROR-DATA
WRITE ERROR-DATA AFTER ADVANCING 1 LINES
END-IF
* FINALLY CHECK CREDIT RATING, USED EVALUATE METHOD.
EVALUATE CREDIT-RATING
WHEN "EX" MOVE "NONE" TO ERROR-VALUE
WHEN "VG" MOVE "NONE" TO ERROR-VALUE
WHEN "G " MOVE "NONE" TO ERROR-VALUE
WHEN "A " MOVE "NONE" TO ERROR-VALUE
WHEN OTHER
COMPUTE ERROR-COUNT = ERROR-COUNT + 1
IF WRITE-COUNT < 1
PERFORM 003-WRITEDATA
END-IF
MOVE "Credit rating is not valid."
TO ERROR-VALUE
MOVE ERROR-BODY TO ERROR-DATA
WRITE ERROR-DATA AFTER ADVANCING 1 LINES
END-EVALUATE.

* SIMPLY WRITES THE HEADER THEN LINES OF DATA THAT HAVE ERRORS.
003-WRITEDATA.
SET WRITE-COUNT TO 1
* OUTPUT HEADERS HERE.
IF HEADER-COUNT = 0
MOVE DATA-HEADER-1 TO ERROR-DATA
WRITE ERROR-DATA AFTER ADVANCING 1 LINES
MOVE DATA-HEADER-2 TO ERROR-DATA
WRITE ERROR-DATA AFTER ADVANCING 1 LINES
SET HEADER-COUNT TO 1
END-IF
* PRETTY OUTPUT RECORD
MOVE CUST-NO TO DATA-NO
MOVE CUST-NAME TO DATA-NAME
MOVE MAX-CREDIT TO DATA-CRED
MOVE CREDIT-RATING TO DATA-RATE
MOVE TOTAL-BAL-DUE TO DATA-BAL
MOVE DATA-BODY TO ERROR-DATA
WRITE ERROR-DATA AFTER ADVANCING 2 LINES.

WonderingravenNov 14, 2010, 3:38 am · #14

cobol is soo old school, I havn't seen cobol is years... like woah

XanoNov 14, 2010, 8:27 pm · #15

Heres two more for ya.

First one is a master/transaction file batch processor (I'm not as happy with my code on this one, I may end up revising it when I get time someday)

Code: IDENTIFICATION DIVISION.
   PROGRAM-ID. CH1302.
   AUTHOR. BEN MAERE.

   ENVIRONMENT DIVISION.
   INPUT-OUTPUT SECTION.
   FILE-CONTROL.
   * MASTER DATA FILE
   SELECT OLD-MASTER ASSIGN TO "Payroll-Master.MST"
   ORGANIZATION IS LINE SEQUENTIAL.
   * TRANSACTION DATA FILE
   SELECT TRANSACTIONS ASSIGN TO "Payroll-Trans.dat"
   ORGANIZATION IS LINE SEQUENTIAL.
   * CONTROL LISTING FILE
   SELECT CONTROL-LISTING ASSIGN TO "Control-Listing.dat"
   ORGANIZATION IS LINE SEQUENTIAL.
   * NEW MASTER FILE.
   SELECT NEW-MASTER ASSIGN TO "New-Payroll-Master.dat"
   ORGANIZATION IS LINE SEQUENTIAL.

   DATA DIVISION.
   FD OLD-MASTER.
   01 OLD-MASTER-DATA.
   88 OLD-ENDOFFILE VALUES HIGH-VALUES.
   05 OM-EMPLOYEE-NO PIC X(5).
   05 PIC X(24).
   05 OM-ANNUAL-SAL PIC 9(6).
   05 PIC X(45).
   FD TRANSACTIONS.
   01 TRANS-DATA.
   88 TRANS-ENDOFFILE VALUES HIGH-VALUES.
   05 TRANS-EMPLOYEE-NO PIC X(5).
   05 PIC X(24).
   05 TRANS-ANNUAL-SAL PIC 9(6).
   05 PIC X(45).
   FD NEW-MASTER.
   01 NEW-MASTER-DATA.
   05 NM-EMPLOYEE-NO PIC X(5).
   05 PIC X(24).
   05 NM-ANNUAL-SAL PIC 9(6).
   05 PIC X(45).
   FD CONTROL-LISTING.
   01 CL-BUFFER PIC X(90).
   WORKING-STORAGE SECTION.
   01 CL-HEADER-1.
   05 PIC X(30).
   05 CL-HEADBUF-1 PIC X(38).
   05 CL-DATE-1 PIC XXXX/XX/XX.
   05 CL-PAGE-1 PIC X(10) VALUE " PAGE 01".
   01 CL-HEADER-2.
   05 PIC X(10).
   05 PIC X(20) VALUE "EMPLOYEE NO.".
   05 PIC X(24) VALUE "PREVIOUS ANNUAL SALARY".
   05 PIC X(21) VALUE "NEW ANNUAL SALARY".
   05 PIC X(15) VALUE "ACTION TAKEN".
   01 CL-DATA.
   05 PIC X(12).
   05 CL-EMPLOYEE-NO PIC X(5).
   05 PIC X(13).
   05 CL-PREV-SAL PIC $ZZZ,ZZZ.99.
   05 PIC X(13).
   05 CL-NEW-SAL PIC $ZZZ,ZZZ.99.
   05 PIC X(8).
   05 ACTION-TAKEN PIC X(16).
   * 1 = NEW RECORD ADDED, 2 = UPDATED RECORD, 0 = NOTHING
   01 ACTION-TAKEN-NO PIC 9(1).

   PROCEDURE DIVISION.
   001-MAIN.
   * Gets system date.
   MOVE FUNCTION CURRENT-DATE (1:8) TO CL-DATE-1

   * OPEN ALL FILES AT ONCE.
   OPEN INPUT OLD-MASTER
   INPUT TRANSACTIONS
   OUTPUT CONTROL-LISTING
   OUTPUT NEW-MASTER

   * STARTS CONTROL-LISTING HEADERS
   MOVE CL-HEADER-1 TO CL-BUFFER
   WRITE CL-BUFFER AFTER ADVANCING 6 LINES
   MOVE CL-HEADER-2 TO CL-BUFFER
   WRITE CL-BUFFER AFTER ADVANCING 2 LINES
   MOVE " " TO CL-BUFFER
   WRITE CL-BUFFER AFTER ADVANCING 1 LINES

   * START 002-READPROCESS
   PERFORM 002-READPROCESS

   * CLOSE ALL FILES AT ONCE.
   CLOSE OLD-MASTER
   TRANSACTIONS
   CONTROL-LISTING
   NEW-MASTER
   STOP RUN.

   002-READPROCESS.
   PERFORM UNTIL OLD-ENDOFFILE OR TRANS-ENDOFFILE
   READ OLD-MASTER
   AT END SET OLD-ENDOFFILE TO TRUE
   END-READ

   READ TRANSACTIONS
   AT END SET TRANS-ENDOFFILE TO TRUE
   END-READ

   PERFORM 003-COMPARE
   END-PERFORM.

   003-COMPARE.
   * HALTS PROCESSING IF BOTH FILES ARE AT END.
   IF NOT TRANS-ENDOFFILE AND NOT OLD-ENDOFFILE
   * THIS IF IS FOR RECORD UPDATING OR NO UPDATE.
   IF OM-EMPLOYEE-NO = TRANS-EMPLOYEE-NO
   MOVE OLD-MASTER-DATA TO NEW-MASTER-DATA
   MOVE TRANS-ANNUAL-SAL TO NM-ANNUAL-SAL
   WRITE NEW-MASTER-DATA

   * CHECK FOR ACTION TAKEN FOR CONTROL-LISTING
   IF OM-ANNUAL-SAL = TRANS-ANNUAL-SAL
   SET ACTION-TAKEN-NO TO 0
   ELSE
   SET ACTION-TAKEN-NO TO 2
   END-IF
   PERFORM 004-CONTROL-WRITE
   END-IF

   * THIS IF IS FOR TRANS BUT NO OLD-MASTER RECORD
   IF NOT TRANS-ENDOFFILE AND
   OM-EMPLOYEE-NO > TRANS-EMPLOYEE-NO
   MOVE TRANS-DATA TO NEW-MASTER-DATA
   WRITE NEW-MASTER-DATA

   * CHECK FOR ACTION TAKEN FOR CONTROL-LISTING
   SET ACTION-TAKEN-NO TO 1
   PERFORM 004-CONTROL-WRITE

   READ TRANSACTIONS
   AT END SET TRANS-ENDOFFILE TO TRUE
   END-READ

   PERFORM 003-COMPARE
   END-IF

   * THIS IF IS FOR NO UPDATE
   IF NOT OLD-ENDOFFILE AND
   OM-EMPLOYEE-NO < TRANS-EMPLOYEE-NO
   MOVE OLD-MASTER-DATA TO NEW-MASTER-DATA
   WRITE NEW-MASTER-DATA

   * CHECK FOR ACTION TAKEN FOR CONTROL-LISTING
   SET ACTION-TAKEN-NO TO 0
   PERFORM 004-CONTROL-WRITE

   READ OLD-MASTER
   AT END SET OLD-ENDOFFILE TO TRUE
   END-READ

   PERFORM 003-COMPARE
   END-IF
   END-IF.

   004-CONTROL-WRITE.
   IF ACTION-TAKEN-NO = 2
   MOVE NM-EMPLOYEE-NO TO CL-EMPLOYEE-NO
   MOVE OM-ANNUAL-SAL TO CL-PREV-SAL
   MOVE NM-ANNUAL-SAL TO CL-NEW-SAL
   MOVE "RECORD UPDATED" TO ACTION-TAKEN
   MOVE CL-DATA TO CL-BUFFER
   WRITE CL-BUFFER AFTER ADVANCING 1 LINE
   ELSE IF ACTION-TAKEN-NO = 1
   MOVE NM-EMPLOYEE-NO TO CL-EMPLOYEE-NO
   MOVE ZEROES TO CL-PREV-SAL
   MOVE NM-ANNUAL-SAL TO CL-NEW-SAL
   MOVE "NEW RECORD ADDED" TO ACTION-TAKEN
   MOVE CL-DATA TO CL-BUFFER
   WRITE CL-BUFFER AFTER ADVANCING 1 LINE
   END-IF.
And this second one is a table/array program. It calculates take-home pay based on a tax table and a master input file.
Code: IDENTIFICATION DIVISION.
PROGRAM-ID. CH1202.
AUTHOR. BEN MAERE.
* Write a program that outputs a report with a persons name and
* taxable income shown. Use the tax table and salary file
* provided. This should use a table for the tax table.

ENVIRONMENT DIVISION.
FILE-CONTROL.
SELECT TAX-TABLE ASSIGN TO "CH1202-TABLE.DAT"
ORGANIZATION IS LINE SEQUENTIAL.
SELECT SALARY-FILE ASSIGN TO "CH1202.DAT"
ORGANIZATION IS LINE SEQUENTIAL.
SELECT OUTPUT-FILE ASSIGN TO "CH1202-OUTPUT.DAT"
ORGANIZATION IS LINE SEQUENTIAL.

DATA DIVISION.
FD TAX-TABLE.
01 TAX-TABLE-DATA.
88 TAX-ENDOFFILE VALUES HIGH-VALUES.
05 MAX-TAXABLE PIC 9(6).
05 FEDERAL-TAX PIC V9(3).
05 STATE-TAX PIC V9(3).
FD SALARY-FILE.
01 SALARY-RECORD.
88 SAL-ENDOFFILE VALUES HIGH-VALUES.
05 EMP-NO PIC X(5).
05 EMP-NAME PIC X(20).
05 PIC X(4).
05 ANN-SAL PIC 9(6).
05 PIC X(9).
05 DEP-CNT PIC 9(2).
05 PIC X(34).
* Using something like OUTPUT-BUFFER is so much easier.
FD OUTPUT-FILE.
01 OUTPUT-BUFFER PIC X(80).
WORKING-STORAGE SECTION.
* Working storage table here.
01 LOADED-TAX-TABLE.
05 WS-TAX-TABLE OCCURS 20 TIMES
ASCENDING KEY WS-TAXABLE
INDEXED BY X3.
10 WS-TAXABLE PIC 9(6).
10 WS-FEDERAL PIC V9(3).
10 WS-STATE PIC V9(3).
* This was easier to do using an index and subscript together.
01 X1 PIC 99 VALUE 0.
01 X2 PIC 99 VALUE 0.
01 TAX-REC-COUNT PIC 99 VALUE 0.
* For the report headers!
01 REPORTHEADING.
05 PIC X(33) VALUE " MONTHLY SALARY REPORT".
05 PIC X(3) VALUE " ".
05 HEADINGDATE PIC XXXX/XX/XX VALUE "2000/12/31".
05 PIC X(10) VALUE " PAGE 01".
* For the report SUB headers!
01 REPORTSUBHEAD.
05 SUBHEAD-1 PIC X(30) VALUE " EMPLOYEE".
05 SUBHEAD-2 PIC X(30) VALUE " MONTHLY TAKE-HOME".
* For the report BODY!
01 REPORT-BODY.
05 BODY-NAME PIC X(20).
05 PIC X(11).
05 BODY-PAY PIC $ZZ,ZZZ.99.
* Hold variables for all the necessary calculations.
01 CALCULATIONS.
05 STD-DEDUCTION PIC 9(6)V99 VALUE 0.
05 DEP-DEDUCTION PIC 9(6)V99 VALUE 0.
05 FICA-DEDUCTION PIC 9(6)V99 VALUE 0.
05 TAXABLE-INCOME PIC 9(6)V99 VALUE 0.
05 CALC-STATE-TAX PIC V9(3) VALUE 000.
05 CALC-FED-TAX PIC V9(3) VALUE 000.
05 ANNUAL-HOME PIC 9(6)V99 VALUE 0.
05 MONTH-HOME PIC 9(5)V99 VALUE 0.

PROCEDURE DIVISION.
001-MAIN.
* Gets system date.
MOVE FUNCTION CURRENT-DATE (1:8) TO HEADINGDATE

* Get the tax table from the data file and stores in WS table.
PERFORM 002-GET-TAX-TABLE

* Open files for calculation and output.
OPEN INPUT SALARY-FILE
OUTPUT OUTPUT-FILE

* Start of the report writing, this prints headers.
MOVE REPORTHEADING TO OUTPUT-BUFFER
WRITE OUTPUT-BUFFER AFTER ADVANCING 6 LINES
MOVE REPORTSUBHEAD TO OUTPUT-BUFFER
WRITE OUTPUT-BUFFER AFTER ADVANCING 2 LINES
MOVE " NAME" TO SUBHEAD-1
MOVE " PAY" TO SUBHEAD-2
MOVE REPORTSUBHEAD TO OUTPUT-BUFFER
WRITE OUTPUT-BUFFER AFTER ADVANCING 1 LINES
MOVE " " TO OUTPUT-BUFFER
WRITE OUTPUT-BUFFER AFTER ADVANCING 1 LINES

* Start data perform function.
PERFORM UNTIL SAL-ENDOFFILE
READ SALARY-FILE
AT END SET SAL-ENDOFFILE TO TRUE
NOT AT END PERFORM 003-SALARY-CALC
END-READ
END-PERFORM

* Closes the two files.
CLOSE SALARY-FILE
OUTPUT-FILE
STOP RUN.

* This procedure gets the information from the tax table
* file and writes it to the ws-tax-table table item.
002-GET-TAX-TABLE.
* Opens the tax file.
OPEN INPUT TAX-TABLE

PERFORM UNTIL TAX-ENDOFFILE OR X1 > 20
* Reads the file.
COMPUTE X1 = X1 + 1
READ TAX-TABLE
AT END SET TAX-ENDOFFILE TO TRUE
NOT AT END
MOVE TAX-TABLE-DATA TO WS-TAX-TABLE(X1)
COMPUTE TAX-REC-COUNT = TAX-REC-COUNT + 1
END-READ
END-PERFORM

* Close the tax file.
CLOSE TAX-TABLE.

003-SALARY-CALC.
* Compute standard deduction.
IF ANN-SAL > 10000
COMPUTE STD-DEDUCTION = 10000 * .10
ELSE
COMPUTE STD-DEDUCTION = ANN-SAL * .10
END-IF
* Compute dependent deduction.
COMPUTE DEP-DEDUCTION = 2000 * DEP-CNT
* Compute FICA (SS and Medicare)
IF ANN-SAL > 90000
COMPUTE FICA-DEDUCTION = 90000 * .062
COMPUTE FICA-DEDUCTION = FICA-DEDUCTION+(ANN-SAL*.0145)
ELSE
COMPUTE FICA-DEDUCTION = ANN-SAL*.062
COMPUTE FICA-DEDUCTION = FICA-DEDUCTION+(ANN-SAL*.0145)
END-IF

* Compute taxable income
COMPUTE
TAXABLE-INCOME = ANN-SAL - STD-DEDUCTION - DEP-DEDUCTION

* Find tax % in table.
PERFORM UNTIL X2 >= TAX-REC-COUNT
COMPUTE X2 = X2 + 1
IF WS-TAXABLE(X2) > ANN-SAL
COMPUTE CALC-FED-TAX = WS-FEDERAL(X2)
COMPUTE CALC-STATE-TAX = WS-STATE(X2)
COMPUTE X2 = (TAX-REC-COUNT + 1)
END-IF
END-PERFORM
MOVE ZEROES TO X2

* Compute annual take-home pay, then monthly take-home pay.
COMPUTE ANNUAL-HOME =
ANN-SAL - (CALC-STATE-TAX*TAXABLE-INCOME)-(CALC-FED-TAX *
TAXABLE-INCOME) - FICA-DEDUCTION
COMPUTE MONTH-HOME = ANNUAL-HOME / 12

* Write report line.
MOVE EMP-NAME TO BODY-NAME
MOVE MONTH-HOME TO BODY-PAY
MOVE REPORT-BODY TO OUTPUT-BUFFER
WRITE OUTPUT-BUFFER
MOVE ZEROES TO CALCULATIONS.

redleader36Nov 14, 2010, 9:22 pm · #16

Wonderingraven on 03:38:13 AM / 14-Nov-10cobol is soo old school, I havn't seen cobol is years... like woah

My thoughts exactly. Why COBOL, Xano?

XanoNov 14, 2010, 10:24 pm · #17

i see it often in various state govt, banking, and other big long standing industries. its a hell of a high paying job to maintain cobol, and if a company has cobol and wants it converted to something else, i can do that too.

there are many benefits still to knowing cobol.

jphillipsNov 15, 2010, 6:20 pm · #18

...and fortran. The huge plus (and minus at the same time) is you get to admin HELLA old miniframe systems that rarely break...

redleader36Nov 16, 2010, 3:36 am · #19

i see. Its just that back in high school we had to learn COBOL because our school couldn't afford any better compilers or IDEs. I had already taken C++ classes outside of school and really didn't like the COBOL language. That was just my impression back then. If there is a bit of a niche for it, that's really cool!

For now i work too much with mysql and php to even look at COBOL again. cantlook

XanoNov 16, 2010, 7:04 pm · #20

oh i do tons of PHP, (obviously by the amount of customizations done to this SMF install) I just like COBOL. I like it better than VB.NET or ASP.net