
      ************************************************************************
      * Copyright (C) 1996-1999 Micro Focus International Ltd.
      * All rights reserved.
      *  
      * This demonstration program is provided for use by users of 
      * Micro Focus products (the "Software") and may be used, 
      * modified and distributed as part of your application provided 
      * that you properly acknowledge the copyright of Micro Focus in this
      * material.
      *     
      * All conditions, warranties and undertakings, express or implied, 
      * statutory or otherwise, on the part of Micro Focus are excluded, 
      * including without limitation those of merchantability or fitness  
      * for purpose. This shall not, however, purport to exclude or 
      * restrict the liability of Micro Focus to any extent not 
      * permitted by law.
      *
      * IN NO EVENT WILL MICRO FOCUS BE LIABLE FOR ANY INDIRECT, 
      * INCIDENTAL, SPECIAL, CONSEQUENTIAL OR OTHER DAMAGES ARISING OUT 
      * OF THE USE OF THE DEMONSTRATION PROGRAM DISTRIBUTED WITH THE 
      * SOFTWARE, WHETHER OR NOT INFORMED OF THE POSSIBILITIES OF 
      * DAMAGES IN ADVANCE.  THESE LIMITATIONS APPLY TO ALL CAUSES OF 
      * ACTION, INCLUDING BREACH OF CONTRACT, BREACH OF WARRANTY, STRICT
      * LIABILITY, AND ANY ACTIONS IN TORTS.
      ************************************************************************

       special-names.
          console is crt
          crt status is key-status.
       input-output section.
       file-control.
           select stock-file assign "MUSTOCK.DAT"
                organization indexed
                access dynamic
                record key stock-key
                status file-status
                lock mode automatic.
      /
       data division.

      ***********************************************************
      * File Definition                                         *
      ***********************************************************

       file section.
       fd  stock-file.
       01  stock-record.
           03  stock-key                        pic 9(06).
           03  stock-data.
               05  stock-description-1          pic x(53).
               05  stock-description-2          pic x(53).
               05  stock-description-3          pic x(53).
               05  stock-held                   pic 9(06).
               05  stock-cost                   pic 9(06)v99.
      /
       working-storage section.
       01     stock-00   .
           03    stock-00-0101 pic x(0080) value "----------------------
      -    "----------------------------------------------------------".
           03    stock-00-0201 pic x(0001) value "|".
           03 filler           pic x(0078).
           03    stock-00-0280 pic x(0001) value "|".
           03    stock-00-0301 pic x(0001) value "|".
           03 filler           pic x(0031).
           03    stock-00-0333 pic x(0011) value " Acme Inc. ".
           03 filler           pic x(0020).
           03    stock-00-0364 pic x(0017) value "Date   /  /     |".
           03    stock-00-0401 pic x(0001) value "|".
           03 filler           pic x(0031).
           03    stock-00-0433 pic x(0011) value "===========".
           03 filler           pic x(0020).
           03    stock-00-0464 pic x(0017) value "Time   :        |".
           03    stock-00-0501 pic x(0001) value "|".
           03 filler           pic x(0027).
           03    stock-00-0529 pic x(0020) value "Stock Control System".
           03 filler           pic x(0031).
           03    stock-00-0580 pic x(0001) value "|".
           03    stock-00-0601 pic x(0001) value "|".
           03 filler           pic x(0027).
           03    stock-00-0629 pic x(0020) value "====================".
           03 filler           pic x(0031).
           03    stock-00-0680 pic x(0001) value "|".
           03    stock-00-0701 pic x(0001) value "|".
           03 filler           pic x(0078).
           03    stock-00-0780 pic x(0001) value "|".
           03    stock-00-0801 pic x(0001) value "|".
           03 filler           pic x(0078).
           03    stock-00-0880 pic x(0001) value "|".
           03    stock-00-0901 pic x(0025) value "|  Stock Code    [
      -    "  ]".
           03 filler           pic x(0054).
           03    stock-00-0980 pic x(0001) value "|".
           03    stock-00-1001 pic x(0001) value "|".
           03 filler           pic x(0078).
           03    stock-00-1080 pic x(0001) value "|".
           03    stock-00-1101 pic x(0022) value "|  Stock Description [
      -    "".
           03 FILLER           PIC X(0053).
           03    STOCK-00-1176 PIC X(0005) VALUE "]   |".
           03    stock-00-1201 pic x(0001) value "|".
           03 filler           pic x(0020).
           03    stock-00-1222 pic x(0001) value "[".
           03 filler           pic x(0053).
           03    stock-00-1276 pic x(0005) value "]   |".
           03    stock-00-1301 pic x(0001) value "|".
           03 filler           pic x(0020).
           03    stock-00-1322 pic x(0001) value "[".
           03 filler           pic x(0053).
           03    stock-00-1376 pic x(0005) value "]   |".
           03    stock-00-1401 pic x(0001) value "|".
           03 filler           pic x(0078).
           03    stock-00-1480 pic x(0001) value "|".
           03    stock-00-1501 pic x(0025) value "|  Stock Held    [
      -    "  ]".
           03 filler           pic x(0054).
           03    stock-00-1580 pic x(0001) value "|".
           03    stock-00-1601 pic x(0001) value "|".
           03 filler           pic x(0078).
           03    stock-00-1680 pic x(0001) value "|".
           03    stock-00-1701 pic x(0028) value "|  Cost per Unit [
      -    "     ]".
           03 filler           pic x(0051).
           03    stock-00-1780 pic x(0001) value "|".
           03    stock-00-1801 pic x(0001) value "|".
           03 filler           pic x(0078).
           03    stock-00-1880 pic x(0001) value "|".
           03    stock-00-1901 pic x(0001) value "|".
           03 filler           pic x(0078).
           03    stock-00-1980 pic x(0001) value "|".
           03    stock-00-2101 pic x(0080) value "----------------------
      -    "----------------------------------------------------------".
           03    stock-00-2201 pic x(0040)
                 value "-----Open Mode----Lock Mode--Last Operat".
           03    stock-00-2241 pic x(0040)
                 value "ion-----------Outcome------File Status--".
           03 filler           pic x(1037).

       01     stock-01    redefines    stock-00   .
           03 filler           pic x(0658).
           03   stock-01-code           pic 9(0006).
           03 filler           pic x(0158).
           03   stock-01-description-1  pic x(0053).
           03 filler           pic x(0027).
           03   stock-01-description-2  pic x(0053).
           03 filler           pic x(0027).
           03   stock-01-description-3  pic x(0053).
           03 filler           pic x(0103).
           03   stock-01-held           pic 9(0006).
           03 filler           pic x(0154).
           03   stock-01-cost           pic $$$$$9.99.
           03 filler           pic x(0579).

       01  key-status.
           03  key-type        PIC X.
           03  key-code-1      PIC 9(2) COMP-X.
           03  key-code-2      PIC 9(2) COMP-X.

      ***********************************************************
      * File Status Variables                                   *
      ***********************************************************

       01  file-status.
           03  status-1                 pic x.
           03  status-2                 pic x.

       01  binary-status redefines file-status pic 9(04) comp.
      ***********************************************************
      * Date and Time Variables                                 *
      ***********************************************************

       01  DATE-YYMMDD.
           03  DATE-YY                 PIC 9999.
           03  DATE-MM                 PIC 99.
           03  DATE-DD                 PIC 99.
           03  TIME-HR                 PIC 99.
           03  TIME-MIN                PIC 99.
           03  TIME-SEC                PIC 99.
           03  THE-REST                PIC x(7).

       01  the-date.
           03  days                     pic 99.
           03  filler                   pic x.
           03  month                    pic 99.
           03  filler                   pic x.
           03  year                     pic 9999.

       01  the-time.
           03  hours                    pic 99.
           03  filler                   pic x.
           03  mins                     pic 99.

      ***********************************************************
      * Information Line Declaration                            *
      ***********************************************************

       01  status-line.
           03  filler                   pic x(02).
           03  open-mode                pic x(14).
           03  filler                   pic x(02).
           03  lock-mode                pic x(09)
                   value "---------".
           03  filler                   pic x(03).
           03  last-operation           pic x(11).
           03  filler                   pic x(03).
           03  was-it-successful        pic x(20).
           03  filler                   pic x(08).
           03  error-code.
               05 stat-1                pic x.
               05 filler                pic x.
               05 stat-2                pic 9(03).

       01  hyphen-line                  pic x(80)
               value all "-".

       01  yesno                        pic x.

       01    inpopt.
           03   inpopt-00      pic x(39)
                value " F1-Read Key F2-Read next F3-Start not ".
           03   inpopt-01      pic x(40)
                value "<                               ESC-Exit".

      ***********************************************************
      * Program for input only                                  *
      ***********************************************************

       procedure division.
       main.
           initialize stock-01.
           display space.
           display stock-00.
           display inpopt at 2301.
           open input stock-file.
           move "----Open Input" to open-mode.
           move "-Open Input" to last-operation.
           perform status-check.
           if was-it-successful not = "----------Successful"
               move "----Closed----" to open-mode
               move "--------Open-failed-" to was-it-successful
               perform display-date
               display hyphen-line at 2201 upon crt-under
               display status-line at 2201 upon crt-under
               go to endit.

      ***********************************************************
      * Main Loop                                               *
      ***********************************************************

       ent-ry.
           perform display-date.
           display hyphen-line at 2201 upon crt-under
           display status-line at 2201 upon crt-under
           accept stock-01.
           if key-type = "1"
              evaluate key-code-1
                when 0 go to wrap-up
                when 1 perform read-on-key
                when 2 perform read-next
                when 3 perform start-not-less-than
              end-evaluate
           end-if
           go to ent-ry.

      ***********************************************************
      * Closing-Down Paragraphs                                 *
      ***********************************************************

       wrap-up.
           close stock-file.
           move "----Closed----" to open-mode.
           move "------Closed" to last-operation.
           perform status-check.
           display hyphen-line at 2201 upon crt-under.
           display status-line at 2201 upon crt-under.

       endit.
           display "Do you wish to restart (Y/N) [ ]"
               at 2424 upon crt-under.
           accept yesno at 2454 with auto no-echo.
           if yesno = "Y" or "y"
              go to main
           else if yesno = "N" or "n"
                   go to prog-end
                else
                   go to endit
           end-if.

       prog-end.
           exit program.
           stop run.


      ***********************************************************
      * File-Handling Paragraphs                                *
      ***********************************************************

       read-on-key.
           move "Read on key" to last-operation.
           perform move-key-from-screen-to-rec.
           read stock-file.
           perform status-check.
           if was-it-successful equal "----------Successful" or
           was-it-successful equal "-------Record locked"
               perform move-from-rec-to-screen
           else
               perform blank-screen
           end-if
           display stock-01.

       read-next.
           move "--Read Next" to last-operation.
           read stock-file next.
           perform status-check.
           if was-it-successful equal "----------Successful" or
           was-it-successful equal "-------Record locked"
               perform move-from-rec-to-screen
           else
               perform blank-screen
           end-if
           display stock-01.

       start-not-less-than.
           move "Start not <" to last-operation.
           perform move-key-from-screen-to-rec.
           start stock-file key not less than stock-key.
           perform status-check.

      ***********************************************************
      *    File Status Checking Routines.                       *
      ***********************************************************

       status-check.
           move status-1 to stat-1
           if status-1 = 9
               move binary-status to stat-2
           else
               move status-2 to stat-2
           end-if
           evaluate status-1
               when "0"
                  move "----------Successful" to was-it-successful
               when "1"
                  move "---------End of file" to was-it-successful
               when "2"
                  move "---------Invalid Key" to was-it-successful
               when "9"
                  perform look-up-error thru error-end
           end-evaluate.

      ***********************************************************
      *     Look Up Error Number                                *
      ***********************************************************

       look-up-error.
           move low-values to status-1.
           move binary-status to stat-2.
           evaluate stat-2
             when 002
               move "-------File not open" to was-it-successful
             when 007
               move "Disk space exhausted" to was-it-successful
             when 013
               move "------File not found" to was-it-successful
             when 024
               move "----------Disk error" to was-it-successful
             when 041
               move "---Corrupt ISAM file" to was-it-successful
             when 065
               move "---------File locked" to was-it-successful
             when 068
               move "-------Record locked" to was-it-successful
             when 139
               move "Record inconsistency" to was-it-successful
             when 146
               move "---No current record" to was-it-successful
             when 180
               move "------File malformed" to was-it-successful
             when 208
               move "-------Network error" to was-it-successful
             when 213
               move "------Too many locks" to was-it-successful
           end-evaluate.
       error-end.
           exit.


      ***********************************************************
      *     Subroutines for moving Data to and from the Screen  *
      ***********************************************************

       move-key-from-screen-to-rec.
          move stock-01-code to stock-key.

       move-from-screen-to-rec.
          move stock-01-code to stock-key.
          move stock-01-description-1 to stock-description-1.
          move stock-01-description-2 to stock-description-2.
          move stock-01-description-3 to stock-description-3.
          move stock-01-held to stock-held.
          move stock-01-cost to stock-cost.

       move-from-rec-to-screen.
          move stock-key to stock-01-code.
          move stock-description-1 to stock-01-description-1.
          move stock-description-2 to stock-01-description-2.
          move stock-description-3 to stock-01-description-3.
          move stock-held to stock-01-held.
          move stock-cost to stock-01-cost.

       blank-screen.
          move spaces to stock-01-description-1.
          move spaces to stock-01-description-2.
          move spaces to stock-01-description-3.
          move 0 to stock-01-held.
          move 0 to stock-01-cost.

      ***********************************************************
      * Date and Time Routines.                                 *
      ***********************************************************

       display-date.
          move FUNCTION CURRENT-DATE TO DATE-YYMMDD
          move DATE-DD TO days
          move DATE-MM TO month
          move DATE-YY TO year
          display the-date at 0369.
          move   TIME-HR to hours.
          move   TIME-MIN to mins.
          display the-time at 0469.
