World of A1200/World_Of_A1200.iso/programs/database/isam/examples/books.rexx

OS/2 REXX Batch file | 1995-02-27 | 37KB | 1,516 lines

/* Here is a sample ARexx ISAM application */

/* This should run the same as the C example */


/* Here is how the Book and Category records look like from the C Language

  struct Book {
     /* 00 */  char  Title [30];
     /* 30 */  char  Author [30];
     /* 60 */  char  Publisher [30];
     /* 90 */  UWORD Copyright;
     /* 92 */  char  Category;
     /* 93 */  char  Form;  /* P-aperback, H-ardCover, T-radePB, C-offeeTable */
     /* 94 */  UWORD Pages;
     /* 96 */  float Value;
  }; /*100 */

  struct Category {
     /* 00 */  char Code;
     /* 01 */  char Name [30];
  }; /* 31 */

*/

/*
 trace all
*/

SIGNAL ON ERROR
SIGNAL ON SYNTAX
SIGNAL ON BREAK_C

if ( ~show( 'L', 'rexxsupport.library' ) )
  then
    do
      if ( ~addlib( 'rexxsupport.library', 0, -30, 0 ) )
        then
          do
            say "Couldn't open rexxsupport library."
            exit 10
        end
    end

if ( ~show( 'L', 'rexxisam.library' ) )
  then
    do
      if ( ~addlib( 'rexxisam.library', 0, -30, 0 ) )
        then
          do
            say "Couldn't open rexxisam library."
            exit 10
        end
    end

ISAM = 1

              /* define some constants */
TRUE = 1
FALSE = 0
OK = 0
ERROR_NO_SUCH_RECORD  = 1210
ERROR_DELETED_RECORD  = 1035
ERROR_RECORD_TOO_HIGH = 1235
ERROR_RECORD_EXISTS   = 1225
ERROR_NO_MORE_RECORDS = 1200

MAXRECSIZE = 100
MAXKEYSIZE = 30
CLEAR  = '0001 0000'x  /* MEMF_CLEAR - for memory allocation */

KeyMem  = 0
ToMem   = 0
FromMem = 0
CatRecMem  = 0
BookRecMem = 0

KeyMem  = allocmem( MAXKEYSIZE, CLEAR )
FromMem = allocmem( MAXKEYSIZE, CLEAR )
ToMem   = allocmem( MAXKEYSIZE, CLEAR )

CatRecMem  = allocmem( MAXRECSIZE, CLEAR )
BookRecMem = allocmem( MAXRECSIZE, CLEAR )

do forever

  SpecsFileNameB  = "DATA:Book.specs"
  SpecsFileNameC  = "DATA:BookCat.specs"

  BookTypes = "s30 s30 s30 u2 s1 s1 u2 f4"
  BookVars  = "Title Author Publisher Copyright Category Form Pages Value"
  BookFmts  = ' %30.30s %30.30s %30.30s %4u %4.1s "%4.1s "  %6u %8.2lf '

  CatTypes = "s1 s30"
  CatVars  = "CatCode CatName"
  CatFmts  = ' "  %.1s " %30.30s '

  ISAMHandleB = 0
  error = OpenISAMFile( SpecsFileNameB, TRUE, 'R', TRUE, "ISAMHandleB" )
  if (error ~= OK ) then
    do
      say "Error:" error "opening '" SpecsFileNameB "'"
      break
    end
  ISAMHandleC = 0
  error = OpenISAMFile( SpecsFileNameC, TRUE, 'R', TRUE, "ISAMHandleC" )
  if (error ~= OK ) then
    do
      say "Error:" error "opening '" SpecsFileNameC "'"
      break
    end

  do forever
    say ""
    say "1  : Store  Book     5 : Store  Book Category"
    say "2  : Modify Book     6 : Modify Book Category"
    say "3  : Delete Book     7 : Delete Book Category"
    say "4  : List   Books    8 : List   Book Categories"
    say ""
    say "0  : exit"
    say ""
    say "SELECT ?"

    parse pull selectit
    say ""


    if ( selectit = 0 ) then
      break

    select

      when ( selectit = 1 ) then
        do
         say "Category ?"
         parse upper pull Category
         Category = left( Category, 1 )

         error = AssembleRecord( KeyMem, 1, "s1", "Category" )
         if (error ~= OK ) then
           do
             say "Error" error "from AssembleRecord -  main"
             return FALSE
           end
         error = ReadUniqueISAMRecord( ISAMHandleC, 0, KeyMem, ,
                                       FALSE, ' ', "tmpRecNo", CatRecMem )
         select
           when (error = ERROR_NO_SUCH_RECORD ) then
             do
               say "No such Category."
             end

           when (error = OK ) then
             do
             end

           otherwise
             do
               say "Error" error "."
             end
         end

         if ( error ~= OK ) then
           iterate

         say "Title ?"
         parse pull Title
         Title = left( Title, 30, ' ' )

         say "Author ?"
         parse pull Author
         Author = left( Author, 30, ' ' )

         say "Publisher ?"
         parse pull Publisher
         Publisher = left( Publisher, 30, ' ' )

         say "Copyright Year ?"
         parse pull Copyright

         say "Form (P/H/T/C) ?"
         parse upper pull Form
         Form = left( Form, 1 )

         say "Number of Pages ?"
         parse pull Pages

         say "Value ?"
         parse pull Value


         say "Enter a number to Store Book: ('-1' to abort)"
         parse pull number
         say ""
         if ( number = -1 ) then
           iterate

         error = AssembleRecord( BookRecMem, 100, BookTypes, BookVars )
         if (error ~= OK ) then
           do
             say "Error" error " from AssembleRecord - main"
             iterate
           end

         error = StoreISAMRecord( ISAMHandleB, BookRecMem, FALSE, ' ', ,
                                  "RecNo" )
         if (error = OK) then
             say "Record# " RecNo
           else
             say "Error:" error " from StoreISAMRecord - book."
         iterate
        end


      when ( selectit = 2 ) then
        do
         say "Rec# :"
         parse pull RecNo
         say ""

         error = ReadISAMRecord( ISAMHandleB, RecNo, FALSE, ' ', BookRecMem )
         select
           when (error = ERROR_DELETED_RECORD) then
             say "That record has been deleted."

           when (error = ERROR_RECORD_TOO_HIGH) then
             say "That record number is too high."

           when (error = OK) then
             do
             end

           otherwise
             say "Error:" error "from ReadISAMRecord - mod. book."
     end
         if ( error ~= OK ) then
           iterate

         call EditBook()


         say "Enter a number to Modify Book: ('-1' to abort)"
         parse pull number
         say ""
         if ( number = -1 ) then
           iterate

         error = ModifyISAMRecord( ISAMHandleB, RecNo, BookRecMem )
         if (error = OK) then
             say "Book Modified."
           else
             say "Error:" error "from ModifyISAMRecord - book."
         iterate
        end


      when ( selectit = 3 ) then
        do
         say "Rec# :"
         parse pull RecNo
         say ""

         error = ReadISAMRecord( ISAMHandleB, RecNo, FALSE, ' ', BookRecMem )
         select
           when (error = ERROR_DELETED_RECORD) then
             say "That record has been deleted."

           when (error = ERROR_RECORD_TOO_HIGH) then
             say "That record number is too high."

           when (error = OK) then
             do
               error = DisAssembleRecord( BookRecMem, 100, BookTypes, BookVars )
               if (error ~= OK ) then
                 do
                   say "Error" error "from DisAssembleRecord - main"
                   return FALSE
                 end

               say "Title     : '" || Title || "'"
               say "Author    : '" || Author || "'"
               say "Publisher : '" || Publisher || "'"
               say "Copyright : "  Copyright
               say "Category  : '" || Category || "'"
               say "Form      : '" || Form || "'"
               say "Pages     : "  Pages
               say "Value     : "  Value
               say ""
             end

           otherwise
             say "Error:" error "from ReadISAMRecord - del. book."
     end
         if ( error ~= OK ) then
           iterate


         say "Enter a number to Delete Book: ('-1' to abort)"
         parse pull number
         say ""
         if ( number = -1 ) then
           iterate

         error = DeleteISAMRecord( ISAMHandleB, RecNo )
         select
           when (error = ERROR_DELETED_RECORD) then
             say "That record has been deleted."

           when (error = ERROR_RECORD_TOO_HIGH) then
             say "That record number is too high."

           when (error = OK) then
             do
               say "Record deleted."
             end

           otherwise
             say "Error:" error "from DeleteISAMRecord - book."
     end

         iterate
        end


      when ( selectit = 4 ) then
        do
          call ListBooks()
          iterate
        end


      when ( selectit = 5 ) then
        do
         say "Category Code ?"
         parse upper pull CatCode
         CatCode = left( CatCode, 1 )

         say "Category Name ?"
         parse pull CatName
         CatName = left( CatName, 30, ' ' )

         error = AssembleRecord( CatRecMem, 31, CatTypes, CatVars )
         if (error ~= OK ) then
           do
             say "Error" error "from AssembleRecord - store cat."
             iterate
           end

         say "Enter a number to Store Category: ('-1' to abort)"
         parse pull number
         say ""
         if ( number = -1 ) then
           iterate

         error = StoreISAMRecord( ISAMHandleC, CatRecMem, FALSE, ' ', "RecNo" )
         select
           when (error = ERROR_RECORD_EXISTS) then
             say "That Category already exists."

           when (error = OK) then
             say "Record# " RecNo

           otherwise
             say "Error:" error "from StoreISAMRecord - category"
         end
         iterate
        end


      when ( selectit = 6 ) then
        do
         say "Category Code ?"
         parse upper pull CatCode
         CatCode = left( CatCode, 1 )

         error = AssembleRecord( KeyMem, 1, "s1", "CatCode" )
         if (error ~= OK ) then
           do
             say "Error" error "from AssembleRecord - mod. cat."
             return FALSE
           end

         error = ReadUniqueISAMRecord( ISAMHandleC, 0, KeyMem, ,
                                       FALSE, ' ', "RecNo", CatRecMem )
         select
           when (error = ERROR_NO_SUCH_RECORD) then
             say "No such Category."

           when (error = OK) then
             do
             end

           otherwise
             say "Error:" error " from ReadUniqueISAMRecord - mod. cat."
         end
         if ( error ~= OK ) then
           iterate

         error = DisAssembleRecord( CatRecMem, 31, CatTypes, CatVars )
         if (error ~= OK ) then
           do
             say "Error" error "from DisAssembleRecord - mod. cat."
             iterate
           end

         say "'" CatName "'"

         say "New Category Code ?"
         parse upper pull CatCode
         CatCode = left( CatCode, 1 )

         say "New Category Name ?"
         say "(currently: '" CatName "')"
         parse pull CatName
         CatName = left( CatName, 30, ' ' )

         say "Enter a number to Modify Category: ('-1' to abort) "
         parse pull number
         say ""
         if ( number = -1 ) then
           iterate

         error = AssembleRecord( CatRecMem, 31, CatTypes, CatVars )
         if (error ~= OK ) then
           do
             say "Error" error "from AssembleRecord - mod. cat."
             iterate
           end

         error = ModifyISAMRecord( ISAMHandleC, RecNo, CatRecMem )
         select
           when (error = ERROR_RECORD_EXISTS) then
             say "That Category already exists."

           when (error = OK) then
             say "Category Modified."

           otherwise
             say "Error:" error "from ModifyISAMRecord - category"
         end
         iterate
        end


      when ( selectit = 7 ) then
        do
         say "Category Code ?"
         parse upper pull CatCode
         CatCode = left( CatCode, 1 )

         error = AssembleRecord( KeyMem, 1, "s1", "CatCode" )
         if (error ~= OK ) then
           do
             say "Error" error "from AssembleRecord - del. cat."
             iterate
           end

         error = ReadUniqueISAMRecord( ISAMHandleC, 0, KeyMem, ,
                                       FALSE, ' ', "RecNo", CatRecMem )
         select
           when (error = ERROR_NO_SUCH_RECORD) then
             say "No such Category."

           when (error = OK) then
             do
             end

           otherwise
             say "Error:" error "from ReadUniqueISAMRecord - del. cat."
         end
         if ( error ~= OK ) then
           iterate

         error = DisAssembleRecord( CatRecMem, 31, CatTypes, CatVars )
         if (error ~= OK ) then
           do
             say "Error" error "from DisAssembleRecord - del. cat."
             iterate
           end

         say "Category Code: '" || CatCode || "'"
         say "         Name: '" || CatName || "'"
         say ""

         say "Enter a number to Delete Category: ('-1' to abort)"
         parse pull number
         say ""
         if ( number = -1 ) then
           iterate

         error = DeleteISAMRecord( ISAMHandleC, RecNo )
         select

           when (error = OK) then
             say "Category Deleted."

           otherwise
             say "Error:" error "from DeleteISAMRecord - category."
         end

         iterate
        end

      when ( selectit = 8 ) then
        do
         call ListCategories()
         iterate
        end

      otherwise
         say "No such option."
         iterate
    end /* select */

    iterate
  end  /* do forever - menu */

  break
end /* do forever */



/* earlier 'break's fall through to here */

/*-------------------------- Cleanup at Shutdown ----------------------------*/

END:

SYNTAX:
ERROR:
BREAK_C:

SIGNAL OFF SYNTAX
SIGNAL OFF ERROR
SIGNAL OFF BREAK_C

if ( ( RC ~= 0 ) & ( RC ~= "RC" ) ) then
  do
    if datatype( RC, numeric ) then
      do
        say "Error '"RC"' returned from line '" SIGL "'"
        say ErrorText( RC )
      end
     else
      do
        say "Error returned from line '" SIGL "'"
        say "'" || RC || "'"
      end
    say "Source Line:"
    say "'" || sourceline( SIGL ) || "'"
    say ""
  end


if ( ISAM = 1 ) then
  do
    if ( ISAMHandleB ~= 0 ) then
      do
        error = CloseISAMFile( ISAMHandleB )
        if ( error ~= OK )
          then say "Error" error "returned closing Book ISAM File."
      end
    if ( ISAMHandleC ~= 0 ) then
      do
        error = CloseISAMFile( ISAMHandleC )
        if ( error ~= OK )
          then say "Error" error "returned closing Book Category ISAM File."
      end

    error = EndISAM()
    if ( error ~= OK )
      then say "Error" error "returned Closing ISAM Library."

    ISAM = 0
  end


if ( KeyMem ~= 0 ) then
  do
    freemem( KeyMem,  MAXKEYSIZE )
    KeyMem = 0
  end
if ( FromMem ~= 0 ) then
  do
    freemem( FromMem, MAXKEYSIZE )
    FromMem = 0
  end
if ( ToMem ~= 0 ) then
  do
    freemem( ToMem,   MAXKEYSIZE )
    ToMem = 0
  end

if ( CatRecMem ~= 0 ) then
  do
    freemem( CatRecMem,  MAXRECSIZE )
    CatRecMem = 0
  end
if ( BookRecMem ~= 0 ) then
  do
    freemem( BookRecMem, MAXRECSIZE )
    BookRecMem = 0
  end

if ( show( 'L', 'rexxsupport.library' ) )  then
  remlib( 'rexxsupport.library' )

if ( show( 'L', 'rexxisam.library' ) ) then
  remlib( 'rexxisam.library' )

exit




/*------------------------------ HandlePrefix -------------------------------*/
HandlePrefix: procedure expose prefixLen KeyMem ISAMHandleC CatRecMem ,
FALSE TRUE OK ERROR_NO_SUCH_RECORD

  parse arg keyno

  select

    when (keyno = 0) | (keyno = 1) | (keyno = 2) then
      do
        say "prefix?"
        parse pull prefix
        prefixLen = length( prefix )
        if (prefixLen > 10)
          then
            do
              prefixLen = 10
              prefix = Left( prefix, 10 )
            end
        say "Prefix: '" || prefix || "'"
        say ""
        error = AssembleRecord( KeyMem, 10, "s10", "prefix" )
        if (error ~= OK ) then
          do
            say "Error" error "from AssembleRecord - prefix"
            return FALSE
          end

      end

    when (keyno = 4) then
      do
        say "prefix?"
        parse pull prefix
        prefixLen = length( prefix )
        if (prefixLen > 2)
          then
            do
              prefixLen = 2
              prefix = Left( prefix, 2 )
            end
        say "Prefix: '" || prefix || "'"
        say ""
        error = AssembleRecord( KeyMem, 2, "s2", "prefix" )
        if (error ~= OK ) then
          do
            say "Error" error "from AssembleRecord - prefix"
            return FALSE
          end

            /* ISAM knows Cat key 0 is 1 byte long, so it's OK */
            /* that the prefix has two bytes in it, the 2nd    */
            /* byte will be ignored.                           */
        error = ReadUniqueISAMRecord( ISAMHandleC, 0, KeyMem, ,
                                      FALSE, ' ', "tmpRecNo", CatRecMem )
        select
          when (error = ERROR_NO_SUCH_RECORD ) then
            do
              say "No such Category."
              return FALSE
            end

          when (error = OK ) then
            do
            end

          otherwise
            do
              say "Error" error "."
              return FALSE
            end
        end

      end

    otherwise
      say "Whoops! How did we get here with keyno = " keyno "?"
      return FALSE

  end

  return TRUE


/*------------------------------ HandleKey -------------------------------*/
HandleKey: procedure expose KeyMem ISAMHandleC CatRecMem FALSE TRUE OK ,
ERROR_NO_SUCH_RECORD

  parse arg keyno

  select

    when (keyno = 0) | (keyno = 1) | (keyno = 2) then
      do
        say "Key?"
        parse pull key
        key = left( key, 10, ' ' )
        say "Key: '" || key || "'"
        say ""
        error = AssembleRecord( KeyMem, 10, "s10", "key" )
        if (error ~= OK ) then
          do
            say "Error" error "from AssembleRecord - Key"
            return FALSE
          end
      end

    when (keyno = 4) then
      do
        say "Key?"
        parse pull key
        key = left( key, 2, ' ' )
        say "Key: '" || key || "'"
        say ""
        error = AssembleRecord( KeyMem, 2, "s2", "key" )
        if (error ~= OK ) then
          do
            say "Error" error "from AssembleRecord - Key"
            return FALSE
          end
        error = ReadUniqueISAMRecord( ISAMHandleC, 0, KeyMem, ,
                                      FALSE, ' ', "tmpRecNo", CatRecMem )
        select
          when (error = ERROR_NO_SUCH_RECORD ) then
            do
              say "No such Category."
              return FALSE
            end

          when (error = OK ) then
            do
            end

          otherwise
            do
              say "Error" error "."
              return FALSE
            end
        end
      end


    when (keyno = 5) then
      do
        say "Key?"
        parse pull key
        key = left( key, 1, ' ' )
        say "Key: '" || key || "'"
        say ""
        error = AssembleRecord( KeyMem, 1, "s1", "key" )
        if (error ~= OK ) then
          do
            say "Error" error "from AssembleRecord - Key"
            return FALSE
          end
      end

    when (keyno = 3) | (keyno = 6) then
      do
        say "Key?"
        parse pull key
        say "Key: '" || key || "'"
        say ""
        error = AssembleRecord( KeyMem, 2, "u2", "key" )
        if (error ~= OK ) then
          do
            say "Error" error "from AssembleRecord - Key"
            return FALSE
          end
      end


    when (keyno = 7) then
      do
        say "Key?"
        parse pull key
        say "Key: '" || key || "'"
        say ""
        error = AssembleRecord( KeyMem, 4, "f4", "key" )
        if (error ~= OK ) then
          do
            say "Error" error "from AssembleRecord - Key"
            return FALSE
          end
      end


    otherwise
      say "Whoops! How did we get here with keyno = " keyno "?"
      return FALSE

  end

  return TRUE


/*----------------------------- HandleRange ------------------------------*/

HandleRange: procedure expose FromMem ToMem ISAMHandleC CatRecMem FALSE TRUE ,
                              OK ERROR_NO_SUCH_RECORD

  parse arg keyno, itertype

  select

    when (keyno = 0) | (keyno = 1) | (keyno = 2) then
      do
        if ( (itertype = 1) | ((itertype >= 4) & (itertype <= 9)) ) then
          do
            say "From?"
            parse pull fromkey
            fromkey = left( fromkey, 10, ' ' )
            say "From: '" || fromkey || "'"
            say ""
            error = AssembleRecord( FromMem, 10, "s10", "fromkey" )
            if (error ~= OK ) then
              do
                say "Error" error "from AssembleRecord - Range"
                return FALSE
              end
          end

        if ( (itertype >= 2) & (itertype <= 7) ) then
          do
            say "To?"
            parse pull tokey
            tokey = left( tokey, 10, ' ' )
            say "To: '" || tokey || "'"
            say ""
            error = AssembleRecord( ToMem, 10, "s10", "tokey" )
            if (error ~= OK ) then
              do
                say "Error" error "from AssembleRecord - Range"
                return FALSE
              end
          end

      end


    when (keyno = 4) then
      do
        if ( (itertype = 1) | ((itertype >= 4) & (itertype <= 9)) ) then
          do
            say "From?"
            parse pull fromkey
            fromkey = left( fromkey, 2, ' ' )
            say "From: '" || fromkey || "'"
            say ""
            error = AssembleRecord( FromMem, 2, "s2", "fromkey" )
            if (error ~= OK ) then
              do
                say "Error" error "from AssembleRecord - Range"
                return FALSE
              end
            error = ReadUniqueISAMRecord( ISAMHandleC, 0, FromMem, ,
                                          FALSE, ' ', "tmpRecNo", CatRecMem )
            select
              when (error = ERROR_NO_SUCH_RECORD ) then
                do
                  say "No such Category."
                  return FALSE
                end

              when (error = OK ) then
                do
                end

              otherwise
                do
                  say "Error" error "."
                  return FALSE
                end
            end
          end


        if ( (itertype >= 2) & (itertype <= 7) ) then
          do
            say "To?"
            parse pull tokey
            tokey = left( tokey, 2, ' ' )
            say "To: '" || tokey || "'"
            say ""
            error = AssembleRecord( ToMem, 2, "s2", "tokey" )
            if (error ~= OK ) then
              do
                say "Error" error "from AssembleRecord - Range"
                return FALSE
              end
            error = ReadUniqueISAMRecord( ISAMHandleC, 0, ToMem, ,
                                          FALSE, ' ', "tmpRecNo", CatRecMem )
            select
              when (error = ERROR_NO_SUCH_RECORD ) then
                do
                  say "No such Category."
                  return FALSE
                end

              when (error = OK ) then
                do
                end

              otherwise
                do
                  say "Error" error "."
                  return FALSE
                end
            end
          end

      end


    when (keyno = 5) then
      do
        if ( (itertype = 1) | ((itertype >= 4) & (itertype <= 9)) ) then
          do
            say "From?"
            parse pull fromkey
            say "From: '" || fromkey || "'"
            say ""
            error = AssembleRecord( FromMem, 1, "s1", "fromkey" )
            if (error ~= OK ) then
              do
                say "Error" error "from AssembleRecord - Range"
                return FALSE
              end
          end

        if ( (itertype >= 2) & (itertype <= 7) ) then
          do
            say "To?"
            parse pull tokey
            say "To: '" || tokey || "'"
            say ""
            error = AssembleRecord( ToMem, 1, "s1", "tokey" )
            if (error ~= OK ) then
              do
                say "Error" error "from AssembleRecord - Range"
                return FALSE
              end
          end
      end


    when (keyno = 3) | (keyno = 6) then
      do
        if ( (itertype = 1) | ((itertype >= 4) & (itertype <= 9)) ) then
          do
            say "From?"
            parse pull fromkey
            say "From: '" || fromkey || "'"
            say ""
            error = AssembleRecord( FromMem, 2, "u2", "fromkey" )
            if (error ~= OK ) then
              do
                say "Error" error "from AssembleRecord - Range"
                return FALSE
              end
          end

        if ( (itertype >= 2) & (itertype <= 7) ) then
          do
            say "To?"
            parse pull tokey
            say "To: '" || tokey || "'"
            say ""
            error = AssembleRecord( ToMem, 2, "u2", "tokey" )
            if (error ~= OK ) then
              do
                say "Error" error "from AssembleRecord - Range"
                return FALSE
              end
          end
      end


    when (keyno = 7) then
      do
        if ( (itertype = 1) | ((itertype >= 4) & (itertype <= 9)) ) then
          do
            say "From?"
            parse pull fromkey
            say "From: '" || fromkey || "'"
            say ""
            error = AssembleRecord( FromMem, 4, "f4", "fromkey" )
            if (error ~= OK ) then
              do
                say "Error" error "from AssembleRecord - Range"
                return FALSE
              end
          end

        if ( (itertype >= 2) & (itertype <= 7) ) then
          do
            say "To?"
            parse pull tokey
            say "To: '" || tokey || "'"
            say ""
            error = AssembleRecord( ToMem, 4, "f4", "tokey" )
            if (error ~= OK ) then
              do
                say "Error" error "from AssembleRecord - Range"
                return FALSE
              end
          end
      end

    otherwise
      say "Whoops! How did we get here with keyno = " keyno "?"
      return FALSE

  end

  return TRUE


/*-------------------------------- EditBook ---------------------------------*/
EditBook: procedure expose BookRecMem OK BookTypes BookVars BookFmts KeyMem ,
                           ISAMHandleC CatRecMem TRUE FALSE ERROR_NO_SUCH_RECORD
  do forever
    error = DisAssembleRecord( BookRecMem, 100, BookTypes, BookVars )
    if (error ~= OK ) then
      do
        say "Error" error "from DisAssembleRecord - EditBook"
        return
      end

    say "Current Record:"

    say "Title     : '" || Title || "'"
    say "Author    : '" || Author || "'"
    say "Publisher : '" || Publisher || "'"
    say "Copyright : "  Copyright
    say "Category  : '" || Category || "'"
    say "Form      : '" || Form || "'"
    say "Pages     : "  Pages
    say "Value     : "  Value

    say ""


    say "Edit:"
    say "1 : Title       5 : Category"
    say "2 : Author      6 : Form"
    say "3 : Publisher   7 : Pages"
    say "4 : Copyright   8 : Value"
    say "0  : end Edit"
    say ""
    say "SELECT ?"

    parse pull selectit
    say ""


    if ( selectit = 0 ) then
      break

    select

      when (selectit = 1) then
        do
          say "Title ?"
          parse pull Title
          Title = left( Title, 30, ' ' )
        end

      when (selectit = 2) then
        do
          say "Author ?"
          parse pull Author
          Author = left( Author, 30, ' ' )
        end

      when (selectit = 3) then
        do
          say "Publisher ?"
          parse pull Publisher
          Publisher = left( Publisher, 30, ' ' )
        end

      when (selectit = 4) then
        do
          say "Copyright Year ?"
          parse pull Copyright
        end

      when (selectit = 5) then
        do
          say "Category ?"
          parse pull Category
          Category = left( Category, 2, ' ' )

          error = AssembleRecord( KeyMem, 2, "s2", "Category" )
          if (error ~= OK ) then
            do
              say "Error" error "from AssembleRecord - EditBook"
              return
            end
          error = ReadUniqueISAMRecord( ISAMHandleC, 0, KeyMem, ,
                                        FALSE, ' ', "tmpRecNo", CatRecMem )
          select
            when (error = ERROR_NO_SUCH_RECORD ) then
              do
                say "No such Category."
                return
              end

            when (error = OK ) then
              do
              end

            otherwise
              do
                say "Error" error "reading Category - Editbook."
                return
              end
          end
        end

      when (selectit = 6) then
        do
          say "Form (P/H/T/C) ?"
          parse pull Form
          Form = left( Form, 1 )
        end

      when (selectit = 7) then
        do
          say "Number of Pages ?"
          parse pull Pages
        end

      when (selectit = 8) then
        do
          say "Value ?"
          parse pull Value
        end

      otherwise
        do
          say "No such option."
          iterate
        end

    end

    error = AssembleRecord( BookRecMem, 100, BookTypes, BookVars )
    if (error ~= OK ) then
      do
        say "Error" error "from AssembleRecord - EditBook"
        return
      end

  end  /* do forever */

  return


/*---------------------------- ListCategories ----------------------------*/
ListCategories : procedure expose ISAMHandleC TRUE FALSE OK ,
                                  CatRecMem CatTypes CatVars CatFmts ,
                                  ERROR_NO_MORE_RECORDS

  error = SetUpISAMIterationRange( ISAMHandleC, 0, 0 )
  if ( error ~= OK ) then
    do
      say "Couldn't set up list."
      say "Error: ", error
      return
    end

  error = CountISAMRecords( ISAMHandleC, 0, 0, "Count" )
  if ( error ~= OK ) then
    do
      say "Couldn't count Categories."
      say "Error: ", error
      return
    end

  select
    when (Count = 0) then say "There are no Categories."
    when (Count = 1) then say "There is 1 Category."
    otherwise             say "There are " Count "Categories."
  end


  if ( Count = 0 ) then
    return

  do forever
    say ""
    say "Print the List to someplace other than the screen? (Y/N) "
    parse upper pull FileDev
    FileDev = left( FileDev, 1 )
    if ( ( FileDev = 'Y' ) | ( FileDev = 'N' ) ) then
      break
    say "Not an option."
  end

  if ( FileDev = 'Y' ) then
    do
      say "File/Device Name: "
      parse pull filename
      tf = open( "fh", filename, write )
      if ( tf = FALSE ) then
        do
          say "Couldn't open '" filename "' for output."
          return
        end
    end

  if ( FileDev = 'Y' ) then
    do
      call writeln "fh", ""
      call writeln "fh", "CODE ---------- Category ----------"
      call writeln "fh", "==================================="
    end
   else
    do
      say ""
      say ""
      say "CODE ---------- Category ----------"
      say "==================================="
    end


  error = OK

  do while (error = OK )
    error = ReadNextISAMRecord( ISAMHandleC, 0, ,
                                FALSE, ' ', "RecNo", CatRecMem )
    select
      when (error = OK) then
        do
          error = DisAssembleRecord( CatRecMem, 31, CatTypes, CatVars, CatFmts )
          if (error ~= OK ) then
            do
              say "Error" error "from DisAssembleRecord - List cats."
              return FALSE
            end
          if ( FileDev = 'Y' )
            then call writeln "fh", CatCode CatName
            else
             say CatCode CatName
        end

      when (error = ERROR_NO_MORE_RECORDS) then
        do
        end

      otherwise
        say "Error:" error "from ReadNextISAMRecord - List cats."
    end

  end


  if ( FileDev = 'Y' ) then
    do
      tf = close( "fh" )
      if ( tf = FALSE ) then
        do
          say "Error closing " filename "'"
        end
    end

  return



/*------------------------------- ListBooks ------------------------------*/
ListBooks: procedure expose TRUE FALSE OK FromMem ToMem KeyMem ISAMHandleB ,
                            BookRecMem BookTypes BookVars BookFmts ,
                            ERROR_NO_MORE_RECORDS

  do forever
    say ""
    say "List Books by what key:"
    say "1 : Title       5 : Category/Form"
    say "2 : Author      6 : Form"
    say "3 : Publisher   7 : Pages"
    say "4 : Copyright   8 : Value"
    say ""
    say "SELECT ?"

    parse pull selectit
    say ""
    if ( ( selectit < 1 ) | ( selectit > 8 ) ) then
      do
        say "No such option."
        iterate
      end
    keyno = selectit - 1
    break
  end

  do forever
    say ""
    say "List by:"
    say "1 : All key values."
    say "2 : Range of key values."
    say "3 : One key value."
    say "4 : Key prefix (keys 1/2/3/5 only)."
    say ""
    say "SELECT ?"

    parse pull selectit
    say ""
    if ( ( selectit < 1 ) | ( selectit > 4 ) ) then
      do
        say "No such option."
        iterate
      end
    kp1 = keyno+1
    if ( selectit = 4 ) then
      select
        when ( (kp1 = 1) | (kp1 = 2) | (kp1 = 3) | (kp1 = 5) ) then
          break

        otherwise
          do
            say "Not valid for key selected."
            iterate
          end
      end

    break
  end


  select

    when ( (selectit = 1) | (selectit = 2) ) then
      do
        if (selectit = 1)
          then itertype = 0
          else itertype = 7

        if ( ~HandleRange( keyno, itertype ) ) then
          return

        if ( (itertype = 1) | ((itertype >= 4) & (itertype <= 9)) )
          then FromVar = FromMem
          else FromVar = 0

        if ( (itertype >= 2) & (itertype <= 7) )
          then ToVar = ToMem
          else ToVar = 0

        error = SetUpISAMIterationRange( ISAMHandleB, ,
                                         keyno, itertype, FromVar, ToVar )
      end

    when (selectit = 3) then
      do
        if ( ~HandleKey( keyno ) ) then
          return
        error = SetUpISAMIterationKey( ISAMHandleB, keyno, KeyMem )
      end

    when (selectit = 4) then
      do
        if ( ~Handleprefix( keyno ) ) then
          return
        error = SetUpISAMIterationPrefix( ISAMHandleB, keyno, ,
                                          KeyMem, prefixLen )
      end

  end
  if ( error ~= OK ) then
    do
      say "Couldn't set up list."
      say "Error:" error
      return
    end

  say "Stop Counting at how many Books: "
  parse pull CountMax
  say ""

  error = CountISAMRecords( ISAMHandleB, keyno, CountMax, "Count" )
  if ( error ~= OK ) then
    do
      say "Couldn't count Books."
      say "Error:" error
      return
    end

  select
    when (Count = 0) then say "There are no Books"
    when (Count = 1) then say "There is 1 Book"
    otherwise             say "There are" Count "Books"
  end
  say "matching that criteria."
  if ( Count = 0 ) then
    return

  do forever
    say ""
    say "Print the List to someplace other than the screen? (Y/N) "
    parse upper pull FileDev
    FileDev = left( FileDev, 1 )
    if ( ( FileDev = 'Y' ) | ( FileDev = 'N' ) ) then
      break
    say "Not an option."
    iterate
  end

  if ( FileDev = 'Y' ) then
    do
      say "File/Device Name: "
      parse pull filename
      tf = open( "fh", filename, write )
      if ( tf = FALSE ) then
        do
          say "Couldn't open '" filename "' for output."
          return
        end
    end



  if ( FileDev = 'Y' ) then
    do
      call writeln "fh", ""
      call writeln "fh", ,
 "REC# ----------- TITLE ------------ ----------- AUTHOR ------------"
      call writeln "fh", ,
 "     --------- PUBLISHER ---------- COPY. CAT. FORM -$VALUE- #PAGES"
      call writeln "fh", ,
 "==================================================================="
    end
   else
    do
      say ""
      say "REC# ----------- TITLE ------------ ----------- AUTHOR ------------"
      say "     --------- PUBLISHER ---------- COPY. CAT. FORM -$VALUE- #PAGES"
      say "==================================================================="
    end


  error = OK
  do while (error = OK)
    error = ReadNextISAMRecord( ISAMHandleB, keyno, ,
                                FALSE, ' ', "RecNo", BookRecMem )

    select
      when (error = OK) then
        do
          RecNo = left( RecNo, 4, " " )
          error = DisAssembleRecord( BookRecMem, 100, BookTypes, ,
                                     BookVars, BookFmts )
          if (error ~= OK ) then
            do
              say "Error" error "from DisAssembleRecord - ListBooks"
              return FALSE
            end

          if ( FileDev = 'Y' ) then
            do
              call writeln "fh", RecNo Title Author
              call writeln "fh", ,
                  "    " Publisher Copyright Category Form Value Pages
              call writeln "fh", ""
            end
           else
            do
              say RecNo Title Author
              say "    " Publisher Copyright Category Form Value Pages
              say ""
            end
        end

      when (error = ERROR_NO_MORE_RECORDS) then
        do
        end

      otherwise
        say "Error: "error" from ReadNext - ListBooks."
    end

  end


  if ( FileDev = 'Y' ) then
    do
      tf = close( "fh" )
      if ( tf = FALSE ) then
        do
          say "Error closing '" filename "'"
        end
    end

  return