000100 Identification Division.
000200 Program-Id. OVN181
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 Procedure Division.
013100     Perform Initiera
013200     Perform Until Klar
013300        Read ARTFIL
013400           At End
013500              Set KLAR to True
013600           Not At End
013700              Perform Skrivut
013800        End-Read
013900     End-Perform
014000     Perform Skriv-List-Summa
014100     Perform Skriv-List-Slutrad
014200     Perform Avsluta
014300     GoBack
014400     .
014500 Initiera.
014600     Open Input ARTFIL
014700     If Artfil-Openfel
014800        Move 99 to Return-Code
014900        Display Artfil-Meddelande
015000        Stop Run
015100     Else
015200        Display 'OPEN av ARTFIL ok...'
015300        Open Output LISTFIL
015400        Display 'OPEN av LISTFIL ok...'
015500     End-If
015600     .
015700 Skrivut.
015800     Move Artfil-Nr in Artfil-Post(1:1) to Ny-Grupp
015900     Perform Kontrollera-Brytning
016000     Move Corr Artfil-Post
016100            to List-ArtikelRad
016200     Perform Summeringar
016300
016400     Write List-Rad
016500        from List-ArtikelRad
016600     Add 1 to Radnummer
016700     Move Ny-Grupp to Gammal-Grupp
016800     .
016900 Kontrollera-Brytning.
017000     Evaluate True
017100        When Liststart
017200           Perform Skriv-List-Rubrik
017300           Perform Skriv-Artikel-Rubrik
017400           Perform Skriv-Artikel-Grupp
017500        When Gammal-Grupp Not Equal Ny-Grupp
017600           Perform Skriv-List-Summa
017700           Perform Skriv-Artikel-Rubrik
017800           Perform Skriv-Artikel-Grupp
017900        When Radmax
018000           Perform Skriv-List-Rubrik
018100           Perform Skriv-Artikel-Rubrik
018200           Set Radstart to True
018300     End-Evaluate
018400     .
018500 Summeringar.
018600     Add Artfil-Kv1 in Artfil-Post to
018700         Artfil-Kv1-Summa Artfil-RadSumma
018800         Artfil-Kv1-Total
018900     Add Artfil-Kv2 in Artfil-Post to
019000         Artfil-Kv2-Summa Artfil-RadSumma
019100         Artfil-Kv2-Total
019200     Add Artfil-Kv3 in Artfil-Post to
019300         Artfil-Kv3-Summa Artfil-RadSumma
019400         Artfil-Kv3-Total
019500     Move Artfil-Radsumma to Artfil-Summa
019600     Move Zero to Artfil-Radsumma
019700     .
019800 Skriv-Artikel-Grupp.
019900     Move Ny-Grupp to Grp-Nyckel
020000     Call Tabpgm Using Tabpgm-Post
020100     Move Grp-Beskrivning
020200            to List-Beskrivning
020300     Write List-Rad
020400        from List-Artikelgrupp
020500     .
020600 Skriv-Artikel-Rubrik.
020700     Write List-Rad
020800        from List-Blankrad
020900     Write List-Rad
021000        from List-ArtikelRubrik
021100     Write List-Rad
021200        from List-Separator
021300     .
021400 Skriv-List-Rubrik.
021500     Add 1 to Sidnr
021600     Move Sidnr to List-Sidnr
021700
021800     Write List-Rad
021900        from List-Rubrik
022000     .
022100 Skriv-List-Slutrad.
022200     Write List-Rad
022300        from List-Separator
022400     Write List-Rad
022500        from List-Slutrad
022600     .
022700 Skriv-List-Summa.
022800     Move Artfil-Kv1-Summa to List-Kv1-Summa
022900     Move Artfil-Kv2-Summa to List-Kv2-Summa
023000     Move Artfil-Kv3-Summa to List-Kv3-Summa
023100     Write List-Rad
023200        from List-Separator
023300     Write List-Rad
023400        from List-Summa
023500     Move 0 to Artfil-Kv1-Summa
023600               Artfil-Kv2-Summa
023700               Artfil-Kv3-Summa
023800     If Klar
023900        Move Artfil-Kv1-Total to List-Kv1-Summa
024000        Move Artfil-Kv2-Total to List-Kv2-Summa
024100        Move Artfil-Kv3-Total to List-Kv3-Summa
024200        Write List-Rad
024300           from List-Separator
024400        Write List-Rad
024500           from List-Summa
024600     End-If
024700     .
024800 Avsluta.
024900     Close ARTFIL
025000     Display 'CLOSE av ARTFIL ok...'
025100     Close ARTFIL
025200     Display 'CLOSE av LISTFIL ok...'
025300     Display 'Programmet avslutar...'
025400     .