Mainframe Developer Basics: COBOL - 08 PStoKSDS,RRDS,Spool

*FROM PS, BASED ON CONDITION, WRITE TO KSDS,RRDS,SPOOL*
IDENTIFICATION DIVISION.
PROGRAM-ID. TREFILE.
AUTHOR. SRIBLOG.
DATE-WRITTEN. NOV/26/2013.
DATE-COMPILED. NOV/26/2013.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT PS ASSIGN TO DD1
ORGANIZATION IS SEQUENTIAL
ACCESS IS SEQUENTIAL
FILE STATUS IS WS-PS.
SELECT KSDS ASSIGN TO DD2
ORGANIZATION IS INDEXED
ACCESS IS RANDOM
RECORD KEY KSDS-REGNO
FILE STATUS IS WS-KSDS.
SELECT RRDS ASSIGN TO DD3
ORGANIZATION RELATIVE
ACCESS SEQUENTIAL
RELATIVE KEY RRN
FILE STATUS WS-RRDS.
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 KSDS.
01 KSDS-REC.
02 KSDS-REGNO PIC 9(4).
02 FILLER PIC X.
02 KSDS-NAME PIC X(17).
02 FILLER PIC X(2).
02 KSDS-COUNTRY PIC X(5).
02 FILLER PIC X.
02 KSDS-STATE PIC X(13).
02 FILLER PIC X(2).
02 KSDS-SALARY PIC 9(6).
02 FILLER PIC X(29).
FD RRDS.
01 RRDS-REC.
02 RRDS-REGNO PIC 9(4).
02 FILLER PIC X.
02 RRDS-NAME PIC X(17).
02 FILLER PIC X(2).
02 RRDS-COUNTRY PIC X(5).
02 FILLER PIC X.
02 RRDS-STATE PIC X(13).
02 FILLER PIC X(2).
02 RRDS-SALARY PIC 9(6).
02 FILLER PIC X(29).
WORKING-STORAGE SECTION.
01 VARIABLES.
05 WS-PS PIC 9(2).
88 PS-SUCCESS VALUE 00.
88 PS-EOF VALUE 10.
05 WS-KSDS PIC 9(2).
88 KSDS-SUCCESS VALUE 00.
05 WS-RRDS PIC 9(2).
88 RRDS-SUCCESS VALUE 00.
05 RRN PIC 9(2) VALUE 01.
05 PS-COUNT PIC 9(2) VALUE 00.
05 KSDS-COUNT PIC 9(2) VALUE 00.
05 RRDS-COUNT PIC 9(2) VALUE 00.
05 SALARY PIC 9(6) VALUE 000000.
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-OPEN-PARA
THRU 2100-OPEN-PARA-EXIT
PERFORM 2100-READ-PARA
THRU 2100-READ-PARA-EXIT
UNTIL PS-EOF
.
2000-PROCESS-PARA-EXIT.
EXIT
.
2100-OPEN-PARA.
OPEN INPUT PS
EVALUATE TRUE
WHEN PS-SUCCESS
CONTINUE
WHEN OTHER
DISPLAY 'PS OPEN ERROR' WS-PS
PERFORM 9000-TERMINATION-PARA
THRU 9000-TERMINATION-PARA-EXIT
END-EVALUATE
OPEN OUTPUT KSDS
EVALUATE TRUE
WHEN KSDS-SUCCESS
CONTINUE
WHEN OTHER
DISPLAY 'KSDS OPEN ERROR' WS-KSDS
PERFORM 2101-CLOSE-PARA
THRU 2101-CLOSE-PARA-EXIT
PERFORM 9000-TERMINATION-PARA
THRU 9000-TERMINATION-PARA-EXIT
END-EVALUATE
OPEN OUTPUT RRDS
EVALUATE TRUE
WHEN RRDS-SUCCESS
CONTINUE
WHEN OTHER
DISPLAY 'RRDS OPEN ERROR' WS-RRDS
PERFORM 2101-CLOSE-PARA
THRU 2101-CLOSE-PARA-EXIT
PERFORM 2102-CLOSE-PARA
THRU 2102-CLOSE-PARA-EXIT
PERFORM 9000-TERMINATION-PARA
THRU 9000-TERMINATION-PARA-EXIT
END-EVALUATE
.
2100-OPEN-PARA-EXIT.
EXIT
.
2101-CLOSE-PARA.
CLOSE PS
EVALUATE TRUE
WHEN PS-SUCCESS
CONTINUE
WHEN OTHER
DISPLAY 'PS CLOSE ERROR' WS-PS
END-EVALUATE
.
2101-CLOSE-PARA-EXIT.
EXIT
.
2102-CLOSE-PARA.
CLOSE KSDS
EVALUATE TRUE
WHEN KSDS-SUCCESS
CONTINUE
WHEN OTHER
DISPLAY 'KSDS CLOSE ERROR' WS-KSDS
END-EVALUATE
.
2102-CLOSE-PARA-EXIT.
EXIT
.
2103-CLOSE-PARA.
CLOSE RRDS
EVALUATE TRUE
WHEN RRDS-SUCCESS
CONTINUE
WHEN OTHER
DISPLAY 'RRDS CLOSE ERROR' WS-RRDS
END-EVALUATE
.
2103-CLOSE-PARA-EXIT.
EXIT
.
2100-READ-PARA.
READ PS
EVALUATE TRUE
WHEN PS-SUCCESS
COMPUTE SALARY=PS-SALARY+(0.3)*PS-SALARY
IF SALARY > 100000 AND SALARY < 200000 THEN
PERFORM 2010-KSDS-PARA
THRU 2010-KSDS-PARA-EXIT
ELSE IF SALARY > 50000 AND SALARY <=100000 THEN
PERFORM 2020-RRDS-PARA
THRU 2020-RRDS-PARA-EXIT
ELSE IF SALARY < 50000 OR SALARY > 200000 THEN
PERFORM 2030-SPOOL-PARA
THRU 2030-SPOOL-PARA-EXIT
END-IF
END-IF
END-IF
WHEN PS-EOF
PERFORM 2101-CLOSE-PARA
THRU 2101-CLOSE-PARA-EXIT
PERFORM 2102-CLOSE-PARA
THRU 2102-CLOSE-PARA-EXIT
PERFORM 2103-CLOSE-PARA
THRU 2103-CLOSE-PARA-EXIT
PERFORM 3000-DISPLAY-PARA
THRU 3000-DISPLAY-PARA-EXIT
PERFORM 9000-TERMINATION-PARA
THRU 9000-TERMINATION-PARA-EXIT
WHEN OTHER
DISPLAY 'READ ERROR' WS-PS
PERFORM 2101-CLOSE-PARA
THRU 2101-CLOSE-PARA-EXIT
PERFORM 2102-CLOSE-PARA
THRU 2102-CLOSE-PARA-EXIT
PERFORM 2103-CLOSE-PARA
THRU 2103-CLOSE-PARA-EXIT
PERFORM 9000-TERMINATION-PARA
THRU 9000-TERMINATION-PARA-EXIT
END-EVALUATE
.
2100-READ-PARA-EXIT.
EXIT
.
2020-RRDS-PARA.
MOVE PS-REC TO RRDS-REC
WRITE RRDS-REC
EVALUATE TRUE
WHEN RRDS-SUCCESS
ADD 1 TO RRDS-COUNT
ADD 1 TO RRN
WHEN OTHER
DISPLAY 'RRDS WRITE ERROR' WS-RRDS
END-EVALUATE
.
2020-RRDS-PARA-EXIT.
EXIT
.
2010-KSDS-PARA.
MOVE PS-REC TO KSDS-REC
WRITE KSDS-REC
EVALUATE TRUE
WHEN KSDS-SUCCESS
ADD 1 TO KSDS-COUNT
WHEN OTHER
DISPLAY 'KSDS WRITE ERROR' WS-KSDS
END-EVALUATE
.
2010-KSDS-PARA-EXIT.
EXIT
.
2030-SPOOL-PARA.
DISPLAY PS-REC
ADD 1 TO PS-COUNT
.
2030-SPOOL-PARA-EXIT.
EXIT
.
3000-DISPLAY-PARA.
DISPLAY 'SPOOL COUNT' PS-COUNT
DISPLAY 'RRDS COUNT' RRDS-COUNT
DISPLAY 'KSDS COUNT' KSDS-COUNT
.
3000-DISPLAY-PARA-EXIT.
EXIT
.
9000-TERMINATION-PARA.
STOP RUN
.
9000-TERMINATION-PARA-EXIT.
EXIT
.

Pages

COBOL - 08 PStoKSDS,RRDS,Spool