TurboIMAGE/XL Database Management System Reference Manual MPE/iX V6.5 (30391-90011)

Chapter 6 283
Host Language Access
COBOL II
* 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,