Editing Pgcobol.cbl

This is the compplete source code of the Cobol program, which contains the high level SQL statements.
<pre>
       IDENTIFICATION DIVISION.

       PROGRAM-ID. pgcobol.


       ENVIRONMENT DIVISION.

       CONFIGURATION SECTION.
       source-computer. Linux-laptop.
       object-computer. Linux-laptop.
       special-names.
           console is scherm.

       SOURCE-COMPUTER. IBM-AT.
       OBJECT-COMPUTER. IBM-AT.

       INPUT-OUTPUT SECTION.
       FILE-CONTROL.
         select fprinter assign to "pgcobol.prt";
         ORGANIZATION LINE SEQUENTIAL.
       DATA DIVISION.

       FILE SECTION.
       FD fprinter.
       01 file-buffer PIC X(242).
       WORKING-STORAGE SECTION.

      *   copy 'SQLCA.cpy'.
      *   copy 'EMPREC.cpy'.

       01 DATASRC PIC X(64) value
      *   "pgsql://10.68.171.50:5432".
      *   "pgsql://10.68.171.50:5432/cobol_gixsql".
          "pgsql://localhost:5432/cobol_gixsql".
       01 DBUSR     PIC X(64)  value "gix_user".
       01 DBPWD     PIC X(64)  value "gix_user".

       01 CUR-STEP    PIC X(16).
       01 empcount    PIC 9(5).
       01 employee-record.
           03 r-ENO PIC S9(4) COMP.
           03 r-LNAME PIC X(10).
           03 r-FNAME PIC X(10).
           03 r-STREET PIC X(20).
           03 r-CITY PIC X(15).
           03 r-ST PIC XX.
           03 r-ZIP PIC X(5).
           03 r-DEPT PIC X(4).
      *    03 a-PAYRATE PIC S9(13)V99 COMP-3 VALUE 0.
           03 r-PAYRATE PIC S9(13)V99 COMP-3 VALUE 0.
           03 r-COM PIC S9V99 COMP-3.
           03 r-MISCDATA PIC X(132).
           03 r-DNUM1 PIC S99V99 COMP-3.
           03 r-DNUM2 PIC S99V99 COMP-3.
           03 r-DNUM3 PIC S99V99 COMP-3.

       01 employee-row.
           03 p-ENO PIC z(3)9.
           03 filler pic x value space.
           03 p-LNAME PIC X(10).
           03 filler pic x value space.
           03 p-FNAME PIC X(10).
           03 filler pic x value space.
           03 p-STREET PIC X(20).
           03 filler pic x value space.
           03 p-CITY PIC X(15).
           03 filler pic x value space.
           03 p-ST PIC XX.
           03 filler pic x value space.
           03 p-ZIP PIC X(5).
           03 filler pic x value space.
           03 p-DEPT PIC X(4).
           03 filler pic x value space.
           03 p-PAYRATE PIC z(12)9.99.
           03 filler pic x value space.
           03 p-COM PIC 9v99.
           03 filler pic x value space.
           03 p-DNUM1 PIC z9.99.
           03 filler pic x value space.
           03 p-DNUM2 PIC z9.99.
           03 filler pic x value space.
           03 p-DNUM3 PIC z9.99.
           03 filler pic x value space.
           03 p-miscdata-text pic X(128).

       01 employee-header.
           03 h-ENO pic x(5) value 'Eno'.
           03 h-LNAME PIC X(11) value 'Lname'.
           03 h-FNAME PIC X(11) value 'Fname'.
           03 h-STREET PIC X(21) value space.
           03 h-CITY PIC X(16) value 'City'.
           03 h-ST PIC X(3) value 'ST'.
           03 h-ZIP PIC X(6) value 'zip'.
           03 h-DEPT PIC X(5) value 'Dept'.
           03 h-PAYRATE PIC x(17) value 'Payrate'.
           03 h-COM PIC x(4) value 'Com'.
           03 h-DNUM1 PIC x(6) value 'Dnum1'.
           03 h-DNUM2 PIC x(6) value 'Dnum1'.
           03 h-DNUM3 PIC x(6) value 'Dnum1'.
           03 h-miscdata-text pic X(128) value 'Misc data'.

       01 employee-page.
           03 filler pic x(118) value space.
           03 filler pic x(10) value 'page'.
           03 f-page-number PIC z(3)9.

      *01 MISCDATA PIC X(132).

       01 miscdata-group.
           49 miscdata-len pic 9(8) comp-5.
           49 miscdata-text pic X(128).

       01 IDX              PIC 9(2).
       01 print-buffer     PIC X(242).
       01 line-number      PIC 99 value 99.
       01 page-number      PIC 9999 value zero.

       01 TMPNUM          PIC 9(4).

       EXEC SQL
           INCLUDE employee-table
       END-EXEC.

       EXEC SQL
           INCLUDE SQLCA
       END-EXEC.

       EXEC SQL AT cobol_sql
           DECLARE employeecursor CURSOR FOR
             SELECT * FROM emptable
       END-EXEC.

       PROCEDURE DIVISION.

       r00-main.

           perform r90-init.
           perform r80-verwerk.
           perform r99-exit.

       r80-verwerk.

           EXEC SQL AT cobol_sql
               SELECT COUNT(*) INTO :empcount FROM emptable
           END-EXEC.

           display "Rijen in emptable" upon scherm.
           display empcount upon scherm.

           perform r81-init-cursor.

           perform r85-verwerk-employee until
                   SQLCODE < 0 or SQLCODE = 100

           perform r89-close-cursor.

       r81-init-cursor.

           EXEC SQL AT cobol_sql START TRANSACTION END-EXEC.
           display "start transaction" upon scherm.
           display SQLCODE upon scherm.

           EXEC SQL OPEN employeecursor END-EXEC.

           display "open cursor" upon scherm.
           display SQLCODE upon scherm.

           EXEC SQL FETCH employeecursor INTO :employee-table END-EXEC.

           display "fetch cursor" upon scherm.
           display SQLCODE upon scherm.

       r85-verwerk-employee.

           move ENO to r-ENO.
           move LNAME to r-LNAME.
           move FNAME to r-FNAME.
           move STREET to r-STREET.
           move CITY to r-CITY.
           move ST to r-ST.
           move ZIP to r-ZIP.
           move DEPT to r-DEPT.
           move PAYRATE to r-PAYRATE.
           move COM to r-COM.
           move DNUM1 to r-DNUM1.
           move DNUM2 to r-DNUM2.
           move DNUM3 to r-DNUM3.
           move MISCDATA to miscdata-group.
      *    move miscdata-len to r-miscdata-len.
      *    move miscdata-text to r-miscdata-text.

           move r-ENO to p-ENO.
           move r-LNAME to p-LNAME.
           move r-FNAME to p-FNAME.
           move r-STREET to p-STREET.
           move r-CITY to p-CITY.
           move r-ST to p-ST.
           move r-ZIP to p-ZIP.
           move r-DEPT to p-DEPT.
           move r-PAYRATE to p-PAYRATE.
           move r-COM to p-COM.
           move r-DNUM1 to p-DNUM1.
           move r-DNUM2 to p-DNUM2.
           move r-DNUM3 to p-DNUM3.
           move miscdata-text to p-miscdata-text.

           display employee-row upon scherm.
           perform p00-print.

           EXEC SQL FETCH employeecursor INTO :employee-table END-EXEC.

           display "fetch cursor" upon scherm.
           display SQLCODE upon scherm.

       r89-close-cursor.

           EXEC SQL CLOSE employeecursor END-EXEC.

       r90-init.
           perform s00-connect.
           open output fprinter.

       r99-exit.

           perform s99-disconnect.
           close fprinter.
           perform z99-exit.

       z99-exit.

           stop run.

       s00-connect.
           display "DATASRC" upon scherm.
           display "DBUSR" upon scherm.
           display "DBPWD" upon scherm.

           MOVE 'CONNECT' TO CUR-STEP.
           EXEC SQL
      *       CONNECT :DBUSR IDENTIFIED BY :DBPWD USING :DATASRC
              CONNECT TO :DATASRC AS cobol_sql USER :DBUSR USING :DBPWD
      *       CONNECT TO "pgsql://10.68.171.50:5432/cobol_gixsql"
      *                USER :DBUSR USING :DBPWD
           END-EXEC.
           display "connect to database" upon scherm.
           display SQLCODE upon scherm.

       s99-disconnect.
           display "DATASRC" upon scherm.
           display "DBUSR" upon scherm.
           display "DBPWD" upon scherm.

           MOVE 'DISCONNECT' TO CUR-STEP.
           EXEC SQL CONNECT RESET cobol_sql END-EXEC.
           EXEC SQL DISCONNECT cobol_sql END-EXEC.
           display "disconnect from database" upon scherm.
           display SQLCODE upon scherm.

       p00-print.
           if line-number > 50 then
             move 1 to line-number 
             add 1 to page-number 
             move page-number to f-page-number
             move employee-page to print-buffer
             write file-buffer from print-buffer
             move employee-header to print-buffer
             write file-buffer from print-buffer
             move employee-row to print-buffer
             write file-buffer from print-buffer
           else
             add 1 to page-number 
             move employee-row to print-buffer
             write file-buffer from print-buffer.

       999-PRG-ERR.
           display 'ERR - ' CUR-STEP ' : ' SQLCODE.
           display 'ERR - ' CUR-STEP ' : ' SQLERRMC(1:SQLERRML).
           MOVE -1 TO RETURN-CODE.

</pre>
<hr/>
Terug naar: [[Cobol and PostgreSQL]]