000100 Identification Division. 000200 Program-Id. OVN191 000300 Environment Division. 000400 Input-Output Section. 000500 File-Control. 000600 Select ARTFIL Assign to ARTDD 000700 Organization is Sequential 000800 Access Is Sequential 000900 File Status is Artfil-Status 001000 . 001100 Select LISTFIL Assign to LISTDD 001200 Organization is Sequential 001300 Access Is Sequential 001400 . 001500 Data Division. 001600 File Section. 001700 FD ARTFIL Recording Mode f 001800 Record Contains 80. 001900 01 Artfil-Post. 002000 05 Artfil-Nr Pic X(05). 002100 05 Pic X(01). 002200 05 Artfil-Namn Pic X(25). 002300 05 Pic X(01). 002400 05 Artfil-Typ Pic X(01). 002500 05 Pic X(01). 002600 05 Artfil-Lp1 Pic X(02). 002700 05 Artfil-Kv1 Pic 9(06). 002800 05 Artfil-Lp2 Pic X(02). 002900 05 Artfil-Kv2 Pic 9(06). 003000 05 Artfil-Lp3 Pic X(02). 003100 05 Artfil-Kv3 Pic 9(06). 003200 05 Pic X(22). 003300 003400 FD LISTFIL Recording Mode f 003500 Record Contains 120. 003600 01 List-Rad Pic X(120). 003700 003800 003900 Working-Storage Section. 004000 01 Tabpgm Pic X(08) VAlue 'OVN18TAB'. 004100 004200 01 Tabpgm-Post. 004300 05 Grp-Nyckel Pic X(01). 004400 05 Grp-Beskrivning Pic X(25). 004500 01 Raknare-och-Annat. 004600 05 Radnummer Pic 99 Value 0. 004700 88 Radstart Value 0. 004800 88 Radmax Value 25. 004900 05 Sidnr Pic 99 Value 0. 005000 88 ListStart Value 0. 005100 05 Gammal-Grupp Pic X Value Space. 005200 05 Ny-Grupp Pic X. 005300 005400 01 Summor. 005500 05 Artfil-Radsumma Pic 9(06) Value 0. 005600 05 Artfil-Kv1-Summa Pic 9(06) Value 0. 005700 05 Artfil-Kv2-Summa Pic 9(06) Value 0. 005800 05 Artfil-Kv3-Summa Pic 9(06) Value 0. 005900 05 Artfil-Kv1-Total Pic 9(06) Value 0. 006000 05 Artfil-Kv2-Total Pic 9(06) Value 0. 006100 05 Artfil-Kv3-Total Pic 9(06) Value 0. 006200 006300 01 Artfil-Meddelande. 006400 05 Pic X(35) Value 'ARTFIL gick ej att öppna, status: '. 006500 05 Artfil-Status Pic X(02) Value Space. 006600 88 Artfil-Openfel Value '01' thru '99'. 006700 006800 01 Villkor Pic 9 Value 0. 006900 88 Klar Value 1. 007000 88 Tabklar Value 2. 007100 007200 01 List-Separator. 007300 05 Pic X(120) Value All '_'. 007400 007500 01 List-Blankrad. 007600 05 Pic X(120) Value All Space. 007700 007800 01 List-Rubrik. 007900 05 Pic X(65) Value 'Utskrift av Artikelregister'. 008000 05 Pic X(07) Value 'Sidnr:'. 008100 05 List-Sidnr Pic Z(02). 008200 008300 01 List-Summa. 008400 05 Pic X(38) Value 'Totalsummor'. 008500 05 List-Kv1-Summa Pic Z(06). 008600 05 Pic X(05) Value Space. 008700 05 List-Kv2-Summa Pic Z(06). 008800 05 Pic X(05) Value Space. 008900 05 List-Kv3-Summa Pic Z(06). 009000 009100 01 List-Slutrad. 009200 05 Pic X(120) Value 'Slut på utskrift'. 009300 009400 01 List-Artikelgrupp. 009500 05 List-Beskrivning Pic X(25). 009600 009700 01 List-ArtikelRubrik. 009800 05 Pic X(06) Value 'Artnr'. 009900 05 Pic X(26) Value 'Artnamn'. 010000 05 Pic X(02) Value Space. 010100 05 Pic X(04) Value 'Lp1'. 010200 05 Pic X(07) Value 'Antal'. 010300 05 Pic X(04) Value 'Lp2'. 010400 05 Pic X(07) Value 'Antal'. 010500 05 Pic X(04) Value 'Lp3'. 010600 05 Pic X(07) Value 'Antal'. 010700 05 Pic X(05) Value 'Summa'. 010800 010900 01 List-ArtikelRad. 011000 05 Artfil-Nr Pic X(05). 011100 05 Pic X(01) Value Space. 011200 05 Artfil-Namn Pic X(25). 011300 05 Pic X(01) Value Space. 011400 05 Artfil-Typ Pic X(01). 011500 05 Pic X(01) Value Space. 011600 05 Artfil-Lp1 Pic X(02). 011700 05 Pic X(02) Value Space. 011800 05 Artfil-Kv1 Pic Z(06). 011900 05 Pic X(01) Value Space. 012000 05 Artfil-Lp2 Pic X(02). 012100 05 Pic X(02) Value Space. 012200 05 Artfil-Kv2 Pic Z(06). 012300 05 Pic X(01) Value Space. 012400 05 Artfil-Lp3 Pic X(02). 012500 05 Pic X(02) Value Space. 012600 05 Artfil-Kv3 Pic Z(06). 012700 05 Pic X(01) Value Space. 012800 05 Artfil-Summa Pic Z(06). 012900 013000 01 List-Datum1. 013100 05 Pic X(15) Value 'Utskrivet:'. 013200 05 Datum1 Pic X(50). 013300 013400 01 List-Datum2. 013500 05 Pic X(15) Value 'Giltig t.o.m :'. 013600 05 Datum2 Pic X(50). 013700 013800 Procedure Division. 013900 Perform Initiera 014000 Perform Until Klar 014100 Read ARTFIL 014200 At End 014300 Set KLAR to True 014400 Not At End 014500 Perform Skrivut 014600 End-Read 014700 End-Perform 014800 Perform Skriv-List-Summa 014900 Perform Skriv-List-Slutrad 015000 Perform Avsluta 015100 GoBack 015200 . 015300 Initiera. 015400 Open Input ARTFIL 015500 If Artfil-Openfel 015600 Move 99 to Return-Code 015700 Display Artfil-Meddelande 015800 Stop Run 015900 Else 016000 Display 'OPEN av ARTFIL ok...' 016100 Open Output LISTFIL 016200 Display 'OPEN av LISTFIL ok...' 016300 End-If 016400 . 016500 Skrivut. 016600 Move Artfil-Nr in Artfil-Post(1:1) to Ny-Grupp 016700 Perform Kontrollera-Brytning 016800 Move Corr Artfil-Post 016900 to List-ArtikelRad 017000 Perform Summeringar 017100 017200 Write List-Rad 017300 from List-ArtikelRad 017400 Add 1 to Radnummer 017500 Move Ny-Grupp to Gammal-Grupp 017600 . 017700 Kontrollera-Brytning. 017800 Evaluate True 017900 When Liststart 018000 Perform Skriv-List-Rubrik 018100 Perform Skriv-List-Datum 018200 Perform Skriv-Artikel-Rubrik 018300 Perform Skriv-Artikel-Grupp 018400 When Gammal-Grupp Not Equal Ny-Grupp 018500 Perform Skriv-List-Summa 018600 Perform Skriv-Artikel-Rubrik 018700 Perform Skriv-Artikel-Grupp 018800 When Radmax 018900 Perform Skriv-List-Rubrik 019000 Perform Skriv-Artikel-Rubrik 019100 Set Radstart to True 019200 End-Evaluate 019300 . 019400 Summeringar. 019500 Add Artfil-Kv1 in Artfil-Post to 019600 Artfil-Kv1-Summa Artfil-RadSumma 019700 Artfil-Kv1-Total 019800 Add Artfil-Kv2 in Artfil-Post to 019900 Artfil-Kv2-Summa Artfil-RadSumma 020000 Artfil-Kv2-Total 020100 Add Artfil-Kv3 in Artfil-Post to 020200 Artfil-Kv3-Summa Artfil-RadSumma 020300 Artfil-Kv3-Total 020400 Move Artfil-Radsumma to Artfil-Summa 020500 Move Zero to Artfil-Radsumma 020600 . 020700 Skriv-Artikel-Grupp. 020800 Move Ny-Grupp to Grp-Nyckel 020900 Call Tabpgm Using Tabpgm-Post 021000 Move Grp-Beskrivning 021100 to List-Beskrivning 021200 Write List-Rad 021300 from List-Artikelgrupp 021400 . 021500 Skriv-Artikel-Rubrik. 021600 Write List-Rad 021700 from List-Blankrad 021800 Write List-Rad 021900 from List-ArtikelRubrik 022000 Write List-Rad 022100 from List-Separator 022200 . 022300 Skriv-List-Rubrik. 022400 Add 1 to Sidnr 022500 Move Sidnr to List-Sidnr 022600 022700 Write List-Rad 022800 from List-Rubrik 022900 . 023000 Skriv-List-Slutrad. 023100 Write List-Rad 023200 from List-Separator 023300 Write List-Rad 023400 from List-Slutrad 023500 . 023600 Skriv-List-Summa. 023700 Move Artfil-Kv1-Summa to List-Kv1-Summa 023800 Move Artfil-Kv2-Summa to List-Kv2-Summa 023900 Move Artfil-Kv3-Summa to List-Kv3-Summa 024000 Write List-Rad 024100 from List-Separator 024200 Write List-Rad 024300 from List-Summa 024400 Move 0 to Artfil-Kv1-Summa 024500 Artfil-Kv2-Summa 024600 Artfil-Kv3-Summa 024700 If Klar 024800 Move Artfil-Kv1-Total to List-Kv1-Summa 024900 Move Artfil-Kv2-Total to List-Kv2-Summa 025000 Move Artfil-Kv3-Total to List-Kv3-Summa 025100 Write List-Rad 025200 from List-Separator 025300 Write List-Rad 025400 from List-Summa 025500 End-If 025600 . 025700 Skriv-List-Datum. 025800 Call 'BastForeDatum' Using Datum1, Datum2 025900 Write List-Rad 026000 from List-Blankrad 026100 Write List-Rad 026200 from List-Datum1 026300 Write List-Rad 026400 from List-Datum2 026500 . 026600 Avsluta. 026700 Close ARTFIL 026800 Display 'CLOSE av ARTFIL ok...' 026900 Close ARTFIL 027000 Display 'CLOSE av LISTFIL ok...' 027100 Display 'Programmet avslutar...' 027200 . 027300*-------------------------------------------------------- 027310* B a s t F o r e D a t u m 027320*-------------------------------------------------------- 027400 Identification Division. 027500 Program-Id. BastForeDAtum. 027600 Data Division. 027700 Working-Storage Section. 027800 027900 77 IDagensDatum Pic 9(07). 028000 77 DagensDatum Pic 9(08). 028100 77 DagensDagnummer Pic 9(01). 028200 77 DagensManadsnummer Pic 99. 028300 028400 77 INastaDatum Pic 9(07). 028500 77 NastaDatum Pic 9(08). 028600 77 NastaDagnummer Pic 9(01). 028700 77 NastaManadsnummer Pic 99. 028800 028900 01 Tabellerna. 029000 05 Dagarna. 029100 10 Pic X(10) Value 'Mandagen'. 029200 10 Pic X(10) Value 'Tisdagen'. 029300 10 Pic X(10) Value 'Onsdagen'. 029400 10 Pic X(10) Value 'Torsdagen'. 029500 10 Pic X(10) Value 'Fredagen'. 029600 10 Pic X(10) Value 'Lördagen'. 029700 10 Pic X(10) Value 'Söndagen'. 029800 05 Dagtab Redefines Dagarna. 029900 10 Dagen Pic X(10) Occurs 7. 030000 05 Manaderna. 030100 10 Pic X(10) Value 'Januari'. 030200 10 Pic X(10) Value 'Februari'. 030300 10 Pic X(10) Value 'Mars'. 030400 10 Pic X(10) Value 'April'. 030500 10 Pic X(10) Value 'Maj'. 030600 10 Pic X(10) Value 'Juni'. 030700 10 Pic X(10) Value 'Juli'. 030800 10 Pic X(10) Value 'Augusti'. 030900 10 Pic X(10) Value 'September'. 031000 10 Pic X(10) Value 'Oktober'. 031100 10 Pic X(10) Value 'November'. 031200 10 Pic X(10) Value 'December'. 031300 05 Mantab Redefines Manaderna. 031400 10 Manaden Pic X(10) Occurs 12. 031500 031600 Linkage Section. 031700 01 Datumrad1 Pic X(50). 031800 01 Datumrad2 Pic X(50). 031900*----------------------------------------------------------------- 032000 Procedure Division Using Datumrad1, 032100 Datumrad2. 032200 Move Function CURRENT-DATE(1:8) to DagensDatum 032300 Move Dagensdatum(5:2) to Dagensmanadsnummer 032400 032500 Compute IDagensDatum = Function INTEGER-OF-DATE(DagensDatum) 032600 Compute DagensDagnummer = Function REM (IdagensDatum , 7 ) 032700 If DagensDagnummer = 0 032800 Move 7 to DagensDagnummer 032900 End-If 033000 033100 String Dagen(DagensDagnummer) Delimited by Space 033200 ' den ' Delimited by Size 033300 DagensDatum(5:2) Delimited by Size 033400 ' ' Delimited by Size 033500 Manaden(DagensManadsnummer) Delimited by Space 033600 ' ' Delimited by Size 033700 DagensDatum(1:4) Delimited by Size 033800 033900 Into DatumRad1 034000 End-String 034100 034200 Call 'DATNEXT' Using NastaDatum 034300 034400 Move Nastadatum(5:2) to Nastamanadsnummer 034500 034600 Compute INastaDatum = Function INTEGER-OF-DATE(NastaDatum) 034700 Compute NastaDagnummer = Function REM (INastaDatum , 7 ) 034800 If NastaDagnummer = 0 034900 Move 7 to NastaDagnummer 035000 End-If 035100 035200 String Dagen(NastaDagnummer) Delimited by Space 035300 ' den ' Delimited by Size 035400 NastaDatum(5:2) Delimited by Size 035500 ' ' Delimited by Size 035600 Manaden(NastaManadsnummer) Delimited by Space 035700 ' ' Delimited by Size 035800 NastaDatum(1:4) Delimited by Size 035900 036000 Into DatumRad2 036100 End-String 036200 036300 GoBack 036400 . 036500*----------------------------------------------------------------- 036600* D a t n e x t 036700*----------------------------------------------------------------- 036800 Identification Division. 037000 Program-Id. Datnext. 037100 Data Division. 037200 Working-Storage Section. 037300 77 DagensDatum Pic 9(08). 037400 77 IntDagensDatum Pic 9(07). 037500 77 IntNastaDatum Pic 9(07). 037600 Linkage Section. 037700 01 NastaDatum Pic 9(08). 037800 037900 Procedure Division Using NastaDatum. 038000 Move Function CURRENT-DATE(1:8) to DagensDatum 038100 Compute IntNastaDatum = 038200 Function INTEGER-OF-DATE(DagensDAtum) + 30 038300 End-Compute 038400 Compute Nastadatum = 038500 Function DATE-OF-INTEGER(IntNastaDatum) 038600 End-Compute 038700 GoBack 038800 . 038900*----------------------------------------------------------------- 039000 End Program Datnext. 039100*----------------------------------------------------------------- 039200 End Program BastForeDatum. 039210*----------------------------------------------------------------- 039300 End Program OVN191. 039400*-----------------------------------------------------------------