      $SET db2(db=db2demo) charset(ebcdic)
      *---------------------------------------------------------------
      *--- Copyright (C) 1992-2006 Micro Focus International Ltd.
      *--- All rights reserved.
      *---------------------------------------------------------------
      *--- Dynamic SQL example - varying-list SELECT
      *---------------------------------------------------------------
       IDENTIFICATION DIVISION.
       PROGRAM-ID.    HCODYN2.

       DATA DIVISION.
       WORKING-STORAGE SECTION.

       01  PRODUCT-LINE.
           05 FILLER                   PIC X(010) VALUE
              'Product = '.
           05 DISPLAY-ID               PIC X(004) VALUE ' '.
           05 FILLER                   PIC X(010) VALUE
              '   Desc = '.
           05 DISPLAY-DESC             PIC X(035) VALUE ' '.
           05 FILLER                   PIC X(007) VALUE
              ' Amt = '.
           05 DISPLAY-AMT              PIC $,$$$,$$9.99.

      *--- Please note: VARCHARS must use host variable with
      *--- level 49's if a length component is used

       01  WS-SELECT.
           49 WS-SELECT-IX             PIC S9(04) COMP.
           49 WS-SELECT-DATA           PIC X(1500).

       01  IX                          PIC S9(04) COMP.
       01  ERR-REC-LTH                 PIC S9(09) COMP.
       01  ERR-MSG-AREA.
           05 ERR-MSG-LTH              PIC S9(04) COMP.
           05 ERR-MSG-TEXT             PIC X(700).
           05 ERR-MSG-TBL    REDEFINES ERR-MSG-TEXT.
              10 ERR-TEXT              PIC X(070) OCCURS 10 TIMES.

      *--- Declare an Output SQLDA Structure

       01  OUT-SQLDA.
           05 OUT-SQLDAID              PIC X(008) VALUE 'O-DA   '.
           05 OUT-SQLDABC              PIC S9(09) COMP.
           05 OUT-SQLN                 PIC S9(04) COMP.
           05 OUT-SQLD                 PIC S9(04) COMP.
           05 OUT-SQLVAR                          OCCURS 4 TIMES.
              10 OUT-SQLTYPE           PIC S9(04) COMP.
              10 OUT-SQLLEN            PIC S9(04) COMP.
              10 OUT-SQLDATA           USAGE IS POINTER.
              10 OUT-SQLIND            USAGE IS POINTER.
              10 OUT-SQLNAME.
                 15 OUT-SQLNAMEL       PIC S9(04) COMP.
                 15 OUT-SQLNAMEC       PIC X(030).

      *--- Declare an Input SQLDA Structure

       01  IN-SQLDA.
           05 IN-SQLDAID               PIC X(008) VALUE 'I-DA   '.
           05 IN-SQLDABC               PIC S9(09) COMP.
           05 IN-SQLN                  PIC S9(04) COMP.
           05 IN-SQLD                  PIC S9(04) COMP.
           05 IN-SQLVAR                           OCCURS 1 TIMES.
              10 IN-SQLTYPE            PIC S9(04) COMP.
              10 IN-SQLLEN             PIC S9(04) COMP.
              10 IN-SQLDATA            USAGE IS POINTER.
              10 IN-SQLIND             USAGE IS POINTER.
              10 IN-SQLNAME.
                 15 IN-SQLNAMEL        PIC S9(04) COMP.
                 15 IN-SQLNAMEC        PIC X(030).

       LINKAGE SECTION.

       01  WS-DATE                     PIC X(010).
           EXEC SQL INCLUDE SQLCA      END-EXEC.
           EXEC SQL INCLUDE PRODUCT    END-EXEC.

      *---------------------------------------------------------------
      *--- Dynamic SQL example - varying-list SELECT
      *---------------------------------------------------------------

       PROCEDURE DIVISION           USING WS-DATE
                                          SQLCA
                                          DCLPRODUCT.

       0000-MAIN-LOGIC.

           DISPLAY 'BEG HCODYN2 TEST'

      *--- Demonstrate a varying-list SELECT

           MOVE 1                      TO WS-SELECT-IX
           MOVE SPACES                 TO WS-SELECT-DATA

           STRING 'SELECT PROD_ID,PROD_DESC,AMT_EACH' DELIMITED BY SIZE
                  ',CURRENT DATE'                     DELIMITED BY SIZE
                  ' FROM DEMO.PRODUCT'                DELIMITED BY SIZE
                  ' WHERE PROD_ID >= ?'               DELIMITED BY SIZE
                  ' ORDER BY PROD_ID, PROD_DESC'      DELIMITED BY SIZE
             INTO WS-SELECT-DATA
             WITH POINTER WS-SELECT-IX
           END-STRING

      *--- HCO will automatically convert dashes in cursor
      *--- and dynamic SQL names to underscores
      *--- sinces dashes in these names are supported in DB2 UDB V5
      *--- or earlier

           EXEC SQL
                DECLARE CSR-02 CURSOR FOR DYNAM-CSR02
           END-EXEC

      *--- Initialize SQLDA area to 4 as we know that we need
      *--- 4 host variables to be defined for the fetch
      *--- In a true varying list example, you would not know this

           MOVE 4                      TO OUT-SQLN
           MOVE 4                      TO OUT-SQLD
           COMPUTE OUT-SQLDABC          = 16 + (44 * OUT-SQLD)

      *--- The PREPARE INTO will define type/size of the host var's
      *--- into the SQLDA so the program doesn't need to do it

           EXEC SQL
                PREPARE DYNAM-CSR02 INTO :OUT-SQLDA FROM :WS-SELECT
           END-EXEC

           IF SQLCODE NOT = 0
               PERFORM 9999-SQL-ERR  THRU 9999-EXIT
           END-IF

      *--- Set ADDRESSes to store data for FETCH CURSOR

           SET OUT-SQLDATA(4)          TO ADDRESS OF WS-DATE
           SET OUT-SQLDATA(3)          TO ADDRESS OF PRD-AMT-EACH
           SET OUT-SQLDATA(2)          TO ADDRESS OF PRD-PROD-DESC
           SET OUT-SQLDATA(1)          TO ADDRESS OF PRD-PROD-ID

      *--- Set up input SQLDA to only get PROD-IDs > 1005

           MOVE 1                      TO IN-SQLN
           MOVE 1                      TO IN-SQLD
           COMPUTE IN-SQLDABC           = 16 + (44 * IN-SQLD)
           MOVE 452                    TO IN-SQLTYPE (1)
           MOVE 4                      TO IN-SQLLEN (1)
           SET IN-SQLDATA(1)           TO ADDRESS OF PRD-PROD-ID
           MOVE '1000'                 TO PRD-PROD-ID

           EXEC SQL
                OPEN CSR-02 USING DESCRIPTOR :IN-SQLDA
           END-EXEC

           IF SQLCODE NOT = 0
               PERFORM 9999-SQL-ERR  THRU 9999-EXIT
           END-IF

           PERFORM 2000-FETCH-CSR    THRU 2000-EXIT
              UNTIL SQLCODE NOT = 0

           EXEC SQL
                CLOSE CSR-02
           END-EXEC

           DISPLAY 'DATE = ' WS-DATE
           DISPLAY 'END HCODYN2 TEST'

           GOBACK.

      *---------------------------------------------------------------
      *--- Get data from table
      *---------------------------------------------------------------

       2000-FETCH-CSR.

           MOVE SPACES                 TO  PRD-PROD-DESC-TEXT

           EXEC SQL
                FETCH CSR-02 USING DESCRIPTOR :OUT-SQLDA
           END-EXEC

           IF SQLCODE = 0
               MOVE PRD-PROD-ID        TO DISPLAY-ID
               MOVE PRD-PROD-DESC-TEXT TO DISPLAY-DESC
               MOVE PRD-AMT-EACH       TO DISPLAY-AMT
               DISPLAY PRODUCT-LINE
           ELSE
               IF SQLCODE NOT = +100
                   PERFORM 9999-SQL-ERR THRU 9999-EXIT
               END-IF
           END-IF.

       2000-EXIT.
           EXIT.

      *---------------------------------------------------------------
      *--- Call DSNTIAR to get SQL Error Message text
      *---------------------------------------------------------------

       9999-SQL-ERR.

           MOVE 70                     TO ERR-REC-LTH
           MOVE 700                    TO ERR-MSG-LTH

           CALL 'DSNTIAR'           USING SQLCA
                                          ERR-MSG-AREA
                                          ERR-REC-LTH

           PERFORM VARYING IX FROM 1 BY 1 UNTIL IX > 10
               DISPLAY ERR-TEXT (IX)
           END-PERFORM.

       9999-EXIT.
           EXIT.
