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