000100 Identification Division. 000200 Program-Id. FREQPGMD. 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 MileageXX 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 'FREQMILD'. 012000 77 MT-City-Pair Pic X(07). 012100 77 MT-Pekare Pointer. 012200 012300 012400 01 Pic 9 Value 0. 012500 88 Readend Value 1. 012600 88 Lineend Value 2. 012700 012800 77 Line-Table-Rows Pic 99 Value 1. 012900 01 Tables. 013000 05 Line-Table Occurs 25 Times 013100 Depending on Line-Table-Rows 013200 Ascending 013300 Key is Line-Table-Airline-Id 013400 Indexed by Lineindex. 013500 10 Line-Table-Airline-Id Pic X(02). 013600 10 Line-Table-Airline-Name Pic X(25). 013700 013800 Linkage Section. 013900 77 LS-MT-Mileage Pic 9(05). 014000 014100 01 Parameter. 014200 05 Parameter-Len Pic S9(04) Binary. 014300 05 Date-Pgm-Parm-Data Pic X(07). 014400 014500*--------------------------------------- 014600 Procedure Division Using Parameter. 014700*--------------------------------------- 014800 Display '==> FREQREAD is starting...' 014900 Perform Open-Files 015000 Perform Check-Parameter-Len 015100 Perform Call-Datepgm 015200 Perform Fill-Line-Table 015300 Perform Write-Freq-Header1 015400 Perform Write-Freq-Daterows 015500 Perform Write-Freq-Header2 015600 Perform Read-Freqfile Until End-Of-Freq-File 015700 Perform Write-Freq-Trailer 015800 Perform Close-Files 015900 Display '==> FREQREAD ended normally' 016000 GoBack 016100 . 016200*------------------------------------- 016300 Check-Parameter-Len. 016400*------------------------------------- 016500 If Parameter-Len = 0 016600 Display '*** Parameter missing' 016700 Move 12 to Return-Code 016800 GoBack 016900 End-If 017000 . 017100*------------------------------------- 017200 Call-Datepgm. 017300*------------------------------------- 017400 Call Date-Pgm Using 017500 Date-Pgm-Parm-Data 017600 Date-Pgm-Parm-Status 017700 Date-Pgm-Date-Row1 017800 Date-Pgm-Date-Row2 017900 018000 If Parm-Error 018100 Display '*** Parameter ' 018200 Date-Pgm-Parm-Data 018300 ' is invalid' 018400 Move 8 to Return-Code 018500 GoBack 018600 End-If 018700 . 018800*------------------------------------- 018900 Read-Freqfile. 019000*------------------------------------- 019100 Read Freqfile 019200 At End 019300 Set End-Of-Freq-File to True 019400 Not At End 019500 Perform Write-Freq-Detail 019600 End-Read 019700 . 019800*------------------------------------- 019900 Calculate-Bonus. 020000*------------------------------------- 020100 Evaluate True 020200 When LS-MT-Mileage Less Than 500 020300 Move 500 to Incbonus-Value 020400 Incbonus in List-Detail 020500 When Tourist 020600 Move LS-MT-Mileage to 020700 Incbonus-Value 020800 Incbonus in List-Detail 020900 When Business 021000 Compute Incbonus-Value = 021100 LS-MT-Mileage * 1.25 021200 Move Incbonus-Value to 021300 Incbonus in List-Detail 021400 When Firstclass 021500 Compute Incbonus-Value = 021600 LS-MT-Mileage * 1.50 021700 Move Incbonus-Value to 021800 Incbonus in List-Detail 021900 End-Evaluate 022000 022100 Add Incbonus-Value to Incbonus-Total 022200 . 022300*------------------------------------- 022400 Call-Search-City-Pair-Table. 022500*------------------------------------- 022600 Move City-Pair in File-Record 022700 to MT-City-Pair 022800 Call MT-Freqmile Using MT-City-Pair, 022900 MT-Pekare 023000 If MT-Pekare = Null 023100 Display 'Hittar inte City-Pair: ' 023200 MT-City-Pair 023300 Move 99 to Return-Code 023400 GoBack 023500 Else 023600 Set Address of LS-MT-Mileage to MT-Pekare 023700 Move LS-MT-Mileage to 023800 Mileage in List-Detail 023900 End-If 024000 . 024100*------------------------------------- 024200 Fill-Line-Table. 024300*------------------------------------- 024400 Perform Until Lineend 024500 Read Freqline 024600 At End 024700 Set Lineend to True 024800 Not At End 024900 Move Airline-Id in Line-Record to 025000 Line-Table-Airline-Id(Line-Table-Rows) 025100 Move Airline-Name in Line-Record to 025200 Line-Table-Airline-Name(Line-Table-Rows) 025300 Add 1 to Line-Table-Rows 025400 End-Read 025500 End-Perform 025600 . 025700*------------------------------------- 025800 Search-Line-Table. 025900*------------------------------------- 026000 Search All Line-Table 026100 At End 026200 Move '*** N/A ***' to 026300 Airline-Name in List-Detail 026400 When Line-Table-Airline-Id(Lineindex) = 026500 Airline-Id in File-Record 026600 Move Line-Table-Airline-Name(Lineindex) to 026700 Airline-Name in List-Detail 026800 026900 End-Search 027000 . 027100*------------------------------------- 027200 Write-Freq-Daterows. 027300*------------------------------------- 027400 Write Listrow from Date-Row1 027500 Write Listrow from Date-Row2 027600 Write Listrow from List-Blankrow 027700 . 027800*------------------------------------- 027900 Write-Freq-Header1. 028000*------------------------------------- 028100 Write Listrow from List-Header1 028200 Write Listrow from List-Blankrow 028300 . 028400*------------------------------------- 028500 Write-Freq-Header2. 028600*------------------------------------- 028700 Write Listrow from List-Header2 028800 Write Listrow from List-Blankrow 028900 . 029000*------------------------------------- 029100 Write-Freq-Trailer. 029200*------------------------------------- 029300 Write Listrow from List-Blankrow 029400 Move Mileage-Total to 029500 Mileage in List-Trailer 029600 Move Incbonus-Total to 029700 Incbonus in List-Trailer 029800 Write Listrow from List-Trailer 029900 . 030000*------------------------------------- 030100 Write-Freq-Detail. 030200*------------------------------------- 030300 Perform Call-Search-City-Pair-Table 030400 Perform Search-Line-Table 030500 Perform Calculate-Bonus 030600 Move Corr File-Record to List-Detail 030700 Add LS-MT-Mileage to 030800 Mileage-Total 030900 031000 Write Listrow from List-Detail 031100 . 031200*------------------------------------- 031300 Open-Files. 031400*------------------------------------- 031500 Open Input FREQFILE 031600 If Freqfile-Openerror 031700 Display '==> Openerror: FREQFILE' 031800 Display '==> Status : ' Freqfile-Status 031900 Move 21 to Return-Code 032000 Goback 032100 End-If 032200 Display '==> FREQFILE is Open' 032300 032400 Open Input FREQLINE 032500 If Freqline-Openerror 032600 Display '==> Openerror: FREQLINE' 032700 Display '==> Status : ' Freqline-Status 032800 Move 21 to Return-Code 032900 Goback 033000 End-If 033100 Display '==> FREQLINE is Open' 033200 033300 Open Output FREQLIST 033400 If Freqlist-Openerror 033500 Display '==> Openerror: FREQLIST' 033600 Display '==> Status : ' Freqlist-Status 033700 Move 23 to Return-Code 033800 Goback 033900 End-If 034000 Display '==> FREQLIST is Open' 034100 . 034200*------------------------------------- 034300 Close-Files. 034400*------------------------------------- 034500 Close FREQFILE 034600 FREQLINE 034700 FREQLIST 034800 . 034900 End Program FREQPGMD. 035000