000100 Identification Division.
000200 Program-ID. AROMA2B.
000300
000400 Environment Division.
000500 Configuration Section.
000600 Special-Names.
000700     Decimal-Point is Comma.
000800
000900 Input-Output Section.
001000 File-Control.
001100     Select Sales-File Assign to AROMA2S
001200            Organization is Sequential
001300            .
001400     Select Customer-File Assign to AROMA2C
001500            Organization is Indexed
001600            Access is Random
001700            Record Key is CF-Cust-ID
001800            .
001900     Select Oils-File Assign to AROMA2O
002000            Organization is Indexed
002100            Access is Dynamic
002200            Record Key is OF-Oil-Id
002300            .
002400     Select Sorted-File Assign to AROMA2SS
002500            Organization is Sequential
002600            .
002700     Select Work-File   Assign to AROMA2W
002800            .
002900     Select Summary-Report Assign to AROMA2R
003000            Organization is Sequential
003100            .
003200 Data Division.
003300 File Section.
003400 FD Sales-File Recording Mode F.
003500 01 Sales-Rec.
003600    88 End-Of-Sales-File    Value High-Values.
003700    05 SF-Cust-Id              Pic X(05).
003800    05 SF-Oil-Id.
003900       10 SF-Oil-Type          Pic X(01).
004000          88 Essential-Oil     Value 'E'.
004100       10 SF-Oil-Nr            Pic X(02).
004200    05 SF-Unit-Size            Pic 9.
004300    05 SF-Units-Sold           Pic 999.
004400    05 Filler                  Pic X(68).
004500
004600 FD Customer-File.
004700 01 Customer-Rec.
004800    88 End-Of-Customer-File Value High-Values.
004900    05 CF-Cust-ID             Pic X(5).
005000    05 CF-Cust-Name           Pic X(25).
005100    05 CF-Cust-Address        Pic X(30).
005200    05 Filler                 Pic X(20).
005300
005400 FD Oils-File.
005500 01 Oils-Rec.
005600    88 End-Of-Oil-File Value High-Values.
005700    05 OF-Oil-Id              Pic X(03).
005800    05 OF-Oil-Name            Pic X(20).
005900    05 OF-Cost-Per-Mls        Pic 99V99.
006000    05 Filler                 Pic X(53).
006100
006200 SD Work-File.
006300 01 Work-Rec.
006400    88 End-Of-Work-File Value High-Values.
006500    05 WF-Cust-Id              Pic X(05).
006600    05 WF-Oil-Id               Pic X(03).
006700    05 WF-Unit-Size            Pic 9.
006800    05 WF-Units-Sold           Pic 999.
006900    05 Filler                  Pic X(78).
007000
007100 FD Summary-Report Recording Mode F.
007200 01 Print-Line                   Pic X(79).
007300
007400 FD Sorted-File Recording Mode F.
007500 01 Sorted-Rec                   Pic X(80).
007600
007700
007800 Working-Storage Section.
007900 77 OT-Rows      Pic 99 Value 0.
008000
008100 01 Oils-Table.
008200    05 Oil-Cost-Values Occurs 35 Depending on OT-Rows.
008300       10 OT-Oil-Id         Pic X(03).
008400       10 OT-Oil-Name       Pic X(20).
008500       10 OT-Cost-Per-Ml    Pic 99V99.
008600
008700 01 Report-Heading-Line.
008800    05 Pic X(15) Value Space.
008900    05 Pic x(35) Value 'Aromamora Summary Sales Report'.
009000
009100 01 Report-Heading-Spaceline.
009200    05 Pic X(50) Value Space.
009300
009400 01 Report-Heading-Underline.
009500    05 Pic X(15) Value Space.
009600    05 Pic X(32) Value All '-'.
009700
009800 01 Topic-Heading-Line.
009900    05 Pic X(18) Value 'Customer Name'.
010000    05 Pic X(08) Value Space.
010100    05 Pic X(10) Value 'Cust-Id'.
010200    05 Pic X(08) Value 'Sales'.
010300    05 Pic X(11) Value 'Qty-Sold'.
010400    05 Pic X(11) Value 'Sales Value'.
010500
010600 77 UCLC-Cust-Name        Pic X(20).
010700 77 UCLC-Blank-Pos        Pic 9(02) Value 0.
010800
010900 01 Cust-Sales-Line.
011000    05 Prn-Cust-Name      Pic X(25).
011100    05 Prn-Cust-Id        Pic BBB9(5).
011200    05 Prn-Cust-Sales     Pic BBBBBZZ9.
011300    05 Prn-Qty-Sold       Pic BBBBBZZ.ZZ9.
011400    05 Prn-Sales-Value    Pic BBBBZZZ.ZZ9,99.
011500
011600 01 Total-Sales-Line.
011700    05 Pic X(35) Value Space.
011800    05 Pic X(19) Value 'Total Sales       :'.
011900    05 Prn-Total-Sales   Pic BBBBBBZZ.ZZ9.
012000
012100 01 Total-Qty-Sold-Line.
012200    05 Pic X(35) Value Space.
012300    05 Pic X(19) Value 'Total Qty Sold    :'.
012400    05 Prn-Total-Qty-Sold  Pic BBBBBZZZ.ZZ9.
012500
012600 01 Total-Sales-Value-Line.
012700    05 Pic X(35) Value Space.
012800    05 Pic X(19) Value 'Total Sales Value :'.
012900    05 Prn-Total-Sales-Value Pic BZZZZ.ZZ9,99.
013000
013100 01 Cust-Totals.
013200    05 Cust-Sales        Pic 999.
013300    05 Cust-Qty-Sold     Pic 9(05).
013400    05 Cust-Sales-Value  Pic 9(05)V99.
013500
013600 01 Final-Totals.
013700    05 Total-Sales       Pic 9(05)    Value Zero.
013800    05 Total-Qty-Sold    Pic 9(06)    Value Zero.
013900    05 Total-Sales-Value Pic 9(06)V99 Value Zero.
014000
014100 01 Temp-Variables.
014200    05 Sale-Qty-Sold     Pic 99999.
014300    05 Value-Of-Sale     Pic 999999V99.
014400    05 Prev-Cust-Id      Pic X(05).
014500
014600 Procedure Division.
014700 Produce-Summary-Report.
014800     Open Input Customer-File
014900     Open Input Oils-File
015000
015100     Sort Work-File On Ascending WF-Cust-Id
015200        Input  Procedure Select-Essential-Oils
015300        Output Procedure Print-Summary-Report
015400
015500     If Sort-Return Not = 0
015600        Display 'Sort-Return-Code ' Sort-Return
015700        Move 99 to Return-Code
015800     End-If
015900
016000     Close Sales-File
016100     Close Summary-Report, Sorted-File
016200
016300     GoBack
016400     .
016500 Select-Essential-Oils.
016600     Display '*** SORT Input Procedure'
016700     Open INPUT Sales-File
016800     Perform Read-Sales-File
016900
017000
017100     Perform Until End-Of-Sales-File
017200        If Essential-Oil
017300           Release Work-Rec From Sales-Rec
017400        End-If
017500        Perform Read-Sales-File
017600     End-Perform
017700
017800     .
017900 Read-Sales-File.
018000     Read Sales-File
018100        At End
018200           Set End-Of-Sales-File to True
018300        Not At End
018400           Display '*** Sales-Rec: ' Sales-Rec(1:20)
018500     End-Read
018600     .
018700 Print-Summary-Report.
018800     Display '*** SORT Output Procedure'
018900     Open Output Summary-Report
019000     Open Output Sorted-File
019100
019200     Write Print-Line
019300        From Report-Heading-Line
019400        After Advancing 1 Line
019500     Write Print-Line
019600        From Report-Heading-Underline
019700        After Advancing 1 Line
019800     Write Print-Line
019900        From ToPic-Heading-Line
020000        After Advancing 3 Lines
020100     Write Print-Line
020200        From Report-Heading-Spaceline
020300        After Advancing 1 Line
020400
020500     Perform Return-Work-File
020600
020700     Perform Print-Customer-Lines
020800             Until End-Of-Work-File
020900
021000     Write Print-Line
021100        From Report-Heading-Spaceline
021200        After Advancing 1 Line
021300
021400     Move Total-Sales to Prn-Total-Sales
021500     Write Print-Line
021600        From Total-Sales-Line
021700        After Advancing 3 Lines
021800
021900     Move Total-Qty-Sold to Prn-Total-Qty-Sold
022000     Write Print-Line
022100        From Total-Qty-Sold-Line
022200        After Advancing 2 Lines
022300
022400     Move Total-Sales-Value to Prn-Total-Sales-Value
022500     Write Print-Line
022600        From Total-Sales-Value-Line
022700        After Advancing 2 Lines
022800     .
022900 Print-Customer-Lines.
023000     Move Zero to Cust-Totals
023100     Move WF-Cust-Id to Prn-Cust-Id, Prev-Cust-Id
023200
023300     Perform Until WF-Cust-Id NOT = Prev-Cust-Id
023400        Write Sorted-Rec
023500            from Work-Rec
023600        Add 1 to Cust-Sales, Total-Sales
023700
023800        Compute Sale-Qty-Sold =
023900           WF-Unit-Size * WF-Units-Sold
024000
024100        Add Sale-Qty-Sold
024200           to Cust-Qty-Sold, Total-Qty-Sold
024300        Move WF-Oil-Id to OF-Oil-Id
024400        Read Oils-File
024500           Invalid Key
024600              Display '??? WF-Oil-Id: ' WF-Oil-Id
024700              Move 0 to OF-Cost-Per-Mls
024800              Move 55 to Return-Code
024900        End-Read
025000
025100        Compute Value-Of-Sale =
025200           Sale-Qty-Sold * OF-Cost-Per-Mls
025300        Add Value-Of-Sale
025400           to Cust-Sales-Value, Total-Sales-Value
025500
025600        Perform Return-Work-File
025700     End-Perform
025800
025900     Move Prev-Cust-Id to CF-Cust-Id
026000
026100     Read Customer-File
026200        Invalid Key
026300          Move '*** N/A ***' to Prn-Cust-Name
026400        Not Invalid Key
026500          Move CF-Cust-Name to Prn-Cust-Name
026600     End-Read
026700
026800     Move Cust-Sales to Prn-Cust-Sales
026900     Move Cust-Qty-Sold to Prn-Qty-Sold
027000     Move Cust-Sales-Value to Prn-Sales-Value
027100
027200     Perform Make-Upper-Lower-Case
027300
027400     Write Print-Line
027500        From Cust-Sales-Line
027600        After Advancing 2 Lines
027700     .
027800 Make-Upper-Lower-Case.
027900     Move Prn-Cust-Name(1:1) to UCLC-Cust-Name(1:1)
028000     Move Function Lower-Case(Prn-Cust-Name(2:))
028100          to UCLC-Cust-Name(2:)
028200     Move UCLC-Cust-Name to Prn-Cust-Name
028300
028400     Perform Varying UCLC-Blank-Pos from 2 by 1
028500         Until UCLC-Blank-Pos = Length Of UCLC-Cust-Name
028600         If UCLC-Cust-Name(UCLC-Blank-Pos:1) = Space
028700            Move Function Upper-Case
028800                 (UCLC-Cust-Name(UCLC-Blank-Pos + 1:1)) to
028900                  Prn-Cust-Name(UCLC-Blank-Pos + 1:1)
029000         End-If
029100     End-Perform
029200     .
029300 Return-Work-File.
029400     Return Work-File
029500        At End
029600           Set End-Of-Work-File to TRUE
029700     End-Return
029800     .
029900
030000  End Program AROMA2B.