(a) PAD chart

Figures 7-11 through 7-13 show a PAD flowchart of example 4.

Figure 7-11 Flowchart of program example 4 (1/3)

Figure 7-12 Flowchart of program example 4 (2/3)

Figure 7-13 Flowchart of program example 4 (3/3)

(b) Coding example

A coding example of an embedded SQL UAP written in COBOL follows:

00010*STOCK MANAGEMENT PROG.
00020*
00030*
00040* ALL RIGHTS RESERVED,COPYRIGHT (C)1997 HITACHI,LTD.
00050* LICENSED MATERIAL OF HITACHI,LTD.
00060*
00070 IDENTIFICATION DIVISION.
00080 PROGRAM-ID. ECOBUAP.
00090*
00100 ENVIRONMENT DIVISION.
00110 CONFIGURATION SECTION.
00120 SOURCE-COMPUTER. HITAC.
00130 OBJECT-COMPUTER. HITAC.
00140 INPUT-OUTPUT SECTION.
00150 FILE-CONTROL.
00160     SELECT INPUT-CARD-FILE
00170       ASSIGN TO  DISK
00180       ORGANIZATION IS LINE SEQUENTIAL.
00190     SELECT PRINT-STOCK-FILE
00200       ASSIGN TO  LP.
00210*
00220 DATA DIVISION.
00230 FILE SECTION.
00240 FD  INPUT-CARD-FILE
00250                    DATA RECORD USER-CARD-REC I-STOCK-REC.
00260*
00270 01  USER-CARD-REC.
00280     02 IUSERID          PIC X(20).
00290     02 IPSWD            PIC X(20).
00300     02 FILLER           PIC X(40).
00310*
00320 01  I-STOCK-REC.
00330     02 ITYPE            PIC X(1).
00340     02 FILLER           PIC X(2).
00350     02 IPCODE           PIC X(4).
00360     02 FILLER           PIC X(2).
00370     02 IPNAME           PIC N(8).
00380     02 ICOLOR           PIC N(1).
00390     02 IPRICE           PIC X(9).
00400     02 ISTOCK           PIC X(9).
00410     02 IFLUX            PIC X(1).
00420     02 FILLER           PIC X(34).
00430*
00440 FD  PRINT-STOCK-FILE RECORDING MODE IS F
00450                      LABEL RECORD IS OMITTED
00460                      DATA RECORD PRINT-STOCK-REC.
00470 01  PRINT-STOCK-REC      PIC X(132).
00480*
00490 WORKING-STORAGE SECTION.
00500*
00510     EXEC SQL                                            1
00520           BEGIN DECLARE SECTION                         1
00530     END-EXEC.                                           1
00540 77  XUSERID            PIC X(30).                       1
00550 77  XPSWD              PIC X(30).                       1
00560 77  XPCODE             PIC X(4)  VALUE '0000'.          1
00570 77  XPNAME             PIC N(8).                        1
00580 77  XCOLOR             PIC N(1).                        1
00590 77  XPRICE             PIC S9(9) COMP.                  1
00600 77  XSTOCK             PIC S9(9) COMP.                  1
00610* INDICATOR VARIABLE                                     1
00620 77  XIPCODE            PIC S9(4) COMP  VALUE 1040.      1
00630 77  XIPNAME            PIC S9(4) COMP  VALUE 1050.      1
00640 77  XICOLOR            PIC S9(4) COMP  VALUE 1060.      1
00650 77  XIPRICE            PIC S9(4) COMP  VALUE 1070.      1
00660 77  XISTOCK            PIC S9(4) COMP  VALUE 1080.      1
00670*                                                        1
00680*                                                        1
00690     EXEC SQL                                            1
00700           END DECLARE SECTION                           1
00710     END-EXEC.                                           1
00720*
00730 01  HEADING-REC.
00740     02 FILLER          PIC X(13) VALUE SPACE.
00750     02 FILLER          PIC X(32)
00760           VALUE '******  STOCK TABLE LIST  ******'.
00770     02 FILLER          PIC X(87) VALUE SPACE.
00780*
00790 01  COLUMN-NAME-REC.
00800     02 FILLER          PIC X(14) VALUE SPACE.
00810     02 FILLER          PIC X(9)  VALUE 'PCODE'.
00820     02 FILLER          PIC X(16) VALUE 'PNAME'.
00830     02 FILLER          PIC X(8)  VALUE 'COLOR'.
00840     02 FILLER          PIC X(8)  VALUE 'PRICE'.
00850     02 FILLER          PIC X(8)  VALUE 'QUANTITY'.
00860     02 FILLER          PIC X(69) VALUE SPACE.
00870*
00880 01  LINE-REC.
00890     02 FILLER          PIC X(14) VALUE SPACE.
00900     02 FILLER          PIC X(9)  VALUE '-----  '.
00910     02 FILLER          PIC X(16) VALUE '--------  '.
00920     02 FILLER          PIC X(8)  VALUE '------- '.
00930     02 FILLER          PIC X(8)  VALUE '------- '.
00940     02 FILLER          PIC X(8)  VALUE '------- '.
00950     02 FILLER          PIC X(69) VALUE SPACE.
00960*
00970 01  SELECT-OUT-REC.
00980     02 FILLER          PIC X(14) VALUE SPACE.
00990     02 O-PCODE         PIC X(5).
01000     02 FILLER          PIC X(2)  VALUE SPACE.
01010     02 O-KANJI         CHARACTER TYPE KEIS.
01020        03 O-PNAME         PIC N(8).
01030        03 FILLER          PIC X(2)  VALUE SPACE.
01040        03 O-COLOR         PIC N(5).
01050        03 FILLER          PIC X(6)  VALUE SPACE.
01060        03 O-PRICE         PIC X(8)  JUST RIGHT.
01070        03 FILLER          PIC X(2)  VALUE SPACE.
01080        03 O-STOCK         PIC X(8)  JUST RIGHT.
01090        03 FILLER          PIC X(69) VALUE SPACE.
01100 77  O-PCODE-NULL       PIC X(5) VALUE '*****'.
01110 77  O-PNAME-NULL       PIC N(10) VALUE NC'----------'.
01120 77  O-COLOR-NULL       PIC N(5) VALUE NC'-----'.
01130 77  O-PRICE-NULL       PIC X(8) VALUE '********'.
01140 77  O-STOCK-NULL        PIC X(8) VALUE '********'.
01150*
01160 01  I-CARD-ERROR-REC.
01170     02 FILLER          PIC X(14) VALUE SPACE.
01180     02 FILLER          PIC X(41)
01190           VALUE '***  ERROR  ***  NO CARD FOR CONNECT  ***'.
01200     02 FILLER          PIC X(77) VALUE SPACE.
01210*
01220 01  CONNECT-ERROR-REC.
01230     02 FILLER          PIC X(14) VALUE SPACE.
01240     02 FILLER          PIC X(45)
01250           VALUE '***  ERROR  ***  CANNOT CONNECT  ***  CODE = '.
01260     02 CNCT-EC         PIC X(5).
01270     02 FILLER          PIC X(68) VALUE SPACE.
01280*
01290 01  NORMAL-END-REC.
01300     02 FILLER          PIC X(14) VALUE SPACE.
01310     02 FILLER          PIC X(22)
01320           VALUE '***  NORMAL ENDED  ***'.
01330     02 FILLER          PIC X(96) VALUE SPACE.
01340*
01350 01  SQLERR-PRINT-REC.
01360     02 FILLER          PIC X(14) VALUE SPACE.
01370     02 FILLER          PIC X(34)
01380           VALUE '***  HiRDB SQL ERROR MESSAGE-ID = '.
01390     02 RC-MSGID        PIC X(8).
01400     02 FILLER          PIC X(14) VALUE ' SQLERRORMC ='.
01500     02 RC-SQLERRMC     PIC X(62).
01510*
01520 01  WSQLCODE           PIC -(10)9.
01530*
01540 01  WMSGID.
01550     02 FILLER          PIC X(8).
01560     02 MSGID           PIC X(3).
01570*
01580 01  ERRORMSGID.
01590     02 FILLER          PIC X(5) VALUE 'KFPA1'.
01600     02 E-MSGID         PIC X(4).
01610     02 FILLER          PIC X(2) VALUE '-E'.
01620*
01630 01  EOF                PIC X(1) VALUE '0'.
01640 01  ERR-FLG            PIC X(1) VALUE '0'.
01650*
01660*
01670 PROCEDURE DIVISION.
01680 MAIN SECTION.
01690 M-1.
01700     OPEN INPUT  INPUT-CARD-FILE
01710             OUTPUT PRINT-STOCK-FILE.
01720     READ INPUT-CARD-FILE
01730           AT END
01740             MOVE '1' TO ERR-FLG
01750             GO TO M-3
01760     END-READ.
01770     MOVE IUSERID TO XUSERID.
01780     MOVE IPSWD TO XPSWD.
01790*
01800     EXEC SQL                                           (a) 2
01810           WHENEVER SQLERROR                            (a) 2
01820              GO TO M-2                                 (a) 2
01830     END-EXEC.                                          (a) 2
01840     EXEC SQL                                           (b) 2
01850           CONNECT USER :XUSERID USING :XPSWD           (b) 2
01860     END-EXEC.                                          (b) 2
01870     PERFORM CHANGE.
01880     GO TO M-3.
01890 M-2.
01900     MOVE '2' TO ERR-FLG.
01910*
01920 M-3.
01930     EVALUATE ERR-FLG
01940       WHEN '0'
01950         PERFORM NORMAL
01960       WHEN '1'
01970         WRITE PRINT-STOCK-REC
01980           FROM I-CARD-ERROR-REC
01990           AFTER ADVANCING 2 LINES
02000       WHEN '2'
02010         MOVE SQLCODE  TO CNCT-EC
02020         WRITE PRINT-STOCK-REC
02030           FROM CONNECT-ERROR-REC
02040           AFTER ADVANCING 2 LINES
02050       WHEN '3'
02060         PERFORM ERROR
02070     END-EVALUATE.
02080 M-4.
02090     CLOSE INPUT-CARD-FILE
02100           PRINT-STOCK-FILE.
02110 M-EX.
02120     EXEC SQL
02130        WHENEVER SQLERROR   CONTINUE 
02140     END-EXEC.
02150     EXEC SQL
02160        WHENEVER NOT FOUND  CONTINUE 
02170     END-EXEC
02180     EXEC SQL
02190        WHENEVER SQLWARNING CONTINUE 
02200     END-EXEC.
02210    EXEC SQL
02220        DISCONNECT
02230     END-EXEC.
02240     GOBACK.
02250 CHANGE SECTION.
02260 H-1.
02270     READ INPUT-CARD-FILE
02280       AT END
02290         MOVE '1' TO ERR-FLG
02300     END-READ.
02310     EXEC SQL
02320          WHENEVER SQLERROR
02330            GO TO H-2
02340     END-EXEC.
02350     PERFORM UNTIL EOF = '1' OR ERR-FLG NOT = '0'
02360       EVALUATE ITYPE
02370         WHEN 'I'
02380           PERFORM ADDITION
02390         WHEN 'U'
02400           PERFORM UPDATE
02410         WHEN 'D'
02420           PERFORM DELETION
02430       END-EVALUATE
02440       READ INPUT-CARD-FILE
02450         AT END
02460           MOVE '1' TO EOF
02470       END-READ
02480     END-PERFORM.
02490     GO TO H-EX.
02500 H-2.
02510     MOVE '3' TO ERR-FLG.
02520 H-EX.
02530     EXIT.
02540*
02550 ADDITION SECTION.
02560 T-1.
02570     MOVE IPCODE  TO XPCODE.
02580     MOVE IPNAME  TO XPNAME.
02590     MOVE ICOLOR  TO XCOLOR.  
02600     MOVE IPRICE  TO XPRICE.
02610     MOVE ISTOCK  TO XSTOCK.
02620     EXEC SQL 
02610           WHENEVER SQLERROR GO TO T-2
02620     END-EXEC.
02630     EXEC SQL                                                    3
02640           INSERT INTO STOCK(PCODE, PNAME, COLOR, PRICE, SQUANTITY)   3
02650              VALUES(:XPCODE, :XPNAME, :XCOLOR, :XPRICE, :XSTOCK)   3
02660     END-EXEC.                                                   3
02670     GO TO T-EX.
02680 T-2.
02690     MOVE '3' TO ERR-FLG.
02700 T-EX.
02710     EXIT.
02720 UPDATE SECTION.
02730 K-1.
02740     MOVE IPCODE TO XPCODE.
02750     MOVE ISTOCK TO XSTOCK.
02760     EXEC SQL
02770           WHENEVER SQLERROR GO TO K-2
02780     END-EXEC.
02790     EVALUATE IFLUX
02800       WHEN '1'                                                  4
02810         EXEC SQL                                            (a) 4
02820               UPDATE STOCK SET SQUANTITY = SQUANTITY + :XSTOCK    (a) 4
02830                  WHERE PCODE=:XPCODE                        (a) 4
02840         END-EXEC                                            (a) 4
02850       WHEN '2'                                                  4
02860         EXEC SQL                                            (b) 4
02870               UPDATE STOCK SET SQUANTITY = SQUANTITY - :XSTOCK    (b) 4
02880                  WHERE PCODE=:XPCODE                        (b) 4
02890         END-EXEC                                            (b) 4
02900     END-EVALUATE.
02910     GO TO K-EX.
02920 K-2.
02930     MOVE '3' TO ERR-FLG.
02940 K-EX.
02950     EXIT.
02960*
02970 DELETION SECTION.
02980 S-1.
02990     MOVE IPCODE TO XPCODE.
03010     EXEC SQL
03020           WHENEVER SQLERROR GO TO S-2
03030     END-EXEC.
03040     EXEC SQL                                                   5
03050           DELETE FROM STOCK                                    5
03060              WHERE PCODE=:XPCODE                               5
03070     END-EXEC.                                                  5
03080     GO TO S-EX.
03090 S-2.
03100     MOVE '3' TO ERR-FLG.
03110 S-EX.
03120     EXIT.
03130*
03140 NORMAL SECTION.
03150 F-0.
03160     WRITE PRINT-STOCK-REC
03170        FROM HEADING-REC
03180        AFTER ADVANCING 4 LINES.
03190     WRITE PRINT-STOCK-REC
03200        FROM COLUMN-NAME-REC
03210        AFTER ADVANCING 2 LINES.
03220     WRITE PRINT-STOCK-REC
03230        FROM LINE-REC
03240        AFTER ADVANCING 2 LINES.
03250 F-1.
03260     EXEC SQL
03270           WHENEVER SQLERROR GO TO F-4
03280     END-EXEC.
03290     EXEC SQL                                                (a) 6
03300           DECLARE CR1 CURSOR FOR                            (a) 6
03310             SELECT PCODE,PNAME,COLOR,PRICE,SQUANTITY FROM STOCK  (a) 6
03320     END-EXEC.                                               (a) 6
03330     EXEC SQL                                                (b) 6
03340           OPEN CR1                                          (b) 6
03350     END-EXEC.                                               (b) 6
03360 F-2.
03370     EXEC SQL                                                (a) 7
03380           WHENEVER NOT FOUND                                (a) 7
03390              GO TO F-3                                      (a) 7
03400     END-EXEC.                                               (a) 7
03410     EXEC SQL                                                (b) 7
03420           FETCH CR1                                         (b) 7
03430              INTO :XPCODE:XIPCODE, :XPNAME:XIPNAME,         (b) 7
03440                :XCOLOR:XICOLOR, :XPRICE:XIPRICE, :XSTOCK:XISTOCK  (b) 7
03450     END-EXEC.                                               (b) 7
03460     EXEC SQL
03470          WHENEVER NOT FOUND  
03480             CONTINUE
03490     END-EXEC.
03500     IF XIPCODE IS >= 0 THEN
03510       MOVE XPCODE TO O-PCODE 
03520     ELSE
03530       MOVE O-PCODE-NULL TO O-PCODE
03540     END-IF.
03550     IF XIPNAME IS >= 0 THEN
03560       MOVE XPNAME TO O-PNAME
03570     ELSE 
03580       MOVE O-PNAME-NULL TO O-PNAME
03590     END-IF.
03600     IF XICOLOR IS >= 0 THEN
03610       MOVE XCOLOR TO O-COLOR
03620     ELSE 
03630       MOVE O-COLOR-NULL TO O-COLOR    
03640     END-IF.
03650     IF XIPRICE IS >= 0 THEN
03660       MOVE XPRICE TO O-PRICE
03670     ELSE 
03680       MOVE O-PRICE-NULL TO O-PRICE    
03690     END-IF.
03700     IF XISTOCK IS >= 0 THEN
03710       MOVE XSTOCK TO O-STOCK 
03720     ELSE 
03730       MOVE O-STOCK-NULL TO O-STOCK
03740     END-IF.
03750     WRITE PRINT-STOCK-REC
03760           FROM SELECT-OUT-REC
03770           AFTER ADVANCING 2 LINES.
03780     GO TO F-2.
03790 F-3.
03800     EXEC SQL
03810        WHENEVER SQLERROR   CONTINUE 
03820     END-EXEC.
03830     EXEC SQL
03840        WHENEVER NOT FOUND  CONTINUE 
03850     END-EXEC
03860     EXEC SQL
03870        WHENEVER SQLWARNING CONTINUE 
03880     END-EXEC.
03890     EXEC SQL                                              (a) 8
03900        CLOSE CR1                                          (a) 8
03910     END-EXEC.                                             (a) 8
03920*
03930     EXEC SQL                                              (b) 8
03940        COMMIT                                             (b) 8
03950     END-EXEC.                                             (b) 8
03960*
03970     WRITE PRINT-STOCK-REC
03980           FROM NORMAL-END-REC
03990           AFTER ADVANCING 2 LINES.
04000     GO TO F-EX.
04010 F-4.
04020     PERFORM ERROR.
04030 F-EX.
04040     EXIT.
04050 ERROR SECTION.
04060 I-1.
04070     MOVE SQLCODE TO WSQLCODE.
04080     MOVE WSQLCODE TO WMSGID.
04090     MOVE MSGID TO E-MSGID.
04100     MOVE ERRORMSGID TO RC-MSGID.
04110     MOVE SQLERRMC TO RC-SQLERRMC.
04120     WRITE PRINT-STOCK-REC
04130           FROM SQLERR-PRINT-REC
04140           AFTER ADVANCING 2 LINES.
04150     EXEC SQL                                            (a) 9
04160        WHENEVER SQLERROR   CONTINUE                     (a) 9
04170     END-EXEC.                                           (a) 9
04180     EXEC SQL                                            (a) 9
04190        WHENEVER NOT FOUND  CONTINUE                     (a) 9
04200     END-EXEC.                                           (a) 9
04210     EXEC SQL                                            (a) 9
04220        WHENEVER SQLWARNING CONTINUE                     (a) 9
04230     END-EXEC.                                           (a) 9
04240     EXEC SQL                                            (b) 9
04250        ROLLBACK                                         (b) 9
04260     END-EXEC.                                           (b) 9
04270 I-EX.
04280     EXIT.

1. Starting and ending the embedded SQL declaration section
   Encloses the variables to be used in the UAP between BEGIN DECLARE SECTION and END DECLARE SECTION. These variables indicate the start and end of the embedded SQL declaration section.
   
2. Connecting with HiRDB
   

   (a)Specifying the abnormal processing

   Specifies the branch destination (M-2) as the process to be executed if an error (SQLERROR) occurs after execution of the subsequent SQL statements.

   (b)Connecting to HiRDB

   Informs HiRDB of the authorization identifier (XUSERID) and the password (XPSWD) so that the UAP can use HiRDB.

3. Inserting rows into the stock table
   Inserts the values read into the embedded variables into each column of the stock table.
   
4. Updating stock table rows
   

   (a)Incoming stock

   Sets the product code that was read into embedded variable :XPCODE as the key, and retrieves the row to be updated from the stock table. Updates the row by adding the value that was read into embedded variable :XQUANTITY to the QUANTITY value of the retrieved row.

   (b)Stock

   Sets the product code that was read into embedded variable :XPCODE as the key, and retrieves the row to be updated from the stock table. Updates the row by deleting the value that was read into embedded variable :XQUANTITY from the QUANTITY value of the retrieved row.

5. Deleting stock table rows
   Sets the product code that was read into embedded variable :XPCODE as the key, and deletes the rows having a key equal to that value.
   
6. Declaring and opening the CR1 cursor
   

   (a)Declaring the CR1 cursor

   Declares the CR1 cursor for retrieving rows from the stock table (STOCK).

   (b)Opening the CR1 cursor

   Positions the cursor immediately in front of a row to be retrieved from the stock table (STOCK) so that the row can be fetched.

7. Fetching stock table rows
   

   (a)Specifying the abnormal processing

   Retrieves the row indicated by the CR1 cursor from the stock table (STOCK), and sets the row values into the embedded variables.

   (b)Executing the FETCH statement

   Fetches the row indicated by the CR1 cursor from the stock table (STOCK), and sets the data to the embedded variables.

8. Terminating the transaction
   

   (a)Closing the CR1 cursor

   Closes the CR1 cursor.

   (b)Terminating the transaction

   Terminates the current transaction normally, and validates the results of the database addition, update, and deletion operations that were executed in that transaction.

9. Rolling back the transaction
   

   Specifying the processing

   Specifies continuation to the next instruction (without special processing) if an error (SQLERROR) or warning (SQLWARNING) occurs during execution of a subsequent SQL statement.

   Invalidating the transaction

   Rolls back the current transaction to invalidate the results of the database addition, update, and deletion operations that were executed in that transaction.

(a) PAD chart

Figures 7-14 through 7-17 show the PAD chart for program example 5.

Figure 7-14 PAD chart for program example 5 (1/4)

Figure 7-15 PAD chart for program example 5 (2/4)

Figure 7-16 PAD chart for program example 5 (3/4)

Figure 7-17 PAD chart for program example 5 (4/4)

(b) Coding example

00010  **********************************************
00020  *                                            *
00030  *  EMBEDDED TYPE SQL  COBOL  UAP             *
00040  *  ROW INTERFACE SAMPLE                      *
00050  *                   1997/11/27               *
00060  **********************************************
00070   IDENTIFICATION DIVISION.
00080   PROGRAM-ID.            ROW-SAMPLE.
00090   AUTHOR.                CLIENT.
00100   DATA-WRITTEN.          1997/11/27.
00110   DATA-COMPILED.         ROW-SAMPLE.
00120   REMARKS.
00130   *
00140   ENVIRONMENT DIVISION.
00150   CONFIGURATION SECTION.
00160   SOURCE-COMPUTER. HITAC.
00170   OBJECT-COMPUTER. HITAC.
00180   INPUT-OUTPUT SECTION.
00190   FILE-CONTROL.
00200       SELECT OUTLIST ASSIGN TO LP.
00210   *
00220   DATA DIVISION.
00230   FILE SECTION.
00240   FD OUTLIST RECORDING MODE IS F
00250              LABEL RECORD IS OMITTED
00260              DATA RECORD OUTREC.
00270   01 OUTREC               PIC X(80).
00280   *
00290   WORKING STORAGE SECTION.
00300       EXEC SQL
00310         BEGIN DECLARE SECTION
00320       END-EXEC.
00330   01 IN-REC1 IS GLOBAL.
00340     02 IN-CHR1            PIC X(15)      VALUE 'EVA-00'.
00350     02 IN-INT1            PIC S9(9) COMP VALUE 255.
00360     02 IN-INT2            PIC S9(9) COMP VALUE 1.
00370   
00380   01 XSQLROW IS GLOBAL1
00390     02 ROW-CHR1    PIC X(30).                    1
00400     02 ROW-INT1    PIC S9(9) COMP.               1
00410     02 ROW-INT2    PIC S9(9) COMP.               1
00420
00430     EXEC SQL
00440       END DECLARE SECTION
00450     END-EXEC.
00460
00470   01 DISP-REC IS GLOBAL.
00480     02 DISP-CHR1   PIC X(15).
00490     02 DISP-INT1   PIC S9(9).
00500     02 DISP-INT2   PIC S9(4).
00510   01 ERRFLG  PIC S9(4) COMP IS GLOBAL.
00520
00530   01 MSG-ERR   PIC X(10) VALUE '!! ERROR'.
00540   01 MSG-CODE IS GLOBAL.
00550      02 FILLER   PIC X(15) VALUE '!! SQLCODE ='
00560      02 MSG-SQLCODE  PIC S9(9) DISPLAY.
00570   01 MSG-MC IS GLOBAL.
00580      02 FILLER   PIC X(15) VALUE '!! SQLERRMC ='
00590      02 MSG-SQLERRMC PIC X(100).
00600
00610   PROCEDURE DIVISION.
00620   **********************************************
00630   *   DISPLAY TITLE 
00640   **********************************************
00650   MAIN SECTION
00660      CALL 'DISPLAY-TITLE'.
00670      MOVE ZERO TO ERRFLG.
00680   
00690   **********************************************
00700   *   CONNECT
00710   **********************************************
00720   EXEC SQL
00730     WHENEVER SQLERROR GOTO ERR-EXIT
00740   END-EXEC
00750   
00760   DISPLAY '***** CONNECT '.
00770   EXEC SQL                                       2
00780     CONNECT                                      2
00790   END-EXEC.                                      2
00800   DISPLAY '***** CONNECT : END'.
00810  
00820   **********************************************
00830   *   INIT                 
00840   **********************************************
00850       DISPLAY '## TABLE WILL BE INITIALIZED'.
00860       CALL 'INIT-TABLE'.
00870       IF ERRFLG < ZERO
00880          GO TO ERR-EXIT
00890       END-IF
00900       DISPLAY '## IS NORMAL'.
00910  
00920   **********************************************
00930   *   INSERT
00940   **********************************************
00950       DISPLAY 'INSERT ## DATA'.
00960       CALL 'TEST-INSERT'.
00970       IF ERRFLG < ZERO
00980       GO TO ERR-EXIT
00990       END-IF
01000       DISPLAY '## IS NORMAL'.
01010   
01020   **********************************************
01030   *   ROW
01040   **********************************************
01050       DISPLAY '## ROW TYPE TEST WILL BE EXECUTED'.
01060       CALL 'TEST-ROW'.
01070       IF ERRFLG < ZERO
01080       GO TO ERR-EXIT
01090       END-IF
01100       DISPLAY '## IS NORMAL'.
01110   
01120   **********************************************
01130   *   DISCONNECT 
01140   **********************************************
01150   ERR-EXIT.
01160        IF SQLCODE < ZERO
01170          MOVE SQLCODE TO MSG-SQLCODE
01180          MOVE SQLERRMC TO MSG-SQLERRMC
01190          DISPLAY MSG-ERR
01200          DISPLAY MSG-CODE
01210          DISPLAY MSG-MC
01220          MOVE -1 TO ERRFLG
01230      END-IF
01240  
01250      EXEC SQL
01260        WHENEVER SQLERROR CONTINUE
01270      END-EXEC
01280      EXEC SQL
01290        WHENEVER NOT FOUND CONTINUE
01300      END-EXEC
01310      EXEC SQL
01320        WHENEVER SQLWARNING CONTINUE
01330      END-EXEC
01340   
01350      DISPLAY '##DISCONNECT'
01360   
01370      EXEC SQL                                    3
01380        DISCONNECT                                3
01390      END-EXEC                                    3
01400      STOP RUN.
01410 
01420   **********************************************
01430   *   INSERT STATEMENT TEST
01440   **********************************************
01450   IDENTIFICATION DIVISION.
01460   PROGRAM-ID. TEST-INSERT.
01470   DATA DIVISION.
01480   WORKING-STORAGE SECTION.
01490     01 DCNT PIC S9(9) COMP.
01500   PROCEDURE DIVISION.
01510        EXEC SQL
01520          WHENEVER SQLERROR GOTO :Exit-Test-Insert
01530        END-EXEC.
01540   **********************************************
01550   *   INSERT HOST 
01560   **********************************************
01570        DISPLAY 'INSERT start WITH ***** EMBEDDED 
             VARIABLE'
01580        MOVE ZERO TO DCNT.
01590   INSERT-LOOP.
01600        COMPUTE IN-INT1 = DCNT
01610        COMPUTE IN-INT2 = DCNT + 100
01620        COMPUTE DCNT = DCNT + 1
01630        EXEC SQL                                  4
01640          INSERT INTO TT1(CLM1,                    4
01650                          CLM2,                    4
01660                          CLM3)                    4
01670           VALUES (:IN-CHR1,                      4
01680                   :IN-INT1,                      4
01690                   :IN-INT2)                      4
01700        END-EXEC                                  4
01710        IF DCNT <20 THEN
01720          GO TO INSERT-LOOP
01730        END-IF
01740        DISPLAY '***** insert : SUCCESS'.
01750   **********************************************
01760   *
01770   **********************************************
01780   EXIT-TEST-INSERT.
01790        IF SQLCODE < ZERO
01800          MOVE SQLCODE TO MSG-SQLCODE
01810          MOVE SQLERRMC TO MSG-SQLERRMC
01820          DISPLAY MSG-CODE
01830          DISPLAY MSG-MC
01840          MOVE -1 TO ERRFLG
01850       END-IF
01860       DISPLAY '>> TEST-INSERT<<'
01870       GOBACK.
01880   **********************************************
01890   *   WARNING
01900   **********************************************
01910   INSERT-WARNING.
01920       DISPLAY 'WARNING'
01930       MOVE SQLCODE TO MSG-SQLCODE
01940       MOVE SQLERRMC TO MSG-SQLERRMC
01950       DISPLAY MSG-CODE
01960       DISPLAY MSG-MC,
01970   END PROGRAM TEST-INSERT.
01980   
01990   **********************************************
02000   *    TEST ROW
02010   **********************************************
02020   IDENTIFICATION DIVISION.
02030   PROGRAM-ID. TEST-ROW.
02040   DATA DIVISION.
02050   WORKING-STORAGE SECTION.
02060   PROCEDURE DIVISION.
02070          DISPLAY '***** ROW CURSOR OPEN'
02080          EXEC SQL                                5
02090            DECLARE CUR_ROW CURSOR FOR            5
02100               SELECT ROW FROM TT15
02110               WHERE CLM2 = 10                    5
02120               FOR UPDATE OF CLM35
02130          END-EXEC                                5
02140   **********************************************
02150   *   ROW CURSOR
02160   **********************************************
02170           DISPLAY '***** ROW CURSOR OPEN'.
02180           EXEC SQL
02190             WHENEVER SQLERROR GOTO :Exit-Test-Row
02200          END-EXEC
02210          EXEC SQL                                6
02220            OPEN CUR_ROW                          6
02230          END-EXEC                                6
02240      
02250   **********************************************
02260   *   FETCH ROW CURSOR
02270   **********************************************
02280       DISPLAY '***** ROW CURSOR FETCH'
02290       EXEC SQL
02300         WHENEVER NOT FOUND GOTO :Exit-Test-ROW
02310       END-EXEC
02320       EXEC SQL
02330         WHENEVER SQLERROR GOTO :Exit-Test-ROW
02340       END-EXEC
02350       MOVE SPACE TO XSQLROW
02360       EXEC SQL                                   7
02370         FETCH CUR_ROW INTO :XSQLROW              7
02380       END-EXEC                                   7
02390       DISPLAY '## FETCH DATA'
02400       MOVE ROW-CHR1 TO DISP-CHR1
02410       MOVE ROW-INT1 TO DISP-INT1
02420       MOVE ROW-INT2 TO DISP-INT2
02430       DISPLAY DISP-REC
02440   
02450       DISPLAY '***** ROW UPDATE'
02460       MOVE 'ANGEL' TO ROW-CHR1
02470       EXEC SQL                                   8
02480         UPDATE TT1 SET ROW = :XSQLROW            8
02490          WHERE CURRENT OF CUR_ROW                8
02500       END-EXEC                                   8
02510   
02520   **********************************************
02530   *   FETCH ROW CURSOR 
02540   **********************************************
02550       DISPLAY '***** ROW CURSOR CLOSE'
02560       EXEC SQL
02570         WHENEVER NOT FOUND CONTINUE
02580       END-EXEC
02590       EXEC SQL
02600         WHENEVER SQLERROR CONTINUE
02610       END-EXEC
02620       EXEC SQL                                   9
02630         CLOSE CUR_ROW                            9
02640       END-EXEC.                                  9
02650   **********************************************
02660   *
02670   **********************************************
02680   EXIT-TEST-ROW.
02690        IF SQLCODE < ZERO THEN
02700          MOVE SQLCODE TO MSG-SQLCODE
02710          MOVE SQLERRMC TO MSG-SQLERRMC
02720          DISPLAY MSG-CODE
02730          DISPLAY MSG-MC
02740          MOVE -1 TO ERRFLG
02750        END-IF
02760        EXEC SQL
02770          WHENEVER NOT FOUND CONTINUE
02780        END-EXEC
02790        EXEC SQL
02800          WHENEVER SQLERROR CONTINUE
02810        END-EXEC
02820        EXEC SQL
02830          COMMIT
02840        END-EXEC
02850        DISPLAY '>> TEST-ROW END <<'
02860        GOBACK.
02870   
02880   **********************************************
02890   *   WARNING
02900   **********************************************
02910   ROW-WARNING.
02920       DISPLAY 'WARNING'
02930       MOVE SQLCODE TO MSG-SQLCODE
02940       MOVE SQLERRMC TO MSG-SQLERRMC
02950       DISPLAY MSG-CODE
02960       DISPLAY MSG-MC.
02970   END PROGRAM TEST-ROW.
02980  
02990  
03000   ************************************************
03010   *   INITIALIZE TABLE
03020   ************************************************
03030   IDENTIFICATION DIVISION.
03040   PROGRAM-ID. INIT-TABLE.
03050   DATA DIVISION.
03060   WORKING-STORAGE SECTION.
03070   PROCEDURE DIVISION.
03080      EXEC SQL
03090        WHENEVER SQLERROR CONTINUE
03100      END-EXEC
03110   
03120   ************************************************
03130   *   DROP TABLE
03140   ************************************************
03150            DISPLAY '***** DROP TABLE'.
03160            EXEC SQL                              10
03170              DROP TABLE TT1                      10
03180            END-EXEC                              10
03190            DISPLAY '***** CREATE SCHEMA'.
03200            EXEC SQL                              11
03210              CREATE SCHEMA                       11
03220            END-EXEC                              11
03230  
03240   ************************************************
03250   *   COMMIT
03260   ************************************************
03270           DISPLAY '***** COMMIT START'.
03280           EXEC SQL
03290             WHENEVER SQLERROR GOTO EXIT-INIT-TABLE
03300           END-EXEC
03310           EXEC SQL
03320             COMMIT
03330           END-EXEC
03340           DISPLAY '***** COMMIT : END '.
03350   
03360   ************************************************
03370   *   CREATE TABLE
03380   ************************************************
03390           DISPLAY '***** create table'.
03400           EXEC SQL                               12
03410              CREATE FIX TABLE TT1(CLM1 CHAR(30), 12
03420                                    CLM2 INTEGER, 12
03430                                    CLM3 INTEGER) 12
03440           END-EXEC                               12
03450   
03460           DISPLAY '***** create table : SUCCESS'.
03470   
03480   ************************************************
03490   *
03500   ************************************************
03510   EXIT-INIT-TABLE.
03520     IF SQLCODE < ZERO THEN
03530       MOVE SQLCODE TO MSG-SQLCODE
03540       MOVE SQLERRMC TO MSG-SQLERRMC
03550       DISPLAY MSG-CODE
03560       DISPLAY MSG-MC
03570       MOVE -1 TO ERRFLG
03580     END-IF
03590     GOBACK.
03600   
03610   ************************************************
03620   *   WARNING
03630   ************************************************
03640   INIT-TABLE-WARNING.
03650       DISPLAY 'WARNING'
03660       MOVE SQLCODE TO MSG-SQLCODE
03670       MOVE SQLERRMC TO MSG-SQLERRMC
03680       DISPLAY MSG-CODE
03690       DISPLAY MSG-MC.
03700   END PROGRAM INIT-TABLE.
03710  
03720   ************************************************
03730   *   DISPLAY
03740   ************************************************
03750   IDENTIFICATION DIVISION.
03760   PROGRAM-ID. DISPLAY-TITLE.
03770   DATA DIVISION.
03780   WORKING-STORAGE SECTION.
03790   PROCEDURE DIVISION.
03800      DISPLAY '###################################'
03810      DISPLAY '#                                 #'
03820      DISPLAY '# THIS PROGRAM IS A SAMPLE        #'
03830      DISPLAY '# PROGRAM FOR THE ROW-TYPE        #'
03840      DISPLAY '# INTERFACE                       #'
03850      DISPLAY '###################################'
03860   END PROGRAM DISPLAY-TITLE.
03870   END PROGRAM ROW-SAMPLE.

1. Declaring a ROW-type embedded variable
   Declares the embedded variable (:XSQLROW) to be used by the row interface.
   
2. Connecting to HiRDB
   Uses the authorization identifier and password set in the PDUSER environment variable to connect to the server.
   
3. Disconnecting from HiRDB
   Disconnects the UAP from the server.
   
4. Adding rows
   Adds data to the FIX table (TT1).
   
5. Declaring the CUR_ROW cursor
   Declares the CUR_ROW cursor, because the row interface will be used to retrieve the FIX table (TT1).
   
6. Opening the CUR_ROW cursor
   Positions the cursor immediately in front of a row to be retrieved from the FIX table (TT1) so that the row can be fetched.
   
7. Fetching rows
   Fetches the row indicated by the CUR_ROW cursor from the FIX table (TT1), and sets the value to the embedded variable (:XSQLROW).
   
8. Updating rows
   Updates the FIX table (TT1) row where the CUR_ROW cursor is positioned with the embedded variable (:XSQLROW) value.
   
9. Closing the CUR_ROW cursor
   Closes the CUR_ROW cursor.
   
10. Dropping tables (TT1)
    Deletes any existing tables of the same name so that the FIX table (TT1) can be created.
    
11. Creating a schema
    Creates a schema in case there are no schemas.
    
12. Creating the FIX table (TT1)
    Creates the FIX table (TT1). The row interface can be used only for tables that have the FIX attribute.
    

A coding example that uses the TYPE, TYPEDEF, and SAME AS clauses follows:

 
000100 IDENTIFICATION  DIVISION.
000200 PROGRAM-ID.     CBL001.
000300 DATA            DIVISION.
000400 WORKING-STORAGE SECTION.
000500     EXEC SQL BEGIN DECLARE SECTION END-EXEC.
000600* -- type declaration --
000700 01  VCHR20 TYPEDEF.
000800     05  LEN  PIC S9(4) COMP.
000900     05  STR  PIC X(20).
001000
001100* -- data declaration --
001200 01  D-4C.
001300     05  XCUT     TYPE VCHR20.
001400     05  XCOLOR   PIC X(10).
001500     05  XCLARITY SAME AS XCOLOR.
001600     05  XCARAT   PIC S9(4) COMP.
001700
001800     EXEC SQL END DECLARE SECTION END-EXEC.
   :                 :
   :                 :
002000 PROCEDURE DIVISION.
002100 CB_001 SECTION.
   :                 :
   :                 :
003400 INS-1.
003500       EXEC SQL
003600        INSERT INTO A_DIM (C1, C2, C3, C4)
003700            VALUES (:XCUT, :XCOLOR, :XCLARITY, :XCARAT)
003800       END-EXEC.
   :                :
   :                :
005000 INS-EX.
005100     EXIT.
005200 END PROGRAM CBL001.