000100 Identification Division. 000200 Program-Id. FREQDATE. 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 77 Parameter-Data Pic X(07). 001100 88 DShort Value 'DATUM=S'. 001200 88 DMedium Value 'DATUM=M'. 001300 88 DLong Value 'DATUM=X'. 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' Using Datumrad1, Datumrad2 003000 When DMedium 003100 Call 'DATMEDIUM' Using Datumrad1, Datumrad2 003200 When DLong 003300 Call 'DATLONG' Using Datumrad1, Datumrad2 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 009200 01 Tabellen. 009300 05 Manaderna. 009400 10 Pic X(10) Value 'Januari'. 009500 10 Pic X(10) Value 'Februari'. 009600 10 Pic X(10) Value 'Mars'. 009700 10 Pic X(10) Value 'April'. 009800 10 Pic X(10) Value 'Maj'. 009900 10 Pic X(10) Value 'Juni'. 010000 10 Pic X(10) Value 'Juli'. 010100 10 Pic X(10) Value 'Augusti'. 010200 10 Pic X(10) Value 'September'. 010300 10 Pic X(10) Value 'Oktober'. 010400 10 Pic X(10) Value 'November'. 010500 10 Pic X(10) Value 'December'. 010600 05 Mantab Redefines Manaderna. 010700 10 Manaden Pic X(10) Occurs 12. 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 016300 01 Tabellerna. 016400 05 Dagarna. 016500 10 Pic X(10) Value 'Mandagen'. 016600 10 Pic X(10) Value 'Tisdagen'. 016700 10 Pic X(10) Value 'Onsdagen'. 016800 10 Pic X(10) Value 'Torsdagen'. 016900 10 Pic X(10) Value 'Fredagen'. 017000 10 Pic X(10) Value 'Lördagen'. 017100 10 Pic X(10) Value 'Söndagen'. 017200 05 Dagtab Redefines Dagarna. 017300 10 Dagen Pic X(10) Occurs 7. 017400 05 Manaderna. 017500 10 Pic X(10) Value 'Januari'. 017600 10 Pic X(10) Value 'Februari'. 017700 10 Pic X(10) Value 'Mars'. 017800 10 Pic X(10) Value 'April'. 017900 10 Pic X(10) Value 'Maj'. 018000 10 Pic X(10) Value 'Juni'. 018100 10 Pic X(10) Value 'Juli'. 018200 10 Pic X(10) Value 'Augusti'. 018300 10 Pic X(10) Value 'September'. 018400 10 Pic X(10) Value 'Oktober'. 018500 10 Pic X(10) Value 'November'. 018600 10 Pic X(10) Value 'December'. 018700 05 Mantab Redefines Manaderna. 018800 10 Manaden Pic X(10) Occurs 12. 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 ' ' 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 ' ' 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*----------------------------------------------------------------- 026900 End Program FREQDATE. 027000*-----------------------------------------------------------------