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