home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / viscobv6.zip / vac22os2 / ibmcobol / samples / winestr / wineordr.cbl < prev    next >
Text File  |  1997-03-22  |  9KB  |  241 lines
  1.       * --------------------------------------------- *
  2.       *  WINEORDR.CBL
  3.       *     Wine Order class for the wine store sample.
  4.       *     Version 2
  5.       * --------------------------------------------- *
  6.  
  7.        IDENTIFICATION DIVISION.
  8.        CLASS-ID. "WineOrder" inherits SOMObject.
  9.  
  10.        ENVIRONMENT DIVISION.
  11.        Configuration Section.
  12.        Repository.
  13.             CLASS SOMObject is "SOMObject"
  14.             CLASS Bottle is "Bottle"
  15.             CLASS WineOrder is "WineOrder".
  16.  
  17.        DATA DIVISION.
  18.        Working-Storage Section.
  19.        01  WS-Ev            Usage Pointer.
  20.        01  Order-Object.
  21.           05 Order-Number              PIC X(5).
  22.           05 Order-Date                PIC X(10).
  23.           05 Bottles.
  24.               10 Bottle-Count          PIC 9(4).
  25.               10 Bottle-Item  Occurs 1 to 64 times
  26.                               Depending on Bottle-Count
  27.                               Indexed by Item-Count.
  28.                   15 bottleObj  Usage Object Reference Bottle.
  29.  
  30.        PROCEDURE DIVISION.
  31.  
  32.       * ========================================
  33.       * ========================================
  34.        Identification Division.
  35.        Method-Id. "DescribeOrder".
  36.        DATA DIVISION.
  37.        Working-Storage Section.
  38.        01  WS-Type                     PIC X(20).
  39.        01  WS-Cost                     PIC 9(3)V99.
  40.        Linkage Section.
  41.        01  LS-Items.
  42.            05  LS-Item-Count            PIC 9(4).
  43.            05  LS-Item      Occurs 1 to 64 times
  44.                             Depending on LS-Item-Count
  45.                             Indexed by LS-Index.
  46.                10 LS-Type              PIC X(20).
  47.                10 LS-Cost              PIC 9(3)V99.
  48.        PROCEDURE DIVISION
  49.                    Returning LS-Items.
  50.            Move Bottle-Count to LS-Item-Count.
  51.            Set LS-Index to 1.
  52.            if (Item-Count > 0)
  53.               Perform Varying Item-Count from 1 by 1
  54.                          Until (Item-Count > Bottle-Count)
  55.                  Invoke bottleObj(Item-Count) "GetCost"
  56.                              returning WS-Cost
  57.                  Move WS-Cost to LS-Cost(LS-Index)
  58.                  Invoke bottleObj(Item-Count) "GetType"
  59.                              returning WS-Type
  60.                  Move WS-Type to LS-Type(LS-Index)
  61.                  Set LS-Index up by 1
  62.               End-Perform
  63.            End-If.
  64.            Exit Method.
  65.        End Method "DescribeOrder".
  66.  
  67.       * ========================================
  68.       * ========================================
  69.        IDENTIFICATION DIVISION.
  70.        Method-Id. "addBottle".
  71.        DATA DIVISION.
  72.        Working-Storage Section.
  73.        01  Found-Flag                  PIC X(4).
  74.            88  Found                      Value "0".
  75.            88  Not-Found                  Value "1".
  76.        01  Equal-Flag                  PIC X.
  77.        Linkage Section.
  78.        01 LS-Parms.
  79.            05 LS-Item-Count            PIC S9(8) COMP.
  80.            05 LS-Flag                  PIC X.
  81.        01 LS-Type                      PIC X(20).
  82.        01 LS-Cost                      PIC 9(3)V99.
  83.  
  84.        PROCEDURE DIVISION
  85.                    Using LS-Type  LS-Cost
  86.                    Returning LS-Parms.
  87.  
  88.            Move "1" to LS-Flag Found-Flag.
  89.            Perform Varying Item-Count From 1 by 1
  90.                      Until (Item-Count > 64) or (Found)
  91.               If bottleObj(Item-Count) NOT = NULL
  92.                  Perform Check-Equal
  93.                  Move Bottle-Count to LS-Item-Count
  94.               Else If Found-Flag = "1"
  95.                  Invoke Bottle "somNew"
  96.                                 Returning bottleObj(Item-Count)
  97.                  Invoke bottleObj(Item-Count) "SetType"
  98.                                  Using LS-Type
  99.                  Invoke bottleObj(Item-Count) "SetCost" Using LS-Cost
  100.                  Add 1 to Bottle-Count
  101.                  Move Bottle-Count to LS-Item-Count
  102.                  Move "0" to LS-Flag Found-Flag
  103.                  End-if
  104.               End-if
  105.            End-Perform.
  106.            Exit Method.
  107.  
  108.        Check-Equal.
  109.            Invoke bottleObj(Item-Count) "isEqual"
  110.                      Using LS-Type LS-Cost
  111.                      Returning Equal-Flag.
  112.            If Equal-Flag  = High-Value
  113.               Display
  114.                     " Sorry .. that wine is already in the order."
  115.               Move "0" to Found-Flag
  116.            End-If.
  117.  
  118.        End Method "addBottle".
  119.  
  120.       * ========================================
  121.       * ========================================
  122.        IDENTIFICATION DIVISION.
  123.        Method-Id. "DeleteBottle".
  124.        DATA DIVISION.
  125.        Working-Storage Section.
  126.        01  Found-Flag                  PIC X(4).
  127.            88  Found                     Value "0".
  128.            88  Not-Found                 Value "1".
  129.        Local-Storage Section.
  130.        77  Bott-Type                   PIC X(20).
  131.        77  Bott-Cost                   PIC 9(3)V99.
  132.        Linkage Section.
  133.        01 LS-Parms.
  134.            05 LS-Item-Count            PIC S9(8) COMP.
  135.            05 LS-Flag                  PIC X.
  136.        01  LS-Type                     PIC x(20).
  137.        01  LS-Cost                     PIC 9(3)V99.
  138.        PROCEDURE DIVISION
  139.                    Using LS-Type LS-Cost LS-Parms.
  140.  
  141.            Move "1" to Found-Flag LS-Flag.
  142.            Perform Varying Item-Count From 1 by 1
  143.                      until (Item-Count > Bottle-Count) or (Found)
  144.               Invoke bottleObj(Item-Count) "GetType"
  145.                      Returning Bott-Type
  146.               If LS-Type = Bott-Type
  147.                  Invoke bottleObj(Item-Count) "GetCost"
  148.                         Returning Bott-Cost
  149.                  If LS-Cost = Bott-Cost
  150.                     Set bottleObj(Item-Count) to bottleObj(Bottle-Count)
  151.                     Set bottleObj(Bottle-Count) to NULL
  152.                     Subtract 1 from Bottle-Count
  153.                     Move Bottle-Count to LS-Item-Count
  154.                     Move "0" to Found-Flag LS-Flag
  155.                  End-If
  156.               End-if
  157.            End-Perform.
  158.            Exit Method.
  159.        End Method "DeleteBottle".
  160.  
  161.  
  162.       * ========================================
  163.       * ========================================
  164.        IDENTIFICATION DIVISION.
  165.        Method-Id. "CalculateCost".
  166.        DATA DIVISION.
  167.        Local-Storage Section.
  168.        77  Cost                        PIC 9(3)V99.
  169.        Linkage Section.
  170.        01  LS-Total-Cost               PIC 9(7)V99.
  171.        PROCEDURE DIVISION
  172.                    Returning LS-Total-Cost.
  173.  
  174.            Move 0 to LS-Total-Cost.
  175.            Perform Varying Item-Count From 1 by 1
  176.                     until Item-Count > Bottle-Count
  177.               Invoke bottleObj(Item-Count) "GetCost" returning Cost
  178.               Add Cost to LS-Total-Cost
  179.            End-Perform.
  180.            Exit Method.
  181.        End Method "CalculateCost".
  182.  
  183.       * ========================================
  184.       * ========================================
  185.        IDENTIFICATION DIVISION.
  186.        Method-Id. "GetOrderNumber".
  187.        DATA DIVISION.
  188.        Linkage Section.
  189.        01  LS-Order-Number             PIC X(5).
  190.  
  191.        PROCEDURE DIVISION
  192.                    Returning LS-Order-Number.
  193.            Move Order-Number to LS-Order-Number.
  194.            Exit Method.
  195.        End Method "GetOrderNumber".
  196.  
  197.       * ========================================
  198.       * ========================================
  199.        IDENTIFICATION DIVISION.
  200.        Method-Id. "GetOrderDate".
  201.        DATA DIVISION.
  202.        Linkage Section.
  203.        01  LS-Order-Date               PIC X(10).
  204.        PROCEDURE DIVISION
  205.                    Returning LS-Order-Date.
  206.            Move Order-Date to LS-Order-Date.
  207.            Exit Method.
  208.        End Method "GetOrderDate".
  209.  
  210.  
  211.       * ========================================
  212.       * ========================================
  213.        IDENTIFICATION DIVISION.
  214.        Method-Id. "SetOrderNumber".
  215.        DATA DIVISION.
  216.        Linkage Section.
  217.        01  LS-OrderNumber             PIC X(5).
  218.        PROCEDURE DIVISION
  219.                    Using LS-OrderNumber.
  220.            Move LS-OrderNumber to Order-Number.
  221.            Exit Method.
  222.        End Method "SetOrderNumber".
  223.  
  224.       * ========================================
  225.       * ========================================
  226.        IDENTIFICATION DIVISION.
  227.        Method-Id. "SetOrderDate".
  228.        DATA DIVISION.
  229.        Linkage Section.
  230.        01  LS-OrderDate               PIC X(10).
  231.        PROCEDURE DIVISION
  232.                    Using LS-OrderDate.
  233.            Move LS-OrderDate to Order-Date.
  234.            Exit Method.
  235.        End Method "SetOrderDate".
  236.  
  237.       *---------------------------------
  238.        END CLASS "WineOrder".
  239.  
  240.  
  241.