000100 Identification Division. 000200 Program-Id. FFPGM6. 000300*--------------------------------------------- 000400* Frequent Flyer DB2 - Uppgift 6 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 . 001810 Select FREQDATE Assign to FFDDD 001820 Organization is Sequential 001830 Access is Sequential 001840 File Status is Freqdate-Status 001850 . 001900 Data Division. 002000 File Section. 002100 002200 FD FREQLIST Recording mode F. 002300 01 Listrow Pic X(120). 002400 002410 FD FREQDATE Recording mode F. 002420 01 Daterow Pic X(80). 002430 002500*--------------------------------------- 002600 Working-Storage Section. 002700*--------------------------------------- 002701 01 WS-Daterow. 002710 05 Date-Start Pic X(10) Value '2000-01-01'. 002711 05 Date-Sep Pic X(01). 002712 88 OK-Date-Sep Value '+'. 002720 05 Date-End Pic X(10) Value '2099-12-31'. 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'. 004101 004130 01 Freqdate-Status Pic X(02). 004140 88 Search-Date-File Values '00'. 004150 88 No-Search-Date-File Values '01' thru '97'. 004160 88 Search-Date-Record Value '98'. 004170 88 No-Search-Date-Record Value '99'. 004180 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 009810 01 Date-Row3. 009820 05 Pic X(20) Value 'Search Interval:'. 009830 05 DR3-Start Pic X(10). 009840 05 Pic X(03) Value ' - '. 009850 05 DR3-End Pic X(10). 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 011910 P.Flight_Date Between :Date-Start and :Date-End 011920 and 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 012510 P.Flight_Date Between :Date-Start and :Date-End 012520 and 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 014710 Perform Read-Freqdate 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 Read-Freqdate. 015800*------------------------------------- 015801 If Search-Date-File 015802 Read Freqdate Into WS-Daterow 015803 At End 015804 Set No-Search-Date-Record to True 015806 Not At end 015807 Evaluate True 015808 When Not OK-Date-Sep 015809 Display '*** Parameter format incorrect' 015810 Display '*** Must be yyyy-dd-mm+yyyy-dd-mm' 015811 Move 99 to Return-Code 015812 GoBack 015813 When Date-Start(6:2) > 12 or 015814 Date-Start(9:2) > 31 015815 Display '*** Invalid Date-Start value' 015816 Display '*** ' Date-Start 015817 Move 98 to Return-Code 015818 GoBack 015819 When Date-End(6:2) > 12 or 015820 Date-End(9:2) > 31 015821 Display '*** Invalid Date-End value' 015822 Move 98 to Return-Code 015823 Display '*** ' Date-End 015824 GoBack 015825 When Other 015826 Move Date-Start to DR3-Start 015827 Move Date-End to DR3-End 015831 Set Search-Date-Record to True 015832 End-Evaluate 015833 End-Read 015834 Else 015835 Set No-Search-Date-Record to True 015836 Move '*' to DR3-Start DR3-End 015837 End-If 015838 . 015839*------------------------------------- 015840 Call-Datepgm. 015850*------------------------------------- 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 023810 Write Listrow from Date-Row3 023820 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 029010 Else 029020 Open Input FREQDATE 029100 End-If 029200 Display '==> FREQLIST is Open' 029210 Display '==> FREQDATE may be open' 029300 . 029400*------------------------------------- 029500 Close-Files. 029600*------------------------------------- 029700 Close FREQLIST 029800 . 029900 End Program FFPGM6. 030000