000100 Identification Division. 000200 Program-Id. FREQDATX. 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 000900 Linkage Section. 001000 01 Parameter-Data Pic X(07). 001100 88 DShort Value 'DATUM=S'. 001200 88 DMedium Value 'DATUM=M'. 001300 88 DLong Value 'DATUM=X'. 001400 01 Parameter-Datum Redefines Parameter-Data. 001500 05 PMM Pic 9(02). 001600 05 Pic X(01). 001700 88 Datum Value '/'. 001800 05 PDD Pic 9(02). 001900 77 Parameter-Status Pic 9. 002000 88 Parameter-Fel Value 0. 002100 88 Parameter-OK Value 1. 002200 01 Datumrad1 Pic X(50). 002300 01 Datumrad2 Pic X(50). 002400 002500*----------------------------------------------------------------- 002600 Procedure Division Using Parameter-Data, 002700 Parameter-Status, 002800 Datumrad1, 002900 Datumrad2. 003000*----------------------------------------------------------------- 003100 Set Parameter-OK to True 003200 Evaluate True 003300 When DShort 003400 Call 'DATSHORT' Using Datumrad1, Datumrad2 003500 When DMedium 003600 Call 'DATMEDIUM' Using Datumrad1, Datumrad2 003700 When DLong 003800 Call 'DATLONG' Using Datumrad1, Datumrad2 003900 When Datum 004000 If (PDD not Numeric) or (PMM not Numeric) 004100 Set Parameter-Fel to True 004200 Else 004300 Call 'DATDAG' Using Parameter-Datum, Datumrad1 004400 End-If 004500 When Other 004600 Set Parameter-Fel to True 004700 End-Evaluate 004800 GoBack 004900 . 005000*----------------------------------------------------------------- 005100* D A T S H O R T 005200*----------------------------------------------------------------- 005300 Identification Division. 005400 Program-Id. DATSHORT. 005500 Data Division. 005600 Working-Storage Section. 005700 77 DagensDatum Pic X(08). 005800 77 NastaDatum Pic X(08). 005900 Linkage Section. 006000 01 Datumrad1 Pic X(50). 006100 01 Datumrad2 Pic X(50). 006200*----------------------------------------------------------------- 006300 Procedure Division Using Datumrad1, 006400 Datumrad2. 006500 006600 Move Function CURRENT-DATE(1:8) to DagensDatum 006700 String 'Den ' Delimited by Size 006800 DagensDatum(7:2) Delimited by Size 006900 '/' Delimited by Size 007000 DagensDatum(5:2) Delimited by Size 007100 ', ' Delimited by Size 007200 DagensDAtum(1:4) Delimited by Size 007300 Into Datumrad1 007400 End-String 007500 007600 Call 'DATNEXT' Using NastaDatum 007700 007800 String 'Den ' Delimited by Size 007900 NastaDatum(7:2) Delimited by Size 008000 '/' Delimited by Size 008100 NastaDatum(5:2) Delimited by Size 008200 ', ' Delimited by Size 008300 NAstaDatum(1:4) Delimited by Size 008400 Into Datumrad2 008500 End-String 008600 . 008700*----------------------------------------------------------------- 008800 End Program DATSHORT. 008900*----------------------------------------------------------------- 009000*----------------------------------------------------------------- 009100* D A T M E D I U M 009200*----------------------------------------------------------------- 009300 Identification Division. 009400 Program-Id. DATMEDIUM. 009500 Data Division. 009600 Working-Storage Section. 009700 77 DagensDatum Pic 9(08). 009800 77 DagensManadsnummer Pic 99. 009900 010000 77 NastaDatum Pic 9(08). 010100 77 NastaManadsnummer Pic 99. 010200 010300 01 Tabellerna. 010400 05 Manaderna. 010500 10 Pic X(10) Value 'Januari'. 010600 10 Pic X(10) Value 'Februari'. 010700 10 Pic X(10) Value 'Mars'. 010800 10 Pic X(10) Value 'April'. 010900 10 Pic X(10) Value 'Maj'. 011000 10 Pic X(10) Value 'Juni'. 011100 10 Pic X(10) Value 'Juli'. 011200 10 Pic X(10) Value 'Augusti'. 011300 10 Pic X(10) Value 'September'. 011400 10 Pic X(10) Value 'Oktober'. 011500 10 Pic X(10) Value 'November'. 011600 10 Pic X(10) Value 'December'. 011700 05 Mantab Redefines Manaderna. 011800 10 Manaden Pic X(10) Occurs 12. 011900 012000 Linkage Section. 012100 01 Datumrad1 Pic X(50). 012200 01 Datumrad2 Pic X(50). 012300*----------------------------------------------------------------- 012400 Procedure Division Using Datumrad1, 012500 Datumrad2. 012600 012700 Move Function CURRENT-DATE(1:8) to DagensDatum 012800 Move DagensDatum(5:2) to DagensManadsnummer 012900 013000 String 'Den ' Delimited By Size 013100 DagensDatum(7:2) Delimited by Size 013200 ' ' Delimited by Size 013300 Manaden(DagensManadsnummer) Delimited by Space 013400 ' ' Delimited by Size 013500 DagensDatum(1:4) Delimited by Size 013600 Into DatumRad1 013700 End-String 013800 013900 Call 'DATNEXT' Using NastaDatum 014000 Move NastaDatum(5:2) to NastaManadsnummer 014100 014200 String 'Den ' Delimited By Size 014300 NastaDatum(7:2) Delimited by Size 014400 ' ' Delimited by Size 014500 Manaden(NastaManadsnummer) Delimited by Space 014600 ' ' Delimited by Size 014700 NastaDatum(1:4) Delimited by Size 014800 Into DatumRad2 014900 End-String 015000 015100 GoBack 015200 . 015300*----------------------------------------------------------------- 015400 End Program DATMEDIUM. 015500*----------------------------------------------------------------- 015600*----------------------------------------------------------------- 015700* D A T L O N G 015800*----------------------------------------------------------------- 015900 Identification Division. 016000 Program-Id. DATLONG. 016100 Data Division. 016200 Working-Storage Section. 016300 016400 77 IDagensDatum Pic 9(07). 016500 77 DagensDatum Pic 9(08). 016600 77 DagensDagnummer Pic 9(01). 016700 77 DagensManadsnummer Pic 99. 016800 016900 77 INastaDatum Pic 9(07). 017000 77 NastaDatum Pic 9(08). 017100 77 NastaDagnummer Pic 9(01). 017200 77 NastaManadsnummer Pic 99. 017300 017400 01 Tabellerna. 017500 05 Dagarna. 017600 10 Pic X(10) Value 'Mandagen'. 017700 10 Pic X(10) Value 'Tisdagen'. 017800 10 Pic X(10) Value 'Onsdagen'. 017900 10 Pic X(10) Value 'Torsdagen'. 018000 10 Pic X(10) Value 'Fredagen'. 018100 10 Pic X(10) Value 'L¦rdagen'. 018200 10 Pic X(10) Value 'S¦ndagen'. 018300 05 Dagtab Redefines Dagarna. 018400 10 Dagen Pic X(10) Occurs 7. 018500 05 Manaderna. 018600 10 Pic X(10) Value 'Januari'. 018700 10 Pic X(10) Value 'Februari'. 018800 10 Pic X(10) Value 'Mars'. 018900 10 Pic X(10) Value 'April'. 019000 10 Pic X(10) Value 'Maj'. 019100 10 Pic X(10) Value 'Juni'. 019200 10 Pic X(10) Value 'Juli'. 019300 10 Pic X(10) Value 'Augusti'. 019400 10 Pic X(10) Value 'September'. 019500 10 Pic X(10) Value 'Oktober'. 019600 10 Pic X(10) Value 'November'. 019700 10 Pic X(10) Value 'December'. 019800 05 Mantab Redefines Manaderna. 019900 10 Manaden Pic X(10) Occurs 12. 020000 020100 Linkage Section. 020200 01 Datumrad1 Pic X(50). 020300 01 Datumrad2 Pic X(50). 020400*----------------------------------------------------------------- 020500 Procedure Division Using Datumrad1, 020600 Datumrad2. 020700 020800 Move Function CURRENT-DATE(1:8) to DagensDatum 020900 Move Dagensdatum(5:2) to Dagensmanadsnummer 021000 021100 Compute IDagensDatum = Function INTEGER-OF-DATE(DagensDatum) 021200 Compute DagensDagnummer = Function REM (IdagensDatum , 7 ) 021300 If DagensDagnummer = 0 021400 Move 7 to DagensDagnummer 021500 End-If 021600 021700 String Dagen(DagensDagnummer) Delimited by Space 021800 ' den ' Delimited by Size 021900 DagensDatum(5:2) Delimited by Size 022000 ' ' Delimited by Size 022100 Manaden(DagensManadsnummer) Delimited by Space 022200 ' ' Delimited by Size 022300 DagensDatum(1:4) Delimited by Size 022400 022500 Into DatumRad1 022600 End-String 022700 022800 Call 'DATNEXT' Using NastaDatum 022900 023000 Move Nastadatum(5:2) to Nastamanadsnummer 023100 023200 Compute INastaDatum = Function INTEGER-OF-DATE(NastaDatum) 023300 Compute NastaDagnummer = Function REM (INastaDatum , 7 ) 023400 If NastaDagnummer = 0 023500 Move 7 to NastaDagnummer 023600 End-If 023700 023800 String Dagen(NastaDagnummer) Delimited by Space 023900 ' den ' Delimited by Size 024000 NastaDatum(5:2) Delimited by Size 024100 ' ' Delimited by Size 024200 Manaden(NastaManadsnummer) Delimited by Space 024300 ' ' Delimited by Size 024400 NastaDatum(1:4) Delimited by Size 024500 024600 Into DatumRad2 024700 End-String 024800 024900 GoBack 025000 . 025100*----------------------------------------------------------------- 025200 End Program DATLONG. 025300*----------------------------------------------------------------- 025400*----------------------------------------------------------------- 025500* D A T N E X T 025600*----------------------------------------------------------------- 025700 Identification Division. 025800 Program-Id. DATNEXT is Common program. 025900 Data Division. 026000 Working-Storage Section. 026100 77 DagensDatum Pic 9(08). 026200 77 IntDagensDatum Pic 9(07). 026300 77 IntNastaDatum Pic 9(07). 026400 Linkage Section. 026500 01 NastaDatum Pic 9(08). 026600 026700 Procedure Division Using NastaDatum. 026800 Move Function CURRENT-DATE(1:8) to DagensDatum 026900 Compute IntNastaDatum = 027000 Function INTEGER-OF-DATE(DagensDAtum) + 30 027100 End-Compute 027200 Compute Nastadatum = 027300 Function DATE-OF-INTEGER(IntNastaDatum) 027400 End-Compute 027500 GoBack 027600 . 027700*----------------------------------------------------------------- 027800 End Program DATNEXT. 027900*----------------------------------------------------------------- 028000*----------------------------------------------------------------- 028100* D A T D A G 028200*----------------------------------------------------------------- 028300 Identification Division. 028400 Program-Id. DATDAG. 028500 Data Division. 028600 Working-Storage Section. 028700 01 DagensDatum Pic 9(08). 028800 77 IntDagensDatum Pic 9(07). 028900 77 IntDagNum Pic 9(01). 029000 029100 01 Tabellen. 029200 05 Dagarna. 029300 10 Pic X(10) Value 'Mandagen'. 029400 10 Pic X(10) Value 'Tisdagen'. 029500 10 Pic X(10) Value 'Onsdagen'. 029600 10 Pic X(10) Value 'Torsdagen'. 029700 10 Pic X(10) Value 'Fredagen'. 029800 10 Pic X(10) Value 'L¦rdagen'. 029900 10 Pic X(10) Value 'S¦ndagen'. 030000 05 Dagtab Redefines Dagarna. 030100 10 Dagen Pic X(10) Occurs 7. 030200 030300 Linkage Section. 030400 01 Parameter-Datum. 030500 05 PMM Pic 9(02). 030600 05 Pic X(01). 030700 05 PDD Pic 9(02). 030800 01 Datumrad1 Pic X(50). 030900 031000 Procedure Division Using Parameter-Datum, Datumrad1. 031100 031200 Move Function CURRENT-DATE(1:8) to DagensDatum 031300 Move PMM to Dagensdatum(5:2) 031400 Move PDD to Dagensdatum(7:) 031410 Display '*** Datum: ' DagensDAtum 031500 Compute IntDagNum = 031600 Function Rem(Function INTEGER-OF-DATE(DagensDatum),7) 031700 End-Compute 031810 Display '*** Dagnum: ' IntDagnum 031900 If IntDagNum = 0 032000 Move 7 to IntDagNum 032100 End-If 032200 Move Dagen(IntDagNum) to DatumRad1 032300 032400 GoBack 032500 . 032600*----------------------------------------------------------------- 032700 End Program DATDAG. 032800*----------------------------------------------------------------- 032900 End Program FREQDATX.