000100 Identification Division. 000200 Program-Id. FFPGM7. 000210*--------------------------------------------- 000220* Frequent Flyer DB2 - Uppgift 7 000510* Läser in cursor-rader till tabell i LS. 000520* Söker efter destinationer i tabellen. 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. 002910 77 Bonus-Total Pic 9(08). 003000 77 Mileage-Bonus Pic 9(08). 003300 77 WS-SQLCODE Pic +(09). 003400 77 FetchNumber Pic 99 Value 1. 003410 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. 003810 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 LD-Flight-Date Pic X(10). 007000 05 Pic X(02). 007100 05 LD-Airline-Name Pic X(23). 007200 05 Pic X(02). 007300 05 LD-Flight-Number Pic X(04). 007400 05 Pic X(02). 007500 05 LD-Class-Of-Travel Pic X(01). 007900 05 Pic X(02). 008000 05 LD-City-Pair Pic X(07). 008100 05 Pic X(02). 008200 05 LD-Mileage Pic Z(07). 008300 05 Pic X(03). 008400 05 LD-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. 009710 009720 01 List-Searchrow. 009730 05 Searchrow-Data1 Pic X(35) 009740 Value 'The following CITY-PAIRs searched:'. 009750 05 Searchrow-Data2 Pic X(40). 009751 009752 01 No-of-Search-City-Pairs Pic 9(02). 009753 01 SearchRow-Pointer Pic 9(02) Value 1. 009760 009832 01 Accept-City-PairCurrent Pic X(07). 009833 01 Accept-Search-City-Pair Pic X(07). 009840 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 ( 012100 P.Flight_Number = F.Flight_Number 012200 And 012300 F.Airline_Id = A.Airline_Id 012400 And 012500 F.City_Pair = M.City_Pair 012600 ) 012700 Or 012800 ( 012900 P.Flight_Number = F.Flight_Number 013000 And (Substr(F.City_Pair,1,3) = 013100 Substr(M.City_Pair,5,3)) 013200 And 013300 Substr(F.City_Pair,5,3) = 013400 Substr(M.City_Pair,1,3) 013500 And 013600 F.Airline_Id = A.Airline_Id 013700 ) 013800 Order By P.Flight_Date, F.Airline_Id 013900 End-Exec 014000 . 014010 01 Allocate-Data. 014020 05 All-Heap-Id Pic S9(08) Binary Value 0. 014030 05 All-Number-of-Rows Pic S9(08) Binary Value 1. 014031 05 All-Number-of-Bytes Pic S9(08) Binary. 014040 05 All-Pointer Pointer. 014041 05 All-RC Pic S9(08) Binary. 014042 88 All-OK Value 0. 014044 05 All-Storage-Pgm Pic X(08) Value 'CEEGTST'. 014050 014060 01 Flyerinfo-Row. 014070 05 WS-Flight-Date Pic X(10). 014080 05 WS-Flight-Number Pic X(04). 014090 05 WS-Class-Of-Travel Pic X(01). 014091 05 WS-City-Pair Pic X(07). 014092 05 Ws-Mileage Pic S9(05) Packed-Decimal. 014093 05 WS-Airline-Id Pic X(02). 014094 05 WS-Airline-Name Pic X(25). 014095 014096 01 Search-City-Pair-Ind Pic 9(01) Value 0. 014097 88 City-Pair-Not-Found Value 0. 014098 88 City-Pair-Found Value 1. 014099 014100 77 Accepted-Num Pic 9(02) Value 0. 014101 014102 01 Accepted-City-Pairs. 014103 05 A-City-Pair-Current Pic X(07). 014104 05 A-City-Pair-Last Pic X(07) VAlue Space. 014105 05 Pic 9(01) Value 0. 014106 88 Accept-Ready Value 1. 014107 05 A-City-Pair Occurs 20 Depending on Accepted-Num 014108 Indexed By CPX1. 014109 10 A-Origin Pic X(03). 014110 10 Pic X(01). 014111 10 A-Dest Pic X(03). 014112 014120 Linkage Section. 014200 01 Parameter. 014300 05 Parameter-Len Pic S9(04) Binary. 014400 05 Date-Pgm-Parm-Data Pic X(07). 014500 014520 01 FlyerTable. 014530 05 FlyerTable-Row Occurs 1 to 1000 014540 Depending on All-Number-Of-Rows 014541 Indexed by FlyerX1 014542 . 014550 10 Flight-Date Pic X(10). 014560 10 Flight-Number Pic X(04). 014570 10 Class-Of-Travel Pic X(01). 014571 88 TouristClass Value 'Y'. 014572 88 BusinessClass Value 'C'. 014573 88 FirstClass Value 'F'. 014580 10 City-Pair Pic X(07). 014590 10 Mileage Pic S9(05) Packed-Decimal. 014591 10 Airline-Id Pic X(02). 014592 10 Airline-Name Pic X(25). 014593 014600*--------------------------------------- 014700 Procedure Division Using Parameter. 014800*--------------------------------------- 014900 Display '==> FFPGM1 is starting...' 015000 Perform Open-Files 015001 Perform Count-Number-of-Rows. 015002 Perform Allocate-Storage. 015100 Perform Call-Datepgm 015110 Perform Write-Freq-Headers 015200 Perform Open-Cursor 015400 Perform Fetch-Flyerinfo-to-Table Until Klar 015401 Perform Close-Cursor 015402 Perform Accept-City-Pair 015410 Perform Write-Freq-Detail 015420 Varying TableRowNumber from 1 by 1 015430 Until TableRowNumber > All-Number-Of-Rows 015500 Perform Write-Freq-Trailer 015600 Perform Close-Files 015700 Display '==> FFPGM1 ended normally' 015800 GoBack 015900 . 015901*------------------------------------- 015902 Accept-City-Pair. 015903*------------------------------------- 015904 Accept A-City-Pair-Current 015907 Perform Until Accept-Ready 015908 Display '*** Accepted: ' A-City-Pair-Current 015909 If A-City-Pair-Current = A-City-Pair-Last 015910 Set Accept-Ready to True 015911 Else 015912 Add 1 to Accepted-Num 015913 Move A-City-Pair-Current to 015914 A-City-Pair(Accepted-Num) A-City-Pair-Last 015915 Accept A-City-Pair-Current 015916 End-If 015917 End-Perform 015918 . 015919*------------------------------------- 015920 Check-City-Pair-Request. 015921*------------------------------------- 015922 Set CPX1 to 1 015923 Search A-City-Pair 015924 At End 015925 Set City-Pair-Not-Found to True 015926 When A-City-Pair(CPX1) = 015927 City-Pair(TableRowNumber) 015928 Display '*** Found dest-request: ' 015929 A-City-Pair(CPX1) 015930 Set City-Pair-Found to True 015931 End-Search 015932 . 015933 015934*------------------------------------- 015935 Count-Number-of-Rows. 015936*------------------------------------- 015940 Exec SQL 015950 Select Count(*) 015970 Into :All-Number-of-Rows 015971 From Flights 015980 End-Exec 015990 Display '*** Number of rows: ' All-Number-of-Rows 015991 . 015992*------------------------------------- 015993 Allocate-Storage. 015994*------------------------------------- 016008 Multiply Length of Flyertable-Row 016009 By All-Number-Of-Rows 016010 Giving All-Number-Of-Bytes 016011 016012 Call All-Storage-Pgm Using 016013 All-Heap-Id, 016014 All-Number-of-Bytes, 016015 All-Pointer 016016 All-RC 016017 If Not All-OK 016018 Display '*** Error allocation storage: ' 016019 All-RC 016020 Display '*** Number of bytes : ' 016021 All-Number-of-Bytes 016022 Move 999 to Return-Code 016023 Stop Run 016024 Else 016025 Set Address of FlyerTable to All-Pointer 016026 End-If 016027 . 016030*------------------------------------- 016100 Call-Datepgm. 016200*------------------------------------- 016300 Call Date-Pgm Using 016400 Date-Pgm-Parm-Data 016500 Date-Pgm-Parm-Status 016600 Date-Pgm-Date-Row1 016700 Date-Pgm-Date-Row2 016800 016900 If Parm-Error 017000 Display '*** Parameter ' 017100 Date-Pgm-Parm-Data 017200 ' is invalid' 017300 Move 8 to Return-Code 017400 GoBack 017500 End-If 017600 . 017700*------------------------------------- 017800 Fetch-Flyerinfo-to-Table. 017900*------------------------------------- 018200 Exec SQL 018300 Fetch Flyerinfo 018400 Into 018500 :WS-Flight-Number, 018600 :WS-Flight-Date, 018700 :WS-Class-Of-Travel, 018800 :WS-City-Pair, 018900 :WS-Airline-Id, 019000 :WS-Mileage, 019100 :WS-Airline-Name 019200 End-Exec 019300 Evaluate SQLCODE 019400 When 0 019410 Display '*** Fetching Flyerinfo: ' FetchNumber 019500 Move FlyerInfo-Row to 019510 FlyerTable-Row(FetchNumber) 019530 Display '*** Table ' FlyerTable-Row(FetchNumber) 019540 Display '*** Info ' FlyerInfo-Row 019550 Add 1 to FetchNumber 019600 When 100 019700 Set Klar to True 019710 Display '*** Number of rows: ' 019720 All-Number-of-Rows 019730 Display '*** FetchNumber : ' 019740 FetchNumber 019800 When Other 019900 Perform SQL-Error 020000 End-Evaluate 020100 . 020200*--------------------------------------- 020300 SQL-Error. 020400*--------------------------------------- 020500 Move SQLCODE to WS-SQLCODE 020600 Display '*** SQL-Fel ***' 020700 Display 'SQLCODE : ' WS-SQLCODE 020800 Display 'SQLSTATE : ' SQLSTATE 020900 Display 'SQLMedd : ' SQLERRMC(1:SQLERRML) 021000 Move 99 to Return-Code 021100 Set Klar to True 021200 . 021300*------------------------------------- 021400 Write-Freq-Headers. 021500*------------------------------------- 021600 Write Listrow from List-Header1 021700 Write Listrow from List-Blankrow 021800 Perform Write-Freq-Daterows 021900 Write Listrow from List-Header2 022000 Write Listrow from List-Blankrow 022100 . 022200*------------------------------------- 022300 Write-Freq-Trailer. 022400*------------------------------------- 022500 Write Listrow from List-Blankrow 022600 Move Mileage-Total to 022700 LT-Mileage in List-Trailer1 022800 022900 Move Bonus-Total to 023000 LT-Bonus 023100 023200 Write Listrow from List-Trailer1 023201 Write Listrow from List-Blankrow 023210 Perform Write-List-Searchrow 023220 Write Listrow from List-Blankrow 023300 Move PageNumber to LT-PageNumber 023400 Write Listrow from List-Blankrow 023500 Write Listrow from List-Trailer2 023600 . 023700*------------------------------------- 023800 Write-Freq-Daterows. 023900*------------------------------------- 024000 Write Listrow from Date-Row1 024100 Write Listrow from Date-Row2 024200 Write Listrow from List-Blankrow 024300 . 024400*------------------------------------- 024500 Write-Freq-Detail. 024600*------------------------------------- 024610 Perform Check-City-Pair-Request 024620 If City-Pair-Found 024700 Add Mileage(TableRowNumber) 024800 to Mileage-Total 024810 Move Mileage(TableRowNumber) to LD-Mileage 024820 025000 Perform Calculate-Bonus 025010 025100 Add Mileage-Bonus to Bonus-Total 025200 Move Mileage-Bonus to LD-Bonus 025210 Move Flight-Date(TableRowNumber) 025220 to LD-Flight-Date 025230 Move Flight-Number(TableRowNumber) 025240 to LD-Flight-Number 025250 Move Class-Of-Travel(TableRowNumber) 025260 to LD-Class-Of-Travel 025270 Move City-Pair(TableRowNumber) 025280 to LD-City-Pair 025290 Move Airline-Name(TableRowNumber) 025291 to LD-Airline-Name 025292 025300 Write Listrow from List-Detail 025310 End-If 025400 . 025410*------------------------------------- 025420 Write-List-Searchrow. 025430*------------------------------------- 025440 Perform Varying No-of-Search-City-Pairs 025450 From 1 by 1 Until 025451 No-of-Search-City-Pairs > 025452 Accepted-Num 025460 String 025461 A-City-Pair(No-of-Search-City-Pairs) 025462 ',' Delimited By SIze 025470 Into Searchrow-Data2 025480 With Pointer Searchrow-Pointer 025490 End-Perform 025491 Write Listrow from List-Blankrow 025492 Write Listrow from List-Searchrow 025493 . 025500*------------------------------------- 025600 Calculate-Bonus. 025700*------------------------------------- 025800 If Mileage(TableRowNumber) <= 500 025810 Move 500 to LD-Bonus Mileage-Bonus 026000 Else 026100 Evaluate True 026200 When TouristClass(TableRowNumber) 026300 Move Mileage(TableRowNumber) 026310 to Mileage-Bonus 026400 When BusinessClass(TableRowNumber) 026500 Multiply Mileage(TableRowNumber) by 1,25 026600 Giving Mileage-Bonus 026700 When FirstClass(TableRowNumber) 026800 Multiply Mileage(TableRowNumber) by 1,50 026900 Giving Mileage-Bonus 027000 When Other 027100 Display '*** Invalid Class-Of-Travel : ' 027200 LD-Class-Of-Travel 027300 Move 999 to Return-Code 027400 Stop Run 027500 End-Evaluate 027600 End-If 027700 . 027800*------------------------------------- 027900 Open-Cursor. 028000*------------------------------------- 028100 Exec SQL 028200 Open 028300 Flyerinfo 028400 End-Exec 028500 . 028510*------------------------------------- 028520 Close-Cursor. 028530*------------------------------------- 028540 Exec SQL 028550 Close 028560 Flyerinfo 028570 End-Exec 028571 Display '*** Cursor Flyerinfo closed' 028580 . 028600*------------------------------------- 028700 Open-Files. 028800*------------------------------------- 028900 Open Output FREQLIST 029000 If Freqlist-Openerror 029100 Display '==> Openerror: FREQLIST' 029200 Display '==> Status : ' Freqlist-Status 029300 Move 22 to Return-Code 029400 Goback 029500 End-If 029600 Display '==> FREQLIST is Open' 029700 . 029800*------------------------------------- 029900 Close-Files. 030000*------------------------------------- 030100 Close FREQLIST 030200 . 030300 End Program FFPGM7. 030400