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.
Program COBEX8 performs paragraph
A200-CONNECT-DBENVIRONMENT 1 to establish a DBE session.
This paragraph executes the
CONNECT command 5 for the sample DBEnvironment, PartsDBE.
The program performs paragraph A550-DECLARE-CURSOR 2 , which
contains the DECLARE CURSOR command 9 . This
command is a preprocessor directive and is not executed at run time.
At run time, paragraph A550-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.
The program then performs paragraph B100-GET-DATA through
B100-EXIT until the DONE flag
is set 3 .
Paragraph B100-GET-DATA prompts for an order number or a
zero 10 . When the user enters a zero 11 , the DONE flag is
set and the program terminates. When the user enters
an order number, the program begins a transaction by performing
paragraph A300-BEGIN-TRANSACTION 12 , which executes the
BEGIN WORK command 6 .
Cursor ORDERREVIEW is then opened 13 and paragraph
B200-FETCH-ROW through B200-EXIT performed 14 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 20 , when the last row has already been
fetched 21 , or when ALLBASE/SQL cannot execute this command for some
other reason 22 .
The program user wants to stop reviewing rows from the active
set 30 .
Note that in three of the above cases,
20 , 21 , 30 ,
the flag is set when B600-LAST-ROW is performed 31 .
The FETCH command 15 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
sets the FIRST-TIME flag to indicate that a row has been found 16 .
B300-DISPLAY-ROW 17 is performed to display the
current row, and B400-DISPLAY-UPDATE 18 is performed
to offer the option of updating the current row 26 .
In paragraph B300-DISPLAY-ROW 24 , if column RECEIVEDQTY in
the current row contains a null value, the message
ReceivedQty is NULL is displayed 25 .
Paragraph B400-DISPLAY-UPDATE prompts the user to indicate
whether the current RECEIVEDQTY value is to be updated 26 .
If so, and if the user enters a 0, a null value is assigned to
RECEIVEDQTY 27 . If a value other than 0 is entered,
that value is assigned to RECEIVEDQTY 28 .
Paragraph B500-MORE-ROWS is performed 19 , prompting the user
to indicate if another row is to be fetched 29 . If so, the
FETCH command is re-executed. If not, paragraph B600-LAST-ROW 30
asks whether the user wants to make permanent any updates he
may have made in the active set 32 . To keep any row
changes, the program performs paragraph A400-COMMIT-WORK 34 ,
which executes the COMMIT WORK command 7 . To undo any row
changes, the program performs paragraph A450-ROLLBACK-WORK 33 ,
which executes the ROLLBACK WORK command 8 .
The COMMIT WORK command is also executed when ALLBASE/SQL sets SQLCODE to
100 following execution of the FETCH command 20 21 .
SQLCODE is set to 100 when
no rows qualify for the active set.
If the FETCH command fails for some other
reason, the ROLLBACK WORK command is executed instead 23 .
Before any COMMIT WORK or ROLLBACK WORK command is executed,
cursor ORDERREVIEW is closed 35 .
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 10 , the program
terminates by performing paragraph A500-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 Runtime Dialog of Program COBEX8
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
No more rows to display!
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, KAREN THOMAS, JOANN GRAY.
INSTALLATION. HP.
DATE-WRITTEN. 17 OCT 1987.
DATE-COMPILED. 17 OCT 1987.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. HP-9000.
OBJECT-COMPUTER. HP-9000.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT TERM ASSIGN TO ":CO:".
DATA DIVISION.
FILE SECTION.
FD TERM.
01 PROMPT-USER 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 * * * * * * *
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 NOFILE PIC S9(9) COMP VALUE -3071.
01 NOMEMORY PIC S9(9) COMP VALUE -4008.
01 DEADLOCK PIC S9(9) COMP VALUE -14024.
01 FIRST-TIME PIC X(01) VALUE 'Y'.
01 RESPONSE PIC S9(9) COMP VALUE 0.
01 RESPONSE1 PIC X(1) 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.
PROCEDURE DIVISION.
A100-MAIN.
ACCEPT RESPONSE.
DISPLAY "Program to UPDATE OrderItems Table via a CURSOR - C"
"OBEX8".
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 N"
"umber".
DISPLAY " Repeat the above five steps until there are no mo"
"re rows".
DISPLAY " Close Cursor".
DISPLAY " End Transaction".
DISPLAY " Repeat the above eleven steps until user enters 0"
"."
DISPLAY " Release PartsDBE".
DISPLAY " ".
OPEN OUTPUT TERM.
PERFORM A200-CONNECT-DBENVIRONMENT THRU A200-EXIT. 1
PERFORM A550-DECLARE-CURSOR THRU A550-EXIT. 2
PERFORM B100-GET-DATA THRU B100-EXIT 3
UNTIL DONE.
PERFORM A500-TERMINATE-PROGRAM THRU A500-EXIT. 4
A100-EXIT.
EXIT.
A200-CONNECT-DBENVIRONMENT.
DISPLAY "Connect to ../sampledb/PartsDBE".
EXEC SQL
CONNECT TO 'sampledb/PartsDBE' 5
END-EXEC.
PERFORM S100-SQL-STATUS-CHECK THRU S100-EXIT.
A200-EXIT.
EXIT.
A300-BEGIN-TRANSACTION.
DISPLAY "Begin Work".
EXEC SQL 6
BEGIN WORK
END-EXEC.
PERFORM S100-SQL-STATUS-CHECK THRU S100-EXIT.
A300-EXIT.
EXIT.
A400-COMMIT-WORK.
DISPLAY "Commit Work".
EXEC SQL 7
COMMIT WORK
END-EXEC.
PERFORM S100-SQL-STATUS-CHECK THRU S100-EXIT.
A400-EXIT.
EXIT.
A450-ROLLBACK-WORK.
DISPLAY "Rollback Work".
EXEC SQL 8
ROLLBACK WORK
END-EXEC.
PERFORM S100-SQL-STATUS-CHECK THRU S100-EXIT.
A450-EXIT.
EXIT.
A500-TERMINATE-PROGRAM.
EXEC SQL
RELEASE
END-EXEC.
IF SQLCODE NOT = OK
OR SQLWARN0 NOT = " "
PERFORM S200-SQL-EXPLAIN THRU S200-EXIT
UNTIL SQLCODE = 0.
STOP RUN.
A500-EXIT.
EXIT.
***********************************************************
* DECLARE CURSOR and OPEN CURSOR must physically appear *
* in the program before the FETCH, regardless of the *
* sequence in which the paragraphs will be performed. *
***********************************************************
A550-DECLARE-CURSOR.
DISPLAY "Declare Cursor".
EXEC SQL 9
DECLARE ORDERREVIEW
CURSOR FOR
SELECT ORDERNUMBER,
ITEMNUMBER,
VENDPARTNUMBER,
RECEIVEDQTY
FROM PURCHDB.ORDERITEMS
WHERE ORDERNUMBER = :ORDERNUMBER
AND VENDPARTNUMBER IS NOT NULL
FOR UPDATE OF RECEIVEDQTY
END-EXEC.
******************************************************************
* DECLARE CURSOR is a preprocessor directive, not executed at *
* run time. Thus no completion code status check is necessary. *
******************************************************************
A550-EXIT.
EXIT.
B100-GET-DATA.
MOVE SPACE TO RESPONSE1.
MOVE "Enter OrderNumber or 0 to STOP > " 10
TO PROMPT-USER.
DISPLAY " ".
WRITE PROMPT-USER.
ACCEPT RESPONSE.
IF RESPONSE IS ZERO 11
MOVE "X" TO DONE-FLAG
GO TO B100-EXIT
ELSE
MOVE RESPONSE TO ORDERNUMBER
MOVE 0 TO ROWCOUNTER.
PERFORM A300-BEGIN-TRANSACTION THRU A300-EXIT. 12
DISPLAY "Open Cursor".
EXEC SQL 13
OPEN ORDERREVIEW
END-EXEC.
IF SQLCODE NOT = OK
MOVE "X" TO DONE-FLAG
PERFORM S100-SQL-STATUS-CHECK THRU S100-EXIT
GO TO B100-EXIT.
************************************************************
* In this case, if a warning has occurred, the transaction *
* continues. *
************************************************************
MOVE SPACES TO DONE-FETCH-FLAG.
MOVE "Y" TO FIRST-TIME.
PERFORM B200-FETCH-ROW THRU B200-EXIT 14
UNTIL DONE-FETCH.
B100-EXIT.
EXIT.
B200-FETCH-ROW.
EXEC SQL 15
FETCH ORDERREVIEW
INTO :ORDERNUMBER,
:ITEMNUMBER,
:VENDPARTNUMBER,
:RECEIVEDQTY :RECEIVEDQTYIND
END-EXEC.
IF SQLCODE = OK
AND SQLWARN0 = " "
MOVE "N" TO FIRST-TIME 16
PERFORM B300-DISPLAY-ROW THRU B300-EXIT 17
PERFORM B400-DISPLAY-UPDATE THRU B400-EXIT 18
PERFORM B500-MORE-ROWS THRU B500-EXIT 19
ELSE
IF SQLCODE = NOTFOUND
IF FIRST-TIME = "Y"
DISPLAY " " 20
DISPLAY "Row not found!"
PERFORM B600-LAST-ROW THRU B600-EXIT
GO TO B200-EXIT
ELSE
DISPLAY " "
DISPLAY "No more rows to display!" 21
PERFORM B600-LAST-ROW THRU B600-EXIT
GO TO B200-EXIT
ELSE
PERFORM S100-SQL-STATUS-CHECK THRU S100-EXIT 22
MOVE "X" TO DONE-FETCH-FLAG
PERFORM C400-CLOSE-CURSOR THRU C400-EXIT
PERFORM A450-ROLLBACK-WORK THRU A450-EXIT. 23
B200-EXIT.
EXIT.
B300-DISPLAY-ROW. 24
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
DISPLAY " ReceivedQty is NULL" 25
ELSE
DISPLAY " ReceivedQty: " QTYNUMFORMAT.
B300-EXIT.
EXIT.
B400-DISPLAY-UPDATE.
MOVE "Do you want to change ReceivedQty (Y/N)? > " 26
TO PROMPT-USER.
MOVE SPACE TO RESPONSE1.
DISPLAY " ".
WRITE PROMPT-USER.
ACCEPT RESPONSE1.
IF RESPONSE1 NOT = "Y" AND RESPONSE1 NOT = "y"
GO TO B400-EXIT.
MOVE "Enter New ReceivedQty (0 for NULL)>" TO PROMPT-USER
DISPLAY " "
WRITE PROMPT-USER
ACCEPT QTYNUMFORMAT
MOVE QTYNUMFORMAT TO RECEIVEDQTY
DISPLAY "Update PurchDB.OrderItems Table".
IF RECEIVEDQTY = 0 27
MOVE -1 TO RECEIVEDQTYIND
ELSE
MOVE 0 TO RECEIVEDQTYIND. 28
EXEC SQL
UPDATE PURCHDB.ORDERITEMS
SET RECEIVEDQTY = :RECEIVEDQTY :RECEIVEDQTYIND
WHERE CURRENT OF ORDERREVIEW
END-EXEC.
IF SQLCODE NOT = OK
OR SQLWARN0 NOT = " "
PERFORM S100-SQL-STATUS-CHECK THRU S100-EXIT
ELSE
ADD 1 TO ROWCOUNTER.
B400-EXIT.
EXIT.
B500-MORE-ROWS.
MOVE "Do you want to see another row (Y/N)? > " 29
TO PROMPT-USER
MOVE SPACE TO RESPONSE1
DISPLAY " "
WRITE PROMPT-USER
ACCEPT RESPONSE1
IF RESPONSE1 = "N" OR RESPONSE1 = "n" 30
PERFORM B600-LAST-ROW THRU B600-EXIT.
B500-EXIT.
EXIT.
B600-LAST-ROW.
MOVE "X" TO DONE-FETCH-FLAG. 31
PERFORM C400-CLOSE-CURSOR THRU C400-EXIT.
IF ROWCOUNTER > 0
MOVE "Do you want to save changes you made (Y/N)? > " 32
TO PROMPT-USER
MOVE SPACE TO RESPONSE1
DISPLAY " "
WRITE PROMPT-USER
ACCEPT RESPONSE1
IF RESPONSE1 = "N" OR RESPONSE1 = "n"
PERFORM A450-ROLLBACK-WORK THRU A450-EXIT 33
ELSE
PERFORM A400-COMMIT-WORK THRU A400-EXIT 34
MOVE ROWCOUNTER TO ROWCOUNTFORMAT
DISPLAY ROWCOUNTFORMAT, " row(s) changed."
ELSE
PERFORM A450-ROLLBACK-WORK THRU A450-EXIT.
B600-EXIT.
EXIT.
C400-CLOSE-CURSOR. 35
DISPLAY "Close Cursor".
EXEC SQL
CLOSE ORDERREVIEW
END-EXEC.
PERFORM S100-SQL-STATUS-CHECK THRU S100-EXIT.
C400-EXIT.
EXIT.
S100-SQL-STATUS-CHECK.
**************************************************************
* This paragraph is an 'all-purpose' error handling routine. *
* It is intended to indicate areas where you may want to *
* insert specific processing for certain error conditions. *
* *
* Depending on the SQL command being used, you may want to *
* move some error handling up to the performing paragraph. *
**************************************************************
IF SQLCODE = DEADLOCK
OR SQLCODE = NOMEMORY
DISPLAY "Issue your command again later.".
IF SQLCODE < DEADLOCK
MOVE "X" TO ABORT-FLAG.
**************************************************************
* The above conditions cause SQL to roll back the current *
* transaction. If the transaction is rolled back, the *
* CURSOR will be closed automatically. *
**************************************************************
IF SQLCODE NOT = OK
OR SQLWARN0 NOT = " "
PERFORM S200-SQL-EXPLAIN
UNTIL SQLCODE = 0.
IF ABORT PERFORM A500-TERMINATE-PROGRAM THRU A500-EXIT.
S100-EXIT.
EXIT.
S200-SQL-EXPLAIN.
EXEC SQL
SQLEXPLAIN :SQLMESSAGE
END-EXEC.
DISPLAY SQLMESSAGE.
S200-EXIT.
EXIT.
|
