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

272 Chapter6
Host Language Access
COBOL II
******************************************************************
* ACCESS : Mode 1 - Shared Modify Access
*
* Called By: 30-DO-ACTION
*
* Calls : DBLOCK in mode 5 (unconditional item level locking)
* DBFIND in mode 1 (chained access)
* DBGET in mode 5 (forward chained read)
* DBUNLOCK in mode 1 (unlock)
* 1100-GET-ERROR-AND-EXPLAIN
200-GET-SALES-FOR-DATE.
MOVE 1 TO NUM-OF-ELEMENTS
MOVE 21 TO LENGTH-OF-DESCRIPTOR
MOVE "SALES;" TO DATA-SET-OF-DESCRIPTOR
MOVE "PURCH-DATE;" TO DATA-ITEM-OF-DESCRIPTOR
MOVE " =" TO RELOP-FOR-DATA-ITEM
DISPLAY CLEAR SCREEN
DISPLAY " Enter The Date of Purchase as (YYMMDD) >>> "
NO ADVANCING
ACCEPT SEARCH-ITEM-VALUE FREE
MOVE 5 TO DB-MODE
MOVE SEARCH-ITEM-VALUE TO VALUE-FOR-DATA-ITEM
CALL "DBLOCK" USING DBNAME, LOCK-DESCRIPTOR-ARRAY, DB-MODE,
STATUS1
IF CONDITION NOT = 0 THEN
PERFORM 1100-GET-ERROR-AND-EXPLAIN
END-IF
MOVE "SALES;" TO SALES-DETAIL
MOVE 1 TO DB-MODE
MOVE "PURCH-DATE;" TO SEARCH-ITEM-NAME
CALL "DBFIND" USING DBNAME, SALES-DETAIL, DB-MODE, STATUS1,
SEARCH-ITEM-NAME, SEARCH-ITEM-VALUE
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 Sales 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 CLEAR SCREEN
DISPLAY SALES-BUFFER-HEADER
DISPLAY LINE-HEADER
PERFORM WITH TEST BEFORE UNTIL CONDITION = END-OF-CHAIN
MOVE 5 TO DB-MODE
MOVE " @ ;" TO LIST
CALL "DBGET" USING DBNAME, SALES-DETAIL, DB-MODE,
STATUS1, LIST, SALES-BUFFER,