000100 Identification Division. 000200 Program-Id. FREQPGM6. 000300 Environment Division. 000400 Input-Output Section. 000500 File-Control. 000600 Select FREQFILE Assign to FREQFDD 000700 Organization is Indexed 000800 Access is Sequential 000900 Record Key is Flight-Date in File-Record 001000 File Status is Freqfile-Status 001100 . 001200 Select FREQLINE Assign to FREQADD 001300 Organization is Indexed 001400 Access is Sequential 001500 Record Key is Airline-Id in Line-Record 001600 File Status is Freqline-Status 001700 . 001800 Select FREQLIST Assign to FREQLDD 001900 Organization is Sequential 002000 Access is Sequential 002100 File Status is Freqlist-Status 002200 . 002300 Data Division. 002400 File Section. 002500 FD FREQFILE. 002600 01 File-Record. 002700 88 End-Of-Freq-File Value High-Value. 002800 05 Pic X(01). 002900 05 Flight-Date Pic X(05). 003000 05 City-Pair. 003100 10 Origin Pic X(03). 003200 10 Pic X(01). 003300 10 Dest Pic X(03). 003400 05 Airline-Id Pic X(02). 003500 05 Flight-Number Pic 9(04). 003600 05 Class-Of-Travel Pic X(01). 003700 88 Tourist Value 'Y'. 003800 88 Business Value 'C'. 003900 88 Firstclass Value 'F'. 004000 05 Mileage Pic 9(05). 004100 05 Pic X(55). 004200 004300 FD FREQLINE. 004400 01 Line-Record. 004500 05 Airline-Id Pic X(02). 004600 05 Airline-Name Pic X(25). 004700 05 Pic X(53). 004800 004900 FD FREQLIST Recording mode F. 005000 01 Listrow Pic X(120). 005100 005200*--------------------------------------- 005300 Working-Storage Section. 005400*--------------------------------------- 005500 005600 77 Mileage-Total Pic 9(08) Value 0. 005700 77 Incbonus-Value Pic 9(08) Value 0. 005800 77 Incbonus-Total Pic 9(08) Value 0. 005900 006000 01 Freqfile-Status Pic X(02). 006100 88 Freqfile-Openerror Values '01' thru '99'. 006200 01 Freqmile-Status Pic X(02). 006300 88 Freqmile-Openerror Values '01' thru '99'. 006400 01 Freqline-Status Pic X(02). 006500 88 Freqline-Openerror Values '01' thru '99'. 006600 01 Freqlist-Status Pic X(02). 006700 88 Freqlist-Openerror Values '01' thru '99'. 006800 006900 01 Date-Row1. 007000 05 Pic X(20) Value 'Printed :'. 007100 05 Date-Pgm-Date-Row1 Pic X(50) Value Space. 007200 007300 01 Date-Row2. 007400 05 Pic X(20) Value 'Valid Until :'. 007500 05 Date-Pgm-Date-Row2 Pic X(50) Value Space. 007600 007700 77 Date-Pgm Pic X(08) Value 'FREQDATE'. 007800 77 Date-Pgm-Parm-Status Pic 9. 007900 88 Parm-Error Value 0. 008000 88 Parm-OK Value 1. 008100 008200 01 List-Blankrow. 008300 05 Pic X(120) Value Spaces. 008400 008500 01 List-Header1. 008600 05 Pic X(35) Value 'Frequent Flyer Report'. 008700 008800 01 List-Header2. 008900 05 Flight-Date Pic X(07) Value 'Date'. 009000 05 Airline-Name Pic X(27) Value 'Airline-Name'. 009100 05 Flight-Number Pic X(06) Value 'Flnr'. 009200 05 Class-Of-Travel Pic X(03) Value 'Cl'. 009300 05 City-Pair Pic X(10) Value 'C-Pair'. 009400 05 Mileage Pic X(11) Value 'Mileage'. 009500 05 Incbonus Pic X(11) Value 'Inc Bonus'. 009600 009700 01 List-Trailer. 009800 05 Pic X(48) 009900 Value 'Total Mileage '. 010000 05 Mileage Pic Z(11). 010100 05 Incbonus Pic Z(11). 010200 010300 01 List-Detail. 010400 05 Flight-Date Pic X(05). 010500 05 Pic X(01). 010600 05 Airline-Name Pic X(25). 010700 05 Pic X(03). 010800 05 Flight-Number Pic Z(04). 010900 05 Pic X(02). 011000 05 Class-Of-Travel Pic X(01). 011100 05 Pic X(02). 011200 05 City-Pair Pic X(07). 011300 05 Pic X(02). 011400 05 Mileage Pic Z(07). 011500 05 Pic X(04). 011600 05 Incbonus Pic Z(07). 011700 05 Pic X(04). 011800 011900 77 MT-Freqmile Pic X(08) Value 'FREQMILE'. 012000 77 MT-Count Pic 9(03) Value 0. 012100 01 Tab-Search. 012200 05 TS-City-Pair. 012300 10 TS-Org-City Pic X(03). 012400 10 Pic X(01). 012500 10 TS-Dst-City Pic X(03). 012600 01 Mile-Table. 012700 05 City-Pair-Table Occurs 350 012800 Depending on MT-Count 012900 Ascending Key MT-City-Pair 013000 Indexed By Ndx. 013100 10 MT-City-Pair. 013200 15 MT-Org-City Pic X(03). 013300 15 Pic X(01). 013400 15 MT-Dst-Citu Pic X(03). 013500 10 Pic X(01). 013600 10 MT-Act-Miles Pic 9(05). 013700 013800 01 Pic 9 Value 0. 013900 88 Readend Value 1. 014000 88 Lineend Value 2. 014100 014200 77 Line-Table-Rows Pic 99 Value 1. 014300 01 Tables. 014400 05 Line-Table Occurs 25 Times 014500 Depending on Line-Table-Rows 014600 Ascending 014700 Key is Line-Table-Airline-Id 014800 Indexed by Lineindex. 014900 10 Line-Table-Airline-Id Pic X(02). 015000 10 Line-Table-Airline-Name Pic X(25). 015100 015200 Linkage Section. 015300 01 Parameter. 015400 05 Parameter-Len Pic S9(04) Binary. 015500 05 Date-Pgm-Parm-Data Pic X(07). 015600 015700*--------------------------------------- 015800 Procedure Division Using Parameter. 015900*--------------------------------------- 016000 Display '==> FREQREAD is starting...' 016100 Perform Open-Files 016200 Perform Check-Parameter-Len 016300 Perform Call-Datepgm 016400 Perform Fill-Line-Table 016500 Perform Fill-Mile-Table 016600 Perform Write-Freq-Header1 016700 Perform Write-Freq-Daterows 016800 Perform Write-Freq-Header2 016900 Perform Read-Freqfile Until End-Of-Freq-File 017000 Perform Write-Freq-Trailer 017100 Perform Close-Files 017200 Display '==> FREQREAD ended normally' 017300 GoBack 017400 . 017500*------------------------------------- 017600 Check-Parameter-Len. 017700*------------------------------------- 017800 If Parameter-Len = 0 017900 Display '*** Parameter missing' 018000 Move 12 to Return-Code 018100 GoBack 018200 End-If 018300 . 018400*------------------------------------- 018500 Call-Datepgm. 018600*------------------------------------- 018700 Call Date-Pgm Using 018800 Date-Pgm-Parm-Data 018900 Date-Pgm-Parm-Status 019000 Date-Pgm-Date-Row1 019100 Date-Pgm-Date-Row2 019200 019300 If Parm-Error 019400 Display '*** Parameter ' 019500 Date-Pgm-Parm-Data 019600 ' is invalid' 019700 Move 8 to Return-Code 019800 GoBack 019900 End-If 020000 . 020100*------------------------------------- 020200 Read-Freqfile. 020300*------------------------------------- 020400 Read Freqfile 020500 At End 020600 Set End-Of-Freq-File to True 020700 Not At End 020800 Perform Write-Freq-Detail 020900 End-Read 021000 . 021100*------------------------------------- 021200 Calculate-Bonus. 021300*------------------------------------- 021400 Evaluate True 021500 When Mileage in File-Record Less Than 500 021600 Move 500 to Incbonus-Value 021700 Incbonus in List-Detail 021800 When Tourist 021900 Move Mileage in File-Record to 022000 Incbonus-Value 022100 Incbonus in List-Detail 022200 When Business 022300 Compute Incbonus-Value = 022400 Mileage in File-Record * 1.25 022500 Move Incbonus-Value to 022600 Incbonus in List-Detail 022700 When Firstclass 022800 Compute Incbonus-Value = 022900 Mileage in File-Record * 1.50 023000 Move Incbonus-Value to 023100 Incbonus in List-Detail 023200 End-Evaluate 023300 023400 Add Incbonus-Value to Incbonus-Total 023500 . 023600*------------------------------------- 023700 Search-City-Pair-Table. 023800*------------------------------------- 023900 Move City-Pair in File-Record 024000 to TS-City-Pair 024100 Search All City-Pair-Table 024200 At End 024300 Perform Search-Reverse-City-Pair 024400 When MT-City-Pair(Ndx) = TS-City-Pair 024500 Move MT-Act-Miles(Ndx) to 024600 Mileage in List-Detail 024700 End-Search 024800 . 024900*------------------------------------- 025000 Search-Reverse-City-Pair. 025100*------------------------------------- 025200 Move Origin in File-Record to 025300 TS-Dst-City 025400 Move Dest in File-Record to 025500 TS-Org-City 025600 Search All City-Pair-Table 025700 At End 025800 Display 'Hittar inte City-Pair: ' 025900 TS-City-Pair 026000 Move 99 to Return-Code 026100 GoBack 026200 When MT-City-Pair(Ndx) = TS-City-Pair 026300 Move MT-Act-Miles(Ndx) to 026400 Mileage in List-Detail 026500 End-Search 026600 . 026700*------------------------------------- 026800 Fill-Mile-Table. 026900*------------------------------------- 027000 Call MT-Freqmile Using Mile-Table, MT-Count 027100 . 027200*------------------------------------- 027300 Fill-Line-Table. 027400*------------------------------------- 027500 Perform Until Lineend 027600 Read Freqline 027700 At End 027800 Set Lineend to True 027900 Not At End 028000 Move Airline-Id in Line-Record to 028100 Line-Table-Airline-Id(Line-Table-Rows) 028200 Move Airline-Name in Line-Record to 028300 Line-Table-Airline-Name(Line-Table-Rows) 028400 Add 1 to Line-Table-Rows 028500 End-Read 028600 End-Perform 028700 . 028800*------------------------------------- 028900 Search-Line-Table. 029000*------------------------------------- 029100 Search All Line-Table 029200 At End 029300 Move '*** N/A ***' to 029400 Airline-Name in List-Detail 029500 When Line-Table-Airline-Id(Lineindex) = 029600 Airline-Id in File-Record 029700 Move Line-Table-Airline-Name(Lineindex) to 029800 Airline-Name in List-Detail 029900 030000 End-Search 030100 . 030200*------------------------------------- 030300 Write-Freq-Daterows. 030400*------------------------------------- 030500 Write Listrow from Date-Row1 030600 Write Listrow from Date-Row2 030700 Write Listrow from List-Blankrow 030800 . 030900*------------------------------------- 031000 Write-Freq-Header1. 031100*------------------------------------- 031200 Write Listrow from List-Header1 031300 Write Listrow from List-Blankrow 031400 . 031500*------------------------------------- 031600 Write-Freq-Header2. 031700*------------------------------------- 031800 Write Listrow from List-Header2 031900 Write Listrow from List-Blankrow 032000 . 032100*------------------------------------- 032200 Write-Freq-Trailer. 032300*------------------------------------- 032400 Write Listrow from List-Blankrow 032500 Move Mileage-Total to 032600 Mileage in List-Trailer 032700 Move Incbonus-Total to 032800 Incbonus in List-Trailer 032900 Write Listrow from List-Trailer 033000 . 033100*------------------------------------- 033200 Write-Freq-Detail. 033300*------------------------------------- 033400 Perform Search-City-Pair-Table 033500 Perform Search-Line-Table 033600 Perform Calculate-Bonus 033700 Move Corr File-Record to List-Detail 033800 Add Mileage in File-Record to 033900 Mileage-Total 034000 034100 Write Listrow from List-Detail 034200 . 034300*------------------------------------- 034400 Open-Files. 034500*------------------------------------- 034600 Open Input FREQFILE 034700 If Freqfile-Openerror 034800 Display '==> Openerror: FREQFILE' 034900 Display '==> Status : ' Freqfile-Status 035000 Move 21 to Return-Code 035100 Goback 035200 End-If 035300 Display '==> FREQFILE is Open' 035400 035500 Open Input FREQLINE 035600 If Freqline-Openerror 035700 Display '==> Openerror: FREQLINE' 035800 Display '==> Status : ' Freqline-Status 035900 Move 21 to Return-Code 036000 Goback 036100 End-If 036200 Display '==> FREQLINE is Open' 036300 036400 Open Output FREQLIST 036500 If Freqlist-Openerror 036600 Display '==> Openerror: FREQLIST' 036700 Display '==> Status : ' Freqlist-Status 036800 Move 23 to Return-Code 036900 Goback 037000 End-If 037100 Display '==> FREQLIST is Open' 037200 . 037300*------------------------------------- 037400 Close-Files. 037500*------------------------------------- 037600 Close FREQFILE 037700 FREQLINE 037800 FREQLIST 037900 . 038000 End Program FREQPGM6. 038100