START

START with OpenCOBOL

The START COBOL verb is a very powerful programming construct. OpenCOBOL does a pretty good job of implementing this feature of COBOL.

      *>>SOURCE FORMAT IS FIXED
      *> ***************************************************************
      *><* ================
      *><* indexing example                   
      *><* ================
      *><* :Author:    Brian Tiffin 
      *><* :Date:      17-Feb-2009 
      *><* :Purpose:   Fun with Indexed IO routines 
      *><* :Tectonics: cobc -x indexing.cob 
      *> ***************************************************************
       identification division.
       program-id. indexing.
 
       environment division.
       configuration section.
 
       input-output section.
       file-control.
          select optional indexing
          assign to "indexing.dat"
          organization is indexed
          access mode is dynamic
          record key is keyfield of indexing-record
       	  alternate record key is splitkey of indexing-record
              with duplicates
      *> ** OpenCOBOL does not yet support split keys **
      *>  alternate record key is newkey
      *>      source is first-part of indexing-record
      *>      with duplicates
          .
 
       data division.
       file section.
       fd indexing.
       01 indexing-record.
          03 keyfield          pic x(8).
          03 splitkey.
             05 first-part     pic 99.
             05 middle-part    pic x.
             05 last-part      pic 99.
          03 data-part         pic x(54).
 
       working-storage section.
       01 display-record.
          03 filler            pic x(4)  value spaces.
          03 keyfield          pic x(8).
          03 filler            pic xx    value spaces.
          03 splitkey.
             05 first-part     pic z9.
             05 filler         pic x     value space.
             05 middle-part    pic x.
             05 filler         pic xx    value all "+".
             05 last-part      pic z9.
          03 filler            pic x(4)  value all "-".
          03 data-part         pic x(54).
 
      *> control break 
       01 oldkey               pic 99x99.
 
      *> In a real app this should well be two separate flags
       01 control-flag         pic x.
          88 no-more-duplicates          value high-value
             when set to false is              low-value.
          88 no-more-records             value high-value
             when set to false is              low-value.
 
      *> ***************************************************************
       procedure division.
 
      *> Open optional index file for read write
       open i-o indexing
 
      *> populate a sample database
       move "1234567800a01some 12345678 data here" to indexing-record
       perform write-indexing-record
       move "8765432100a01some 87654321 data here" to indexing-record
       perform write-indexing-record
       move "1234876500a01some 12348765 data here" to indexing-record
       perform write-indexing-record
       move "8765123400a01some 87651234 data here" to indexing-record
       perform write-indexing-record
 
       move "1234567900b02some 12345679 data here" to indexing-record
       perform write-indexing-record
       move "9765432100b02some 97654321 data here" to indexing-record
       perform write-indexing-record
       move "1234976500b02some 12349765 data here" to indexing-record
       perform write-indexing-record
       move "9765123400b02some 97651234 data here" to indexing-record
       perform write-indexing-record
 
       move "1234568900c13some 12345689 data here" to indexing-record
       perform write-indexing-record
       move "9865432100c13some 98654321 data here" to indexing-record
       perform write-indexing-record
       move "1234986500c13some 12349865 data here" to indexing-record
       perform write-indexing-record
       move "9865123400c13some 98651234 data here" to indexing-record
       perform write-indexing-record
 
      *> close it ... not necessary, but for the example
       close indexing
 
      *> clear the record space for this example
       move spaces to indexing-record
 
      *> open the data file again
       open i-o indexing
 
      *> read all the duplicate 00b02 keys
       move 00 to first-part of indexing-record
       move "b" to middle-part of indexing-record
       move 02 to last-part of indexing-record
 
      *> using read key and then next key / last key compare
       set no-more-duplicates to false
       perform read-indexing-record
       perform read-next-record
           until no-more-duplicates
 
      *> read by key of reference ... the cool stuff
       move 00 to first-part of indexing-record
       move "a" to middle-part of indexing-record
       move 02 to last-part of indexing-record
 
      *> using start and read next
       set no-more-records to false
       perform start-at-key
       perform read-next-by-key
           until no-more-records
 
      *> read by primary key of reference
       move "87654321" to keyfield of indexing-record 
 
      *>
       set no-more-records to false
       perform start-prime-key
       perform read-previous-by-key
           until no-more-records
 
      *> and with that we are done with indexing sample
       close indexing
 
       goback.
      *> ***************************************************************
 
      *><* Write paragraph
       write-indexing-record.
	   write indexing-record
	       invalid key
		   display
		       "rewrite key: " keyfield of indexing-record
		   end-display
                   rewrite indexing-record
                       invalid key
                           display
                               "really bad key: "
                               keyfield of indexing-record
                           end-display
                   end-rewrite
	   end-write
       .
 
      *><* read by alternate key paragraph
       read-indexing-record.
           display "Reading: " splitkey of indexing-record end-display
           read indexing key is splitkey of indexing-record
    	   invalid key
    	       display 
    		  "bad read key: " splitkey of indexing-record
    	       end-display
               set no-more-duplicates to true
           end-read
       .
 
      *><* read next sequential paragraph
       read-next-record.
           move corresponding indexing-record to display-record
           display display-record end-display
           move splitkey of indexing-record to oldkey
 
           read indexing next record
               at end set no-more-duplicates to true
               not at end
                   if oldkey not equal splitkey of indexing-record
                       set no-more-duplicates to true
                   end-if
           end-read
       .
 
      *><* start primary key of reference paragraph
       start-prime-key.
           display "Prime < " keyfield of indexing-record end-display
           start indexing
              key is less than
                  keyfield of indexing-record
              invalid key
                  display
                      "bad start: " keyfield of indexing-record
                  end-display
                  set no-more-records to true
              not invalid key
                  read indexing previous record
                      at end set no-more-records to true
                  end-read
           end-start
       .
 
      *><* read previous by key or reference paragraph
       read-previous-by-key.
           move corresponding indexing-record to display-record
           display display-record end-display
 
           read indexing previous record
               at end set no-more-records to true
           end-read
       .
      *><* start alternate key of reference paragraph
       start-at-key.
           display "Seeking >= " splitkey of indexing-record end-display
           start indexing
              key is greater than or equal to
                  splitkey of indexing-record
              invalid key
                  display
                      "bad start: " splitkey of indexing-record
                  end-display
                  set no-more-records to true
              not invalid key
                  read indexing next record
                      at end set no-more-records to true
                  end-read
           end-start
       .
 
      *><* read next by key or reference paragraph
       read-next-by-key.
           move corresponding indexing-record to display-record
           display display-record end-display
 
           read indexing next record
               at end set no-more-records to true
           end-read
       .
       end program indexing.
      *><*
      *><* Last Update: 20090220

Outputting, on second run, giving the rewrite messages

$ ./indexing
rewrite key: 12345678
rewrite key: 87654321
rewrite key: 12348765
rewrite key: 87651234
rewrite key: 12345679
rewrite key: 97654321
rewrite key: 12349765
rewrite key: 97651234
rewrite key: 12345689
rewrite key: 98654321
rewrite key: 12349865
rewrite key: 98651234
Reading: 00b02
    12345679   0 b++ 2----some 12345679 data here
    97654321   0 b++ 2----some 97654321 data here
    12349765   0 b++ 2----some 12349765 data here
    97651234   0 b++ 2----some 97651234 data here
Seeking >= 00a02
    12345679   0 b++ 2----some 12345679 data here
    97654321   0 b++ 2----some 97654321 data here
    12349765   0 b++ 2----some 12349765 data here
    97651234   0 b++ 2----some 97651234 data here
    12345689   0 c++13----some 12345689 data here
    98654321   0 c++13----some 98654321 data here
    12349865   0 c++13----some 12349865 data here
    98651234   0 c++13----some 98651234 data here
Prime < 87654321
    87651234   0 a++ 1----some 87651234 data here
    12349865   0 c++13----some 12349865 data here
    12349765   0 b++ 2----some 12349765 data here
    12348765   0 a++ 1----some 12348765 data here
    12345689   0 c++13----some 12345689 data here
    12345679   0 b++ 2----some 12345679 data here
    12345678   0 a++ 1----some 12345678 data here

---