000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID. DDOS.
000300******************************************************************
000400** *
000500* © 1996 RECOVERED BY THE SOURCE RECOVERY COMPANY OF GA *
000800** *
000900******************************************************************
001000
001100 ENVIRONMENT DIVISION.
001200
001300 CONFIGURATION SECTION.
001400 SPECIAL-NAMES.
001500 C01 IS TO-TOP-OF-PAGE.
001600
001700 INPUT-OUTPUT SECTION.
001800 FILE-CONTROL.
001900 SELECT WAGE-FILE ASSIGN TO UT-S-WAGEFILE.
002000 SELECT PAYROLL-REPORT ASSIGN TO UT-S-PAYROLL.
002100
002200 DATA DIVISION.
002300
002400 FILE SECTION.
002500
002600 FD WAGE-FILE
002700 RECORDING MODE IS F
002800 LABEL RECORDS ARE STANDARD
002900 RECORD CONTAINS 80 CHARACTERS
003000 BLOCK CONTAINS 0 RECORDS.
003100 01 WAGE-RECORD.
003200 05 IN-NAME PIC X(15).
003300 05 IN-ADDRESS PIC X(20).
003400 05 IN-CITY PIC X(10).
003500 05 IN-STATE PIC X(02).
003600 05 IN-ZIP PIC X(05).
003700 05 IN-SSN PIC X(09).
003800 05 IN-CODE-01 PIC 9(02).
003900 05 IN-CODE-02 PIC 9(02).
004000 05 IN-RATE PIC 9(03)V99.
004100 05 IN-REG-HOURS PIC 9(03)V99.
004200 05 IN-OT-HOURS PIC 9(03)V99.
004300
004400 FD PAYROLL-REPORT
004500 RECORDING MODE IS F
004600 LABEL RECORDS ARE STANDARD
004700 RECORD CONTAINS 133 CHARACTERS
004800 BLOCK CONTAINS 0 RECORDS.
004900 01 PAY-RECORD PIC X(133).
005000
005100 WORKING-STORAGE SECTION.
005200
005300 01 WS-START.
005400 05 FILLER PIC X(30)
005500 VALUE 'WORKING STORAGE STARTS HERE'.
005600
005700 01 WS-CALC-PGM PIC X(08) VALUE 'USERPGM'.
005800
005900 01 WS-PARA PIC X(19) VALUE SPACES JUSTIFIED.
006000
006100 01 WS-ERROR-MSG PIC X(40) VALUE SPACES.
006200
006300 01 WS-ERROR-CODE PIC 9(04) COMP VALUE 0.
006400
006500 01 WS-INPUT-RECORD.
006600 05 WS-NAME PIC X(15).
006700 05 WS-ADDRESS PIC X(20).
006800 05 WS-CITY PIC X(10).
006900 05 WS-STATE PIC X(02).
007000 05 WS-ZIP PIC X(05).
007100 05 WS-SSN PIC X(09).
007200 05 WS-CODE-01 PIC 9(01).
007300 05 WS-CODE-02 PIC 9(02).
007400 05 WS-CODE-03 PIC X(01).
007500 05 WS-RATE PIC 9(03)V99.
007600 05 WS-REG-HOURS PIC 9(03)V99.
007700 05 WS-OT-HOURS PIC 9(03)V99.
007800
007900 01 WS-GROSS PIC 9(05)V99 VALUE ZERO.
008000
008100 01 WS-GROSS-TOTAL PIC 9(07)V99 VALUE ZERO.
008200 01 WS-GROSS-REG PIC 9(07)V99 VALUE ZERO.
008300 01 WS-GROSS-OT PIC 9(07)V99 VALUE ZERO.
008400
008500 01 WS-PARM.
008600 05 WS-MM PIC 9(02).
008700 05 WS-DD PIC 9(02).
008800 05 WS-YY PIC 9(02).
008900
009000 01 WS-SWITCHES.
009100 05 INPUT-FILE-SW PIC X(01) VALUE 'C'.
009200 88 INPUT-OPEN VALUE 'O'.
009300 05 OUTPUT-FILE-SW PIC X(01) VALUE 'C'.
009400 88 OUTPUT-OPEN VALUE 'O'.
009500 05 INPUT-EOF-SW PIC X(01) VALUE 'N'.
009600 88 INPUT-EOF VALUE 'Y'.
009700 05 MONTH-SW PIC X(01) VALUE 'N'.
009800 88 MONTH-NOT-FOUND VALUE 'N'.
009900 88 MONTH-FOUND VALUE 'Y'.
010000 05 WS-CALL-SW PIC X(01).
010100 88 REGULAR VALUE 'R'.
010200 88 OVERTIME VALUE 'O'.
010300
010400 01 WS-COUNTS.
010500 05 RECORDS-READ PIC 9(04) COMP VALUE ZERO.
010600 05 RECORDS-WRITTEN PIC 9(05) COMP-3 VALUE ZERO.
010700 05 RECORDS-REJECTED PIC 9(05) VALUE ZERO.
010800 05 PAGE-COUNT PIC 9(05) VALUE 1.
010900 05 LINE-COUNT PIC 9(02) VALUE 99.
011000 05 WS-LINES PIC 9(01) VALUE 3.
011100
011200 01 WS-DATE-DAY-TIME-FIELDS.
011300 05 WS-CURRENT-DATE PIC X(08).
011400 05 WS-TIME-OF-DAY PIC 9(06).
011500 05 WS-SIGNED-TIME-OF-DAY PIC S9(06).
011600 05 WS-DATE PIC 9(06).
011700 05 WS-DAY PIC 9(05).
011800 05 WS-TIME PIC 9(08).
011900
012000 01 X-FIELDS.
012100 05 X-01 PIC X(01).
012200 05 X-02 PIC X(02) VALUE SPACES.
012300 05 X-04 PIC X(04) VALUE SPACES.
012400 05 X-08 PIC X(08) VALUE SPACES.
012500 05 X-10 PIC X(10).
012600 05 X-20 PIC X(20) VALUE SPACES.
012700 05 X-40 PIC X(40).
012800 05 X-80 PIC X(80) VALUE 'FRED BRANDES'.
012900
013000 01 S9-COMP-3-FIELDS.
013100 05 S9-3-C3 PIC S9(03) COMP-3 VALUE ZERO.
013200 05 S9-4-C3 PIC S9(04) COMP-3 VALUE +0.
013300 05 S9-5-C3 PIC S9(05) COMP-3 VALUE ZERO.
013400 05 S9-6-C3 PIC S9(06) COMP-3.
013500 05 S9-7-C3 PIC S9(07) COMP-3.
013600 05 S9-8-C3 PIC S9(08) COMP-3.
013700 05 S9-9-C3 PIC S9(09) COMP-3.
013800 05 S9-5-V2-C3 PIC S9(05)V99 COMP-3 VALUE ZERO.
013900 05 S9-5-V3-C3 PIC S9(05)V999 COMP-3 VALUE ZEROS.
014000
014100 01 U9-COMP-3-FIELDS.
014200 05 U9-3-C3 PIC 9(03) COMP-3 VALUE ZERO.
014300 05 U9-4-C3 PIC 9(04) COMP-3 VALUE ZERO.
014400 05 U9-5-C3 PIC 9(05) COMP-3 VALUE ZERO.
014500 05 U9-6-C3 PIC 9(06) COMP-3.
014600 05 U9-7-C3 PIC 9(07) COMP-3.
014700 05 U9-8-C3 PIC 9(08) COMP-3.
014800 05 U9-9-C3 PIC 9(09) COMP-3.
014900 05 U9-5-V2-C3 PIC 9(05)V99 COMP-3 VALUE 0.
015000 05 U9-5-V3-C3 PIC 9(05)V999 COMP-3 VALUE ZEROS.
015100
015200 01 S9-FIELDS.
015300 05 S9-3 PIC S9(03) VALUE ZERO.
015400 05 S9-4 PIC S9(04) VALUE +12.
015500 05 S9-5 PIC S9(05) VALUE ZERO.
015600 05 S9-6 PIC S9(06).
015700 05 S9-7 PIC S9(07).
015800 05 S9-8 PIC S9(08).
015900 05 S9-9 PIC S9(09).
016000 05 S9-5-V2 PIC S9(05)V99 VALUE ZERO.
016100 05 S9-5-V3 PIC S9(05)V999 VALUE ZEROS.
016200
016300 01 U9-FIELDS.
016400 05 U9-3 PIC 9(03) VALUE 0.
016500 05 U9-4 PIC 9(04) VALUE ZERO.
016600 05 U9-5 PIC 9(05).
016700 05 U9-6 PIC 9(06).
016800 05 U9-7 PIC 9(07).
016900 05 U9-8 PIC 9(08).
017000 05 U9-9 PIC 9(09).
017100 05 U9-5-V2 PIC 9(05)V99 VALUE 0.
017200 05 U9-5-V3 PIC 9(05)V999 VALUE ZEROS.
017300
017400 01 S9-COMP-FIELDS.
017500 05 S9-3-C PIC S9(03) COMP VALUE ZERO.
017600 05 S9-4-C PIC S9(04) COMP VALUE +12.
017700 05 S9-5-C PIC S9(05) COMP VALUE ZERO.
017800 05 S9-6-C PIC S9(06) COMP.
017900 05 S9-7-C PIC S9(07) COMP.
018000 05 S9-8-C PIC S9(08) COMP.
018100 05 S9-9-C PIC S9(09) COMP VALUE +15.
018200
018300 01 U9-COMP-FIELDS.
018400 05 U9-3-C PIC 9(03) COMP VALUE ZERO.
018500 05 U9-4-C PIC 9(04) COMP VALUE 12.
018600 05 U9-5-C PIC 9(05) COMP VALUE ZERO.
018700 05 U9-6-C PIC 9(06) COMP.
018800 05 U9-7-C PIC 9(07) COMP.
018900 05 U9-8-C PIC 9(08) COMP.
019000 05 U9-9-C PIC 9(09) COMP VALUE 12.
019100
019200 01 EDIT-FIELDS.
019300 05 ZZZCZZZP99 PIC ZZZ,ZZZ.99.
019400 05 ZZZCZZ9P99 PIC ZZZ,ZZ9.99.
019500 05 ZZZCZZ9 PIC ZZZ,ZZ9.
019600 05 ZZZZZ9 PIC ZZZZZ9.
019700 05 ZZZZ9 PIC ZZZZ9.
019800 05 ZZZ9 PIC ZZZ9.
019900 05 ZZZ PIC ZZZ.
020000 05 ZZ9P99MINUS PIC ZZ9.99-.
020100 05 ZZ9P99CR PIC ZZ9.99CR.
020200
020300 01 HEADING-01.
020400 05 FILLER PIC X(01) VALUE SPACES.
020500 05 FILLER PIC X(10) VALUE SPACES.
020600 05 FILLER PIC X(40)
020700 VALUE 'THE SOURCE RECOVERY COMPANY, LLC.'.
020800 05 FILLER PIC X(10) VALUE SPACES.
020900 05 FILLER PIC X(23) VALUE 'WAGE REPORT'.
021000 05 FILLER PIC X(12) VALUE 'REPORT DATE '.
021100 05 RPT-MONTH PIC X(09) VALUE 'MONTH'.
021200 05 FILLER PIC X(01) VALUE SPACES.
021300 05 RPT-DD PIC X(02) VALUE 'DD'.
021400 05 FILLER PIC X(01) VALUE ','.
021500 05 RPT-CC PIC X(02) VALUE '19'.
021600 05 RPT-YY PIC X(02) VALUE 'YY'.
021700 05 FILLER PIC X(10) VALUE SPACES.
021800 05 FILLER PIC X(05) VALUE 'PAGE '.
021900 05 PAGE-01 PIC ZZZZ9.
022000
022100 01 HEADING-02.
022200 05 FILLER PIC X(01) VALUE SPACE.
022300 05 FILLER PIC X(09) VALUE SPACE.
022400 05 FILLER PIC X(15) VALUE 'NAME'.
022500 05 FILLER PIC X(02) VALUE SPACES.
022600 05 FILLER PIC X(20) VALUE 'ADDRESS'.
022700 05 FILLER PIC X(02) VALUE SPACES.
022800 05 FILLER PIC X(10) VALUE 'CITY'.
022900 05 FILLER PIC X(02) VALUE SPACES.
023000 05 FILLER PIC X(02) VALUE 'ST'.
023100 05 FILLER PIC X(02) VALUE SPACES.
023200 05 FILLER PIC X(05) VALUE 'ZIP'.
023300 05 FILLER PIC X(02) VALUE SPACES.
023400 05 FILLER PIC X(09) VALUE 'SSN'.
023500 05 FILLER PIC X(02) VALUE SPACES.
023600 05 FILLER PIC X(10) VALUE 'PAYCODE'.
023700 05 FILLER PIC X(02) VALUE SPACES.
023800 05 FILLER PIC X(06) VALUE 'RATE'.
023900 05 FILLER PIC X(02) VALUE SPACES.
024000 05 FILLER PIC X(06) VALUE 'REG HR'.
024100 05 FILLER PIC X(02) VALUE SPACES.
024200 05 FILLER PIC X(06) VALUE 'OT HR'.
024300 05 FILLER PIC X(02) VALUE SPACES.
024400 05 FILLER PIC X(08) VALUE 'GROSS'.
024500 05 FILLER PIC X(06) VALUE SPACES.
024600
024700 01 HEADING-03.
024800 05 FILLER PIC X(01) VALUE SPACE.
024900 05 FILLER PIC X(09) VALUE SPACE.
025000 05 FILLER PIC X(20) VALUE 'YEAR TO DATE TOTALS:'.
025100 05 FILLER PIC X(67) VALUE SPACES.
025200 05 FILLER PIC X(08) VALUE 'REG HR'.
025300 05 FILLER PIC X(02) VALUE SPACES.
025400 05 FILLER PIC X(08) VALUE 'OT HR'.
025500 05 FILLER PIC X(02) VALUE SPACES.
025600 05 FILLER PIC X(10) VALUE 'YTD GROSS'.
025700 05 FILLER PIC X(06) VALUE SPACES.
025800
025900 01 DETAIL-01.
026000 05 FILLER PIC X(01).
026100 05 FILLER PIC X(09).
026200 05 DTL-NAME PIC X(15).
026300 05 FILLER PIC X(02).
026400 05 DTL-ADDRESS PIC X(20).
026500 05 FILLER PIC X(02).
026600 05 DTL-CITY PIC X(10).
026700 05 FILLER PIC X(02).
026800 05 DTL-STATE PIC X(02).
026900 05 FILLER PIC X(02).
027000 05 DTL-ZIP PIC X(05).
027100 05 FILLER PIC X(02).
027200 05 DTL-SSN PIC X(09).
027300 05 FILLER PIC X(02).
027400 05 DTL-PAYCODE.
027500 10 DTL-CODE-01 PIC 9(01).
027600 10 DTL-CODE-02 PIC 9(02).
027700 10 DTL-CODE-03 PIC X(01).
027800 10 DTL-DESC PIC X(06).
027900 05 FILLER PIC X(02).
028000 05 DTL-RATE PIC ZZ9.99.
028100 05 FILLER PIC X(02).
028200 05 DTL-REG PIC ZZ9.99.
028300 05 FILLER PIC X(02).
028400 05 DTL-OT PIC ZZ9.99.
028500 05 FILLER PIC X(02).
028600 05 DTL-GROSS PIC Z,ZZZ.99.
028700 05 FILLER PIC X(06).
028800 01 DETAIL-02 REDEFINES DETAIL-01.
028900 05 FILLER PIC X(01).
029000 05 FILLER PIC X(96).
029100 05 TOT-REG PIC Z,ZZ9.99.
029200 05 FILLER PIC X(02).
029300 05 TOT-OT PIC Z,ZZ9.99.
029400 05 FILLER PIC X(02).
029500 05 TOT-GROSS PIC ZZZ,ZZ9.99.
029600 05 FILLER PIC X(06).
029700
029800 01 SUB-SCRIPTS.
029900 05 SUB-1 PIC S9(04) COMP.
030000 05 SUB-1-C3 PIC S9(03) COMP-3.
030100 05 SUB-1-9 PIC 9(03).
030200
030300 01 MONTH-VALUES.
030400 05 FILLER PIC 9(02) VALUE 1.
030500 05 FILLER PIC X(09) VALUE 'JANUARY'.
030600 05 FILLER PIC 9(02) VALUE 2.
030700 05 FILLER PIC X(09) VALUE 'FEBRUARY'.
030800 05 FILLER PIC 9(02) VALUE 3.
030900 05 FILLER PIC X(09) VALUE 'MARCH'.
031000 05 FILLER PIC 9(02) VALUE 4.
031100 05 FILLER PIC X(09) VALUE 'APRIL'.
031200 05 FILLER PIC 9(02) VALUE 5.
031300 05 FILLER PIC X(09) VALUE 'MAY'.
031400 05 FILLER PIC 9(02) VALUE 6.
031500 05 FILLER PIC X(09) VALUE 'JUNE'.
031600 05 FILLER PIC 9(02) VALUE 7.
031700 05 FILLER PIC X(09) VALUE 'JULY'.
031800 05 FILLER PIC 9(02) VALUE 8.
031900 05 FILLER PIC X(09) VALUE 'AUGUST'.
032000 05 FILLER PIC 9(02) VALUE 9.
032100 05 FILLER PIC X(09) VALUE 'SEPTEMBER'.
032200 05 FILLER PIC 9(02) VALUE 10.
032300 05 FILLER PIC X(09) VALUE 'OCTOBER'.
032400 05 FILLER PIC 9(02) VALUE 11.
032500 05 FILLER PIC X(09) VALUE 'NOVEMBER'.
032600 05 FILLER PIC 9(02) VALUE 12.
032700 05 FILLER PIC X(09) VALUE 'DECEMBER'.
032800
032900 01 MONTHS REDEFINES MONTH-VALUES.
033000 05 MONTH-TABLE OCCURS 12 TIMES.
033100 10 MM PIC 9(02).
033200 10 MONTH-NAME PIC X(09).
033300
033400 01 RATE-VALUES.
033500 05 FILLER PIC 9(02) VALUE 1.
033600 05 FILLER PIC 9(03)V99 VALUE 4.15.
033700 05 FILLER PIC 9(02) VALUE 2.
033800 05 FILLER PIC 9(03)V99 VALUE 5.25.
033900 05 FILLER PIC 9(02) VALUE 3.
034000 05 FILLER PIC 9(03)V99 VALUE 6.50.
034100 05 FILLER PIC 9(02) VALUE 4.
034200 05 FILLER PIC 9(03)V99 VALUE 7.75.
034300 05 FILLER PIC 9(02) VALUE 5.
034400 05 FILLER PIC 9(03)V99 VALUE 9.00.
034500 05 FILLER PIC 9(02) VALUE 6.
034600 05 FILLER PIC 9(03)V99 VALUE 10.75.
034700 05 FILLER PIC 9(02) VALUE 7.
034800 05 FILLER PIC 9(03)V99 VALUE 12.50.
034900 05 FILLER PIC 9(02) VALUE 8.
035000 05 FILLER PIC 9(03)V99 VALUE 15.00.
035100 05 FILLER PIC 9(02) VALUE 9.
035200 05 FILLER PIC 9(03)V99 VALUE 18.00.
035300 05 FILLER PIC 9(02) VALUE 10.
035400 05 FILLER PIC 9(03)V99 VALUE 22.00.
035500 05 FILLER PIC 9(02) VALUE 11.
035600 05 FILLER PIC 9(03)V99 VALUE 27.00.
035700 05 FILLER PIC 9(02) VALUE 12.
035800 05 FILLER PIC 9(03)V99 VALUE 32.00.
035900 01 RATE-TABLE REDEFINES RATE-VALUES.
036000 05 RATES OCCURS 12 TIMES
036100 INDEXED BY RATE-INDEX.
036200 10 RATE-CODE PIC 9(02).
036300 10 RATE PIC 9(03)V99.
036400
036500 01 WS-WORK-TABLE.
036600 05 WS-WORK-ROW OCCURS 100 TIMES.
036700 10 WS-WORK-COL OCCURS 100 TIMES.
036800 15 WS-WORK-ELEMENT PIC 9(04) COMP.
036900
037000 01 WS-MOVE-LONG.
037100 05 WS-MOVE-LONG-01 PIC X(2000).
037200
037300******************************************************************
037400* *
037500******************************************************************
037600 LINKAGE SECTION.
037700
037800 01 LNK-MOVE-LONG.
037900 05 LNK-MOVE-LONG-01 PIC X(2000).
038000
038100******************************************************************
038200* *
038300******************************************************************
038400 PROCEDURE DIVISION USING LNK-MOVE-LONG.
038500
038600 0000-MAINLINE.
038700
038800 MOVE '0000-MAINLINE' TO WS-PARA.
038900
039000 MOVE LNK-MOVE-LONG TO WS-MOVE-LONG.
039100
039200 PERFORM 0100-INIT THRU 0100-EXIT.
039300
039400 PERFORM 1000-READ THRU 1000-EXIT.
039500
039600 IF INPUT-EOF
039700 MOVE 'WAGE FILE IS EMPTY' TO WS-ERROR-MSG
039800 MOVE 1002 TO WS-ERROR-CODE
039900 GO TO 9999-TERMINATE.
040000
040100 PERFORM 2000-PROCESS-WAGES THRU 2000-EXIT
040200 UNTIL INPUT-EOF.
040300
040400 MOVE WS-GROSS-REG TO TOT-REG.
040500
040600 MOVE WS-GROSS-OT TO TOT-OT.
040700
040800 MOVE WS-GROSS-TOTAL TO TOT-GROSS.
040900
041000 WRITE PAY-RECORD FROM DETAIL-02
041100 AFTER ADVANCING WS-LINES LINES.
041200
041300 CLOSE PAYROLL-REPORT.
041400
041500 DISPLAY 'COUNT OF RECORDS READ '
041600 RECORDS-READ.
041700
041800 DISPLAY 'COUNT OF RECORDS REJECTED '
041900 RECORDS-REJECTED.
042000
042100 DISPLAY 'COUNT OF RECORDS WRITTEN '
042200 RECORDS-WRITTEN.
042300
042400 GOBACK.
042500
042600******************************************************************
042700* *
042800******************************************************************
042900 0100-INIT.
043000
043100 MOVE '0100-INIT' TO WS-PARA.
043200
043300 MOVE CURRENT-DATE TO WS-CURRENT-DATE.
043400
043500 DISPLAY 'RUN DATE: '
043600 WS-CURRENT-DATE.
043700
043800 OPEN INPUT WAGE-FILE
043900 OUTPUT PAYROLL-REPORT.
044000
044100 MOVE 'O' TO INPUT-FILE-SW.
044200
044300 MOVE 'O' TO OUTPUT-FILE-SW.
044400
044500 ACCEPT WS-PARM FROM CONSOLE.
044600
044700 IF WS-MM NOT NUMERIC
044800 MOVE 'MONTH NOT NUMERIC' TO WS-ERROR-MSG
044900 MOVE 1010 TO WS-ERROR-CODE
045000 GO TO 9999-TERMINATE.
045100
045200 IF WS-DD NOT NUMERIC
045300 MOVE 'DAY NOT NUMERIC' TO WS-ERROR-MSG
045400 MOVE 1010 TO WS-ERROR-CODE
045500 GO TO 9999-TERMINATE.
045600
045700 IF WS-YY NOT NUMERIC
045800 MOVE 'YEAR NOT NUMERIC' TO WS-ERROR-MSG
045900 MOVE 1010 TO WS-ERROR-CODE
046000 GO TO 9999-TERMINATE.
046100
046200 PERFORM 0200-INIT-HEADINGS THRU 0200-EXIT.
046300
046400 0100-EXIT.
046500 EXIT.
046600
046700******************************************************************
046800* *
046900******************************************************************
047000 0200-INIT-HEADINGS.
047100
047200 MOVE '0200-INIT-HEADINGS' TO WS-PARA.
047300
047400 PERFORM 0300-GET-MONTH
047500 VARYING SUB-1 FROM 1 BY 1
047600 UNTIL SUB-1 > 12 OR
047700 MONTH-FOUND.
047800
047900 IF MONTH-NOT-FOUND
048000 MOVE 'INVALID MONTH SPECIFIED' TO WS-ERROR-MSG
048100 MOVE 1001 TO WS-ERROR-CODE
048200 GO TO 9999-TERMINATE.
048300
048400 MOVE MONTH-NAME (SUB-1) TO RPT-MONTH.
048500
048600 MOVE WS-DD TO RPT-DD.
048700
048800 MOVE '19' TO RPT-CC.
048900
049000 MOVE WS-YY TO RPT-YY.
049100
049200 0200-EXIT.
049300 EXIT.
049400
049500******************************************************************
049600* *
049700******************************************************************
049800 0300-GET-MONTH.
049900
050000 MOVE '0300-GET-MONTH' TO WS-PARA.
050100
050200 IF WS-MM = MM (SUB-1)
050300 MOVE 'Y' TO MONTH-SW.
050400
050500 0300-EXIT.
050600 EXIT.
050700
050800******************************************************************
050900* *
051000******************************************************************
051100 0900-HEADINGS.
051200
051300 MOVE '0900-HEADINGS' TO WS-PARA.
051400
051500 MOVE PAGE-COUNT TO PAGE-01.
051600
051700 WRITE PAY-RECORD FROM HEADING-01
051800 AFTER ADVANCING TO-TOP-OF-PAGE.
051900
052000 WRITE PAY-RECORD FROM HEADING-02
052100 AFTER ADVANCING 2 LINES.
052200
052300 MOVE SPACES TO PAY-RECORD.
052400
052500 WRITE PAY-RECORD
052600 AFTER ADVANCING 1 LINES.
052700
052800 ADD 1 TO PAGE-COUNT.
052900
053000 MOVE 4 TO LINE-COUNT.
053100
053200 0900-EXIT.
053300 EXIT.
053400
053500******************************************************************
053600* *
053700******************************************************************
053800 1000-READ.
053900
054000 MOVE '1000-READ' TO WS-PARA.
054100
054200 READ WAGE-FILE
054300 AT END
054400 MOVE 'Y' TO INPUT-EOF-SW
054500 CLOSE WAGE-FILE
054600 MOVE 'C' TO INPUT-FILE-SW.
054700
054800 ADD 1 TO RECORDS-READ.
054900
055000 1000-EXIT.
055100 EXIT.
055200
055300******************************************************************
055400* *
055500******************************************************************
055600 2000-PROCESS-WAGES.
055700
055800 MOVE '2000-PROCESS-WAGES' TO WS-PARA.
055900
056000 MOVE WAGE-RECORD TO WS-INPUT-RECORD.
056100
056200 IF WS-CODE-03 = 'X'
056300 ADD 1 TO RECORDS-REJECTED
056400 GO TO 2000-EXIT.
056500
056600 IF WS-CODE-01 = 1 OR 2 OR 3 OR 4 OR 5
056700 PERFORM 2100-CALC THRU 2100-EXIT
056800 ELSE IF WS-CODE-02 > 12
056900 PERFORM 2200-CALC THRU 2200-EXIT
057000 ELSE
057100 PERFORM 2300-CALC THRU 2300-EXIT.
057200
057300 MOVE WS-NAME TO DTL-NAME.
057400
057500 MOVE WS-ADDRESS TO DTL-ADDRESS.
057600
057700 MOVE WS-CITY TO DTL-CITY.
057800
057900 MOVE WS-STATE TO DTL-STATE.
058000
058100 MOVE WS-ZIP TO DTL-ZIP.
058200
058300 MOVE WS-SSN TO DTL-SSN.
058400
058500 MOVE WS-CODE-01 TO DTL-CODE-01.
058600
058700 MOVE WS-CODE-02 TO DTL-CODE-02.
058800
058900 MOVE WS-CODE-03 TO DTL-CODE-03.
059000
059100 IF WS-CODE-01 = 1 OR 4
059200 MOVE 'REG1/4' TO DTL-DESC
059300 ELSE IF WS-CODE-01 = 2 OR 5
059400 MOVE 'REG2/5' TO DTL-DESC
059500 ELSE IF WS-CODE-01 = 3
059600 MOVE 'REG 3' TO DTL-DESC
059700 ELSE IF WS-CODE-02 = ZERO
059800 MOVE 'PC2-Z' TO DTL-DESC
059900 ELSE IF WS-CODE-03 = 'F'
060000 MOVE 'FULL' TO DTL-DESC
060100 ELSE IF WS-CODE-03 = 'P'
060200 MOVE 'PART' TO DTL-DESC
060300 ELSE
060400 MOVE 'N/A' TO DTL-DESC.
060500
060600 MOVE WS-RATE TO DTL-RATE.
060700
060800 MOVE WS-REG-HOURS TO DTL-REG.
060900
061000 MOVE WS-OT-HOURS TO DTL-OT.
061100
061200 MOVE WS-GROSS TO DTL-GROSS.
061300
061400 PERFORM 3000-WRITE THRU 3000-EXIT.
061500
061600 PERFORM 1000-READ THRU 1000-EXIT.
061700
061800 2000-EXIT.
061900 EXIT.
062000
062100******************************************************************
062200* *
062300******************************************************************
062400 2100-CALC.
062500
062600 MOVE '2100-CALC' TO WS-PARA.
062700
062800 COMPUTE WS-GROSS = (WS-RATE * WS-REG-HOURS) +
062900 (WS-RATE * WS-OT-HOURS * 1.5).
063000
063100 2100-EXIT.
063200 EXIT.
063300
063400******************************************************************
063500* *
063600******************************************************************
063700 2200-CALC.
063800
063900 MOVE '2200-CALC' TO WS-PARA.
064000
064100 CALL WS-CALC-PGM USING WS-CODE-01
064200 WS-RATE
064300 WS-REG-HOURS
064400 WS-OT-HOURS
064500 WS-GROSS.
064600
064700 2200-EXIT.
064800 EXIT.
064900
065000******************************************************************
065100* *
065200******************************************************************
065300 2300-CALC.
065400
065500 MOVE '2300-CALC' TO WS-PARA.
065600
065700 IF WS-CODE-02 < 12
065800 SET RATE-INDEX TO WS-CODE-02
065900 ELSE
066000 SET RATE-INDEX TO 1.
066100
066200 COMPUTE WS-GROSS = (WS-REG-HOURS *
066300 RATE (RATE-INDEX)) +
066400 (WS-OT-HOURS *
066500 RATE (RATE-INDEX) * 1.5).
066600
066700 2300-EXIT.
066800 EXIT.
066900
067000******************************************************************
067100* *
067200******************************************************************
067300 3000-WRITE.
067400
067500 MOVE '3000-WRITE' TO WS-PARA.
067600
067700 IF LINE-COUNT > 56
067800 PERFORM 0900-HEADINGS THRU 0900-EXIT.
067900
068000 ADD 1 TO RECORDS-WRITTEN.
068100
068200 WRITE PAY-RECORD FROM DETAIL-01
068300 AFTER ADVANCING 1 LINES.
068400
068500 ADD 1 TO LINE-COUNT.
068600
068700 3000-EXIT.
068800 EXIT.
068900******************************************************************
069000* *
069100******************************************************************
069200 9999-TERMINATE.
069300
069400 MOVE '9999-TERMINATE' TO WS-PARA.
069500
069600 IF INPUT-OPEN
069700 CLOSE WAGE-FILE.
069800
069900 IF OUTPUT-OPEN
070000 CLOSE PAYROLL-REPORT.
070100
070200 IF WS-ERROR-CODE > 0
070300 DISPLAY 'ERROR CODE: '
070400 WS-ERROR-CODE
070500 DISPLAY 'ERROR MSG: '
070600 WS-ERROR-MSG.
070700
070800 GOBACK.
Back To Top