000100 Identification Division. 000200 Program-Id. FFPGM8. 000300*--------------------------------------------- 000400* Frequent Flyer DB2 - Uppgift 7 000500* Dagnamn i rapporten 000600*--------------------------------------------- 000700 Environment Division. 000800 Configuration Section. 000900 Special-Names. 001000 Decimal-Point is Comma 001100 . 001200 Input-Output Section. 001300 File-Control. 001400 Select FREQLIST Assign to FFLDD 001500 Organization is Sequential 001600 Access is Sequential 001700 File Status is Freqlist-Status 001800 . 001900 Data Division. 002000 File Section. 002100 002200 FD FREQLIST Recording mode F. 002300 01 Listrow Pic X(120). 002400 002500*--------------------------------------- 002600 Working-Storage Section. 002700*--------------------------------------- 002800 002900 77 Mileage-Total Pic 9(08) Value 0. 003000 77 Bonus-Total Pic 9(08). 003100 77 Mileage-Bonus Pic 9(08). 003200 77 WS-SQLCODE Pic +(09). 003300 77 FetchNumber Pic 99 Value 1. 003400 77 TableRowNumber Pic 99. 003500 77 PageNumber Pic 99 Value 1. 003600 003700 01 Indicator Pic 9(01) Value 0. 003800 88 Ejklar Value 0. 003900 88 Klar Value 1. 004000 004100 01 Freqlist-Status Pic X(02). 004200 88 Freqlist-Openerror Values '01' thru '99'. 004300 004400 01 List-Blankrow. 004500 05 Pic X(120) Value Spaces. 004600 004700 01 List-Header1. 004800 05 Pic X(35) Value 'Frequent Flyer Report'. 004900 005000 01 List-Header2. 005100 05 Flight-Datex Pic X(12) Value 'Date'. 005200 05 Pic X(09) Value 'Day'. 005300 05 Flight-Idx Pic X(24) Value ' Airline'. 005400 05 Flight-Numberx Pic X(06) Value 'FlÄ'. 005500 05 Class-Of-Travelx Pic X(03) Value 'Cl'. 005600 05 City-Pairx Pic X(09) Value 'C-Pair'. 005700 05 Mileagex Pic X(08) Value 'Mileage'. 005800 05 Incbonusx Pic X(11) Value 'Inc Bonus'. 005900 006000 01 List-Trailer1. 006100 05 Pic X(54) Value 'Total Mileage '. 006200 05 LT-Mileage Pic Z(08). 006300 05 Pic X(02). 006400 05 LT-Bonus Pic Z(08). 006500 006600 01 List-Trailer2. 006700 05 Pic X(05) Value 'Page '. 006800 05 LT-PageNumber Pic Z(02). 006900 007000 01 List-Detail. 007100 05 LD-Flight-Date Pic X(12). 007200 05 LD-Flight-Dayname Pic X(09). 007300 05 LD-Airline-Name Pic X(24). 007400 05 LD-Flight-Number Pic X(06). 007500 05 LD-Class-Of-Travel Pic X(03). 007600 05 LD-City-Pair Pic X(07). 007700 05 Pic X(02). 007800 05 LD-Mileage Pic Z(07). 007900 05 Pic X(03). 008000 05 LD-Bonus Pic Z(07). 008100 008200 77 Date-Pgm Pic X(08) Value 'FFDATED'. 008300 77 Date-Pgm-Parm-Status Pic 9. 008400 88 Parm-Error Value 0. 008500 88 Parm-OK Value 1. 008600 008700 01 Date-Row1. 008800 05 Pic X(20) Value 'Printed :'. 008900 05 Date-Pgm-Date-Row1 Pic X(50) Value Space. 009000 009100 01 Date-Row2. 009200 05 Pic X(20) Value 'Valid Until :'. 009300 05 Date-Pgm-Date-Row2 Pic X(50) Value Space. 009400 009500 01 List-Searchrow. 009600 05 Searchrow-Data1 Pic X(35) 009700 Value 'The following CITY-PAIRs searched:'. 009800 05 Searchrow-Data2 Pic X(40). 009900 010000 01 No-of-Search-City-Pairs Pic 9(02). 010100 01 SearchRow-Pointer Pic 9(02) Value 1. 010200 010300 01 Accept-City-PairCurrent Pic X(07). 010400 01 Accept-Search-City-Pair Pic X(07). 010500 010600 010700 Exec SQL 010800 Include 010900 SQLCA 011000 End-Exec 011100 . 011200 011300 Exec SQL 011400 Declare 011500 Flyerinfo Cursor 011600 For 011700 Select 011800 P.Flight_Number, 011900 P.Flight_Date, 012000 P.Class_of_Travel, 012100 F.City_pair, 012200 F.Airline_Id, 012300 M.Mileage, 012400 A.Airline_Name 012500 From Flyers P, MILEAGES M , FLIGHTS F, Airlines A 012600 Where 012700 ( 012800 P.Flight_Number = F.Flight_Number 012900 And 013000 F.Airline_Id = A.Airline_Id 013100 And 013200 F.City_Pair = M.City_Pair 013300 ) 013400 Or 013500 ( 013600 P.Flight_Number = F.Flight_Number 013700 And (Substr(F.City_Pair,1,3) = 013800 Substr(M.City_Pair,5,3)) 013900 And 014000 Substr(F.City_Pair,5,3) = 014100 Substr(M.City_Pair,1,3) 014200 And 014300 F.Airline_Id = A.Airline_Id 014400 ) 014500 Order By P.Flight_Date, F.Airline_Id 014600 End-Exec 014700 . 014800 01 Allocate-Data. 014900 05 All-Heap-Id Pic S9(08) Binary Value 0. 015000 05 All-Number-of-Rows Pic S9(08) Binary Value 1. 015100 05 All-Number-of-Bytes Pic S9(08) Binary. 015200 05 All-Pointer Pointer. 015300 05 All-RC Pic S9(08) Binary. 015400 88 All-OK Value 0. 015500 05 All-Storage-Pgm Pic X(08) Value 'CEEGTST'. 015600 015700 01 Flyerinfo-Row. 015800 05 WS-Flight-Date Pic X(10). 015900 05 WS-Flight-Number Pic X(04). 016000 05 WS-Class-Of-Travel Pic X(01). 016100 05 WS-City-Pair Pic X(07). 016200 05 Ws-Mileage Pic S9(05) Packed-Decimal. 016300 05 WS-Airline-Id Pic X(02). 016400 05 WS-Airline-Name Pic X(25). 016500 016600 01 Search-City-Pair-Ind Pic 9(01) Value 0. 016700 88 City-Pair-Not-Found Value 0. 016800 88 City-Pair-Found Value 1. 016900 017000 77 Accepted-Num Pic 9(02) Value 0. 017100 017200 01 Accepted-City-Pairs. 017300 05 A-City-Pair-Current Pic X(07). 017400 05 A-City-Pair-Last Pic X(07) VAlue Space. 017500 05 Pic 9(01) Value 0. 017600 88 Accept-Ready Value 1. 017700 05 A-City-Pair Occurs 20 Depending on Accepted-Num 017800 Indexed By CPX1. 017900 10 A-Origin Pic X(03). 018000 10 Pic X(01). 018100 10 A-Dest Pic X(03). 018200 018300 Linkage Section. 018400 01 Parameter. 018500 05 Parameter-Len Pic S9(04) Binary. 018600 05 Date-Pgm-Parm-Data Pic X(07). 018700 88 Dayname Value 'DATED'. 018800 018900 01 FlyerTable. 019000 05 FlyerTable-Row Occurs 1 to 1000 019100 Depending on All-Number-Of-Rows 019200 Indexed by FlyerX1 019300 . 019400 10 Flight-Date Pic X(10). 019500 10 Flight-Number Pic X(04). 019600 10 Class-Of-Travel Pic X(01). 019700 88 TouristClass Value 'Y'. 019800 88 BusinessClass Value 'C'. 019900 88 FirstClass Value 'F'. 020000 10 City-Pair Pic X(07). 020100 10 Mileage Pic S9(05) Packed-Decimal. 020200 10 Airline-Id Pic X(02). 020300 10 Airline-Name Pic X(25). 020400 020500*--------------------------------------- 020600 Procedure Division Using Parameter. 020700*--------------------------------------- 020800 Display '==> FFPGM1 is starting...' 020900 Perform Open-Files 021000 Perform Count-Number-of-Rows. 021100 Perform Allocate-Storage. 021200 Perform Call-Datepgm 021300 Perform Write-Freq-Headers 021400 Perform Open-Cursor 021500 Perform Fetch-Flyerinfo-to-Table Until Klar 021600 Perform Close-Cursor 021700 Perform Accept-City-Pair 021800 Perform Write-Freq-Detail 021900 Varying TableRowNumber from 1 by 1 022000 Until TableRowNumber > All-Number-Of-Rows 022100 Perform Write-Freq-Trailer 022200 Perform Close-Files 022300 Display '==> FFPGM1 ended normally' 022400 GoBack 022500 . 022600*------------------------------------- 022700 Accept-City-Pair. 022800*------------------------------------- 022900 Accept A-City-Pair-Current 023000 Perform Until Accept-Ready 023100 Display '*** Accepted: ' A-City-Pair-Current 023200 If A-City-Pair-Current = A-City-Pair-Last 023300 Set Accept-Ready to True 023400 Else 023500 Add 1 to Accepted-Num 023600 Move A-City-Pair-Current to 023700 A-City-Pair(Accepted-Num) A-City-Pair-Last 023800 Accept A-City-Pair-Current 023900 End-If 024000 End-Perform 024100 . 024200*------------------------------------- 024300 Check-City-Pair-Request. 024400*------------------------------------- 024500 Set CPX1 to 1 024600 Search A-City-Pair 024700 At End 024800 Set City-Pair-Not-Found to True 024900 When A-City-Pair(CPX1) = 025000 City-Pair(TableRowNumber) 025100 Display '*** Found dest-request: ' 025200 A-City-Pair(CPX1) 025300 Set City-Pair-Found to True 025400 End-Search 025500 . 025600 025700*------------------------------------- 025800 Count-Number-of-Rows. 025900*------------------------------------- 026000 Exec SQL 026100 Select Count(*) 026200 Into :All-Number-of-Rows 026300 From Flights 026400 End-Exec 026500 Display '*** Number of rows: ' All-Number-of-Rows 026600 . 026700*------------------------------------- 026800 Allocate-Storage. 026900*------------------------------------- 027000 Multiply Length of Flyertable-Row 027100 By All-Number-Of-Rows 027200 Giving All-Number-Of-Bytes 027300 027400 Call All-Storage-Pgm Using 027500 All-Heap-Id, 027600 All-Number-of-Bytes, 027700 All-Pointer 027800 All-RC 027900 If Not All-OK 028000 Display '*** Error allocation storage: ' 028100 All-RC 028200 Display '*** Number of bytes : ' 028300 All-Number-of-Bytes 028400 Move 999 to Return-Code 028500 Stop Run 028600 Else 028700 Set Address of FlyerTable to All-Pointer 028800 End-If 028900 . 029000*------------------------------------- 029100 Call-Datepgm. 029200*------------------------------------- 029300 Call Date-Pgm Using 029400 Date-Pgm-Parm-Data 029500 Date-Pgm-Parm-Status 029600 Date-Pgm-Date-Row1 029700 Date-Pgm-Date-Row2 029800 029900 If Parm-Error 030000 Display '*** Parameter ' 030100 Date-Pgm-Parm-Data 030200 ' is invalid' 030300 Move 8 to Return-Code 030400 GoBack 030500 End-If 030600 . 030700*------------------------------------- 030800 Fetch-Flyerinfo-to-Table. 030900*------------------------------------- 031000 Exec SQL 031100 Fetch Flyerinfo 031200 Into 031300 :WS-Flight-Number, 031400 :WS-Flight-Date, 031500 :WS-Class-Of-Travel, 031600 :WS-City-Pair, 031700 :WS-Airline-Id, 031800 :WS-Mileage, 031900 :WS-Airline-Name 032000 End-Exec 032100 Evaluate SQLCODE 032200 When 0 032300 Display '*** Fetching Flyerinfo: ' FetchNumber 032400 Move FlyerInfo-Row to 032500 FlyerTable-Row(FetchNumber) 032600 Display '*** Table ' FlyerTable-Row(FetchNumber) 032700 Display '*** Info ' FlyerInfo-Row 032800 Add 1 to FetchNumber 032900 When 100 033000 Set Klar to True 033100 Display '*** Number of rows: ' 033200 All-Number-of-Rows 033300 Display '*** FetchNumber : ' 033400 FetchNumber 033500 When Other 033600 Perform SQL-Error 033700 End-Evaluate 033800 . 033900*--------------------------------------- 034000 SQL-Error. 034100*--------------------------------------- 034200 Move SQLCODE to WS-SQLCODE 034300 Display '*** SQL-Fel ***' 034400 Display 'SQLCODE : ' WS-SQLCODE 034500 Display 'SQLSTATE : ' SQLSTATE 034600 Display 'SQLMedd : ' SQLERRMC(1:SQLERRML) 034700 Move 99 to Return-Code 034800 Set Klar to True 034900 . 035000*------------------------------------- 035100 Write-Freq-Headers. 035200*------------------------------------- 035300 Write Listrow from List-Header1 035400 Write Listrow from List-Blankrow 035500 Perform Write-Freq-Daterows 035600 Write Listrow from List-Header2 035700 Write Listrow from List-Blankrow 035800 . 035900*------------------------------------- 036000 Write-Freq-Trailer. 036100*------------------------------------- 036200 Write Listrow from List-Blankrow 036300 Move Mileage-Total to 036400 LT-Mileage in List-Trailer1 036500 036600 Move Bonus-Total to 036700 LT-Bonus 036800 036900 Write Listrow from List-Trailer1 037000 Write Listrow from List-Blankrow 037100 Perform Write-List-Searchrow 037200 Write Listrow from List-Blankrow 037300 Move PageNumber to LT-PageNumber 037400 Write Listrow from List-Blankrow 037500 Write Listrow from List-Trailer2 037600 . 037700*------------------------------------- 037800 Write-Freq-Daterows. 037900*------------------------------------- 038000 Write Listrow from Date-Row1 038100 Write Listrow from Date-Row2 038200 Write Listrow from List-Blankrow 038300 . 038400*------------------------------------- 038500 Write-Freq-Detail. 038600*------------------------------------- 038700 Perform Check-City-Pair-Request 038800 If City-Pair-Found 038900 Add Mileage(TableRowNumber) 039000 to Mileage-Total 039100 Move Mileage(TableRowNumber) to LD-Mileage 039200 039300 Perform Calculate-Bonus 039400 039500 Add Mileage-Bonus to Bonus-Total 039600 Move Mileage-Bonus to LD-Bonus 039700 Move Flight-Date(TableRowNumber) 039800 to LD-Flight-Date 039900 Move Flight-Number(TableRowNumber) 040000 to LD-Flight-Number 040100 Move Class-Of-Travel(TableRowNumber) 040200 to LD-Class-Of-Travel 040300 Move City-Pair(TableRowNumber) 040400 to LD-City-Pair 040500 Move Airline-Name(TableRowNumber) 040600 to LD-Airline-Name 040700 040800 Set Dayname to True 040900 Move Flight-Date(TableRowNumber) to 041000 Date-Pgm-Date-Row1 041100 Perform Call-Datepgm 041200 041300 Move Date-Pgm-Date-Row2 to 041400 LD-Flight-Dayname 041500 041600 Write Listrow from List-Detail 041700 End-If 041800 . 041900*------------------------------------- 042000 Write-List-Searchrow. 042100*------------------------------------- 042200 Perform Varying No-of-Search-City-Pairs 042300 From 1 by 1 Until 042400 No-of-Search-City-Pairs > 042500 Accepted-Num 042600 String 042700 A-City-Pair(No-of-Search-City-Pairs) 042800 ',' Delimited By SIze 042900 Into Searchrow-Data2 043000 With Pointer Searchrow-Pointer 043100 End-String 043200 End-Perform 043300 Move Space to Searchrow-Data2 043400 (Searchrow-Pointer - 1:1) 043500 Write Listrow from List-Blankrow 043600 Write Listrow from List-Searchrow 043700 . 043800*------------------------------------- 043900 Calculate-Bonus. 044000*------------------------------------- 044100 If Mileage(TableRowNumber) <= 500 044200 Move 500 to LD-Bonus Mileage-Bonus 044300 Else 044400 Evaluate True 044500 When TouristClass(TableRowNumber) 044600 Move Mileage(TableRowNumber) 044700 to Mileage-Bonus 044800 When BusinessClass(TableRowNumber) 044900 Multiply Mileage(TableRowNumber) by 1,25 045000 Giving Mileage-Bonus 045100 When FirstClass(TableRowNumber) 045200 Multiply Mileage(TableRowNumber) by 1,50 045300 Giving Mileage-Bonus 045400 When Other 045500 Display '*** Invalid Class-Of-Travel : ' 045600 LD-Class-Of-Travel 045700 Move 999 to Return-Code 045800 Stop Run 045900 End-Evaluate 046000 End-If 046100 . 046200*------------------------------------- 046300 Open-Cursor. 046400*------------------------------------- 046500 Exec SQL 046600 Open 046700 Flyerinfo 046800 End-Exec 046900 . 047000*------------------------------------- 047100 Close-Cursor. 047200*------------------------------------- 047300 Exec SQL 047400 Close 047500 Flyerinfo 047600 End-Exec 047700 Display '*** Cursor Flyerinfo closed' 047800 . 047900*------------------------------------- 048000 Open-Files. 048100*------------------------------------- 048200 Open Output FREQLIST 048300 If Freqlist-Openerror 048400 Display '==> Openerror: FREQLIST' 048500 Display '==> Status : ' Freqlist-Status 048600 Move 22 to Return-Code 048700 Goback 048800 End-If 048900 Display '==> FREQLIST is Open' 049000 . 049100*------------------------------------- 049200 Close-Files. 049300*------------------------------------- 049400 Close FREQLIST 049500 . 049600 End Program FFPGM8. 049700