home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / PROGJRN / PJ_7_3A.ARC / ESQL.COB < prev    next >
Encoding:
Text File  |  1989-04-20  |  3.9 KB  |  147 lines
  1. *  LISTING 1
  2.  
  3. DATA DIVISION.
  4. WORKING-STORAGE SECTION.
  5. EXEC SQL  BEGIN DECLARE SECTION  END-EXEC.
  6. 01 ORDER-ENTRY-WORK-AREA.
  7.    05 PRODUCT-ID        PIC X(03).
  8.    05 PRODUCT-NAME      PIC X(20).
  9.    05 PRODUCT-COLOR     PIC X(10).
  10.    05 PRODUCT-FABRIC    PIC X(10).
  11.    05 PRODUCT-PRICE     PIC 9(02)V99.
  12.    05 LOCATION          PIC X(20).
  13.    05 CUSTOMER-ID       PIC X(03).
  14.    05 CUSTOMER-NAME     PIC X(20).
  15.    05 CUSTOMER-LOCATION PIC X(20).
  16.    05 TARIFF-CODE       PIC X(02).
  17. EXEC SQL END DECLARE SECTION END-EXEC.
  18.  
  19.  
  20. *  LISTING 2
  21.  
  22. PROCEDURE DIVISION.
  23. 000-BEGIN.
  24.            PERFORM 001-ACCESS-DATA-BASE.
  25.        . . .
  26.  
  27.  
  28. 001-ACCESS-DATA-BASE.
  29.           EXEC SQL
  30.             SELECT PRODUCT.ID,
  31.                    PRODUCT.COLOR,
  32.                    PRODUCT.LOCATION
  33.                 INTO
  34.                    :PRODUCT-ID,
  35.                    :PRODUCT-COLOR,
  36.                    :PRODUCT-LOCATION
  37.                 FROM PRODUCT
  38.                 WHERE PRODUCT.FABRIC = "MAUVE"
  39.           END-EXEC.
  40. 001-END-DB-ACCESS.
  41.         EXIT.
  42.  
  43.  
  44. *  LISTING 3
  45.  
  46.  DATA DIVISION.
  47.  WORKING-STORAGE SECTION.
  48.  EXEC SQL  BEGIN DECLARE SECTION  END-EXEC.
  49.  01 ORDER-ENTRY-WORK-AREA.
  50.     05 PRODUCT-ID        PIC X(03).
  51.     05 PRODUCT-NAME      PIC X(20).
  52.     05 PRODUCT-COLOR     PIC X(10).
  53.  EXEC SQL END DECLARE SECTION END-EXEC.
  54.  SCREEN SECTION.
  55.  
  56. * (SCREEN SECTION is not standard COBOL but is included
  57. * in many microcomputer COBOL compilers)
  58.  
  59.  01 MAIN-SCREEN.
  60.     05 SC-PRODUCT-ID     PIC X(03).
  61.     05 SC-PRODUCT-NAME   PIC X(20).
  62.     05 SC-PRODUCT-COLOR  PIC X(10).
  63.  PROCEDURE DIVISION.
  64.  000-BEGIN.
  65.      EXEC SQL WHENEVER SQLWARNING
  66.           GO TO :900-WARNING-ROUTINE
  67.      END-EXEC.
  68.      EXEC SQL WHENEVER SQLERROR
  69.           GO TO :920-ERROR-ROUTINE
  70.      END-EXEC.
  71.      PERFORM 100-MAIN-ROUTINE UNTIL some-condition.
  72.      PERFORM 800-TERMINATION-ROUTINE.
  73.      STOP RUN.
  74.  100-MAIN-ROUTINE.
  75.      PERFORM 200-GET-SCREEN-INPUT.
  76.      MOVE SC-PRODUCT-ID TO PRODUCT-ID.
  77.      MOVE SC-PRODUCT-NAME TO PRODUCT-NAME.
  78.      MOVE SC-PRODUCT-COLOR TO PRODUCT-COLOR.
  79.      EXEC SQL
  80.         INSERT  INTO PRODUCT (ID,
  81.                               NAME,
  82.                               COLOR)
  83.                      VALUES  (:PRODUCT-ID,
  84.                               :PRODUCT-NAME,
  85.                               :PRODUCT-COLOR)
  86.      END-EXEC.
  87.  
  88. ************  additional main routine code **************
  89.  200-GET-SCREEN-INPUT.
  90.  800-TERMINATION-ROUTINE.
  91.  900-WARNING-ROUTINE.
  92.  920-ERROR-ROUTINE.
  93. /*  = LISTING 4
  94. WORKING-STORAGE SECTION.
  95.  
  96.  
  97.       . . .
  98.  
  99.  
  100.      EXEC SQL  DECLARE  PRODUCT_CURSOR CURSOR FOR
  101.                SELECT
  102.                      PRODUCT.ID,
  103.                      PRODUCT.NAME,
  104.                      PRODUCT.COLOR,
  105.                      PRODUCT.FABRIC
  106.                FROM  PRODUCT
  107.                WHERE PRODUCT.ID >= :PRODUCT-ID
  108.                ORDER BY PRODUCT.ID
  109.      END-EXEC.
  110. PROCEDURE DIVISION.
  111. 000-MAIN.
  112.     PERFORM 001-INITIALIZE.
  113.     PERFORM 300-CHECK-ON-PRODUCT.
  114.     PERFORM 900-END-PROGRAM.
  115. 300-CHECK-PRODUCT.
  116.      EXEC SQL OPEN PRODUCT_CURSOR END-EXEC.
  117.      PERFORM UNTIL SQLCODE = +100
  118.              EXEC SQL
  119.                   FETCH PRODUCT_CURSOR
  120.                     INTO  :PRODUCT-ID,
  121.                           :PRODUCT-NAME,
  122.                           :PRODUCT-COLOR,
  123.                           :PRODUCT-FABRIC
  124.              END-SQL
  125.              PERFORM 600-VALIDATE-ROUTINE
  126.              IF VALIDATE-RETURN-CODE = 0 THEN
  127.                 ADD 1 TO VALID-RECORD-COUNT
  128.                 PERFORM 400-PRODUCT-UPDATE-ROUTINE
  129.              ELSE
  130.                 ADD 1 TO NON-VALID-RECORD-COUNT
  131.              END-IF
  132.      END-PERFORM
  133.      EXEC SQL CLOSE PRODUCT_CURSOR END-EXEC.
  134.  
  135.  
  136. 400-PRODUCT-UPDATE-ROUTINE.
  137.          . . .
  138.  
  139.  
  140. 600-VALIDATE-ROUTINE.
  141.          . . .
  142.  
  143.  
  144. 900-END-PROGRAM.
  145.  
  146.  
  147.