000100 Identification Division. 000110*--------------------------------------------- 000120* Frequent Flyer DB2 - Uppgift 7 000130*--------------------------------------------- 000200 Program-Id. FFDATED. 000300 Data Division. 000400 Working-Storage Section. 000500 77 Villkoren Pic 9(01) Value 0. 000600 88 Klar Value 1. 000700 88 Tabklar Value 2. 000800 000810 01 Tabellerna Global. 000820 05 Manaderna. 000830 10 Pic X(10) Value 'Januari'. 000840 10 Pic X(10) Value 'Februari'. 000850 10 Pic X(10) Value 'Mars'. 000860 10 Pic X(10) Value 'April'. 000870 10 Pic X(10) Value 'Maj'. 000880 10 Pic X(10) Value 'Juni'. 000890 10 Pic X(10) Value 'Juli'. 000891 10 Pic X(10) Value 'Augusti'. 000892 10 Pic X(10) Value 'September'. 000893 10 Pic X(10) Value 'Oktober'. 000894 10 Pic X(10) Value 'November'. 000895 10 Pic X(10) Value 'December'. 000896 05 Mantab Redefines Manaderna. 000897 10 Manaden Pic X(10) Occurs 12. 000898 000899 05 Dagarna. 000900 10 Pic X(10) Value 'Mandag'. 000901 10 Pic X(10) Value 'Tisdag'. 000902 10 Pic X(10) Value 'Onsdag'. 000903 10 Pic X(10) Value 'Torsdag'. 000904 10 Pic X(10) Value 'Fredag'. 000905 10 Pic X(10) Value 'Lordag'. 000906 10 Pic X(10) Value 'Sondag'. 000907 05 Dagtab Redefines Dagarna. 000908 10 Dagen Pic X(10) Occurs 7. 000909 000910 Linkage Section. 001000 77 Parameter-Data Pic X(05). 001100 88 DShort Value 'DATES'. 001200 88 DMedium Value 'DATEM'. 001300 88 DLong Value 'DATEL'. 001301 88 DDay Value 'DATED'. 001310 001400 77 Parameter-Status Pic 9. 001500 88 Parameter-Fel Value 0. 001600 88 Parameter-OK Value 1. 001610 001700 01 Datumrad1 Pic X(50) Global. 001800 01 Datumrad2 Pic X(50) Global. 001900 002000*----------------------------------------------------------------- 002100 Procedure Division Using Parameter-Data, 002200 Parameter-Status, 002300 Datumrad1, 002400 Datumrad2. 002500*----------------------------------------------------------------- 002600 Set Parameter-OK to True 002700 Evaluate True 002800 When DShort 002900 Call 'DATSHORT' 002910* Call 'DATSHORT' Using Datumrad1, Datumrad2 003000 When DMedium 003100 Call 'DATMEDIUM' 003110* Call 'DATMEDIUM' Using Datumrad1, Datumrad2 003200 When DLong 003300 Call 'DATLONG' 003310* Call 'DATLONG' Using Datumrad1, Datumrad2 003320 When DDay 003330 Call 'DATDAY' 003400 When Other 003500 Set Parameter-Fel to True 003600 End-Evaluate 003700 GoBack 003800 . 003900*----------------------------------------------------------------- 004000* D A T S H O R T 004100*----------------------------------------------------------------- 004200 Identification Division. 004300 Program-Id. DATSHORT. 004400 Data Division. 004500 Working-Storage Section. 004600 77 DagensDatum Pic X(08). 004700 77 NastaDatum Pic X(08). 005100*----------------------------------------------------------------- 005200 Procedure Division. 005400 005500 Move Function CURRENT-DATE(1:8) to DagensDatum 005600 String 'Den ' Delimited by Size 005700 DagensDatum(7:2) Delimited by Size 005800 '/' Delimited by Size 005900 DagensDatum(5:2) Delimited by Size 006000 ', ' Delimited by Size 006100 DagensDatum(1:4) Delimited by Size 006200 Into Datumrad1 006300 End-String 006400 006500 Call 'DATNEXT' Using NastaDatum 006600 006700 String 'Den ' Delimited by Size 006800 NastaDatum(7:2) Delimited by Size 006900 '/' Delimited by Size 007000 NastaDatum(5:2) Delimited by Size 007100 ', ' Delimited by Size 007200 NastaDatum(1:4) Delimited by Size 007300 Into Datumrad2 007400 End-String 007401 007410 Exit Program 007500 . 007600*----------------------------------------------------------------- 007700 End Program DATSHORT. 007800*----------------------------------------------------------------- 007900*----------------------------------------------------------------- 008000* D A T M E D I U M 008100*----------------------------------------------------------------- 008200 Identification Division. 008300 Program-Id. DATMEDIUM. 008400 Data Division. 008500 Working-Storage Section. 008600 77 DagensDatum Pic 9(08). 008700 77 DagensManadsnummer Pic 9(02). 008800 008900 77 NastaDatum Pic 9(08). 009000 77 NastaManadsnummer Pic 9(02). 009100 010800 011200*----------------------------------------------------------------- 011300 Procedure Division. 011500 011600 Move Function CURRENT-DATE(1:8) to DagensDatum 011700 Move DagensDatum(5:2) to DagensManadsnummer 011800 011900 String 'Den ' Delimited By Size 012000 DagensDatum(7:2) Delimited by Size 012100 Space Delimited by Size 012200 Manaden(DagensManadsnummer) Delimited by Space 012300 Space Delimited by Size 012400 DagensDatum(1:4) Delimited by Size 012500 Into DatumRad1 012600 End-String 012700 012800 Call 'DATNEXT' Using NastaDatum 012900 Move NastaDatum(5:2) to NastaManadsnummer 013000 013100 String 'Den ' Delimited By Size 013200 NastaDatum(7:2) Delimited by Size 013300 Space Delimited by Size 013400 Manaden(NastaManadsnummer) Delimited by Space 013500 SPace Delimited by Size 013600 NastaDatum(1:4) Delimited by Size 013700 Into DatumRad2 013800 End-String 013900 014000 Exit Program 014100 . 014200*----------------------------------------------------------------- 014300 End Program DATMEDIUM. 014400*----------------------------------------------------------------- 014500*----------------------------------------------------------------- 014600* D A T L O N G 014700*----------------------------------------------------------------- 014800 Identification Division. 014900 Program-Id. DATLONG. 015000 Data Division. 015100 Working-Storage Section. 015200 015300 77 IDagensDatum Pic 9(07). 015400 77 DagensDatum Pic 9(08). 015500 77 DagensDagnummer Pic 9(01). 015600 77 DagensManadsnummer Pic 9(02). 015700 015800 77 INastaDatum Pic 9(07). 015900 77 NastaDatum Pic 9(08). 016000 77 NastaDagnummer Pic 9(01). 016100 77 NastaManadsnummer Pic 9(02). 016200 018900 019300*----------------------------------------------------------------- 019400 Procedure Division. 019600 019700 Move Function CURRENT-DATE(1:8) to DagensDatum 019800 Move Dagensdatum(5:2) to Dagensmanadsnummer 019900 020000 Compute IDagensDatum = Function INTEGER-OF-DATE(DagensDatum) 020100 Compute DagensDagnummer = Function REM (IdagensDatum , 7 ) 020200 If DagensDagnummer = 0 020300 Move 7 to DagensDagnummer 020400 End-If 020500 020600 String Dagen(DagensDagnummer) Delimited by Space 020700 ' den ' Delimited by Size 020800 DagensDatum(5:2) Delimited by Size 020900 ':e ' Delimited by Size 021000 Manaden(DagensManadsnummer) Delimited by Space 021100 ' ' Delimited by Size 021200 DagensDatum(1:4) Delimited by Size 021300 021400 Into DatumRad1 021500 End-String 021600 021700 Call 'DATNEXT' Using NastaDatum 021800 021900 Move Nastadatum(5:2) to Nastamanadsnummer 022000 022100 Compute INastaDatum = Function INTEGER-OF-DATE(NastaDatum) 022200 Compute NastaDagnummer = Function REM (INastaDatum , 7 ) 022300 If NastaDagnummer = 0 022400 Move 7 to NastaDagnummer 022500 End-If 022600 022700 String Dagen(NastaDagnummer) Delimited by Space 022800 ' den ' Delimited by Size 022900 NastaDatum(5:2) Delimited by Size 023000 ':e ' Delimited by Size 023100 Manaden(NastaManadsnummer) Delimited by Space 023200 ' ' Delimited by Size 023300 NastaDatum(1:4) Delimited by Size 023400 023500 Into DatumRad2 023600 End-String 023700 023800 Exit Program 023900 . 024000*----------------------------------------------------------------- 024100 End Program DATLONG. 024200*----------------------------------------------------------------- 024300*----------------------------------------------------------------- 024400* D A T N E X T 024500*----------------------------------------------------------------- 024600 Identification Division. 024700 Program-Id. DATNEXT is Common program. 024800 Data Division. 024900 Working-Storage Section. 025000 77 DagensDatum Pic 9(08). 025100 77 IntDagensDatum Pic 9(07). 025200 77 IntNastaDatum Pic 9(07). 025300 Linkage Section. 025400 01 NastaDatum Pic 9(08). 025500 025600 Procedure Division Using NastaDatum. 025700 Move Function CURRENT-DATE(1:8) to DagensDatum 025800 Compute IntNastaDatum = 025900 Function INTEGER-OF-DATE(DagensDAtum) + 30 026000 End-Compute 026100 Compute Nastadatum = 026200 Function DATE-OF-INTEGER(IntNastaDatum) 026300 End-Compute 026400 Exit Program 026500 . 026600*----------------------------------------------------------------- 026700 End Program DATNEXT. 026800*----------------------------------------------------------------- 026810*----------------------------------------------------------------- 026820* D A T D A Y 026830*----------------------------------------------------------------- 026840 Identification Division. 026850 Program-Id. DATDAY is Common program. 026860 Data Division. 026870 Working-Storage Section. 026890 01 Datum. 026891 05 YYYY Pic X(04). 026892 05 Pic X(01). 026893 05 MM Pic X(02). 026894 05 Pic X(01). 026895 05 DD Pic X(02). 026896 026897 01 RDatum. 026898 05 YYYY Pic X(04). 026900 05 MM Pic X(02). 026902 05 DD Pic X(02). 026903 01 XDatum Redefines Rdatum Pic 9(08). 026904 026905 77 IntDatum Pic 9(07). 026906 77 IntDagnum Pic 9(07). 026907 026908 Procedure Division. 026909 Move Datumrad1 to Datum 026910 Move Corr Datum to RDatum 026914 Compute Intdatum= Function Integer-Of-Date(XDatum) 026916 Compute IntDagnum = Function REM (IntDatum , 7 ) 026917 If IntDagnum = 0 026918 Move 7 to IntDagnum 026919 End-If 026920 026929 Move Dagen(IntDagnum) to Datumrad2 026930 Exit Program 026931 . 026932*----------------------------------------------------------------- 026933 End Program DATDAY. 026934*----------------------------------------------------------------- 026940 End Program FFDATED. 027000*-----------------------------------------------------------------