IDENTIFICATION DIVISION.
PROGRAM-ID. CHARGE-PROGRAM.
AUTHOR. JONAS WIK.
DATE-WRITTEN. OCTOBER 21ST 2002.
DATE-COMPILED.
*****************************************************************
**
** Purpose of the program:
** Input:
** FIELD COLS. TYPE
**
**
** Output:
**
** Date Due: October 14th 2002
** Date Assigned: September 30th 2002
** Dataset Name:
**
*****************************************************************
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
**
FILE-CONTROL.
SELECT PRICE-FILE
ASSIGN TO PRICE-INPUT
ORGANIZATION IS LINE SEQUENTIAL.
SELECT QTY-FILE
ASSIGN TO QTY-INPUT
ORGANIZATION IS LINE SEQUENTIAL.
SELECT REPORT-FILE
ASSIGN TO CHARGE-REPORT.
**
DATA DIVISION.
**
FILE SECTION.
**
FD PRICE-FILE
LABEL RECORDS ARE OMITTED
RECORDING MODE IS F.
01 PF-REC.
05 PF-ITEM-NUM PIC X(4).
05 PF-ITEM-PRICE PIC 9(3)V99.
**
FD QTY-FILE
LABEL RECORDS ARE OMITTED
RECORDING MODE IS F.
01 QF-REC.
05 QF-ITEM-NUM PIC X(4).
05 QF-QTY-SOLD PIC 99.
05 QF-SLS-TAX-CODE PIC 9.
05 QF-ITEM-WEIGHT PIC 99.
**
FD REPORT-FILE
LABEL RECORDS ARE OMITTED
RECORDING MODE IS F.
01 CHARGE-REPORT-REC PIC X(132).
**
WORKING-STORAGE SECTION.
01 WS-CALCULATION-FIELDS.
05 WC-ITEM-PRICE PIC 9(3)V99.
05 WC-EXTENDED-AMOUNT PIC 9(6)V99.
05 WC-SALES-TAX PIC 9(4)V99.
05 WC-FREIGHT-CHARGES PIC 9(4)V99.
05 WC-DISCOUNT PIC 9(5)V99.
05 WC-TAX-RATE PIC V99.
05 WC-ITEM-FREIGHT PIC 99V99.
05 WC-WEIGHT PIC 999.
05 WC-TEMP-WEIGHT PIC 999.
05 WC-DISC-RATE PIC V999.
05 WC-TOTAL PIC 9(6)V99.
01 WS-DATE.
05 PIC XX.
05 WD-YEAR PIC 99.
05 WD-MONTH PIC 99.
05 WD-DAY PIC 99.
05 PIC X(13).
01 WS-SWITCHES.
05 WS-FOUND-SW PIC X(3)
VALUE ' NO'.
05 WS-FOUND-SW2 PIC X(3) VALUE ' NO'.
88 FOUND VALUE 'YES'.
05 WS-EOF-SW PIC X(3).
05 WS-EOF-SW2 PIC X(3).
01 PRICE-TABLE.
05 PRICE-TABS OCCURS 20 TIMES
ASCENDING KEY PT-ITEM-NUM
INDEXED BY C D.
10 PT-ITEM-NUM PIC X(4).
10 PT-ITEM-PRICE PIC 9(3)V99.
01 SALESTAX-TABLE.
05 FILLER PIC X(3) VALUE '105'.
05 FILLER PIC X(3) VALUE '207'.
05 FILLER PIC X(3) VALUE '309'.
05 FILLER PIC X(3) VALUE '406'.
05 FILLER PIC X(3) VALUE '504'.
05 FILLER PIC X(3) VALUE '608'.
**
01 SLSTAX-TAB REDEFINES SALESTAX-TABLE.
05 TAX-TABS OCCURS 6 TIMES
INDEXED BY I.
10 TT-TAX-CODE PIC 9.
10 TT-TAX-RATE PIC V99.
01 FREIGHT-TABLE.
05 FILLER PIC X(7) VALUE '0200550'.
05 FILLER PIC X(7) VALUE '0350825'.
05 FILLER PIC X(7) VALUE '0501250'.
05 FILLER PIC X(7) VALUE '0702000'.
05 FILLER PIC X(7) VALUE '0902640'.
05 FILLER PIC X(7) VALUE '1203200'.
**
01 FREIGHT-TAB REDEFINES FREIGHT-TABLE.
05 FREIGHT-TABS OCCURS 6 TIMES
INDEXED BY J.
10 FT-WEIGHT PIC 999.
10 FT-CHARGE PIC 99V99.
**
**
01 PRICE-INPUT PIC X(9) VALUE "J:HW2.DAT".
01 QTY-INPUT PIC X(11) VALUE "J:ASMT2.DAT".
01 CHARGE-REPORT PIC X(12) VALUE "J:CHGREP.DAT".
**
**
01 CHARGE-REPORT-HEADER1.
05 FILLER PIC X(9) VALUE "JONAS WIK".
05 FILLER PIC X(26).
05 FILLER PIC X(14) VALUE "FREIGHT REPORT".
05 FILLER PIC X(32).
05 FILLER PIC X(6) VALUE "DATE: ".
05 HEADING-MONTH PIC Z9.
05 FILLER PIC X VALUE '/'.
05 HEADING-DAY PIC Z9.
05 FILLER PIC X VALUE '/'.
05 HEADING-YEAR PIC 99.
**
01 CHARGE-REPORT-HEADER2.
05 FILLER PIC X(11) VALUE "ITEM NUMBER".
05 FILLER PIC XX.
05 FILLER PIC X(13) VALUE "QUANTITY SOLD".
05 FILLER PIC XX.
05 FILLER PIC X(15) VALUE "EXTENDED AMOUNT".
05 FILLER PIC XX.
05 FILLER PIC X(9) VALUE "SALES TAX".
05 FILLER PIC XX.
05 FILLER PIC X(15) VALUE "FREIGHT CHARGES".
05 FILLER PIC XX.
05 FILLER PIC X(8) VALUE "DISCOUNT".
05 FILLER PIC XX.
05 FILLER PIC X(13) VALUE "TOTAL CHARGES".
**
**
01 CHARGE-REPORT-MSG-LINE.
05 FILLER PIC X(4).
05 MSG-ITEM-NUM PIC X(4).
05 FILLER PIC XX.
05 MSG-LINE-ITEM PIC X(30).
**
**
01 CHARGE-REPORT-DETAIL-LINE.
05 FILLER PIC X(4).
05 CR-ITEM-NUM PIC X(4).
05 FILLER PIC X(10).
05 CR-QTY-SOLD PIC Z9.
05 FILLER PIC X(10).
05 CR-EXTENDED-AMOUNT PIC $(6).99.
05 FILLER PIC X(6).
05 CR-SALES-TAX PIC $(5).99.
05 FILLER PIC X(7).
05 CR-FREIGHT-CHARGES PIC $(5).99.
05 FILLER PIC X(5).
05 CR-DISCOUNT PIC $(5).99.
05 FILLER PIC X(5).
05 CR-TOTAL-CHARGES PIC $(6).99.
**
01 END-OF-JOB-LINE.
05 PIC X(35) VALUE SPACES.
05 PIC X(30) VALUE
"N O R M A L E N D O F J O B".
PROCEDURE DIVISION.
**
**************************************************************
** THIS PARAGRAPH IS THE MAIN MODULE OF THE PROGRAM. ALL
** PARAGRAPHS IN THE PROGRAM ARE EXECUTED UNDER THE CONTROL
** OF THIS MODULE.
**************************************************************
**
0000-MAIN-RTN.
PERFORM 0100-INIT-RTN THRU 0100-INIT-RTN-EXIT
PERFORM 0800-HDG-RTN THRU 0800-HDG-RTN-EXIT
PERFORM UNTIL WS-EOF-SW2 = 'YES'
READ QTY-FILE
AT END MOVE 'YES' TO WS-EOF-SW2
NOT AT END PERFORM 0200-VALID-RTN
THRU 0200-VALID-RTN-EXIT
END-READ
END-PERFORM.
PERFORM 1000-ENDOFJOB-RTN THRU 1000-ENDOFJOB-RTN-EXIT
CLOSE PRICE-FILE
QTY-FILE
REPORT-FILE
STOP RUN.
**
***************************************************************
** CALLED BY 000-MAIN-LINE-RTN. INITIALIZES VALUES AND OPENS
** THE FILES INVOLVED.
***************************************************************
**
0100-INIT-RTN.
OPEN INPUT PRICE-FILE
QTY-FILE
OUTPUT REPORT-FILE
INITIALIZE WS-CALCULATION-FIELDS
SET D TO 1
PERFORM 0770-DATE-MOVE-RTN THRU 0770-DATE-MOVE-RTN-EXIT
PERFORM 0700-READ UNTIL WS-EOF-SW = 'YES'.
0100-INIT-RTN-EXIT. EXIT.
**
*****************************************************************
** THIS PARAGRAPH VALIDATES THAT...
** 1. ALL NUMERIC FIELDS ARE NUMERIC.
** 2. DEPOSITS OR WITHDRAWAL VALUES CANNOT EXCEED $7,000
** 3. THE TYPE OF ACCOUNT (AR-CODE) IS 'S' 'C' OR 'SS'
** 4. ACCT-NUM IS PRESENT
*****************************************************************
**
0200-VALID-RTN.
SEARCH ALL PRICE-TABS
AT END PERFORM 0999-ERR-RTN THRU 0999-ERR-RTN-EXIT
WHEN PT-ITEM-NUM(C) = QF-ITEM-NUM
PERFORM 0210-VALID-RTN THRU 0210-VALID-RTN-EXIT
END-SEARCH.
0200-VALID-RTN-EXIT. EXIT.
0210-VALID-RTN.
SET I TO 1
SEARCH TAX-TABS
AT END PERFORM 0998-ERR-RTN THRU 0998-ERR-RTN-EXIT
WHEN TT-TAX-CODE(I) = QF-SLS-TAX-CODE
PERFORM 0400-TAX-CALC-RTN THRU 0400-TAX-CALC-RTN-EXIT
PERFORM 0300-CALC-RTN THRU 0300-CALC-RTN-EXIT
END-SEARCH.
0210-VALID-RTN-EXIT.EXIT.
**
0300-CALC-RTN.
* MOVE PT-ITEM-PRICE(C) TO WC-ITEM-PRICE
* COMPUTE WC-EXTENDED-AMOUNT = WC-ITEM-PRICE * QF-QTY-SOLD
* SET I TO 1
* SEARCH TAX-TABS
* AT END PERFORM 0998-ERR-RTN THRU 0998-ERR-RTN-EXIT
* WHEN TT-TAX-CODE(I) = QF-SLS-TAX-CODE
* PERFORM 0400-TAX-CALC-RTN THRU 0400-TAX-CALC-RTN-EXIT
* END-SEARCH.
COMPUTE WC-WEIGHT = QF-QTY-SOLD * QF-ITEM-WEIGHT
SET J TO 1
PERFORM 0350-CHECK-ONETWENTY-RTN
THRU 0350-CHECK-ONETWENTY-RTN-EXIT UNTIL WC-WEIGHT <= 120
SEARCH FREIGHT-TABS
AT END PERFORM 0950-ERROR-RTN THRU 0950-ERROR-RTN-EXIT
WHEN FT-WEIGHT(J) >= WC-WEIGHT
PERFORM 0500-FREIGHT-RTN THRU 0500-FREIGHT-RTN-EXIT
END-SEARCH.
EVALUATE WC-EXTENDED-AMOUNT
WHEN 1000 THRU 25000
MOVE .06 TO WC-DISC-RATE
WHEN 25001 THRU 60000
MOVE .08 TO WC-DISC-RATE
WHEN > 60000
MOVE .095 TO WC-DISC-RATE
END-EVALUATE
COMPUTE WC-DISCOUNT = WC-EXTENDED-AMOUNT * WC-DISC-RATE
COMPUTE WC-TOTAL = WC-EXTENDED-AMOUNT + WC-SALES-TAX
+ WC-FREIGHT-CHARGES - WC-DISCOUNT
PERFORM 0900-WRITE-DETAIL
THRU 0900-WRITE-DETAIL-EXIT.
0300-CALC-RTN-EXIT.EXIT.
0350-CHECK-ONETWENTY-RTN.
COMPUTE WC-WEIGHT = WC-WEIGHT - 120.
ADD 32 TO WC-FREIGHT-CHARGES.
0350-CHECK-ONETWENTY-RTN-EXIT.EXIT.
**
0400-TAX-CALC-RTN.
MOVE PT-ITEM-PRICE(C) TO WC-ITEM-PRICE
COMPUTE WC-EXTENDED-AMOUNT = WC-ITEM-PRICE * QF-QTY-SOLD
MOVE TT-TAX-RATE(I) TO WC-TAX-RATE.
COMPUTE WC-SALES-TAX = WC-EXTENDED-AMOUNT * WC-TAX-RATE.
0400-TAX-CALC-RTN-EXIT.EXIT.
**
0500-FREIGHT-RTN.
ADD FT-CHARGE(J) TO WC-FREIGHT-CHARGES.
0500-FREIGHT-RTN-EXIT.EXIT.
0700-READ.
READ PRICE-FILE
AT END MOVE 'YES' TO WS-EOF-SW
NOT AT END PERFORM 0750-FILL-TABLE
THRU 0750-FILL-TABLE-EXIT
END-READ.
0700-READ-EXIT.EXIT.
**
0750-FILL-TABLE.
MOVE PF-ITEM-NUM TO PT-ITEM-NUM(D).
MOVE PF-ITEM-PRICE TO PT-ITEM-PRICE(D).
SET D UP BY 1.
0750-FILL-TABLE-EXIT.EXIT.
**
*****************************************************************
** THIS PARAGRAPH MOVES THE DATE TO THE HEADING
*****************************************************************
**
0770-DATE-MOVE-RTN.
MOVE FUNCTION CURRENT-DATE TO WS-DATE.
MOVE WD-MONTH TO HEADING-MONTH.
MOVE WD-DAY TO HEADING-DAY.
MOVE WD-YEAR TO HEADING-YEAR.
0770-DATE-MOVE-RTN-EXIT.EXIT.
**
*****************************************************************
** THIS PARAGRAPH PRINTS THE HEADINGS
*****************************************************************
**
0800-HDG-RTN.
WRITE CHARGE-REPORT-REC FROM CHARGE-REPORT-HEADER1 AFTER
ADVANCING 2 LINES.
WRITE CHARGE-REPORT-REC FROM CHARGE-REPORT-HEADER2 AFTER
ADVANCING 2 LINES.
0800-HDG-RTN-EXIT.
**
*****************************************************************
** THIS PARAGRAPH MOVES THE FIELDS AND WRITES THE MAIN LINE IN THE
** REPORT.
*****************************************************************
**
0900-WRITE-DETAIL.
MOVE PT-ITEM-NUM(C) TO CR-ITEM-NUM
MOVE QF-QTY-SOLD TO CR-QTY-SOLD
MOVE WC-EXTENDED-AMOUNT TO CR-EXTENDED-AMOUNT
MOVE WC-SALES-TAX TO CR-SALES-TAX
MOVE WC-FREIGHT-CHARGES TO CR-FREIGHT-CHARGES
MOVE WC-DISCOUNT TO CR-DISCOUNT
MOVE WC-TOTAL TO CR-TOTAL-CHARGES
WRITE CHARGE-REPORT-REC FROM CHARGE-REPORT-DETAIL-LINE
AFTER ADVANCING 1 LINES.
0900-WRITE-DETAIL-EXIT.
**
*****************************************************************
** THIS PARAGRAPH WRITES THE ERROR LINE. AT THE END
** OF THE PROCEDURE THE ERROR LINE FIELDS ARE RE-
** INITIALIZED.
*****************************************************************
**
0950-ERROR-RTN.
WRITE CHARGE-REPORT-REC FROM CHARGE-REPORT-MSG-LINE
AFTER ADVANCING 1 LINES
MOVE SPACES TO MSG-ITEM-NUM.
MOVE SPACES TO MSG-LINE-ITEM.
0950-ERROR-RTN-EXIT.
0999-ERR-RTN.
MOVE QF-ITEM-NUM TO MSG-ITEM-NUM.
MOVE "ITEM NOT IN TABLE" TO MSG-LINE-ITEM.
PERFORM 0950-ERROR-RTN THRU 0950-ERROR-RTN-EXIT.
0999-ERR-RTN-EXIT.
0998-ERR-RTN.
MOVE QF-ITEM-NUM TO MSG-ITEM-NUM.
MOVE "SALES TAX CODE NOT IN TABLE" TO MSG-LINE-ITEM.
PERFORM 0950-ERROR-RTN THRU 0950-ERROR-RTN-EXIT.
0998-ERR-RTN-EXIT.
**
*****************************************************************
** THIS PARAGRAPH WRITES THE FINAL LINES. IT PRODUCES AVERAGES AND
** PRINTS WHAT CHECKING ACCOUNT HAS THE LOWEST BALANCE.
*****************************************************************
**
1000-ENDOFJOB-RTN.
WRITE CHARGE-REPORT-REC FROM END-OF-JOB-LINE
AFTER ADVANCING 2 LINES.
1000-ENDOFJOB-RTN-EXIT. EXIT.
*****************************************************************