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