000100 Identification Division. 000200 Program-Id. FFPGM4. 000210*--------------------------------------------- 000220* Frequent Flyer DB2 - Uppgift 4 000230*--------------------------------------------- 000300 Environment Division. 000301 Configuration Section. 000310 Special-Names. 000320 Decimal-Point is Comma 000330 . 000400 Input-Output Section. 000500 File-Control. 001200 Select FREQLIST Assign to FFLDD 001300 Organization is Sequential 001400 Access is Sequential 001500 File Status is Freqlist-Status 001600 . 001700 Data Division. 001800 File Section. 003000 003100 FD FREQLIST Recording mode F. 003200 01 Listrow Pic X(120). 003300 003400*--------------------------------------- 003500 Working-Storage Section. 003600*--------------------------------------- 003700 003800 77 Mileage-Total Pic 9(08) Value 0. 003801 77 Mileage-Bonus Pic 9(08). 003802 77 Mileage-Bonus-Total Pic 9(08). 003810 77 Mileage-Dec Pic S9(05) Packed-Decimal Value 0. 003811 77 WS-SQLCODE Pic +(09). 003812 77 FetchNumber Pic 99 Value 0. 003813 77 PageNumber Pic 99 Value 1. 003820 003830 01 Cursorinfo Pic 9(01). 003840 88 Klar Value 1. 003900 004200 01 Freqlist-Status Pic X(02). 004300 88 Freqlist-Openerror Values '01' thru '99'. 004400 004500 01 List-Blankrow. 004600 05 Pic X(120) Value Spaces. 004700 004800 01 List-Header1. 004900 05 Pic X(35) Value 'Frequent Flyer Report'. 005000 005100 01 List-Header2. 005200 05 Flight-Datex Pic X(12) Value 'Date'. 005300 05 Flight-Idx Pic X(04) Value 'AlÄ'. 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'. 005710 05 Incbonusx Pic X(11) Value 'Inc Bonus'. 005800 005900 01 List-Trailer1. 006000 05 Pic X(33) Value 'Total Mileage '. 006100 05 LT-Mileage Pic Z(08). 006110 05 Pic X(02). 006120 05 LT-Bonus Pic Z(08). 006200 006210 01 List-Trailer2. 006220 05 Pic X(05) Value 'Page '. 006230 05 LT-PageNumber Pic Z(02). 006240 006300 01 List-Detail. 006400 05 Flight-Date Pic X(10). 006500 05 Pic X(02). 006600 05 Airline-Id Pic X(02). 006700 05 Pic X(02). 006800 05 Flight-Number Pic X(04). 006900 05 Pic X(02). 007000 05 Class-Of-Travel Pic X(01). 007010 88 TouristClass Value 'Y'. 007020 88 BusinessClass Value 'C'. 007030 88 FirstClass Value 'F'. 007100 05 Pic X(02). 007200 05 City-Pair Pic X(07). 007300 05 Pic X(02). 007400 05 Mileage Pic Z(07). 007401 05 Pic X(03). 007402 05 Bonus Pic Z(07). 007403 007404 77 Date-Pgm Pic X(08) Value 'FFDATE'. 007405 77 Date-Pgm-Parm-Status Pic 9. 007406 88 Parm-Error Value 0. 007407 88 Parm-OK Value 1. 007408 007409 01 Date-Row1. 007410 05 Pic X(20) Value 'Printed :'. 007411 05 Date-Pgm-Date-Row1 Pic X(50) Value Space. 007412 007413 01 Date-Row2. 007414 05 Pic X(20) Value 'Valid Until :'. 007415 05 Date-Pgm-Date-Row2 Pic X(50) Value Space. 007416 007417 007420 Exec SQL 007430 Include 007440 SQLCA 007450 End-Exec 007460 . 007470 007480 Exec SQL 007490 Declare 007491 Flyerinfo Cursor 007492 For 007493 Select 007495 P.Flight_Number, 007496 P.Flight_Date, 007497 P.Class_of_Travel, 007498 F.City_pair, 007499 F.Airline_Id, 007500 M.Mileage 007501 From Flyers P, MILEAGES M , FLIGHTS F 007502 Where P.Flight_Number = F.Flight_Number 007503 And 007504 F.City_Pair = M.City_Pair 007505 Or 007506 P.Flight_Number = F.Flight_Number 007507 And (Substr(F.City_Pair,1,3) = 007508 Substr(M.City_Pair,5,3)) 007509 And 007510 Substr(F.City_Pair,5,3) = 007511 Substr(M.City_Pair,1,3) 007512 Order By P.Flight_Date, F.Airline_Id 007513 End-Exec 007520 . 007530 Linkage Section. 007540 01 Parameter. 007550 05 Parameter-Len Pic S9(04) Binary. 007560 05 Date-Pgm-Parm-Data Pic X(07). 007570 007600*--------------------------------------- 007700 Procedure Division Using Parameter. 007800*--------------------------------------- 007900 Display '==> FFPGM1 is starting...' 007910 Perform Check-Parameter-Len 008000 Perform Open-Files 008010 Perform Open-Cursor 008110 Perform Call-Datepgm 008120 Perform Write-Freq-Headers 008200 Perform Fetch-Flyerinfo Until Klar 008300 Perform Write-Freq-Trailer 008400 Perform Close-Files 008500 Display '==> FFPGM1 ended normally' 008600 GoBack 008700 . 008710*------------------------------------- 008720 Check-Parameter-Len. 008730*------------------------------------- 008740 If Parameter-Len = 0 008750 Display '*** Parameter missing' 008760 Move 12 to Return-Code 008770 GoBack 008780 End-If 008790 . 008791*------------------------------------- 008792 Call-Datepgm. 008793*------------------------------------- 008794 Call Date-Pgm Using 008795 Date-Pgm-Parm-Data 008796 Date-Pgm-Parm-Status 008797 Date-Pgm-Date-Row1 008798 Date-Pgm-Date-Row2 008799 008800 If Parm-Error 008801 Display '*** Parameter ' 008802 Date-Pgm-Parm-Data 008803 ' is invalid' 008804 Move 8 to Return-Code 008805 GoBack 008806 End-If 008807 . 008810*------------------------------------- 008900 Fetch-Flyerinfo. 009000*------------------------------------- 009001 Add 1 to FetchNumber 009010 Display '*** Fetching Flyerinfo: ' FetchNumber 009100 Exec SQL 009200 Fetch Flyerinfo 009300 Into 009310 :Flight-Number, 009400 :Flight-Date, 009410 :Class-Of-Travel, 009420 :City-Pair, 009500 :Airline-Id, 009540 :Mileage-Dec 009600 End-Exec 009601 Evaluate SQLCODE 009602 When 0 009603 Perform Write-Freq-Detail 009604 When 100 009605 Set Klar to True 009606 When Other 009607 Perform SQL-Error 009608 End-Evaluate 009700 . 009710*--------------------------------------- 009720 SQL-Error. 009730*--------------------------------------- 009740 Move SQLCODE to WS-SQLCODE 009750 Display '*** SQL-Fel ***' 009760 Display 'SQLCODE : ' WS-SQLCODE 009770 Display 'SQLSTATE : ' SQLSTATE 009780 Display 'SQLMedd : ' SQLERRMC(1:SQLERRML) 009790 Move 99 to Return-Code 009791 Set Klar to True 009792 . 009800*------------------------------------- 009900 Write-Freq-Headers. 010000*------------------------------------- 010100 Write Listrow from List-Header1 010200 Write Listrow from List-Blankrow 010210 Perform Write-Freq-Daterows 010300 Write Listrow from List-Header2 010400 Write Listrow from List-Blankrow 010500 . 010600*------------------------------------- 010700 Write-Freq-Trailer. 010800*------------------------------------- 010900 Write Listrow from List-Blankrow 011000 Move Mileage-Total to 011100 LT-Mileage in List-Trailer1 011101 011110 Move Mileage-Bonus-Total to 011120 LT-Bonus 011130 011200 Write Listrow from List-Trailer1 011210 Move PageNumber to LT-PageNumber 011220 Write Listrow from List-Blankrow 011230 Write Listrow from List-Trailer2 011300 . 011310*------------------------------------- 011320 Write-Freq-Daterows. 011330*------------------------------------- 011340 Write Listrow from Date-Row1 011350 Write Listrow from Date-Row2 011360 Write Listrow from List-Blankrow 011390 . 011400*------------------------------------- 011500 Write-Freq-Detail. 011600*------------------------------------- 011800 Add Mileage-Dec to 011900 Mileage-Total 011910 Move Mileage-Dec to Mileage 011920 Perform Calculate-Bonus 011930 Add Mileage-Bonus to Mileage-Bonus-Total 012000 Move Mileage-Bonus to Bonus 012100 Write Listrow from List-Detail 012200 . 012210*------------------------------------- 012220 Calculate-Bonus. 012230*------------------------------------- 012231 If Mileage-Dec <= 500 012232 Move 500 to Mileage-Dec Mileage-Bonus 012233 Else 012240 Evaluate True 012260 When TouristClass 012261 Move Mileage-Dec to Mileage-Bonus 012262 When BusinessClass 012263 Multiply Mileage-Dec by 1,25 012264 Giving Mileage-Bonus 012270 When FirstClass 012271 Multiply Mileage-Dec by 1,50 012272 Giving Mileage-Bonus 012280 When Other 012290 Display '*** Invalid Class-Of-Travel : ' 012291 Class-Of-Travel 012292 Move 999 to Return-Code 012293 Stop Run 012294 End-Evaluate 012295 End-If 012296 . 012300*------------------------------------- 012400 Open-Cursor. 012500*------------------------------------- 012510 Exec SQL 012520 Open 012530 Flyerinfo 012540 End-Exec 012550 . 012600*------------------------------------- 012700 Open-Files. 012800*------------------------------------- 013500 Open Output FREQLIST 013600 If Freqlist-Openerror 013700 Display '==> Openerror: FREQLIST' 013800 Display '==> Status : ' Freqlist-Status 013900 Move 22 to Return-Code 014000 Goback 014100 End-If 014200 Display '==> FREQLIST is Open' 014300 . 014400*------------------------------------- 014500 Close-Files. 014600*------------------------------------- 014800 Close FREQLIST 014900 . 015000 End Program FFPGM4. 015100