HP 3000 Manuals HP 3000 Manuals
ORDERS Database Model Program (Cont.)
C (Cont.)
Opening the Database.
This paragraph implements the OPEN-THE-DATABASE routine of the sample
program in C. All required values, such as the password, are defined in
the "static char" section of the program. Note that the password DO-ALL
establishes user class number 18. The password DO-ALL is followed by a
semicolon because it is less than eight characters long; a blank can be
substituted for the semicolon. OPEN-THE-DATABASE uses open mode 1, which
is the shared modify access mode. Error trapping is done by referring
all non-zero conditions to the GET-ERROR-AND-EXPLAIN procedure.
Open_The_Database()
{
/*
ACCESS : Mode 1 - Shared Modify Access (SMA) with locking required
Called By: Main Line
Calls : DBOPEN in mode 1 (SMA)
Get_Error_And_Explain
*/
Mode =1;
DBOPEN(DBname,Password,&Mode,&Status);
if (Status.Condition != 0)
Get_Error_And_Explain();
}
Retrieving All the Records on a Chain (with Item Level Locking).
This paragraph implements the GET-SALES-FOR-DATE routine of the sample
program. Chain access is achieved using a call to DBFIND to determine
the location of the first and last entries in the chain. The search item
used for this call is PURCH-DATE. An item level lock is obtained on the
value of the search item before the DBFIND call. After that, individual
chain items are retrieved, until the end of the chain is encountered.
This is done using multiple calls to the DBGET procedure.
The routine traps two exceptional conditions:
1. Status condition 17 from the DBFIND call, indicating that the
chain head cannot be located.
2. Status 15 from the DBGET call, indicating the end of the chain.
The status interpretation routine permits you to either abort or continue
with the execution after viewing all error messages.
Get_Sales_For_Date()
/*
ACCESS : Mode 1 - Shared Modify Access
The Orders database was opened in mode 1
Called By: Main Line
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)
Get_Error_And_Explain
*/
{
struct Lock_Descriptor_Type Lock_Descriptor;
struct Sales_Data_Set_Type Sales_Buffer;
short Search_Item_Value[3];
short Search_Item_Name[8];
short List[40];
short Dummy;
size_t srch_len = 6;
/* Prepare the lock descriptor buffer for obtaining item
level locks on the Sales data set.
*/
Lock_Descriptor.Num_Of_Elements = 1;
Lock_Descriptor.Length_Of_Descriptor = 21;
strcpy(Lock_Descriptor.Data_Set_Of_Descriptor,(char *)Sales_D_Set);
strcpy(Lock_Descriptor.Data_Item_Of_Descriptor,(char *)Purch_Date);
Lock_Descriptor.Relop_For_Data_Item[0] = Equal_Op[0];
Lock_Descriptor.Relop_For_Data_Item[1] = Equal_Op[1];
printf("Enter The Date of Purchase as (YYMMDD) >>> \n");
scanf("%6c", (char *)Search_Item_Value);
/* Request item level locks (mode 5) */
Mode = 5;
/* Append the user's input to the lock descriptor buffer */
strncpy(Lock_Descriptor.Value_For_Data_Item,
(char *)Search_Item_Value,srch_len);
/* Place item level locks on all entries identified by
the value in the Search_Item_Value
*/
DBLOCK(DBname,&Lock_Descriptor,&Mode,&Status);
if (Status.Condition != 0)
Get_Error_And_Explain();
Mode = 1;
strcpy((char *)Search_Item_Name, Purch_Date);
/* Locate the chain identified by the value in the
Search_Item_Value
*/
DBFIND(DBname,Sales_D_Set,&Mode,&Status,
Search_Item_Name, Search_Item_Value);
if (Status.Condition != 0)
{
if (Status.Condition == No_Chain_Head)
{
printf("***************************************\n");
printf("* No Such Entry in the Sales Dataset *\n");
printf("* Please Try Again. *\n");
printf("***************************************\n");
}
else
Get_Error_And_Explain();
}
else
{
/* Start retrieving all records in the current chain */
printf("\n");
printf("Acct-Number Stock_Number Price Tax Total Purch-Date \n");
printf("---------------------------------------------------------\n");
Mode = 5;
strcpy((char *)List,Item_List);
while (Status.Condition != End_Of_Chain)
{
DBGET(DBname,Sales_D_Set,&Mode,&Status,List,&Sales_Buffer,
&Dummy);
if (Status.Condition == 0)
{
printf("\n");
printf("%11d",Sales_Buffer.Account_Number);
printf("%13.8s",Sales_Buffer.Stock_Number);
printf("%8d",Sales_Buffer.Price);
printf("%6d",Sales_Buffer.Tax);
printf("%7d",Sales_Buffer.Total);
printf("%12.6s",Sales_Buffer.Purch_Date);
}
else
{
if (Status.Condition == End_Of_Chain)
{
printf("\n\n\n");
printf ("----> End Of Chain.\n");
}
else
Get_Error_And_Explain();
}
} /* while */
} /* else */
/* Release all locks acquired at the beginning of the process */
Mode = 1; = 1;
DBUNLOCK (DBname,Sales_D_Set,&Mode,&Status);
if (Status.Condition != 0)
Get_Error_And_Explain();
}
COBOL II
The model program presented at the beginning of this chapter is now shown
here in COBOL II. The program performs specific tasks to illustrate the
use of TurboIMAGE/XL intrinsics. Note that the code, although broken out
by task, can be combined to make up a complete, executable program.
Data items are defined at the beginning of the sample program. The
parameters for the TurboIMAGE/XL intrinsics are defined in the data
division, and their values are defined when the procedure is called or,
in some cases, after it is executed.
The database identifier is described as follows:
01 DBNAME.
05 BASEID PIC X(02).
05 BASENAME PIC X(06).
05 TERMINATOR PIC X(02).
To access a database catalogued in a group other than the user's log-on
group, the database name must be followed by a period and the group name,
for example, ORDERS.GROUPX. If the database is in an account other than
the user's account, the group name must be followed by a period and the
account name, for example, ORDERS.GROUPX.ACCOUNT1.
Once the database has been opened and the database identifier has been
moved to the first halfword of the element (as shown in "Opening the
Database"), it remains the same for all subsequent calls illustrated.
The status record is defined in the same way for all tasks but its
content varies depending upon which procedure is called and the results
of that procedure. The status record is defined as follows:
01 STATUS1.
05 CONDITION PIC S9(4) COMP.
05 LENGTH1 PIC S9(4) COMP.
05 RECORD-NUMBER PIC S9(9) COMP.
05 CHAIN-COUNT PIC S9(9) COMP.
05 BACK-POINTER PIC S9(9) COMP.
05 FORWARD-POINTER PIC S9(9) COMP.
NOT-USED-PARM appears as a reminder when a parameter is not used by a
procedure performing the task being illustrated. NOT-USED-PARM is
defined in this program as follows:
01 NOT-USED-PARM-16 PIC S9(4) COMP.
01 NOT-USED-PARM-32 PIC S9(9) COMP.
NOTE Because the Schema Processor, DBSCHEMA, upshifts alphabetic
characters, programs must specify data set and data item names in
all uppercase characters. Take note of this because COBOL II does
not require that you use uppercase characters.
For information on TurboIMAGE/XL data item lengths and type designators,
refer to chapter 3. Tables 3-2 and 3-3 show the TurboIMAGE/XL type
designators, sub-item lengths, and data types typically used to process
them in COBOL II.
NOTE All parameters must be on halfword boundaries.
Defining Data Types, Variables, and Intrinsics.
The following is part of the COBOL II program; it defines all the data
items and records.
IDENTIFICATION DIVISION.
PROGRAM-ID. RECEIVE.
DATE-COMPILED.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SPECIAL-NAMES.
SYMBOLIC CHARACTERS CLEAR, SCREEN IS 28, 86.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 END-OF-CHAIN PIC S9(4) COMP VALUE 15.
01 END-OF-DATA-SET PIC S9(4) COMP VALUE 11.
01 NO-CHAIN-HEAD PIC S9(4) COMP VALUE 17.
01 NO-SUCH-ENTRY PIC S9(4) COMP VALUE 17.
01 ENTRY-HAS-NO-DATA PIC S9(4) COMP VALUE 17.
01 DBNAME.
05 BASEID PIC X(02).
05 BASENAME PIC X(06).
05 TERMINATOR PIC X(02).
01 PASSWORD PIC X(10).
01 STATUS1.
05 CONDITION PIC S9(4) COMP.
05 LENGTH1 PIC S9(4) COMP.
05 RECORD-NUMBER PIC S9(9) COMP.
05 CHAIN-COUNT PIC S9(9) COMP.
05 BACK-POINTER PIC S9(9) COMP.
05 FORWARD-POINTER PIC S9(9) COMP.
01 OPTION PIC S9(4) COMP.
01 DB-MODE PIC S9(4) COMP.
01 LIST PIC X(80).
01 ERROR-BUFFER PIC X(80).
01 ERROR-LENGTH PIC S9(9) COMP.
01 ANSWER PIC S9(4) COMP.
01 LOCK-DESCRIPTOR-ARRAY.
05 NUM-OF-ELEMENTS PIC S9(4) COMP.
05 LOCK-DESCRIPTOR-SALES.
10 LENGTH-OF-DESCRIPTOR PIC S9(4) COMP.
10 DATA-SET-OF-DESCRIPTOR PIC X(16).
10 DATA-ITEM-OF-DESCRIPTOR PIC X(16).
10 RELOP-FOR-DATA-ITEM PIC X(02).
10 VALUE-FOR-DATA-ITEM PIC X(6).
10 NUM-VALUE-FOR-DATA-ITEM REDEFINES
VALUE-FOR-DATA-ITEM PIC S9(9) COMP.
01 SALES-DETAIL PIC X(16).
01 SEARCH-ITEM-NAME PIC X(16).
01 SEARCH-ITEM-VALUE PIC X(6).
01 SALES-BUFFER.
05 ACCOUNT-NUMBER PIC S9(9) COMP.
05 STOCK-NUMBER PIC X(8).
05 QUANTITY PIC S9(4) COMP.
05 PRICE PIC S9(9) COMP.
05 TAX PIC S9(9) COMP.
05 TOTAL PIC S9(9) COMP.
05 PURCH-DATE PIC X(6).
05 DELIV-DATE PIC X(6).
01 SALES-BUFFER-OUT.
05 ACCOUNT-NUMBER-OUT PIC Z(9)9.
05 STOCK-NUMBER-OUT PIC B(7)X(8).
05 QUANTITY-OUT PIC Z(5)9.
05 PRICE-OUT PIC Z(6)9.
05 TAX-OUT PIC Z(4)9.
05 TOTAL-OUT PIC Z(6)9.
05 PURCH-DATE-OUT PIC B(6)X(6).
05 DELIV-DATE-OUT PIC B(6)X(6).
01 SALES-BUFFER-HEADER.
05 ACCOUNT-NUMBER-HEAD PIC X(13)
VALUE "Acct-Number ".
05 STOCK-NUMBER-HEAD PIC X(15)
VALUE "Stock-Number ".
05 QUANTITY-HEAD PIC X(05)
VALUE "QTY ".
05 PRICE-HEAD PIC X(07)
VALUE "Price ".
05 TAX-HEAD PIC X(06)
VALUE "Tax ".
05 TOTAL-HEAD PIC X(07)
VALUE "Total ".
05 PURCH-DATE-HEAD PIC X(13)
VALUE "Purch-Date ".
05 DELIV-DATE-HEAD PIC X(14)
VALUE "Delive-Date ".
01 LINE-HEADER.
05 PIC X(40)
VALUE "----------------------------------------".
05 PIC X(38)
VALUE "--------------------------------------".
01 NOT-USED-PARM-16 PIC S9(4) COMP.
01 NOT-USED-PARM-32 PIC S9(9) COMP.
01 FOUND-VALUE PIC S9(4) COMP.
88 NOT-FOUND VALUE 0.
88 FOUND VALUE 1.
01 CUSTOMER-MASTER PIC X(16).
01 CUSTOMER-BUFFER.
05 ACCOUNT-NUMBER PIC S9(9) COMP.
05 LAST-NAME PIC X(16).
05 FIRST-NAME PIC X(10).
05 INITIAL1 PIC X(02).
05 STREET-ADDRESS PIC X(26).
05 CITY PIC X(12).
05 STATE PIC X(02).
05 ZIP PIC X(06).
05 CREDIT-RATING PIC X(08).
01 CUSTOMER-BUFFER-OUT.
05 ACCOUNT-NUMBER-CUST-OUT PIC 9(6).
05 FIRST-NAME-CUST-OUT PIC X(15) JUST RIGHT.
05 PIC X.
05 INITIAL1-CUST-OUT PIC X(02).
05 LAST-NAME-CUST-OUT PIC X(16) JUST RIGHT.
01 KEY-ITEM-VALUE-PRODUCT PIC X(08).
01 KEY-ITEM-VALUE PIC S9(9) COMP.
01 LIST-NO-ITEM PIC S9(9) COMP.
01 SAVED-RECORD-NUMBER PIC S9(9) COMP.
01 PRODUCT-MASTER PIC X(16).
01 PRODUCT-BUFFER.
05 STOCK-NUMBER PIC X(08).
05 DESCRIPTION PIC X(20).
01 DONE-VALUE PIC S9(4) COMP.
88 NOT-DONE VALUE 0.
88 DONE VALUE 1.
01 TEXT1 PIC X(80).
01 TEXTLEN PIC S9(9) COMP.
01 CUSTOMER-BUFFER-NEW.
05 ACCOUNT-NUMBER PIC S9(9) COMP.
05 LAST-NAME PIC X(16).
05 FIRST-NAME PIC X(10).
05 INITIAL1 PIC X(02).
05 STREET-ADDRESS PIC X(26).
05 CITY PIC X(12).
05 STATE PIC X(02).
05 ZIP PIC X(06).
05 CREDIT-RATING PIC X(08).
01 CUSTOMER-BUFFER-OLD.
05 ACCOUNT-NUMBER PIC S9(9) COMP.
05 LAST-NAME PIC X(16).
05 FIRST-NAME PIC X(10).
05 INITIAL1 PIC X(02).
05 STREET-ADDRESS PIC X(26).
05 CITY PIC X(12).
05 STATE PIC X(02).
05 ZIP PIC X(06).
05 CREDIT-RATING PIC X(08).
01 DATA-ITEM-NAME-IN PIC X(16).
01 M-102-BUFFER.
05 DATA-ITEM-NAME PIC X(16).
05 DATA-ITEM-TYPE PIC X(02).
05 DATA-ITEM-LENGTH PIC S9(4) COMP.
05 DATA-ITEM-COUNT PIC S9(4) COMP.
05 NOT-USED-ITEM PIC S9(4) COMP.
01 MENU.
05 MENU-LINE-1 PIC X(62) VALUE
"--------------------------------------------------------------".
05 MENU-LINE-2 PIC X(62) VALUE
"| |".
05 MENU-LINE-3 PIC X(62) VALUE
"| Entry Point |".
05 MENU-LINE-4 PIC X(62) VALUE
"| O R D E R S D A T A B A S E |".
05 MENU-LINE-5 PIC X(62) VALUE
"|------------------------------------------------------------|".
05 MENU-LINE-6 PIC X(62) VALUE
"| 1)OPEN DATABASE 2)GET SALES RECORD FOR DATE |".
05 MENU-LINE-7 PIC X(62) VALUE
"| 3)GET A CUSTOMER RECORD 4)GET A PRODUCT RECORD |".
05 MENU-LINE-8 PIC X(62) VALUE
"| 5)LIST ALL CUSTOMERS 6)ADD A PRODUCT |".
05 MENU-LINE-9 PIC X(62) VALUE
"| 7)UPDATE CUSTOMER RECORD 8)DELETE A PRODUCT |".
05 MENU-LINE-10 PIC X(62) VALUE
"| 9)REWIND/RESET CUSTOMER SET 10)OBTAIN DATA ITEM INFORMATION|".
05 MENU-LINE-11 PIC X(62) VALUE
"| 11)GENERATE ERROR MESSAGES 12)CLOSE DATABASE |".
Main Body of Program.
PROCEDURE DIVISION.
10-MAIN-LINE.
PERFORM WITH TEST AFTER UNTIL OPTION = 12
PERFORM 20-DISPLAY-MENU
PERFORM 30-DO-ACTION
END-PERFORM
STOP RUN.
20-DISPLAY-MENU.
DISPLAY CLEAR SCREEN
DISPLAY MENU-LINE-1
DISPLAY MENU-LINE-2
DISPLAY MENU-LINE-3
DISPLAY MENU-LINE-4
DISPLAY MENU-LINE-5
DISPLAY MENU-LINE-2
DISPLAY MENU-LINE-6
DISPLAY MENU-LINE-7
DISPLAY MENU-LINE-8
DISPLAY MENU-LINE-9
DISPLAY MENU-LINE-10
DISPLAY MENU-LINE-11
DISPLAY MENU-LINE-2
DISPLAY MENU-LINE-1
DISPLAY SPACE.
30-DO-ACTION.
DISPLAY " Enter your option : "
WITH NO ADVANCING
ACCEPT OPTION FREE
EVALUATE OPTION
WHEN 1 PERFORM 100-OPEN-THE-DATABASE
WHEN 2 PERFORM 200-GET-SALES-FOR-DATE
WHEN 3 PERFORM 300-GET-A-CUSTOMER-RECORD
WHEN 4 PERFORM 400-GET-A-PRODUCT-RECORD
WHEN 5 PERFORM 500-LIST-ALL-CUSTOMERS
WHEN 6 PERFORM 600-ADD-A-PRODUCT
WHEN 7 PERFORM 700-UPDATE-A-CUSTOMER
WHEN 8 PERFORM 800-DELETE-A-PRODUCT
WHEN 9 PERFORM 900-REWIND-CUSTOMER-SET
WHEN 10 PERFORM 1000-GET-DATA-ITEM-INFO
WHEN 11 PERFORM 1100-GET-ERROR-AND-EXPLAIN
WHEN 12 PERFORM 1200-CLOSE-THE-DATABASE
WHEN OTHER
DISPLAY "-----------------------------------"
DISPLAY "| Please enter an option between |"
DISPLAY "| 1 and 12. |"
DISPLAY "-----------------------------------"
DISPLAY "Press Enter to Continue... "
NO ADVANCING
ACCEPT OPTION FREE
END-EVALUATE.