logo
Home

MPE/iX Enterprise Client - COBOL Example

iX-eClient

The following program will select and join two DB2 tables located on a Windows 2000 server, extract a few fields and sort by PROJNO.  The results will be displayed in the STDLIST. 

 $CONTROL BOUNDS,CROSSREF,MAP,SOURCE
 $TITLE "Source File is ANSI1S "
 *****************************************************************
 * *
 * PROGRAM TITLE BLOCK *
 * *
 * *
  *****************************************************************
 * *
 * TASK DATE AUTHOR CHANGES *
 * ---- -------- ---------------- ------------------------- *
 *                         Jeff Shaw       ORIGINAL *
 * *
 *****************************************************************
 $PAGE
 *****************************************************************
 * IDENTIFICATION DIVISION *
 *****************************************************************
 
 IDENTIFICATION DIVISION.
 PROGRAM-ID. TESTS.
 AUTHOR. D THATCHER.
 
 ENVIRONMENT DIVISION.
 CONFIGURATION SECTION.
 SOURCE-COMPUTER. HP-3000.
 OBJECT-COMPUTER. HP-3000.
 
 SPECIAL-NAMES.
 CONDITION-CODE IS CC.
 $PAGE
*****************************************************************
* DATA DIVISION *
*****************************************************************

 DATA DIVISION.
 WORKING-STORAGE SECTION.

 01 CNTR                        PIC S9(4) COMP VALUE 0.
 01 NUMRECS                PIC S9(4) COMP VALUE 10.
 01 COL-NAME              PIC X(50) VALUE SPACES.
 01 COL-VALUE             PIC X(400) VALUE SPACES.
 01 PROJNO                    PIC X(24) VALUE SPACES.
 01 PROJNAME              PIC X(24) VALUE SPACES.
 01 DEPT                         PIC X(24) VALUE SPACES.
 01 RECORD-CNTR       PIC S9(4) COMP VALUE 0.

 01 LONG-SQL.
     05 FILLER                 PIC X(39) VALUE
          "SELECT * FROM EMPLOYEE,DEPARTMENT WHERE".
     05 FILLER                 PIC X(42) VALUE
         " (( DEPARTMENT.DEPTNO=EMPLOYEE.WORKDEPT ))".

 01 SQL-2.
     05 FILLER                 PIC X(33) VALUE
         "SELECT PROJECT.PROJNO AS PROJNO, ".
     05 FILLER                 PIC X(44) VALUE
         "PROJECT.PROJNAME AS PROJNAME,".
     05 FILLER                 PIC X(44) VALUE
         "PROJECT.PROJNAME AS PROJNAME,".
     05 FILLER                PIC X(44) VALUE
         "EMPLOYEE.WORKDEPT AS WORKDEPT,".
     05 FILLER                PIC X(44) VALUE
         "DEPARTMENT.DEPTNAME AS DEPTNAME ".
     05 FILLER                PIC X(44) VALUE
         "FROM EMPLOYEE,PROJECT,DEPARTMENT ".
     05 FILLER               PIC X(44) VALUE
         "WHERE ((PROJECT.DEPTNO = EMPLOYEE.WORKDEPT ".
     05 FILLER               PIC X(44) VALUE
         "AND DEPARTMENT.DEPTNO = PROJECT.DEPTNO )) ".
     05 FILLER              PIC X(44) VALUE
         "ORDER BY PROJNO".
******************
* MESSAGE AREA
******************

01 IP-ADDRESS                               PIC X(40) VALUE SPACES.
01 DATA-SOURCE-NAME             PIC X(20) VALUE SPACES.
01 SQL-COMMAND                        PIC X(1023) VALUE SPACES.
01 SQL-STATUS.
    05 PROG-STATUS                      PIC S9(9) COMP VALUE 0.
    05 ERR-MSG                               PIC X(256).
    05 CONTROL-FILE                     PIC S9(9) COMP VALUE 0.
*****************************************************************
* PROCEDURE DIVISION *
*****************************************************************

PROCEDURE DIVISION.

*****************************************************************
* MAIN PROGRAM FLOW *
*****************************************************************

A000-MAIN-LINE.

    PERFORM B000-OPEN THRU
    B000-EXIT.

    PERFORM B100-PROCESS THRU
    B100-EXIT.

    SHUT-DOWN.
 
     GOBACK.
 
 $PAGE
 
 B000-OPEN.
 
 
 B000-EXIT.
 
     EXIT.
 $PAGE
 *****************************************************************
 * MAIN PROCESSING LOGIC *
 *****************************************************************
 * Open the data base on the host platform as defined by the I/P address*
* In this example its a DB2 data base*

 B100-PROCESS.
         MOVE "DB2BOX" TO IP-ADDRESS.
         MOVE "sample" TO DATA-SOURCE-NAME.
 
        CALL "ANSICONNECT" USING IP-ADDRESS, DATA-SOURCE-NAME,
                                                               SQL-STATUS.
 
         IF PROG-STATUS <> 0
                 DISPLAY "ERROR=",ERR-MSG
         ELSE
                 DISPLAY "DATA SOURCE ",DATA-SOURCE-NAME," OPEN.".
  
         MOVE SQL-2 TO SQL-COMMAND.
 
         CALL "ANSISTATEMENT" USING SQL-COMMAND,SQL-STATUS.
         IF PROG-STATUS <> 0
                 DISPLAY "ERROR ",ERR-MSG GO TO B100-EXIT
         ELSE
                 DISPLAY "SELECT OK...".
 
         MOVE 0 TO RECORD-CNTR.
 
          PERFORM C100-FETCH-RECORDS THRU C100-EXIT.
 
          CALL "ANSICLOSE" USING SQL-STATUS.
 
 B100-EXIT.
         EXIT.
 C100-FETCH-RECORDS.
 
 
         CALL "ANSINEXT" USING  SQL-STATUS.
         IF PROG-STATUS <> 0
 * --- A STATUS CODE OF 11 = NO MORE RECORDS
                 DISPLAY "DONE - ",ERR-MSG
                 DISPLAY "RECORDS SELECTED = ",RECORD-CNTR
                 GO TO C100-EXIT.
 
         MOVE "PROJNO" TO COL-NAME.
 
         CALL "ANSIGETSTRING" USING COL-NAME, COL-VALUE, SQL-STATUS.
 
         IF PROG-STATUS <> 0
                 DISPLAY "ANSIGETSTRING  ERROR ",ERR-MSG.
 
         MOVE COL-VALUE TO PROJNNO.
 
         MOVE "PROJNAME" TO COL-NAME.
 
         CALL "ANSIGETSTRING " USING COL-NAME, COL-VALUE, SQL-STATUS.
 
         IF PROG-STATUS <> 0
                 DISPLAY "ANSIGETSTRING  ERROR ",ERR-MSG.
 
         MOVE COL-VALUE TO PROJNAME.
 
         MOVE "DEPTNAME" TO COL-NAME.
 
         CALL "ANSIGETSTRING " USING COL-NAME, COL-VALUE, SQL-STATUS.
         IF PROG-STATUS <> 0
                 DISPLAY "ERROR = ",ERR-MSG
                 STOP RUN.
 
         MOVE COL-VALUE TO DEPT.
 
         DISPLAY "NAME AND DEPT : ",PROJNO," ",PROJNAME," - ",DEPT.
 
         ADD 1 TO RECORD-CNTR.
 
 
         GO TO C100-FETCH-RECORDS.
 
 C100-EXIT.
         EXIT.  


Home

Copyright 1997-2006  The InterNet Agency.    All rights reserved.
We welcome your comments to the Webmaster