000100 Identification Division. 000200 Program-Id. FFPGM5. 000300*--------------------------------------------- 000400* Frequent Flyer DB2 - Uppgift 5 000500*--------------------------------------------- 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 Mileage-Bonus Pic 9(08). 003100 77 Mileage-Bonus-Total Pic 9(08). 003200 77 Mileage-Dec Pic S9(05) Packed-Decimal Value 0. 003300 77 WS-SQLCODE Pic +(09). 003400 77 FetchNumber Pic 99 Value 0. 003500 77 PageNumber Pic 99 Value 1. 003600 003700 01 Cursorinfo Pic 9(01). 003800 88 Klar Value 1. 003900 004000 01 Freqlist-Status Pic X(02). 004100 88 Freqlist-Openerror Values '01' thru '99'. 004200 004300 01 List-Blankrow. 004400 05 Pic X(120) Value Spaces. 004500 004600 01 List-Header1. 004700 05 Pic X(35) Value 'Frequent Flyer Report'. 004800 004900 01 List-Header2. 005000 05 Flight-Datex Pic X(13) Value 'Date'. 005100 05 Flight-Idx Pic X(24) Value 'Airline'. 005200 05 Flight-Numberx Pic X(06) Value 'FlÄ'. 005300 05 Class-Of-Travelx Pic X(03) Value 'Cl'. 005400 05 City-Pairx Pic X(09) Value 'C-Pair'. 005500 05 Mileagex Pic X(08) Value 'Mileage'. 005600 05 Incbonusx Pic X(11) Value 'Inc Bonus'. 005700 005800 01 List-Trailer1. 005900 05 Pic X(54) Value 'Total Mileage '. 006000 05 LT-Mileage Pic Z(08). 006100 05 Pic X(02). 006200 05 LT-Bonus Pic Z(08). 006300 006400 01 List-Trailer2. 006500 05 Pic X(05) Value 'Page '. 006600 05 LT-PageNumber Pic Z(02). 006700 006800 01 List-Detail. 006900 05 Flight-Date Pic X(10). 007000 05 Pic X(02). 007100 05 Airline-Id Pic X(23). 007200 05 Pic X(02). 007300 05 Flight-Number Pic X(04). 007400 05 Pic X(02). 007500 05 Class-Of-Travel Pic X(01). 007600 88 TouristClass Value 'Y'. 007700 88 BusinessClass Value 'C'. 007800 88 FirstClass Value 'F'. 007900 05 Pic X(02). 008000 05 City-Pair Pic X(07). 008100 05 Pic X(02). 008200 05 Mileage Pic Z(07). 008300 05 Pic X(03). 008400 05 Bonus Pic Z(07). 008500 008600 77 Date-Pgm Pic X(08) Value 'FFDATE'. 008700 77 Date-Pgm-Parm-Status Pic 9. 008800 88 Parm-Error Value 0. 008900 88 Parm-OK Value 1. 009000 009100 01 Date-Row1. 009200 05 Pic X(20) Value 'Printed :'. 009300 05 Date-Pgm-Date-Row1 Pic X(50) Value Space. 009400 009500 01 Date-Row2. 009600 05 Pic X(20) Value 'Valid Until :'. 009700 05 Date-Pgm-Date-Row2 Pic X(50) Value Space. 009800 009900 010000 Exec SQL 010100 Include 010200 SQLCA 010300 End-Exec 010400 . 010500 010600 Exec SQL 010700 Declare 010800 Flyerinfo Cursor 010900 For 011000 Select 011100 P.Flight_Number, 011200 P.Flight_Date, 011300 P.Class_of_Travel, 011400 F.City_pair, 011500 F.Airline_Id, 011600 M.Mileage, 011700 A.Airline_Name 011800 From Flyers P, MILEAGES M , FLIGHTS F, Airlines A 011900 Where 012000 P.Flight_Number = F.Flight_Number 012100 And 012200 F.Airline_Id = A.Airline_Id 012300 And 012400 F.City_Pair = M.City_Pair 012500 Or 012600 P.Flight_Number = F.Flight_Number 012700 And (Substr(F.City_Pair,1,3) = 012800 Substr(M.City_Pair,5,3)) 012900 And 013000 Substr(F.City_Pair,5,3) = 013100 Substr(M.City_Pair,1,3) 013200 And 013300 F.Airline_Id = A.Airline_Id 013400 Order By P.Flight_Date, F.Airline_Id 013500 End-Exec 013600 . 013700 Linkage Section. 013800 01 Parameter. 013900 05 Parameter-Len Pic S9(04) Binary. 014000 05 Date-Pgm-Parm-Data Pic X(07). 014100 014200*--------------------------------------- 014300 Procedure Division Using Parameter. 014400*--------------------------------------- 014500 Display '==> FFPGM1 is starting...' 014600 Perform Open-Files 014700 Perform Call-Datepgm 014800 Perform Open-Cursor 014900 Perform Write-Freq-Headers 015000 Perform Fetch-Flyerinfo Until Klar 015100 Perform Write-Freq-Trailer 015200 Perform Close-Files 015300 Display '==> FFPGM1 ended normally' 015400 GoBack 015500 . 015600*------------------------------------- 015700 Call-Datepgm. 015800*------------------------------------- 015900 Call Date-Pgm Using 016000 Date-Pgm-Parm-Data 016100 Date-Pgm-Parm-Status 016200 Date-Pgm-Date-Row1 016300 Date-Pgm-Date-Row2 016400 016500 If Parm-Error 016600 Display '*** Parameter ' 016700 Date-Pgm-Parm-Data 016800 ' is invalid' 016900 Move 8 to Return-Code 017000 GoBack 017100 End-If 017200 . 017300*------------------------------------- 017400 Fetch-Flyerinfo. 017500*------------------------------------- 017600 Add 1 to FetchNumber 017700 Display '*** Fetching Flyerinfo: ' FetchNumber 017800 Exec SQL 017900 Fetch Flyerinfo 018000 Into 018100 :Flight-Number, 018200 :Flight-Date, 018300 :Class-Of-Travel, 018400 :City-Pair, 018500 :Airline-Id, 018600 :Mileage-Dec, 018700 :Airline-Id 018800 End-Exec 018900 Evaluate SQLCODE 019000 When 0 019100 Perform Write-Freq-Detail 019200 When 100 019300 Set Klar to True 019400 When Other 019500 Perform SQL-Error 019600 End-Evaluate 019700 . 019800*--------------------------------------- 019900 SQL-Error. 020000*--------------------------------------- 020100 Move SQLCODE to WS-SQLCODE 020200 Display '*** SQL-Fel ***' 020300 Display 'SQLCODE : ' WS-SQLCODE 020400 Display 'SQLSTATE : ' SQLSTATE 020500 Display 'SQLMedd : ' SQLERRMC(1:SQLERRML) 020600 Move 99 to Return-Code 020700 Set Klar to True 020800 . 020900*------------------------------------- 021000 Write-Freq-Headers. 021100*------------------------------------- 021200 Write Listrow from List-Header1 021300 Write Listrow from List-Blankrow 021400 Perform Write-Freq-Daterows 021500 Write Listrow from List-Header2 021600 Write Listrow from List-Blankrow 021700 . 021800*------------------------------------- 021900 Write-Freq-Trailer. 022000*------------------------------------- 022100 Write Listrow from List-Blankrow 022200 Move Mileage-Total to 022300 LT-Mileage in List-Trailer1 022400 022500 Move Mileage-Bonus-Total to 022600 LT-Bonus 022700 022800 Write Listrow from List-Trailer1 022900 Move PageNumber to LT-PageNumber 023000 Write Listrow from List-Blankrow 023100 Write Listrow from List-Trailer2 023200 . 023300*------------------------------------- 023400 Write-Freq-Daterows. 023500*------------------------------------- 023600 Write Listrow from Date-Row1 023700 Write Listrow from Date-Row2 023800 Write Listrow from List-Blankrow 023900 . 024000*------------------------------------- 024100 Write-Freq-Detail. 024200*------------------------------------- 024300 Add Mileage-Dec to 024400 Mileage-Total 024500 Move Mileage-Dec to Mileage 024600 Perform Calculate-Bonus 024700 Add Mileage-Bonus to Mileage-Bonus-Total 024800 Move Mileage-Bonus to Bonus 024900 Write Listrow from List-Detail 025000 . 025100*------------------------------------- 025200 Calculate-Bonus. 025300*------------------------------------- 025400 If Mileage-Dec <= 500 025500 Move 500 to Mileage-Dec Mileage-Bonus 025600 Else 025700 Evaluate True 025800 When TouristClass 025900 Move Mileage-Dec to Mileage-Bonus 026000 When BusinessClass 026100 Multiply Mileage-Dec by 1,25 026200 Giving Mileage-Bonus 026300 When FirstClass 026400 Multiply Mileage-Dec by 1,50 026500 Giving Mileage-Bonus 026600 When Other 026700 Display '*** Invalid Class-Of-Travel : ' 026800 Class-Of-Travel 026900 Move 999 to Return-Code 027000 Stop Run 027100 End-Evaluate 027200 End-If 027300 . 027400*------------------------------------- 027500 Open-Cursor. 027600*------------------------------------- 027700 Exec SQL 027800 Open 027900 Flyerinfo 028000 End-Exec 028100 . 028200*------------------------------------- 028300 Open-Files. 028400*------------------------------------- 028500 Open Output FREQLIST 028600 If Freqlist-Openerror 028700 Display '==> Openerror: FREQLIST' 028800 Display '==> Status : ' Freqlist-Status 028900 Move 22 to Return-Code 029000 Goback 029100 End-If 029200 Display '==> FREQLIST is Open' 029300 . 029400*------------------------------------- 029500 Close-Files. 029600*------------------------------------- 029700 Close FREQLIST 029800 . 029900 End Program FFPGM5. 030000