Program Using UPDATE WHERE CURRENT
The flow chart in Figure 8-4 summarizes the functionality of program
COBEX8. This program uses a cursor and the UPDATE WHERE CURRENT command
to update column RECEIVEDQTY in table PURCHDB.ORDERITEMS. The runtime
dialog for COBEX8 appears in Figure 8-5, and the source code in Figure
8-6.
The program first performs paragraph DECLARE-CURSOR 1 , which contains
the DECLARE CURSOR command 5 . This command is a preprocessor directive
and is not executed at run time. At run time, paragraph DECLARE-CURSOR
only displays the message Declare Cursor. The DECLARE CURSOR command
defines a cursor named ORDERREVIEW. The cursor is associated with a
SELECT command that retrieves the following columns for all rows in table
PURCHDB.ORDERITEMS having a specific order number but no null values in
column VENDPARTNUMBER:
ORDERNUMBER (defined NOT NULL)
ITEMNUMBER (defined NOT NULL)
VENDPARTNUMBER
RECEIVEDQTY
Cursor ORDERREVIEW has a FOR UPDATE clause naming column RECEIVEDQTY to
allow the user to change the value in this column.
To establish a DBE session, program COBEX8 performs paragraph
CONNECT-DBENVIRONMENT 2 . This paragraph executes the CONNECT command
24 for the sample DBEnvironment, PARTSDBE.
The program then performs paragraph FETCH-UPDATE through
FETCH-UPDATE-EXIT until the DONE flag is set 3 .
Paragraph FETCH-UPDATE prompts for an order number or a zero 6 . When
the user enters a zero 7 , the DONE flag is set and the program
terminates. When the user enters an order number, the program begins a
transaction by performing paragraph BEGIN-TRANSACTION 8 , which executes
the BEGIN WORK command 25 .
Cursor ORDERREVIEW is then opened 9 and paragraph FETCH-ROW through
FETCH-ROW-EXIT performed 10 to retrieve a row at a time from the active
set. This paragraph is performed until the DONE-FETCH flag is set; this
flag is set when:
* The FETCH command fails; this command fails when no rows qualify
for the active set, when the last row has already been fetched, or
when ALLBASE/SQL cannot execute this command for some other
reason.
* The program user wants to stop reviewing rows from the active set.
The FETCH command 12 names an indicator variable for RECEIVEDQTY, the
only column in the query result that may contain a null value. If
the FETCH command is successful, the program performs paragraph
DISPLAY-UPDATE 13 to display the current row and optionally update it.
Paragraph DISPLAY-UPDATE performs paragraph DISPLAY-ROW 16 to display
the current row 11 . If column RECEIVEDQTY in the current row contains
a null value, the message ReceivedQty is NULL is displayed.
Paragraph DISPLAY-UPDATE then asks
the user whether he wants to update the current RECEIVEDQTY value 17 .
If so, the user is prompted for a new value. The value accepted is used
in one of two UPDATE WHERE CURRENT commands, depending on whether the
user wants to assign a null value to RECEIVEDQTY 18 . If the user
entered a zero, a null value is assigned to this column.
The program then asks whether to FETCH another row 19 . If so, the
FETCH command is re-executed. If not, the program asks whether the user
wants to make permanent any updates he may have made in the active set
20 . To keep any row changes, the program performs paragraph COMMIT-WORK
22 , which executes the COMMIT WORK command 26 . To undo any row
changes, the program performs paragraph ROLLBACK-WORK 21 , which
executes the ROLLBACK WORK command 27 .
The COMMIT WORK command is also executed when ALLBASE/SQL sets SQLCODE to
100 following execution of the FETCH command 14 . SQLCODE is set to 100
when no rows qualify for the active set or when the last row has already
been fetched. If the FETCH command fails for some other reason, the
ROLLBACK WORK command is executed instead 15 .
Before any COMMIT WORK or ROLLBACK WORK command is executed, cursor
ORDERREVIEW is closed 23 . Although the cursor is automatically closed
whenever a transaction is terminated, it is good programming practice to
use the CLOSE command to close open cursors prior to terminating
transactions.
When the program user enters a zero in response to the order
number prompt 6 , the program terminates by performing paragraph
TERMINATE-PROGRAM 4 , which executes the RELEASE command.
Figure 8-4. Flow Chart of Program COBEX8
_________________________________________________________________
| |
| :RUN COBEX8P |
| Program to UPDATE OrderItems Table via a CURSOR - COBEX8 |
| |
| Event List: |
| Connect to PartsDBE |
| Prompt for Order Number |
| Begin Work |
| Open Cursor |
| FETCH a row |
| Display the retrieved row |
| Prompt for new Received Quantity |
| Update row within OrderItems Table |
| FETCH the next row, if any, with the same Order Number |
| Repeat the above five steps until there are no more rows|
| Close Cursor |
| End Transaction |
| Repeat the above eleven steps until user enters 0 |
| Release PartsDBE |
| |
| Declare Cursor |
| Connect to PartsDBE |
| |
| Enter OrderNumber or 0 to STOP > 30520 |
| Begin Work |
| Open Cursor |
| |
| OrderNumber: 30520 |
| ItemNumber: 1 |
| VendPartNumber: 9375 |
| ReceivedQty: 9 |
| |
| Do you want to change ReceivedQty (Y/N)? > N |
| |
| Do you want to see another row (Y/N)? > Y |
| |
| OrderNumber: 30520 |
| ItemNumber: 2 |
| VendPartNumber: 9105 |
| ReceivedQty is NULL |
| |
| |
| |
_________________________________________________________________
Figure 8-5. Execution of Program COBEX8
_______________________________________________________
| |
| Do you want to change ReceivedQty (Y/N)? > Y |
| |
| Enter New ReceivedQty (0 for NULL)> 15 |
| Update PurchDB.OrderItems Table |
| |
| Do you want to see another row (Y/N)? > Y |
| |
| OrderNumber: 30520 |
| ItemNumber: 3 |
| VendPartNumber: 9135 |
| ReceivedQty: 3 |
| |
| Do you want to change ReceivedQty (Y/N)? > N |
| |
| Do you want to see another row (Y/N)? > Y |
| |
| Row Not Found or no more rows |
| |
| Close Cursor |
| Do you want to save changes you made (Y/N)? > Y|
| Commit Work |
| 1 row(s) changed. |
| |
| Enter OrderNumber or 0 to STOP > 30510 |
| Begin Work |
| Open Cursor |
| |
| OrderNumber: 30510 |
| ItemNumber: 1 |
| VendPartNumber: 1001 |
| ReceivedQty: 3 |
| |
| Do you want to change ReceivedQty (Y/N)? > N |
| |
| Do you want to see another row (Y/N)? > N |
| |
| Close Cursor |
| Rollback Work |
| |
| Enter OrderNumber or 0 to STOP > 0 |
| |
| END OF PROGRAM |
| |
| |
| |
_______________________________________________________
Figure 8-5. Execution of Program COBEX8 (page 2 of 2)
____________________________________________________________________________
| |
| |
| * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *|
| * This program illustrates the use of UPDATE WHERE CURRENT *|
| * with a Cursor to update a single row at a time. *|
| * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *|
| IDENTIFICATION DIVISION. |
| PROGRAM-ID. COBEX8. |
| AUTHOR. JIM FRANCIS AND KAREN THOMAS. |
| INSTALLATION. HP. |
| DATE-WRITTEN. 13 MAY 1987. |
| DATE-COMPILED. 13 MAY 1987. |
| REMARKS. ILLUSTRATES UPDATE VIA A CURSOR. |
| ENVIRONMENT DIVISION. |
| CONFIGURATION SECTION. |
| SOURCE-COMPUTER. HP-3000. |
| OBJECT-COMPUTER. HP-3000. |
| SPECIAL-NAMES. CONSOLE IS TERMINAL-INPUT. |
| INPUT-OUTPUT SECTION. |
| FILE-CONTROL. |
| SELECT CRT ASSIGN TO "$STDLIST". |
| DATA DIVISION. |
| FILE SECTION. |
| FD CRT. |
| 01 PROMPT PIC X(34). |
| 01 PROMPT2 PIC X(44). |
| 01 PROMPT3 PIC X(38). |
| 01 PROMPT4 PIC X(41). |
| 01 PROMPT5 PIC X(51). |
| WORKING-STORAGE SECTION. |
| |
| EXEC SQL INCLUDE SQLCA END-EXEC. |
| |
| * * * * * * BEGIN HOST VARIABLE DECLARATIONS * * * * * * * |
| EXEC SQL BEGIN DECLARE SECTION END-EXEC. |
| 01 ORDERNUMBER PIC S9(9) COMP. |
| 01 ITEMNUMBER PIC S9(9) COMP. |
| 01 VENDPARTNUMBER PIC X(16). |
| 01 RECEIVEDQTY PIC S9(4) COMP. |
| 01 RECEIVEDQTYIND SQLIND. |
| 01 SQLMESSAGE PIC X(132). |
| EXEC SQL END DECLARE SECTION END-EXEC. |
| * * * * * * END OF HOST VARIABLE DECLARATIONS * * * * * * * |
| $PAGE |
| 77 DONE-FLAG PIC X VALUE SPACE. |
| 88 NOT-DONE VALUE SPACE. |
| 88 DONE VALUE 'X'. |
| |
| |
____________________________________________________________________________
Figure 8-6. Program COBEX8: Using UPDATE WHERE CURRENT
________________________________________________________________________
| |
| 77 DONE-FETCH-FLAG PIC X VALUE SPACE. |
| 88 NOT-DONE-FETCH VALUE SPACE. |
| 88 DONE-FETCH VALUE 'X'. |
| |
| 77 ABORT-FLAG PIC X VALUE SPACE. |
| 88 NOT-STOP VALUE SPACE. |
| 88 ABORT VALUE 'X'. |
| |
| 01 OK PIC S9(9) COMP VALUE 0. |
| 01 NOTFOUND PIC S9(9) COMP VALUE 100. |
| 01 DEADLOCK PIC S9(9) COMP VALUE -14024. |
| |
| 01 RESPONSE PIC S9(9) COMP VALUE 0. |
| 01 RESPONSE1 PIC X(3) VALUE SPACE. |
| 01 ROWCOUNTER PIC S9(9) COMP VALUE 0. |
| |
| 01 ORDERNUMFORMAT PIC ZZZZZ9. |
| 01 ITEMNUMFORMAT PIC ZZZZZ9. |
| 01 QTYNUMFORMAT PIC ZZZZZ9. |
| 01 ROWCOUNTFORMAT PIC ZZZ9. |
| $PAGE |
| PROCEDURE DIVISION. |
| BEGIN. |
| |
| DISPLAY "Program to UPDATE OrderItems Table via " |
| "a CURSOR - COBEX8". |
| DISPLAY " ". |
| DISPLAY "Event List:". |
| DISPLAY " Connect to PartsDBE". |
| DISPLAY " Prompt for Order Number". |
| DISPLAY " Begin Work". |
| DISPLAY " Open Cursor". |
| DISPLAY " FETCH a row". |
| DISPLAY " Display the retrieved row". |
| DISPLAY " Prompt for new Received Quantity". |
| DISPLAY " Update row within OrderItems Table". |
| DISPLAY " FETCH the next row, if any, with the same "|
| "Order Number". |
| DISPLAY " Repeat the above five steps until " |
| "there are no more rows". |
| DISPLAY " Close Cursor". |
| DISPLAY " End Transaction". |
| DISPLAY " Repeat the above eleven steps until " |
| "user enters 0". |
| DISPLAY " Release PartsDBE". |
| DISPLAY " ". |
| |
| |
________________________________________________________________________
Figure 8-6. Program COBEX8: Using UPDATE WHERE CURRENT (page 2 of 7)
_________________________________________________________________________
| |
| PERFORM DECLARE-CURSOR. 1 |
| |
| OPEN OUTPUT CRT. |
| |
| PERFORM CONNECT-DBENVIRONMENT. 2 |
| |
| PERFORM FETCH-UPDATE THRU FETCH-UPDATE-EXIT UNTIL DONE. 3 |
| |
| PERFORM TERMINATE-PROGRAM. 4 |
| |
| TERMINATE-PROGRAM. |
| |
| EXEC SQL RELEASE END-EXEC. |
| |
| STOP RUN. |
| |
| DECLARE-CURSOR. |
| |
| DISPLAY "Declare Cursor". |
| EXEC SQL DECLARE ORDERREVIEW 5 |
| CURSOR FOR |
| SELECT ORDERNUMBER, |
| ITEMNUMBER, |
| VENDPARTNUMBER, |
| RECEIVEDQTY |
| FROM PURCHDB.ORDERITEMS |
| WHERE ORDERNUMBER = :ORDERNUMBER |
| AND VENDPARTNUMBER IS NOT NULL |
| FOR UPDATE OF RECEIVEDQTY |
| END-EXEC. |
| $PAGE |
| FETCH-UPDATE. |
| MOVE SPACE TO RESPONSE1. |
| MOVE "Enter OrderNumber or 0 to STOP > 6 |
| TO PROMPT. |
| WRITE PROMPT AFTER ADVANCING 1 LINE. |
| ACCEPT RESPONSE FREE. |
| |
| IF RESPONSE IS ZERO THEN 7 |
| MOVE "X" TO DONE-FLAG |
| GO TO FETCH-UPDATE-EXIT |
| ELSE |
| MOVE RESPONSE TO ORDERNUMBER |
| MOVE 0 TO ROWCOUNTER. |
| |
| PERFORM BEGIN-TRANSACTION. 8 |
| |
| |
_________________________________________________________________________
Figure 8-6. Program COBEX8: Using UPDATE WHERE CURRENT (page 3 of 7)
_____________________________________________________________________________
| |
| DISPLAY "Open Cursor". |
| EXEC SQL OPEN ORDERREVIEW END-EXEC. 9 |
| IF SQLCODE NOT = OK THEN |
| PERFORM SQL-STATUS-CHECK |
| MOVE "X" TO DONE-FLAG |
| GO TO FETCH-UPDATE-EXIT. |
| MOVE SPACES TO DONE-FETCH-FLAG. |
| |
| PERFORM FETCH-ROW THRU FETCH-ROW-EXIT 10 |
| UNTIL DONE-FETCH. |
| |
| FETCH-UPDATE-EXIT. |
| |
| EXIT. |
| |
| DISPLAY-ROW. 11 |
| MOVE ORDERNUMBER TO ORDERNUMFORMAT. |
| MOVE ITEMNUMBER TO ITEMNUMFORMAT. |
| MOVE RECEIVEDQTY TO QTYNUMFORMAT. |
| |
| DISPLAY " ". |
| DISPLAY " OrderNumber: " ORDERNUMFORMAT. |
| DISPLAY " ItemNumber: " ITEMNUMFORMAT. |
| DISPLAY " VendPartNumber: " VENDPARTNUMBER. |
| IF RECEIVEDQTYIND < 0 THEN |
| DISPLAY " ReceivedQty is NULL" |
| ELSE |
| DISPLAY " ReceivedQty: " QTYNUMFORMAT. |
| $PAGE |
| FETCH-ROW. |
| EXEC SQL FETCH ORDERREVIEW 12 |
| INTO :ORDERNUMBER, |
| :ITEMNUMBER, |
| :VENDPARTNUMBER, |
| :RECEIVEDQTY :RECEIVEDQTYIND |
| END-EXEC. |
| |
| IF SQLCODE = OK THEN |
| PERFORM DISPLAY-UPDATE 13 |
| ELSE |
| IF SQLCODE = NOTFOUND THEN |
| MOVE "X" TO DONE-FETCH-FLAG |
| DISPLAY " " |
| DISPLAY "Row Not Found or no more rows" |
| PERFORM LAST-ROW |
| GO TO FETCH-ROW-EXIT 14 |
| |
| |
_____________________________________________________________________________
Figure 8-6. Program COBEX8: Using UPDATE WHERE CURRENT (page 4 of 7)
_____________________________________________________________________________
| |
| ELSE |
| PERFORM SQL-STATUS-CHECK |
| MOVE "X" TO DONE-FETCH-FLAG |
| PERFORM CLOSE-CURSOR |
| PERFORM ROLLBACK-WORK. |
| |
| FETCH-ROW-EXIT. |
| |
| EXIT. |
| |
| $PAGE |
| LAST-ROW. |
| MOVE "X" TO DONE-FETCH-FLAG. |
| PERFORM CLOSE-CURSOR. |
| IF ROWCOUNTER > 0 THEN |
| MOVE "Do you want to save changes you made (Y/N)? > " |
| TO PROMPT5. |
| MOVE SPACE TO RESPONSE1. |
| WRITE PROMPT5 AFTER ADVANCING 1 LINE. |
| ACCEPT RESPONSE1. |
| |
| IF RESPONSE1 = "N" OR RESPONSE1 = "n" THEN |
| PERFORM ROLLBACK-WORK |
| ELSE |
| PERFORM COMMIT-WORK |
| MOVE ROWCOUNTER TO ROWCOUNTFORMAT |
| DISPLAY ROWCOUNTFORMAT, " row(s) changed." |
| ELSE IF ROWCOUNTER = 0 THEN |
| PERFORM COMMIT-WORK. |
| |
| DISPLAY-UPDATE. |
| |
| PERFORM DISPLAY-ROW. 16 |
| |
| MOVE "Do you want to change ReceivedQty (Y/N)? > " 17 |
| TO PROMPT2. |
| MOVE SPACE TO RESPONSE1. |
| WRITE PROMPT2 AFTER ADVANCING 1 LINE. |
| ACCEPT RESPONSE1. |
| |
| IF RESPONSE1 = "Y" OR RESPONSE1 = "y" THEN |
| |
| MOVE "Enter New ReceivedQty (0 for NULL)>" TO PROMPT3 |
| WRITE PROMPT3 AFTER ADVANCING 1 LINE |
| ACCEPT RECEIVEDQTY FREE |
| |
| DISPLAY "Update PurchDB.OrderItems Table" |
_____________________________________________________________________________
Figure 8-6. Program COBEX8: Using UPDATE WHERE CURRENT (page 5 of 7)
______________________________________________________________________________
| |
| IF RECEIVEDQTY = 0 THEN 18 |
| MOVE -1 TO RECEIVEDQTYIND |
| ELSE |
| MOVE 0 TO RECEIVEDQTYIND |
| EXEC SQL UPDATE PURCHDB.ORDERITEMS |
| SET RECEIVEDQTY = :RECEIVEDQTY :RECEIVEDQTYIND|
| WHERE CURRENT OF ORDERREVIEW |
| END-EXEC |
| |
| IF SQLCODE NOT = OK THEN PERFORM SQL-STATUS-CHECK |
| ELSE ADD 1 TO ROWCOUNTER. |
| |
| MOVE "Do you want to see another row (Y/N)? > " 19 |
| TO PROMPT4. |
| MOVE SPACE TO RESPONSE1. |
| WRITE PROMPT4 AFTER ADVANCING 1 LINE. |
| ACCEPT RESPONSE1. |
| |
| IF RESPONSE1 = "N" OR RESPONSE1 = "n" THEN 20 |
| PERFORM LAST-ROW. |
| $PAGE |
| CLOSE-CURSOR. |
| |
| DISPLAY "Close Cursor". |
| EXEC SQL CLOSE ORDERREVIEW END-EXEC. 23 |
| IF SQLCODE NOT = OK THEN |
| PERFORM SQL-STATUS-CHECK |
| PERFORM TERMINATE-PROGRAM. |
| |
| SQL-STATUS-CHECK. |
| |
| IF SQLCODE < DEADLOCK THEN |
| MOVE 'X' TO ABORT-FLAG. |
| |
| PERFORM SQLEXPLAIN UNTIL SQLCODE = 0. |
| |
| IF ABORT THEN PERFORM TERMINATE-PROGRAM. |
| |
| SQL-STATUS-CHECK-EXIT. |
| |
| EXIT. |
| |
| SQLEXPLAIN. |
| |
| EXEC SQL SQLEXPLAIN :SQLMESSAGE END-EXEC. |
| DISPLAY SQLMESSAGE. |
| |
| |
______________________________________________________________________________
Figure 8-6. Program COBEX8: Using UPDATE WHERE CURRENT (page 6 of 7)
_____________________________________________________________________________
| |
| CONNECT-DBENVIRONMENT. |
| |
| DISPLAY "Connect to PartsDBE". |
| EXEC SQL CONNECT TO 'PartsDBE' END-EXEC. 24 |
| |
| IF SQLCODE NOT = OK THEN |
| PERFORM SQL-STATUS-CHECK |
| PERFORM TERMINATE-PROGRAM. |
| |
| |
| BEGIN-TRANSACTION. |
| |
| DISPLAY "Begin Work". |
| EXEC SQL BEGIN WORK END-EXEC. 25 |
| IF SQLCODE NOT = OK THEN |
| PERFORM SQL-STATUS-CHECK |
| PERFORM TERMINATE-PROGRAM. |
| |
| COMMIT-WORK. |
| |
| DISPLAY "Commit Work". |
| EXEC SQL COMMIT WORK END-EXEC. 26 |
| IF SQLCODE NOT = OK THEN |
| PERFORM SQL-STATUS-CHECK |
| PERFORM TERMINATE-PROGRAM. |
| |
| ROLLBACK-WORK. |
| |
| DISPLAY "Rollback Work". |
| EXEC SQL ROLLBACK WORK END-EXEC. 27 |
| IF SQLCODE NOT = OK THEN |
| PERFORM SQL-STATUS-CHECK |
| PERFORM TERMINATE-PROGRAM. |
| |
| |
| |
| |
| |
| |
| |
| |
| |
| |
| |
| |
_____________________________________________________________________________
Figure 8-6. Program COBEX8: Using UPDATE WHERE CURRENT (page 7 of 7)