Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- ***********************************************************************
- *-----I D E N T I F I C A T I O N D I V I S I O N-------------------*
- ***********************************************************************
- IDENTIFICATION DIVISION.
- PROGRAM-ID. CBLHO4JN.
- AUTHOR. Jan Noel Calayag.
- ***********************************************************************
- *-----E N V I R O M E N T D I V I S I O N---------------------------*
- ***********************************************************************
- ENVIRONMENT DIVISION.
- INPUT-OUTPUT SECTION.
- FILE-CONTROL.
- SELECT PRINT-WORK-FILE
- ASSIGN TO WORK01
- ORGANIZATION IS SEQUENTIAL.
- SELECT DIVSYS-WORK-FILE
- ASSIGN TO WORK02
- ORGANIZATION IS SEQUENTIAL.
- SELECT PRINT-SORTED-FILE
- ASSIGN TO SORTED01
- ORGANIZATION IS SEQUENTIAL
- FILE STATUS IS FS-PRINT-FILE.
- SELECT DIVSYS-SORTED-FILE
- ASSIGN TO SORTED02
- ORGANIZATION IS SEQUENTIAL
- FILE STATUS IS FS-DIVSYS-FILE.
- SELECT PRINT-FILE
- ASSIGN TO PTCHO4I1
- ORGANIZATION IS SEQUENTIAL
- FILE STATUS IS FS-PRINT-FILE.
- SELECT DIVSYS-FILE
- ASSIGN TO PTCHO4I2
- ORGANIZATION IS SEQUENTIAL
- FILE STATUS IS FS-DIVSYS-FILE.
- SELECT PROV-FUND-SLIP
- ASSIGN TO PTCHO3O1
- ORGANIZATION IS SEQUENTIAL.
- ***********************************************************************
- *-----D A T A D I V I S I O N---------------------------------------*
- ***********************************************************************
- DATA DIVISION.
- * ********************************************************************
- * * F I L E S E C T I O N *
- * ********************************************************************
- FILE SECTION.
- * *****************************************************************
- * * SORT WORK FILES *
- * *****************************************************************
- SD PRINT-WORK-FILE.
- 01 PRINT-WORK-REC.
- 05 WF-PRINT-TYPE PIC X(01).
- 05 WF-PRINT-EMPNO PIC X(06).
- 05 WF-PRINT-DATE PIC X(06).
- 05 FILLER PIC X(01).
- 05 WF-PRINT-EE-CONTR PIC 9(08)V99.
- 05 WF-PRINT-ER-CONTR PIC 9(08)V99.
- 05 WF-PRINT-EE-EARNG PIC 9(08)V99.
- 05 WF-PRINT-ER-EARNG PIC 9(08)V99.
- SD DIVSYS-WORK-FILE.
- 01 DIVSYS-WORK-REC.
- 05 WF-DIVSYS-PREFIX PIC X(03).
- 05 WF-DIVSYS-CODE PIC X(03).
- * *****************************************************************
- * * SORTED FILES *
- * *****************************************************************
- FD PRINT-SORTED-FILE
- RECORD CONTAINS 54 CHARACTERS
- LABEL RECORDS ARE STANDARD
- DATA RECORD IS PRINT-SORTED-REC.
- 01 PRINT-SORTED-REC.
- 05 SF-PRINT-TYPE PIC X(01).
- 05 SF-PRINT-EMPNO PIC X(06).
- 05 SF-PRINT-DATE PIC X(06).
- 05 FILLER PIC X(01).
- 05 SF-PRINT-EE-CONTR PIC 9(08)V99.
- 05 SF-PRINT-ER-CONTR PIC 9(08)V99.
- 05 SF-PRINT-EE-EARNG PIC 9(08)V99.
- 05 SF-PRINT-ER-EARNG PIC 9(08)V99.
- FD DIVSYS-SORTED-FILE
- RECORD CONTAINS 6 CHARACTERS
- LABEL RECORDS ARE STANDARD
- DATA RECORD IS DIVSYS-SORTED-REC.
- 01 DIVSYS-SORTED-REC.
- 05 SF-DIVSYS-PREFIX PIC X(03).
- 05 SF-DIVSYS-CODE PIC X(03).
- * *****************************************************************
- * * INPUT FILES *
- * *****************************************************************
- FD PRINT-FILE.
- 01 PRINT-REC PIC X(54).
- FD DIVSYS-FILE.
- 01 DIVSYS-REC. PIC X(06).
- * *****************************************************************
- * * OUTPUT FILES *
- * *****************************************************************
- FD PROV-FUND-SLIP
- RECORD CONTAINS 132 CHARACTERS
- LABEL RECORDS ARE STANDARD
- DATA RECORD IS PROV-FUND-REC.
- 01 PROV-FUND-REC PIC X(132).
- * ********************************************************************
- * * W O R K I N G S T O R A G E S E C T I O N *
- * ********************************************************************
- WORKING-STORAGE SECTION.
- * *****************************************************************
- * * DIVISION SYSTEM TABLE *
- * *****************************************************************
- 01 WS-TBL-DIVSYS.
- 05 TBL-DIVSYS-REC OCCURS 999 TIMES
- INDEXED BY TBL-DIVSYS-INDEX.
- 10 TBL-DIVSYS-PREFIX PIC X(03).
- 10 TBL-DIVSYS-CODE PIC X(03).
- * *****************************************************************
- * * BUFFER TABLE *
- * *****************************************************************
- 01 WS-TBL-BUFF.
- 05 TBL-BUFF-REC OCCURS 2 TIMES.
- 10 TBL-BUFF-B.
- 15 TBL-BUFF-B-EE-EARNG PIC 9(08)V99 VALUE ZERO.
- 15 TBL-BUFF-B-ER-EARNG PIC 9(08)V99 VALUE ZERO.
- 15 TBL-BUFF-B-EE-CONTR PIC 9(08)V99 VALUE ZERO.
- 15 TBL-BUFF-B-ER-CONTR PIC 9(08)V99 VALUE ZERO.
- 10 TBL-BUFF-D OCCURS 12 TIMES
- INDEXED BY TBL-BUFF-D-INDEX.
- 15 TBL-BUFF-D-DATE.
- 20 TBL-BUFF-D-CC PIC X(02) VALUE SPACES.
- 20 TBL-BUFF-D-YY PIC X(02) VALUE SPACES.
- 20 TBL-BUFF-D-DD PIC X(02) VALUE SPACES.
- 15 TBL-BUFF-B-EE-EARNG PIC X(10) VALUE SPACES.
- 15 TBL-BUFF-B-EE-EARN9 REDEFINES TBL-BUFF-B-EE-EARNG
- PIC 9(08)V99.
- 15 TBL-BUFF-B-ER-EARNG PIC X(10) VALUE SPACES.
- 15 TBL-BUFF-B-ER-EARN9 REDEFINES TBL-BUFF-B-ER-EARNG
- PIC 9(08)V99.
- 15 TBL-BUFF-B-EE-CONTR PIC X(10) VALUE SPACES.
- 15 TBL-BUFF-B-EE-CONT9 REDEFINES TBL-BUFF-B-EE-CONTR
- PIC 9(08)V99.
- 15 TBL-BUFF-B-ER-CONTR PIC X(10) VALUE SPACES.
- 15 TBL-BUFF-B-ER-CONT9 REDEFINES TBL-BUFF-B-ER-CONTR
- PIC 9(08)V99.
- 10 TBL-BUFF-E.
- 15 TBL-BUFF-B-EE-EARNG PIC 9(08)V99 VALUE ZERO.
- 15 TBL-BUFF-B-ER-EARNG PIC 9(08)V99 VALUE ZERO.
- 15 TBL-BUFF-B-EE-CONTR PIC 9(08)V99 VALUE ZERO.
- 15 TBL-BUFF-B-ER-CONTR PIC 9(08)V99 VALUE ZERO.
- * *****************************************************************
- * * PROVIDENT FUND SLIP *
- * *****************************************************************
- 01 RP-PROV-FUND-SLIP PIC X(132).
- 01 RP-RECORD.
- 05 RP-HEADER01 OCCURS 2 TIMES.
- 10 FILLER PIC X(03) VALUE 'DIV'.
- 10 FILLER PIC X(01) VALUE SPACES.
- 10 FILLER PIC X(01) VALUE ':'.
- 10 FILLER PIC X(01) VALUE SPACES.
- 10 RP-DIV PIC X(03) VALUE SPACES.
- 10 FILLER PIC X(56)
- 05
- ***********************************************************************
- *-----P R O C E D U R E D I V I S I O N-----------------------------*
- ***********************************************************************
- PROCEDURE DIVISION.
- * ********************************************************************
- * * 0XXX - MAIN PROGRAM *
- * ********************************************************************
- * *****************************************************************
- * * 0100 - MAIN *
- * *****************************************************************
- 0000-MAIN.
- PERFORM 0100-INITIALIZE THRU 0100-EXIT.
- PERFORM 0300-PROCESS THRU 0300-EXIT.
- PERFORM 0200-END-PROGRAM THRU 0200-EXIT.
- 0000-EXIT.
- EXIT.
- * *****************************************************************
- * * 0100 - INITIALIZE *
- * *****************************************************************
- 0100-INITIALIZE.
- 0100-EXIT.
- EXIT.
- * *****************************************************************
- * * 0200 - END-PROGRAM *
- * *****************************************************************
- 0200-END-PROGRAM.
- 0200-EXIT.
- STOP RUN.
- EXIT.
- * *****************************************************************
- * * 0300 - PROCESS *
- * *****************************************************************
- 0300-PROCESS.
- 0300-EXIT.
- EXIT.
Add Comment
Please, Sign In to add comment