home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 10 / 10.iso / l / l360 / 3.ddi / MUDEMO.@EM / STOCKIN.CBL < prev    next >
Encoding:
Text File  |  1991-04-08  |  16.6 KB  |  393 lines
  1.       $set ans85 mf noosvs
  2.       ************************************************************
  3.       *                                                          *
  4.       *              (C) Micro Focus Ltd. 1989                   *
  5.       *                                                          *
  6.       *                     STOCKIN.CBL                          *
  7.       *                                                          *
  8.       *                      MULTI-USER                          *
  9.       *                      ==========                          *
  10.       *                DEMONSTRATION PROGRAM                     *
  11.       *                =====================                     *
  12.       *                                                          *
  13.       *  This program demonstrates the file and record locking   *
  14.       *         facilities of this MULTI-USER.  This             *
  15.       *   subprogram, which is called by MUDEMO, acquires no     *
  16.       *          locks because it OPENs for INPUT only.          *
  17.       *                                                          *
  18.       ************************************************************
  19.        special-names.
  20.           console is crt.
  21.        input-output section.
  22.        file-control.
  23.            select stock-file assign "MUSTOCK.DAT"
  24.                 organization indexed
  25.                 access dynamic
  26.                 record key stock-key
  27.                 status file-status
  28.                 lock mode automatic.
  29.       /
  30.        data division.
  31.  
  32.       ***********************************************************
  33.       * File Definition                                         *
  34.       ***********************************************************
  35.  
  36.        file section.
  37.        fd  stock-file.
  38.        01  stock-record.
  39.            03  stock-key                        pic 9(06).
  40.            03  stock-data.
  41.                05  stock-description-1          pic x(53).
  42.                05  stock-description-2          pic x(53).
  43.                05  stock-description-3          pic x(53).
  44.                05  stock-held                   pic 9(06).
  45.                05  stock-cost                   pic 9(06)v99.
  46.       /
  47.        working-storage section.
  48.        01     stock-00   .
  49.            03    stock-00-0101 pic x(0080) value "----------------------
  50.       -    "----------------------------------------------------------".
  51.            03    stock-00-0201 pic x(0001) value "|".
  52.            03 filler           pic x(0078).
  53.            03    stock-00-0280 pic x(0001) value "|".
  54.            03    stock-00-0301 pic x(0001) value "|".
  55.            03 filler           pic x(0031).
  56.            03    stock-00-0333 pic x(0011) value " Acme Inc. ".
  57.            03 filler           pic x(0020).
  58.            03    stock-00-0364 pic x(0017) value "Date   /  /     |".
  59.            03    stock-00-0401 pic x(0001) value "|".
  60.            03 filler           pic x(0031).
  61.            03    stock-00-0433 pic x(0011) value "===========".
  62.            03 filler           pic x(0020).
  63.            03    stock-00-0464 pic x(0017) value "Time   :        |".
  64.            03    stock-00-0501 pic x(0001) value "|".
  65.            03 filler           pic x(0027).
  66.            03    stock-00-0529 pic x(0020) value "Stock Control System".
  67.            03 filler           pic x(0031).
  68.            03    stock-00-0580 pic x(0001) value "|".
  69.            03    stock-00-0601 pic x(0001) value "|".
  70.            03 filler           pic x(0027).
  71.            03    stock-00-0629 pic x(0020) value "====================".
  72.            03 filler           pic x(0031).
  73.            03    stock-00-0680 pic x(0001) value "|".
  74.            03    stock-00-0701 pic x(0001) value "|".
  75.            03 filler           pic x(0078).
  76.            03    stock-00-0780 pic x(0001) value "|".
  77.            03    stock-00-0801 pic x(0001) value "|".
  78.            03 filler           pic x(0078).
  79.            03    stock-00-0880 pic x(0001) value "|".
  80.            03    stock-00-0901 pic x(0025) value "|  Stock Code    [
  81.       -    "  ]".
  82.            03 filler           pic x(0054).
  83.            03    stock-00-0980 pic x(0001) value "|".
  84.            03    stock-00-1001 pic x(0001) value "|".
  85.            03 filler           pic x(0078).
  86.            03    stock-00-1080 pic x(0001) value "|".
  87.            03    stock-00-1101 pic x(0022) value "|  Stock Description [
  88.       -    "".
  89.            03 FILLER           PIC X(0053).
  90.            03    STOCK-00-1176 PIC X(0005) VALUE "]   |".
  91.            03    stock-00-1201 pic x(0001) value "|".
  92.            03 filler           pic x(0020).
  93.            03    stock-00-1222 pic x(0001) value "[".
  94.            03 filler           pic x(0053).
  95.            03    stock-00-1276 pic x(0005) value "]   |".
  96.            03    stock-00-1301 pic x(0001) value "|".
  97.            03 filler           pic x(0020).
  98.            03    stock-00-1322 pic x(0001) value "[".
  99.            03 filler           pic x(0053).
  100.            03    stock-00-1376 pic x(0005) value "]   |".
  101.            03    stock-00-1401 pic x(0001) value "|".
  102.            03 filler           pic x(0078).
  103.            03    stock-00-1480 pic x(0001) value "|".
  104.            03    stock-00-1501 pic x(0025) value "|  Stock Held    [
  105.       -    "  ]".
  106.            03 filler           pic x(0054).
  107.            03    stock-00-1580 pic x(0001) value "|".
  108.            03    stock-00-1601 pic x(0001) value "|".
  109.            03 filler           pic x(0078).
  110.            03    stock-00-1680 pic x(0001) value "|".
  111.            03    stock-00-1701 pic x(0028) value "|  Cost per Unit [
  112.       -    "     ]".
  113.            03 filler           pic x(0051).
  114.            03    stock-00-1780 pic x(0001) value "|".
  115.            03    stock-00-1801 pic x(0001) value "|".
  116.            03 filler           pic x(0078).
  117.            03    stock-00-1880 pic x(0001) value "|".
  118.            03    stock-00-1901 pic x(0001) value "|".
  119.            03 filler           pic x(0078).
  120.            03    stock-00-1980 pic x(0001) value "|".
  121.            03    stock-00-2101 pic x(0080) value "----------------------
  122.       -    "----------------------------------------------------------".
  123.            03    stock-00-2201 pic x(0040)
  124.                  value "-----Open Mode----Lock Mode--Last Operat".
  125.            03    stock-00-2241 pic x(0040)
  126.                  value "ion-----------Outcome------File Status--".
  127.            03 filler           pic x(1037).
  128.  
  129.        01     stock-01    redefines    stock-00   .
  130.            03 filler           pic x(0658).
  131.            03   stock-01-code           pic 9(0006).
  132.            03 filler           pic x(0158).
  133.            03   stock-01-description-1  pic x(0053).
  134.            03 filler           pic x(0027).
  135.            03   stock-01-description-2  pic x(0053).
  136.            03 filler           pic x(0027).
  137.            03   stock-01-description-3  pic x(0053).
  138.            03 filler           pic x(0103).
  139.            03   stock-01-held           pic 9(0006).
  140.            03 filler           pic x(0154).
  141.            03   stock-01-cost           pic $$$$$9.99.
  142.            03 filler           pic x(0579).
  143.            03   choice                  pic 9.
  144.  
  145.       ***********************************************************
  146.       * File Status Variables                                   *
  147.       ***********************************************************
  148.  
  149.        01  file-status.
  150.            03  status-1                 pic x.
  151.            03  status-2                 pic x.
  152.  
  153.        01  binary-status redefines file-status pic 9(04) comp.
  154.       ***********************************************************
  155.       * Date and Time Variables                                 *
  156.       ***********************************************************
  157.  
  158.        01  date-to-day.
  159.            03  days                     pic 99.
  160.            03  filler                   pic x.
  161.            03  month                    pic 99.
  162.            03  filler                   pic x.
  163.            03  year                     pic 99.
  164.  
  165.        01  up-to-date-time.
  166.            03  hours                    pic 99.
  167.            03  filler                   pic x.
  168.            03  mins                     pic 99.
  169.  
  170.        01  temp-date.
  171.            03  temp-year                pic xx.
  172.            03  temp-month               pic xx.
  173.            03  temp-day                 pic xx.
  174.        01  temp-time.
  175.            03  temp-hours               pic 99.
  176.            03  temp-mins                pic 99.
  177.            03  temp-rest                pic 9999.
  178.  
  179.       ***********************************************************
  180.       * Information Line Declaration                            *
  181.       ***********************************************************
  182.  
  183.        01  status-line.
  184.            03  filler                   pic x(02).
  185.            03  open-mode                pic x(14).
  186.            03  filler                   pic x(02).
  187.            03  lock-mode                pic x(09)
  188.                    value "---------".
  189.            03  filler                   pic x(03).
  190.            03  last-operation           pic x(11).
  191.            03  filler                   pic x(03).
  192.            03  was-it-successful        pic x(20).
  193.            03  filler                   pic x(08).
  194.            03  error-code.
  195.                05 stat-1                pic x.
  196.                05 filler                pic x.
  197.                05 stat-2                pic 9(03).
  198.  
  199.        01  hyphen-line                  pic x(80)
  200.                value all "-".
  201.  
  202.        01  yesno                        pic x.
  203.  
  204.        01    inpopt.
  205.            03   filler         pic x(10).
  206.            03   inpopt-00      pic x(0056) value "1. Read on Key   2. Re
  207.       -    "ad next   3. start not <   4. exit".
  208.  
  209.       ***********************************************************
  210.       * Program for input only                                  *
  211.       ***********************************************************
  212.  
  213.        procedure division.
  214.        main.
  215.            initialize choice
  216.                       stock-01.
  217.            display space.
  218.            display stock-00.
  219.            display inpopt at 2301.
  220.            display "Input Choice [ ]" at 2433 upon crt-under.
  221.            open input stock-file.
  222.            move "----Open Input" to open-mode.
  223.            move "-Open Input" to last-operation.
  224.            perform status-check.
  225.            if was-it-successful not = "----------Successful"
  226.                move "----Closed----" to open-mode
  227.                display hyphen-line at 2201 upon crt-under
  228.                display status-line at 2201 upon crt-under
  229.                go to endit.
  230.  
  231.       ***********************************************************
  232.       * Main Loop                                               *
  233.       ***********************************************************
  234.  
  235.        ent-ry.
  236.            perform display-date.
  237.            perform display-time.
  238.            display hyphen-line at 2201 upon crt-under
  239.            display status-line at 2201 upon crt-under
  240.            accept stock-01.
  241.            evaluate choice
  242.                 when 1 perform read-on-key
  243.                 when 2 perform read-next
  244.                 when 3 perform start-not-less-than
  245.                 when 4 go to wrap-up
  246.            end-evaluate.
  247.            go to ent-ry.
  248.  
  249.       ***********************************************************
  250.       * Closing-Down Paragraphs                                 *
  251.       ***********************************************************
  252.  
  253.        wrap-up.
  254.            close stock-file.
  255.            move "----Closed----" to open-mode.
  256.            move "------Closed" to last-operation.
  257.            perform status-check.
  258.            display hyphen-line at 2201 upon crt-under.
  259.            display status-line at 2201 upon crt-under.
  260.  
  261.        endit.
  262.            display "Do you wish to restart (Y/N) [ ]"
  263.                at 2424 upon crt-under.
  264.            accept yesno at 2454.
  265.            if yesno = "Y" or "y"
  266.               go to main
  267.            else if yesno = "N" or "n"
  268.                    exit program
  269.                 else
  270.                    go to endit
  271.            end-if.
  272.  
  273.  
  274.       ***********************************************************
  275.       * File-Handling Paragraphs                                *
  276.       ***********************************************************
  277.  
  278.        read-on-key.
  279.            move "Read on key" to last-operation.
  280.            perform move-key-from-screen-to-rec.
  281.            read stock-file.
  282.            perform status-check.
  283.            perform move-from-rec-to-screen.
  284.            display stock-01.
  285.  
  286.        read-next.
  287.            move "--Read Next" to last-operation.
  288.            read stock-file next.
  289.            perform status-check.
  290.            perform move-from-rec-to-screen.
  291.            display stock-01.
  292.  
  293.        start-not-less-than.
  294.            move "Start not <" to last-operation.
  295.            perform move-key-from-screen-to-rec.
  296.            start stock-file key not less than stock-key.
  297.            perform status-check.
  298.  
  299.       ***********************************************************
  300.       *    File Status Checking Routines.                       *
  301.       ***********************************************************
  302.  
  303.        status-check.
  304.             move status-1 to stat-1
  305.             move status-2 to stat-2
  306.             evaluate status-1
  307.                when "0"
  308.                   move "----------Successful" to was-it-successful
  309.                when "1"
  310.                   move "---------End of file" to was-it-successful
  311.                when "2"
  312.                   move "---------Invalid Key" to was-it-successful
  313.                when "9"
  314.                   perform look-up-error thru error-end
  315.             end-evaluate.
  316.  
  317.       ***********************************************************
  318.       *     Look Up Error Number                                *
  319.       ***********************************************************
  320.  
  321.        look-up-error.
  322.            move low-values to status-1.
  323.            move binary-status to stat-2.
  324.            evaluate stat-2
  325.              when 002
  326.                move "-------File not open" to was-it-successful
  327.              when 007
  328.                move "Disk space exhausted" to was-it-successful
  329.              when 013
  330.                move "------File not found" to was-it-successful
  331.              when 024
  332.                move "----------Disk error" to was-it-successful
  333.              when 041
  334.                move "---Corrupt ISAM file" to was-it-successful
  335.              when 065
  336.                move "---------File locked" to was-it-successful
  337.              when 068
  338.                move "-------Record locked" to was-it-successful
  339.              when 139
  340.                move "Record inconsistency" to was-it-successful
  341.              when 146
  342.                move "---No current record" to was-it-successful
  343.              when 180
  344.                move "------File malformed" to was-it-successful
  345.              when 208
  346.                move "-------Network error" to was-it-successful
  347.              when 213
  348.                move "------Too many locks" to was-it-successful
  349.            end-evaluate.
  350.        error-end.
  351.            exit.
  352.  
  353.  
  354.       ***********************************************************
  355.       *     Subroutines for moving Data to and from the Screen  *
  356.       ***********************************************************
  357.  
  358.        move-key-from-screen-to-rec.
  359.           move stock-01-code to stock-key.
  360.  
  361.        move-from-screen-to-rec.
  362.           move stock-01-code to stock-key.
  363.           move stock-01-description-1 to stock-description-1.
  364.           move stock-01-description-2 to stock-description-2.
  365.           move stock-01-description-3 to stock-description-3.
  366.           move stock-01-held to stock-held.
  367.           move stock-01-cost to stock-cost.
  368.  
  369.        move-from-rec-to-screen.
  370.           move stock-key to stock-01-code.
  371.           move stock-description-1 to stock-01-description-1.
  372.           move stock-description-2 to stock-01-description-2.
  373.           move stock-description-3 to stock-01-description-3.
  374.           move stock-held to stock-01-held.
  375.           move stock-cost to stock-01-cost.
  376.  
  377.       ***********************************************************
  378.       * Date and Time Routines.                                 *
  379.       ***********************************************************
  380.  
  381.        display-date.
  382.           accept temp-date from date.
  383.           move temp-day to days.
  384.           move temp-month to month.
  385.           move temp-year to year.
  386.           display date-to-day at 0369.
  387.  
  388.        display-time.
  389.           accept temp-time from time.
  390.           move temp-hours to hours.
  391.           move temp-mins to mins.
  392.           display up-to-date-time at 0469.
  393.