TurboIMAGE/XL Database Management System Reference Manual (30391-90012)

280 Chapter6
Host Language Access
COBOL II
('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 ..............<>"