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
![[Flow Chart of Program COBEX8]](img/x0601.gif)
Figure 8-5 Execution 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
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-6 Program COBEX8: Using UPDATE WHERE CURRENT
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
* 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'.
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 " ".
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
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
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"
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.
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.
|
