HP 3000 Manuals HP 3000 Manuals
ORDERS Database Model Program (contd.)
Closing the Database (contd.)
COBOL II
Retrieving a Data Entry Using a Record Number
This paragraph implements the GET-A-CUSTOMER-RECORD routine of the sample
program. The record number for the directed read is obtained by calling
DBGET in mode 7. The saved record number is then used as the argument
value for a call to DBGET in mode 4. Status 17 indicates two different
conditions for DBGET in modes 4 and 7, as follows:
1. For mode 7, this value means that no entry exists with the
specified search value.
2. For mode 4, this value means that the entry at the specified
record number is empty.
Note that for increased performance, the calculated access call is made
with a list parameter equal to zero.
******************************************************************
* ACCESS : Mode 1 - Shared Modify Access
*
* Called By: 30-DO-ACTION
*
* Calls : DBGET in mode 7 (calculated read)
* DBGET in mode 4 (directed read)
* 1100-GET-ERROR-AND-EXPLAIN
300-GET-A-CUSTOMER-RECORD.
SET NOT-FOUND TO TRUE
DISPLAY CLEAR SCREEN
DISPLAY "Enter the Account # For The Customer Master"
NO ADVANCING
DISPLAY "------------> " NO ADVANCING
ACCEPT KEY-ITEM-VALUE FREE
MOVE 7 TO DB-MODE
MOVE ZERO TO LIST-NO-ITEM
MOVE "@;" TO LIST
MOVE "CUSTOMER;" TO CUSTOMER-MASTER
CALL "DBGET" USING DBNAME, CUSTOMER-MASTER, DB-MODE, STATUS1,
LIST-NO-ITEM, CUSTOMER-BUFFER,
KEY-ITEM-VALUE
IF CONDITION = 0 THEN
SET FOUND TO TRUE
MOVE RECORD-NUMBER TO SAVED-RECORD-NUMBER
ELSE
IF CONDITION = NO-SUCH-ENTRY THEN
DISPLAY CLEAR SCREEN
DISPLAY "*****************************************"
DISPLAY "* No Such Entry in the Customer Data Set."
DISPLAY "* Please Try Again. "
DISPLAY "*****************************************"
DISPLAY "Press Enter to Continue ------------>"
NO ADVANCING
ACCEPT OPTION FREE
ELSE
PERFORM 1100-GET-ERROR-AND-EXPLAIN
END-IF
END-IF
IF FOUND THEN
MOVE 4 TO DB-MODE
MOVE "@;" TO LIST
MOVE "CUSTOMER;" TO CUSTOMER-MASTER
CALL "DBGET" USING DBNAME, CUSTOMER-MASTER, DB-MODE,
STATUS1, LIST, CUSTOMER-BUFFER,
SAVED-RECORD-NUMBER
IF CONDITION NOT = 0 THEN
IF CONDITION = ENTRY-HAS-NO-DATA THEN
DISPLAY CLEAR SCREEN
DISPLAY "***************************************"
DISPLAY "* Entry At The Specified Record Number "
DISPLAY "* Has Been Deleted. "
DISPLAY "***************************************"
DISPLAY "Press Enter To Continue ------------->"
NO ADVANCING
ACCEPT OPTION FREE
ELSE
PERFORM 1100-GET-ERROR-AND-EXPLAIN
END-IF
ELSE
DISPLAY SPACE
DISPLAY SPACE
DISPLAY SPACE
DISPLAY SPACE
DISPLAY SPACE
DISPLAY SPACE
MOVE KEY-ITEM-VALUE TO ACCOUNT-NUMBER-CUST-OUT
DISPLAY "Data On Account# = ",
ACCOUNT-NUMBER-CUST-OUT
DISPLAY "****************************************"
DISPLAY "* *"
MOVE ACCOUNT-NUMBER OF CUSTOMER-BUFFER TO
ACCOUNT-NUMBER-CUST-OUT
DISPLAY "* Account # = ", ACCOUNT-NUMBER-CUST-OUT
DISPLAY "* Last Name = ", LAST-NAME
OF CUSTOMER-BUFFER
DISPLAY "* First Name = ", FIRST-NAME
OF CUSTOMER-BUFFER
DISPLAY "* Initial = ", INITIAL1
OF CUSTOMER-BUFFER
DISPLAY "* Address = ", STREET-ADDRESS
OF CUSTOMER-BUFFER
DISPLAY "* City = ", CITY OF CUSTOMER-BUFFER
DISPLAY "* State = ", STATE OF CUSTOMER-BUFFER
DISPLAY "* Zip = ", ZIP OF CUSTOMER-BUFFER
DISPLAY "* *"
DISPLAY "****************************************"
DISPLAY SPACE
DISPLAY SPACE
DISPLAY "Press Enter to Continue ------------------>"
NO ADVANCING
ACCEPT OPTION FREE
END-IF
END-IF.
Retrieving Master Data Using a Key Value
This paragraph implements the GET-PRODUCT-RECORD routine of the sample
program. The calculated access is achieved by a call to DBGET in mode 7.
The exceptional condition in this routine is indicated by status 17 for
search values which do not have any corresponding entries. Error
trapping calls 1100-GET-ERROR-AND-EXPLAIN upon detection of a
non-exceptional condition.
******************************************************************
* ACCESS : Mode 1 - Shared Modify Access
*
* Called By: 30-DO-ACTION
*
* Calls : DBGET in mode 7 (calculated read)
* 1100-GET-ERROR-AND-EXPLAIN
400-GET-PRODUCT-RECORD.
SET NOT-FOUND TO TRUE
DISPLAY CLEAR SCREEN
DISPLAY "Enter the Stock # in the Product Master ----->"
NO ADVANCING
ACCEPT KEY-ITEM-VALUE-PRODUCT FREE
MOVE 7 TO DB-MODE
MOVE "@;" TO LIST
MOVE "PRODUCT;" TO PRODUCT-MASTER
CALL "DBGET" USING DBNAME, PRODUCT-MASTER, DB-MODE, STATUS1,
LIST, PRODUCT-BUFFER,
KEY-ITEM-VALUE-PRODUCT
IF CONDITION = 0 THEN
SET FOUND TO TRUE
ELSE
SET NOT-FOUND TO TRUE
IF CONDITION = NO-CHAIN-HEAD THEN
DISPLAY CLEAR SCREEN
DISPLAY "****************************************"
DISPLAY "* No Such Entry in the Product Data Set."
DISPLAY "* Please Try Again. "
DISPLAY "****************************************"
DISPLAY "Press Enter To Continue ------------->"
NO ADVANCING
ACCEPT OPTION FREE
ELSE
PERFORM 1100-GET-ERROR-AND-EXPLAIN
END-IF
END-IF
IF FOUND THEN
DISPLAY SPACE
DISPLAY "Data On Stock # = ", KEY-ITEM-VALUE-PRODUCT
DISPLAY "**********************************************"
DISPLAY "* *"
DISPLAY "* Stock # = ", STOCK-NUMBER OF PRODUCT-BUFFER
DISPLAY "* Product = ", DESCRIPTION OF PRODUCT-BUFFER
DISPLAY "* *"
DISPLAY "**********************************************"
DISPLAY SPACE
DISPLAY SPACE
DISPLAY "Press Enter To Continue ------------->"
NO ADVANCING
ACCEPT OPTION FREE
END-IF.
Retrieving Data Serially (with Set Level Locking)
This paragraph implements the LIST-ALL-CUSTOMERS routine of the sample
progam. Serial read of the Customer data set is achieved using multiple
calls to the DBGET procedure in mode 2. Using the list parameter the
routine requests only the ACCOUNT, FIRST-NAME, LAST-NAME, and INITIAL
data items.
This procedure locks the Customer data set exclusively using a call to
the DBLOCK procedure in mode 3. The subsequent DBUNLOCK releases this
lock. This is done when the exceptional condition, end of data set, is
encountered. Locking in a shared modify access environment guarantees
that no other user is modifying the data that you are reading. Error
trapping calls 1100-GET-ERROR-AND-EXPLAIN for any non-exceptional
conditon codes.
******************************************************************
* ACCESS : Mode 1 - Shared Modify Access
*
* Called By: 30-DO-ACTION
*
* Calls : DBLOCK in mode 3 (unconditional)
* DBGET in mode 2 (forward read)
* DBUNLOCK in mode 1 (unlock)
* 1100-GET-ERROR-AND-EXPLAIN
500-LIST-ALL-CUSTOMERS.
DISPLAY CLEAR SCREEN
DISPLAY SPACE
DISPLAY "Acct-Number N A M E"
DISPLAY "-------------------------------------------"
SET NOT-DONE TO TRUE
MOVE 3 TO DB-MODE
MOVE "@;" TO LIST
MOVE "CUSTOMER;" TO CUSTOMER-MASTER
CALL "DBLOCK" USING DBNAME, CUSTOMER-MASTER, DB-MODE, STATUS1
IF CONDITION NOT = 0 THEN
PERFORM 1100-GET-ERROR-AND-EXPLAIN
END-IF
MOVE 2 TO DB-MODE
MOVE "ACCOUNT,LAST-NAME,FIRST-NAME,INITIAL;" TO LIST
PERFORM WITH TEST AFTER UNTIL DONE
CALL "DBGET" USING DBNAME, CUSTOMER-MASTER, DB-MODE,
STATUS1, LIST, CUSTOMER-BUFFER,
NOT-USED-PARM-32
IF CONDITION NOT = 0 THEN
IF CONDITION = END-OF-DATA-SET THEN
SET DONE TO TRUE
DISPLAY SPACE
DISPLAY "*End of Data Set"
DISPLAY "* Press Enter to Continue ------->"
NO ADVANCING
ACCEPT OPTION FREE
ELSE
PERFORM 1100-GET-ERROR-AND-EXPLAIN
END-IF
ELSE
MOVE ACCOUNT-NUMBER OF CUSTOMER-BUFFER TO
ACCOUNT-NUMBER-CUST-OUT
MOVE FIRST-NAME OF CUSTOMER-BUFFER TO
FIRST-NAME-CUST-OUT
MOVE INITIAL1 OF CUSTOMER-BUFFER TO
INITIAL1-CUST-OUT
MOVE LAST-NAME OF CUSTOMER-BUFFER TO
LAST-NAME-CUST-OUT
DISPLAY CUSTOMER-BUFFER-OUT
END-IF
END-PERFORM
MOVE 1 TO DB-MODE
CALL "DBUNLOCK" USING DBNAME, CUSTOMER-MASTER, DB-MODE,
STATUS1
IF CONDITION NOT = 0 THEN
PERFORM 1100-GET-ERROR-AND-EXPLAIN
END-IF.
Adding an Entry
This paragraph implements the ADD-A-PRODUCT routine of the sample program
to add a data entry to the Product manual master data set. The add entry
operation is achieved using a call to DBPUT. Before this call, the
paragraph initiates a TurboIMAGE/XL transaction and locks the product
master data set. The beginning and end of the transaction are indicated
by calls to DBBEGIN and DBEND. Locking is done exclusively at the set
level. For error trapping, 1100-GET-ERROR-AND-EXPLAIN is called when any
status code is not equal to zero.
Note that the list contains an at-sign (@) which requests TurboIMAGE/XL
to return all fields of the data set in the order defined in the schema.
Other valid lists are the null list ('0;') which returns no data, and
same list ('*;') which returns the same fields listed in the previous
call.
******************************************************************
* ACCESS : Mode 1 - Shared Modify Access
*
* Called By: 30-DO-ACTION
*
* Calls : DBLOCK in mode 3 (unconditional)
* DBBEGIN in mode 1 (transaction begin)
* DBPUT in mode 1 (put)
* DBEND in mode 1 (transaction end)
* DBUNLOCK in mode 1 (unlock)
* 1100-GET-ERROR-AND-EXPLAIN
600-ADD-A-PRODUCT.
MOVE 0 TO ANSWER
PERFORM WITH TEST BEFORE UNTIL ANSWER = 1
DISPLAY CLEAR SCREEN
DISPLAY " Please Provide the Following Values "
DISPLAY "****************************************"
DISPLAY "* *"
DISPLAY "* Stock # = " NO ADVANCING
ACCEPT STOCK-NUMBER OF PRODUCT-BUFFER FREE
DISPLAY "* Product = " NO ADVANCING
ACCEPT DESCRIPTION OF PRODUCT-BUFFER FREE
DISPLAY "* *"
DISPLAY "****************************************"
DISPLAY SPACE
DISPLAY SPACE
DISPLAY "Enter, <1> to Continue, <2> to Retry >"
NO ADVANCING
ACCEPT ANSWER FREE
END-PERFORM
MOVE "PRODUCT;" TO PRODUCT-MASTER
MOVE 3 TO DB-MODE
CALL "DBLOCK" USING DBNAME, PRODUCT-MASTER, DB-MODE, STATUS1
IF CONDITION NOT = 0 THEN
PERFORM 1100-GET-ERROR-AND-EXPLAIN
END-IF
MOVE "Add Entry to Product Set Begin" TO TEXT1
MOVE 16 TO TEXTLEN
MOVE 1 TO DB-MODE
CALL "DBBEGIN" USING DBNAME, TEXT1, DB-MODE, STATUS1, TEXTLEN
IF CONDITION NOT = 0 THEN
PERFORM 1100-GET-ERROR-AND-EXPLAIN
END-IF
MOVE "@;" TO LIST
CALL "DBPUT" USING DBNAME, PRODUCT-MASTER, DB-MODE, STATUS1,
LIST, PRODUCT-BUFFER
IF CONDITION = 0 THEN
DISPLAY SPACE
DISPLAY SPACE
DISPLAY SPACE
DISPLAY "*************************************"
DISPLAY "Stock ", STOCK-NUMBER OF PRODUCT-BUFFER,
"Was Successfully Added to the Product Set"
DISPLAY "*************************************"
DISPLAY "Enter to Continue ..............>"
NO ADVANCING
ACCEPT OPTION FREE
ELSE
PERFORM 1100-GET-ERROR-AND-EXPLAIN
END-IF
MOVE "Add Entry to Product Set End" TO TEXT1
MOVE 14 TO TEXTLEN
CALL "DBEND" USING DBNAME, TEXT1, DB-MODE, STATUS1, TEXTLEN
IF CONDITION NOT = 0 THEN
PERFORM 1100-GET-ERROR-AND-EXPLAIN
END-IF
CALL "DBUNLOCK" USING DBNAME, PRODUCT-MASTER, DB-MODE, STATUS1
IF CONDITION NOT = 0 THEN
PERFORM 1100-GET-ERROR-AND-EXPLAIN
END-IF.
Updating an Entry
This paragraph implements the UPDATE-A-CUSTOMER routine of the sample
program. The update process takes place in two phases.
In the first phase, the requested entry is located and retrieved. This
is achieved by a call to DBGET in mode 7. Then, the user provides the
new values.
In the second phase, the recently modified values replace the existing
entry. This is implemented using a call to DBUPDATE. Before this call,
the paragraph starts a TurboIMAGE/XL transaction bracketed by calls for
locking the volatile item. To retrieve the entry, DBGET is called in
mode 1. This call retrieves the entry located in the previous stage.
The paragraph must confirm that values retrieved in the first stage are
still residing in the same entry. This should be done before the actual
update. If the contents of the buffers are the same, the paragraph can
continue with the operation. Otherwise, it should end the transaction
and release the locks.
The exceptional condition for this paragraph is status 17. This
indicates that the requested entry does not exist or is empty.
******************************************************************
* ACCESS : Mode 1 - Shared Modify Access
*
* Called By: 30-DO-ACTION
*
* Calls : DBGET in mode 7 (calculated)
* DBLOCK in mode 5 (unconditional)
* DBBEGIN in mode 1 (transaction begin)
* DBGET in mode 1 (re-read)
* DBUPDATE in mode 1 (update)
* DBEND in mode 1 (transaction end)
* DBUNLOCK in mode 1 (unlock)
* 1100-GET-ERROR-AND-EXPLAIN
700-UPDATE-A-CUSTOMER.
SET NOT-FOUND TO TRUE
DISPLAY CLEAR SCREEN
DISPLAY "Enter the Account # for The Customer Master"
NO ADVANCING
DISPLAY "---------> " NO ADVANCING
ACCEPT KEY-ITEM-VALUE FREE
MOVE 7 TO DB-MODE
MOVE 0 TO LIST-NO-ITEM
MOVE "@;" TO LIST
MOVE "CUSTOMER;" TO CUSTOMER-MASTER
CALL "DBGET" USING DBNAME, CUSTOMER-MASTER, DB-MODE, STATUS1,
LIST, CUSTOMER-BUFFER, KEY-ITEM-VALUE
IF CONDITION = 0 THEN
SET FOUND TO TRUE
DISPLAY SPACE
DISPLAY SPACE
DISPLAY SPACE
DISPLAY "Data On Account # = ", KEY-ITEM-VALUE
DISPLAY "****************************************"
DISPLAY "* *"
DISPLAY "* Account # = ", ACCOUNT-NUMBER
OF CUSTOMER-BUFFER
DISPLAY "* Last Name = ", LAST-NAME
OF CUSTOMER-BUFFER
DISPLAY "* First Name = ", FIRST-NAME
OF CUSTOMER-BUFFER
DISPLAY "* Initial = ", INITIAL1
OF CUSTOMER-BUFFER
DISPLAY "* Address = ", STREET-ADDRESS
OF CUSTOMER-BUFFER
DISPLAY "* City = ", CITY OF CUSTOMER-BUFFER
DISPLAY "* State = ", STATE OF CUSTOMER-BUFFER
DISPLAY "* Zip = ", ZIP OF CUSTOMER-BUFFER
DISPLAY "* *"
DISPLAY "****************************************"
DISPLAY SPACE
DISPLAY SPACE
DISPLAY "Press Enter to Continue ------------------>"
NO ADVANCING
ACCEPT OPTION FREE
ELSE
IF CONDITION = NO-SUCH-ENTRY THEN
DISPLAY CLEAR SCREEN
DISPLAY "*****************************************"
DISPLAY "* No Such Entry in the Customer Data Set."
DISPLAY "* Please Try Again. "
DISPLAY "*****************************************"
DISPLAY "Enter to Continue --------->" NO ADVANCING
ACCEPT ANSWER FREE
ELSE
PERFORM 1100-GET-ERROR-AND-EXPLAIN
END-IF
END-IF
IF FOUND THEN
MOVE CORRESPONDING CUSTOMER-BUFFER TO CUSTOMER-BUFFER-OLD
MOVE 0 TO ANSWER
PERFORM WITH TEST BEFORE UNTIL ANSWER = 1
DISPLAY SPACE
DISPLAY SPACE
DISPLAY SPACE
DISPLAY "Provide New Values For the Following"
DISPLAY "****************************************"
DISPLAY "* *"
DISPLAY "* Account # = " NO ADVANCING
ACCEPT ACCOUNT-NUMBER OF CUSTOMER-BUFFER-NEW FREE
DISPLAY "* Last Name = " NO ADVANCING
ACCEPT LAST-NAME OF CUSTOMER-BUFFER-NEW FREE
DISPLAY "* First Name = " NO ADVANCING
ACCEPT FIRST-NAME OF CUSTOMER-BUFFER-NEW FREE
DISPLAY "* Initial = " NO ADVANCING
ACCEPT INITIAL1 OF CUSTOMER-BUFFER-NEW FREE
DISPLAY "* Address = " NO ADVANCING
ACCEPT STREET-ADDRESS OF CUSTOMER-BUFFER-NEW FREE
DISPLAY "* City = " NO ADVANCING
ACCEPT CITY OF CUSTOMER-BUFFER-NEW FREE
DISPLAY "* State = " NO ADVANCING
ACCEPT STATE OF CUSTOMER-BUFFER-NEW FREE
DISPLAY "* Zip = " NO ADVANCING
ACCEPT ZIP OF CUSTOMER-BUFFER-NEW FREE
DISPLAY "* *"
DISPLAY "****************************************"
DISPLAY SPACE
DISPLAY SPACE
DISPLAY "Enter <1> to Continue, <2> to Retry >"
NO ADVANCING
ACCEPT ANSWER FREE
IF ANSWER = 2 THEN
DISPLAY CLEAR SCREEN
END-IF
END-PERFORM
MOVE 1 TO NUM-OF-ELEMENTS
MOVE 22 TO LENGTH-OF-DESCRIPTOR
MOVE "CUSTOMER;" TO DATA-SET-OF-DESCRIPTOR
MOVE "ACCOUNT;" TO DATA-ITEM-OF-DESCRIPTOR
MOVE " =" TO RELOP-FOR-DATA-ITEM
MOVE KEY-ITEM-VALUE TO NUM-VALUE-FOR-DATA-ITEM
MOVE 5 TO DB-MODE
CALL "DBLOCK" USING DBNAME, LOCK-DESCRIPTOR-ARRAY, DB-MODE,
STATUS1
IF CONDITION NOT = 0 THEN
PERFORM 1100-GET-ERROR-AND-EXPLAIN
END-IF
MOVE "Update Entry In Customer Set Begin" TO TEXT1
MOVE 17 TO TEXTLEN
MOVE 1 TO DB-MODE
CALL "DBBEGIN" USING DBNAME, TEXT1, DB-MODE, STATUS1,
TEXTLEN
IF CONDITION NOT = 0 THEN
PERFORM 1100-GET-ERROR-AND-EXPLAIN
END-IF
CALL "DBGET" USING DBNAME, CUSTOMER-MASTER, DB-MODE,
STATUS1, LIST, CUSTOMER-BUFFER,
NOT-USED-PARM-32
IF CONDITION NOT = 0 THEN
PERFORM 1100-GET-ERROR-AND-EXPLAIN
ELSE
IF CUSTOMER-BUFFER = CUSTOMER-BUFFER-OLD THEN
CALL "DBUPDATE" USING DBNAME, CUSTOMER-MASTER,
DB-MODE, STATUS1, LIST,
CUSTOMER-BUFFER-NEW
IF CONDITION NOT = 0 THEN
PERFORM 1100-GET-ERROR-AND-EXPLAIN
END-IF
ELSE
DISPLAY CLEAR SCREEN
DISPLAY SPACE
DISPLAY SPACE
DISPLAY SPACE
DISPLAY SPACE
DISPLAY "***************************************"
DISPLAY "** During Terminal Interaction *"
DISPLAY "** Data On Account Number ",
KEY-ITEM-VALUE
DISPLAY "** Has Been Modified."
DISPLAY "** *"
DISPLAY "** Please Try Again. *"
DISPLAY "Press Enter to Continue ---------->"
NO ADVANCING
ACCEPT OPTION FREE
END-IF
END-IF
MOVE "Udpate Entry On Customer Set End" TO TEXT1
MOVE 16 TO TEXTLEN
CALL "DBEND" USING DBNAME, TEXT1, DB-MODE, STATUS1, TEXTLEN
IF CONDITION NOT = 0 THEN
PERFORM 1100-GET-ERROR-AND-EXPLAIN
END-IF
CALL "DBUNLOCK" USING DBNAME, CUSTOMER-MASTER, DB-MODE,
STATUS1
IF CONDITION NOT = 0 THEN
PERFORM 1100-GET-ERROR-AND-EXPLAIN
END-IF
END-IF.
Deleting an Entry
This paragraph implements the DELETE-A-PRODUCT routine of the sample
program. The delete operation is achieved by a call to DBDELETE. This
call is preceded by a call to DBGET in mode 7, which locates the entry
for the delete operation. These calls are bracketed by calls to DBBEGIN
and DBEND, which designate the beginning and the end of a TurboIMAGE/XL
transaction.
Using calls to DBLOCK and DBUNLOCK in mode 3, the required resources are
locked before the start of the transaction and released after its end.
Exceptional condition code 17 is trapped after the DBGET call. This
indicates that the requested entry does not exist in the Product data
set.
******************************************************************
* ACCESS : Mode 1 - Shared Modify Access
*
* Called By: 30-DO-ACTION
*
* Calls : DBLOCK in mode 3 (unconditional)
* DBBEGIN in mode 1 (transaction begin)
* DBGET in mode 7 (calculated read)
* DBDELETE in mode 1 (delete)
* DBEND in mode 1 (transaction end)
* DBUNLOCK in mode 1 (unlock)
* 1100-GET-ERROR-AND-EXPLAIN
800-DELETE-A-PRODUCT.
DISPLAY CLEAR SCREEN
DISPLAY "Enter the stock # in the Product Master ----> "
NO ADVANCING
ACCEPT KEY-ITEM-VALUE-PRODUCT FREE
MOVE 3 TO DB-MODE
MOVE "@;" TO LIST
MOVE "PRODUCT;" TO PRODUCT-MASTER
CALL "DBLOCK" USING DBNAME, PRODUCT-MASTER, DB-MODE, STATUS1
IF CONDITION NOT = 0 THEN
PERFORM 1100-GET-ERROR-AND-EXPLAIN
END-IF
MOVE 1 TO DB-MODE
MOVE "Delete Entry From The Product Set Begin " TO TEXT1
MOVE 18 TO TEXTLEN
CALL "DBBEGIN" USING DBNAME, PRODUCT-MASTER, DB-MODE, STATUS1,
TEXTLEN
IF CONDITION NOT = 0 THEN
PERFORM 1100-GET-ERROR-AND-EXPLAIN
END-IF
MOVE 7 TO DB-MODE
CALL "DBGET" USING DBNAME, PRODUCT-MASTER, DB-MODE, STATUS1,
LIST, PRODUCT-BUFFER,
KEY-ITEM-VALUE-PRODUCT
IF CONDITION NOT = 0 THEN
IF CONDITION = NO-CHAIN-HEAD THEN
DISPLAY CLEAR SCREEN
DISPLAY "*****************************************"
DISPLAY "* No Such Entry in the Product Data Set. *"
DISPLAY "* Please Try Again. *"
DISPLAY "*****************************************"
ELSE
PERFORM 1100-GET-ERROR-AND-EXPLAIN
END-IF
ELSE
MOVE 1 TO DB-MODE
CALL "DBDELETE" USING DBNAME, PRODUCT-MASTER, DB-MODE,
STATUS1
IF CONDITION NOT = 0 THEN
PERFORM 1100-GET-ERROR-AND-EXPLAIN
ELSE
DISPLAY SPACE
DISPLAY SPACE
DISPLAY SPACE
DISPLAY SPACE
DISPLAY "*****************************************"
DISPLAY "Product Record ", KEY-ITEM-VALUE-PRODUCT
NO ADVANCING
DISPLAY "Was Successfully Deleted."
DISPLAY "*****************************************"
END-IF
END-IF
MOVE 1 TO DB-MODE
MOVE "Delete Entry From the Product Set End" TO TEXT1
MOVE 18 TO TEXTLEN
CALL "DBEND" USING DBNAME, PRODUCT-MASTER, DB-MODE, STATUS1,
TEXTLEN
IF CONDITION NOT = 0 THEN
PERFORM 1100-GET-ERROR-AND-EXPLAIN
END-IF
MOVE 1 TO DB-MODE
CALL "DBUNLOCK" USING DBNAME, PRODUCT-MASTER, DB-MODE, STATUS1
IF CONDITION NOT = 0 THEN
PERFORM 1100-GET-ERROR-AND-EXPLAIN
END-IF
DISPLAY "Press Enter to Continue -----------> " NO ADVANCING
ACCEPT OPTION FREE.
Rewinding a Data Set
This paragraph implements the REWIND-CUSTOMER-SET routine of the sample
program. Resetting the data set pointer is achieved by a call to DBCLOSE
in mode 2. No special condition is trapped.
******************************************************************
* ACCESS : Mode 1 - Shared Modify Access
*
* Called By: 30-DO-ACTION
*
* Calls : DBCLOSE in mode 2 (rewind)
* 1100-GET-ERROR-AND-EXPLAIN
900-REWIND-CUSTOMER-SET.
MOVE "CUSTOMER;" TO CUSTOMER-MASTER
MOVE 2 TO DB-MODE
CALL "DBCLOSE" USING DBNAME, CUSTOMER-MASTER, DB-MODE, STATUS1
IF CONDITION NOT = 0 THEN
PERFORM 1100-GET-ERROR-AND-EXPLAIN
END-IF.
Obtaining Database Information
This paragraph implements the GET-DATA-ITEM-INFO routine of the sample
program. This information is obtained using a call to DBINFO in mode
102. The data item name passed through the DBINFO buffer identifies the
data item under inquiry.
******************************************************************
* ACCESS : Mode 1 - Shared Modify Access
*
* Called By: 30-DO-ACTION
*
* Calls : DBINFO in mode 102 (item access)
* 1100-GET-ERROR-AND-EXPLAIN
1000-GET-DATA-ITEM-INFO.
DISPLAY CLEAR SCREEN
DISPLAY "Enter your data item name------> " NO ADVANCING
ACCEPT DATA-ITEM-NAME-IN FREE
MOVE 102 TO DB-MODE
CALL "DBINFO" USING DBNAME, DATA-ITEM-NAME-IN, DB-MODE, STATUS1,
M-102-BUFFER
IF CONDITION NOT = 0 THEN
PERFORM 1100-GET-ERROR-AND-EXPLAIN
END-IF
DISPLAY SPACE
DISPLAY SPACE
DISPLAY SPACE
DISPLAY DATA-ITEM-NAME-IN, " Data Item"
DISPLAY "----------------------------------------"
DISPLAY "Data Item Name = ", DATA-ITEM-NAME
DISPLAY "Data Item Type = ", DATA-ITEM-TYPE
DISPLAY "Data Item Length = ", DATA-ITEM-LENGTH
DISPLAY "Data Item Count = ", DATA-ITEM-COUNT
DISPLAY "----------------------------------------"
DISPLAY "Press Enter to Continue... " NO ADVANCING
ACCEPT OPTION FREE.
Obtaining Error Messages and Explanations
The following paragraph implements the GET-ERROR-AND-EXPLAIN routine of
the sample program. This paragraph calls DBEXPLAIN and DBERROR.
DBEXPLAIN interprets the contents of the Status parameter and prints a
message on $STDLIST. DBERROR returns a message in the ERROR-BUFFER,
explaining the condition code returned by TurboIMAGE/XL. At the end the
paragraph, users can choose to abort or continue the execution of this
program.
******************************************************************
* Access : Mode 1 - Shared Modified Access
*
* Called by: 100-OPEN-THE-DATABASE
* 200-GET-SALES-FOR-DATE
* 300-GET-A-CUSTOMER-RECORD
* 400-GET-PRODUCT-RECORD
* 500-LIST-ALL-CUSTOMERS
* 600-ADD-A-PROUDCT
* 700-UPDATE-A-CUSTOMER
* 800-DELETE-A-PRODUCT
* 900-REWIND-CUSTOMER-SET
* 1000-GET-DATA-ITEM-INFO
* 1200-CLOSE-THE-DATABASE
*
* Calls : DBERROR
* DBEXPLAIN
1100-GET-ERROR-AND-EXPLAIN.
MOVE SPACES TO ERROR-BUFFER
CALL "DBERROR" USING STATUS1, ERROR-BUFFER, ERROR-LENGTH
DISPLAY "---------------------------------------------------"
DISPLAY ERROR-BUFFER
DISPLAY "---------------------------------------------------"
DISPLAY SPACE
CALL "DBEXPLAIN" USING STATUS1
MOVE ZERO TO ANSWER
DISPLAY "---Enter, <1> to Abort..., <2> to Continue > "
NO ADVANCING
ACCEPT ANSWER FREE
IF ANSWER NOT = 1 THEN
DISPLAY "Continuing....."
ELSE
STOP RUN
END-IF.
Closing the Database
This paragraph implements the CLOSE-THE-DATABASE routine of the sample
program. Closing the database is achieved by a call to DBCLOSE in mode
1. Error handling is done by refering all non-zero returned conditions
to the 1100-GET-ERROR-AND-EXPLAIN paragraph.
******************************************************************
* ACCESS : Mode 1 - Shared Modify Access
*
* Called By: 30-DO-ACTION
*
* Calls : DBCLOSE in mode 1 (close)
* 1100-GET-ERROR-AND-EXPLAIN
1200-CLOSE-THE-DATABASE.
MOVE 1 TO DB-MODE
CALL "DBCLOSE" USING DBNAME, PASSWORD, DB-MODE, STATUS1
IF CONDITION NOT = 0 THEN
PERFORM 1100-GET-ERROR-AND-EXPLAIN
END-IF.