Mainframe Developer Basics: COBOL

*SORT INPUT PS TO OUTPUT PS BASED ON CONDITION*
IDENTIFICATION DIVISION.
PROGRAM-ID. SOR2.
AUTHOR. SRIBLOG.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT PS ASSIGN TO DD1
ORGANIZATION SEQUENTIAL
ACCESS MODE SEQUENTIAL
FILE STATUS WS-PS .
SELECT PSO ASSIGN TO DD2
ORGANIZATION SEQUENTIAL
ACCESS MODE SEQUENTIAL
FILE STATUS WS-PSO .
SELECT SRT ASSIGN TO DD3 .
DATA DIVISION.
FILE SECTION.
FD PS.
01 PS-REC.
02 PS-REGNO PIC 9(4).
02 FILLER PIC X.
02 PS-NAME PIC X(17).
02 FILLER PIC X(2).
02 PS-COUNTRY PIC X(5).
02 FILLER PIC X.
02 PS-STATE PIC X(13).
02 FILLER PIC X(2).
02 PS-SALARY PIC 9(6).
02 FILLER PIC X(29).
FD PSO.
01 PSO-REC.
02 PSO-REGNO PIC 9(4).
02 FILLER PIC X.
02 PSO-NAME PIC X(17).
02 FILLER PIC X(2).
02 PSO-COUNTRY PIC X(5).
02 FILLER PIC X.
02 PSO-STATE PIC X(13).
02 FILLER PIC X(2).
02 PSO-SALARY PIC 9(6).
02 FILLER PIC X(29).
SD SRT.
01 SRT-REC.
02 SRT-REGNO PIC 9(4).
02 FILLER PIC X.
02 SRT-NAME PIC X(17).
02 FILLER PIC X(2).
02 SRT-COUNTRY PIC X(5).
02 FILLER PIC X.
02 SRT-STATE PIC X(13).
02 FILLER PIC X(2).
02 SRT-SALARY PIC 9(6).
02 FILLER PIC X(29).
WORKING-STORAGE SECTION.
01 VARIABLES.
02 WS-PS PIC 9(2).
88 PS-SUCCESS VALUE 00.
88 PS-EOF VALUE 10.
02 WS-PSO PIC 9(2).
88 PSO-SUCCESS VALUE 00.
88 PSO-EOF VALUE 10.
01 VAR PIC 9(2).
88 EOF VALUE 10.
01 LOC PIC X(7) VALUE 'CHENNAI'.
PROCEDURE DIVISION.
0000-MAIN-PARA.
PERFORM 1000-INITIALIZATION-PARA
THRU 1000-INITIALIZATION-PARA-EXIT
PERFORM 2000-PROCESS-PARA
THRU 2000-PROCESS-PARA-EXIT
PERFORM 9000-TERMINATION-PARA
THRU 9000-TERMINATION-PARA-EXIT
.
0000-MAIN-PARA-EXIT.
EXIT
.
1000-INITIALIZATION-PARA.
.
1000-INITIALIZATION-PARA-EXIT.
EXIT
.
2000-PROCESS-PARA.
PERFORM 2100-SORT-PARA
THRU 2100-SORT-PARA-EXIT
.
2000-PROCESS-PARA-EXIT.
EXIT
.
2100-SORT-PARA.
SORT SRT
ON DESCENDING KEY SRT-NAME
INPUT PROCEDURE IS 2010-INREC-PARA
THRU 2010-INREC-PARA-EXIT
* GIVING PSO
OUTPUT PROCEDURE IS 2011-OUTREC-PARA
THRU 2011-OUTREC-PARA-EXIT
IF SORT-RETURN NOT = 00
DISPLAY 'SORT NOT DONE' SORT-RETURN
END-IF
.
2100-SORT-PARA-EXIT.
EXIT
.
2010-INREC-PARA.
PERFORM 2001-OPEN-PARA
THRU 2001-OPEN-PARA-EXIT
PERFORM 2002-READ-WRITE-PARA
THRU 2002-READ-WRITE-PARA-EXIT
UNTIL PS-EOF
PERFORM 2003-CLOSE-PARA
THRU 2003-CLOSE-PARA-EXIT
.
2010-INREC-PARA-EXIT.
EXIT
.
2011-OUTREC-PARA.
PERFORM 2004-OPEN-PARA
THRU 2004-OPEN-PARA-EXIT
PERFORM 2005-RETURN-WRITE-PARA
THRU 2005-RETURN-WRITE-PARA-EXIT
UNTIL EOF
PERFORM 2006-CLOSE-PARA
THRU 2006-CLOSE-PARA-EXIT
.
2011-OUTREC-PARA-EXIT.
EXIT
.
2004-OPEN-PARA.
OPEN OUTPUT PSO
EVALUATE TRUE
WHEN PSO-SUCCESS
CONTINUE
WHEN OTHER
DISPLAY 'PSO OPEN ERROR' WS-PSO
PERFORM 9000-TERMINATION-PARA
THRU 9000-TERMINATION-PARA-EXIT
END-EVALUATE
.
2004-OPEN-PARA-EXIT.
EXIT
.
2005-RETURN-WRITE-PARA.
RETURN SRT
AT END SET EOF TO TRUE
NOT AT END
IF SRT-SALARY=200000
MOVE SRT-REC TO PSO-REC
WRITE PSO-REC
ELSE
DISPLAY 'LESS SALARY'
END-IF
.
2005-RETURN-WRITE-PARA-EXIT.
EXIT
.
2006-CLOSE-PARA.
CLOSE PSO
EVALUATE TRUE
WHEN PSO-SUCCESS
DISPLAY 'CLOSED PSO'
CONTINUE
WHEN OTHER
DISPLAY 'NOT CLOSED PSO' WS-PSO
PERFORM 9000-TERMINATION-PARA
THRU 9000-TERMINATION-PARA-EXIT
END-EVALUATE
.
2006-CLOSE-PARA-EXIT.
EXIT
.
2001-OPEN-PARA.
OPEN INPUT PS
EVALUATE TRUE
WHEN PS-SUCCESS
CONTINUE
WHEN OTHER
DISPLAY 'OPEN ERROR' WS-PS
PERFORM 9000-TERMINATION-PARA
THRU 9000-TERMINATION-PARA-EXIT
END-EVALUATE
.
2001-OPEN-PARA-EXIT.
EXIT
.
2002-READ-WRITE-PARA.
READ PS
EVALUATE TRUE
WHEN PS-SUCCESS
IF PS-STATE=LOC THEN
MOVE PS-REC TO SRT-REC
RELEASE SRT-REC
ELSE
DISPLAY 'STATE NOT FOUND'
END-IF
WHEN PS-EOF
DISPLAY 'FILE END REACHED'
CONTINUE
WHEN OTHER
DISPLAY 'READ ERROR' WS-PS
END-EVALUATE
.
2002-READ-WRITE-PARA-EXIT.
EXIT
.
2003-CLOSE-PARA.
CLOSE PS
EVALUATE TRUE
WHEN PS-SUCCESS
CONTINUE
WHEN OTHER
DISPLAY 'CLOSE NOT SUCCESSFUL' WS-PS
END-EVALUATE
.
2003-CLOSE-PARA-EXIT.
EXIT
.
9000-TERMINATION-PARA.
STOP RUN
.
9000-TERMINATION-PARA-EXIT.
EXIT
.

Mainframe Developer Basics

Pages

COBOL - 13 ConditionSORT