🚀 go-pugleaf

"[wallie]" <wallie@mostresticator.cjb.net.invalid> schreef in bericht
news:2iknuugtje4trj9uh50io2antkptrtkul1@4ax.com...
> "TRAX" <Stijn.Verspeet@pandora[delete.this].be> wrote:
>
> >
> >> Je bent je sortf-eof vergeten op true te zetten :-)
> >>
> >
> >
> > yups had het ook al gezien maar dat lost mijn probleem nie op :) is er
enig
> >nut te bespeuren in de hele cbl file eens te posten?
>
> Allee, laat u nen keer goe gaan dan ;-)
1 identification division.
     2 program-id. lijst2a.
     3 environment division.
     4 input-output section.
     5 file-control.
     6        select  pat assign to "pat.dat"
     7                organization is indexed
     8                access mode is sequential
     9                record key is pat-dossiernr
    10                alternate record key is pat-naam with duplicates
    11                alternate record key is pat-gebdatum
    12                  with duplicates
    13                alternate record key is pat-woon-post
    14                  with duplicates.
    15        select lijst assign to "lijst2a.spl"
    16                organization is line sequential.
    17        select sortf assign to disk.
    18 data division.
    19 file section.
    20 fd pat.
    21 01 pat-rec.
    22 88 pat-eof value high-value.
    23   04 pat-dossiernr                               pic 9(4).
    24   04 pat-gebdatum                                pic x(8).
    25   04 pat-geslacht                                pic x.
    26   04 pat-naam                                    pic x(25).
    27   04 pat-voornaam                                pic x(20).
    28   04 pat-naam-ger                                pic x(25).
    29   04 pat-adres.
    30     08 pat-straat                                pic x(30).
    31     08 pat-straatnr                              pic x(4).
    32   04 pat-woon-post.
    33     08 pat-woonplaats                            pic x(35).
    34     08 pat-postcode                              pic x(4).
    35   04 pat-tel                                     pic x(10).
    36   04 pat-gsm                                     pic x(10).
    37   04 pat-rel-ger                                 pic x.
    38   04 pat-hsart-riz-nr                            pic x(11).
    39   04 pat-mutnr                                   pic x(3).
    40   04 pat-lidnr-mut                               pic x(11).
    41 sd sortf.
    42 01 s-rec.
    43 88 sortf-eof value high-value.
    44   04 s-naam                                      pic x(25).
    45   04 s-voornaam                                  pic x(20).
    46   04 s-straat                                    pic x(30).
    47   04 s-straatnr                                  pic x(4).
    48   04 s-postcode                                  pic x(4).
    49   04 s-gemeente                                  pic x(35).
    50 fd lijst.
    51 01 l-rec.
    52   04 lijn                                        pic x(80).
    53 working-storage section.
    54 01 postcode                                      pic x(4).
    55 01 i                                             pic 9 value 0.
    56 01 j                                             pic 9 value 0.
    57 01 tabel.

* Microsoft COBOL Version 4.5        L2.4 revision 002 02-Dec-02 22:11 Page
2
*                                     LIJST2A.CBL
    58   04 rij occurs 3.
    59      06 lijn occurs 3                            pic x(25).
    60 procedure division.
    61 programma.
    62     open input pat output lijst
    63     sort sortf on ascending s-gemeente s-naam
    64          with duplicates in order
    65          input procedure is vul-op
    66          output procedure is tabelvullen
    67     close pat lijst
    68 stop run.
    69
    70
    71
    72
    73
    74
    75  vul-op.
    76     read pat at end display "fout: pati?nten bestand is leeg!"
    77     end-read
    78     perform until pat-eof
    79        move pat-naam to s-naam
    80        move pat-voornaam to s-voornaam
    81        move pat-straat to s-straat
    82        move pat-straatnr to s-straatnr
    83        move pat-postcode to s-postcode
    84        move pat-woonplaats to s-gemeente
    85        release s-rec
    86        read pat at end display "pati?ntenbestand is gesorteerd"
    87        end-read
    88     end-perform.
    89
    90
    91
    92 tabelvullen.
    93     return sortf at end display "sortfile corrupt"
    94     end-return
    95     perform until sortf-eof
    96       move s-postcode to postcode
    97       add 1 to i
    98       string s-naam delimited by space
    99              ", " delimited by size
   100              s-voornaam delimited by size
   101             into lijn (1 i)
*   5-S*********************                                           (
0)**
**    User-name  not unique
   102       end-string
   103       string s-straat delimited by space
   104              " " delimited by size
   105              s-straatnr delimited by size
   106              into lijn (2 i)
*   5-S**********************                                          (
2)**
**    User-name  not unique
   107       end-string
   108       string s-postcode delimited by space
   109              " " delimited by size
   110              s-gemeente delimited by size
   111              into lijn (3 i)

* Microsoft COBOL Version 4.5        L2.4 revision 002 02-Dec-02 22:11 Page
3
*                                     LIJST2A.CBL
*   5-S**********************                                          (
2)**
**    User-name  not unique
   112       end-string
   113       if i >= 3 or not postcode = s-postcode
   114         if not postcode = s-postcode
   115           move 3 to j
   116           perform drukken
   117         else
   118         perform drukken
   119         end-if
   120       end-if
   121       return sortf at end set sortf-eof to true
   122                    display "tabel(len) opgevuld."
   123       end-return
   124     end-perform.
   125
   126
   127 drukken.
   128     add 1 to j
   129     move space to l-rec
   130     write l-rec from rij(1) after 2
   131     write l-rec from rij(2) after 1
   132     write l-rec from rij(3) after 1
   133     move space to l-rec
   134     write l-rec after 1
   135     if j >=3
   136       write l-rec after page
   137       move 0 to j
   138     end-if
   139     move 0 to i
   140     move space to tabel.
   141
   142
* Microsoft COBOL Version 4.5        L2.4 revision 002
* (C)Copyright Microsoft Corp 1984, 1991       URN AXUPA/MS0/000000
*                                              REF GNB-024050002A7
*
* Last message on page:  2
*
* Total Messages:     3
* Unrecoverable :     0                    Severe  :     3
* Errors        :     0                    Warnings:     0
* Informational :     0                    Flags   :     0
* Data:        1812     Code:        1131     Dictionary:        2353