6 Example Operations
| ORDER NUMBER | CUSTOMER NAME | PRICE |
|---|---|---|
| 100 | SMITH THOMAS A. | 175.50 |
| 101 | NONAME, JOSEPH | 77.50 |
| 102 | JOHNSON, SAM | 162.50 |
| 103 | HERNANDES, JOSE | 109.75 |
| 104 | HOUSEMAN, SEAN | 133.00 |
| 105 | SONO, JOMO A. | 135.00 |
| 106 | HEINZ HEINING | 175.00 |
| 107 | DALLING, JIMMY | 150.00 |
| 108 | ARAUJA, LUCIANO | 80.00 |
| 109 | BEKKER,BART | 125.00 |
| 110 | GISSING,MALCOMB | 45.00 |
| ====== | ||
| TOTAL ORDERS | 1368.25 |
For the programmer who has not used Eloquence DBMS, there are several small, but important, details which should be noted. In line 1080, B$ is defined as the database name. Two blanks must precede the name. The DBOPEN statement (line 1100) fills these blanks with a database id number (two ASCII digits from 00 through 09). This id number is used in subsequent DBML statements to identify the database, rather than the database name.
Note that the DBOPEN statement opens the database for exclusive access. This means that if another user attempts to open the database an error occurs when DBOPEN is executed. This error takes the form of a non-zero value in the first element of the status array S(*). S(*) must be of type integer and must contain at least ten elements, in this case S(0) through S(9).
1000 ! EXAMPLE PROGRAM 1
1010 !
1020 ! OUTSTANDING ORDERS REPORT (NOT INCLUDING ALL DETAIL)
1030 !
1040 INTEGER S(9)
1050 DIM B$[12],P$[10],Buf$[170]
1060 DIM Desc$[30],order_no$[10],Name$[30]
1070 DISP "Cr/H Cl/S"; ! CLEAR SCREEN
1080 B$=" SAD,SALES"
1090 P$="MANAGER"
1100 DBOPEN (B$,P$,3,S(*)) ! OPEN FOR EXCLUSIVE ACCESS
1110 IF S(0) THEN Dberr
1120 !
1130 ! INITIALIZE VARIABLES & PRINT REPORT HEADER
1140 !
1150 Rep: Total=0
1160 Eof=11
1170 PRINT TAB(20);"OUTSTANDING ORDERS LIST";LIN(1)
1180 PRINT "ORDER NUMBER CUSTOMER NAME";SPA(14);"PRICE";
LIN(1);RPT$("-",48);LIN(1)
1190 !
1200 ! PRODUCE THE REPORT
1210 !
1220 START report:DBGET (B$,"CUSTOMER",2,S(*),"@",Buf$,0)
1230 IF S(0)=Eof THEN End_report
1240 IF S(0) THEN Dberr
1250 UNPACK USING Pf2;Buf$
1260 Pf2:PACKFMT Order_no$,Name$,60X,16X,6X,12X,8X,2X,2X,6X,2X,
Price
1270 PRINT USING Itm_image;Order_no$,Name$,Price
1280 Itm_image: IMAGE 16A,22A,2X,5D.DD
1290 !
1300 ! ACCUMULATE TOTAL
1310 !
1320 Total=Total+Price
1330 GOTO Start_report
1340 !
1350 ! PRINT FINAL TOTALS
1360 !
1370 End_report:PRINT USING Tot_image;Total
1380 END
1390 Tot_image:IMAGE 39X,9("=") / 3X,"TOTAL ORDERS",24X,6D.DD /
1400 !
1410 ! DATABASE ERROR HANDLER
1420 !
1430 Dberr:DISP LIN(1);"UNEXPECTED DATABASE ERROR ";
VAL$(S(0));" IN LINE";S(6)
1440 END
In line 1070 of the program on the previous page, the characters Cr/H and Cl/S should be replaced by the cursor home and clear display special control characters respectively. The status array should be checked for an abnormal condition (non-zero first element) after each DBML operation. If an abnormal condition is detected in this program, control is transferred to the line labeled Dberr, which displays the error code in the status array and the line number where the error occurred.
The process of reading all orders is accomplished by a loop containing a serial-access DBGET (see line 1220). This line reads the next non-empty record from the CUSTOMER set and puts the record into the string Buf$.
The pertinent items from this buffer are extracted via the UNPACK USING statement and then printed. Note the use of Xs to skip unused fields in the PACKFMT. For clarity, each X field corresponds to a field in the database. The whole group could be replaced, however, by 114X. Before reading the next record, the price of the current order is added into the total price of all orders read so far.
When the orders in the CUSTOMER set are exhausted, the first element of the status array, S(0), indicates when an end-of-file has been reached. Line 1230 detects this and branches to print the total of all order prices.
It is not necessary to scan the entire CUSTOMER section to find entries with the correct product number. The chain between the CUSTOMER set and the PRODUCT set with PRODUCT-NO as the search field allows direct access to those entries in the CUSTOMER set with a particular product number. To access the entries on the chain, a DBFIND is first executed (line 1340). Status array element S(5) returns the number of entries in the chain. A FOR-NEXT loop going from 1 to S(5) with a chained mode DBGET (line 1370) extracts the information for each order with the desired product number.
The procedure reads the chain in a "forward" direction. It is possible to read the chain backwards by using a direct mode DBGET and chain pointers which are returned in the status array by both DBFIND and DBGET. It is also possible to use DBGET mode 6 (chained backward). To change example program 2 to do a backward chain read, replace line 1370 with the following:
1370 DBGET (B$,"CUSTOMER",4,S(*),"@",Buf$,S(7))or
1370 DBGET (B$,"CUSTOMER",6,S(*),"@",Buf$,(0))Example program 2 also solves one of the problems of program 1. By opening the database in mode 8 (read-only mode) instead of mode 3 (exclusive access), other users can also open the database in mode 8 and do concurrent reads. Opening in mode 8, however, fails if another user has the database opened in either mode 3 or mode 1. As long as the database is opened by one user in mode 8, no one can open it in a mode which permits modifications of the database.
OUTSTANDING ORDERS LIST
PRODUCT ORDER NUMBER CUSTOMER NAME PRICE
------------------------------------------------------------------
50 (Tricycle)
110 Gissing, Malcomb 45.00
=========
TOTAL ORDERS FOR 50 45.00
1000 (10-Speed Bicycle)
102 Johnson, Sam 162.50
106 Heining, Heinz 175.00
107 Dalling, Jimmy 150.00
=========
TOTAL ORDERS FOR 1000 487.50
100 (Standard Bicycle)
101 Noname, Joseph 77.50
103 Hernandes, Jose 109.75
108 Arauja, Luciano A. 80.00
=========
TOTAL ORDERS FOR 100 267.25
300 (3-Speed Bicycle)
104 Houseman, Sam 133.00
=========
TOTAL ORDERS FOR 300 133.00
500 (5-Speed Bicycle)
100 Smith, Thomas A. 175.50
105 Sono, Jomo A. 135.00
109 Bekker, Bart 125.00
=========
TOTAL ORDERS FOR 500 435.50
TOTAL ORDERS $1368.25
===========
1000 ! EXAMPLE PROGRAM 2
1010 !
1020 ! OUTSTANDING ORDERS REPORT (NOT INCLUDING ALL DETAIL)
1030 !
1040 INTEGER S(9), Prod_no
1050 DIM B$[12],P$[10],Buf$[170]
1060 DIM Desc$[30],Order_no$[10],Name$[30]
1070 DISP "Cr/H Cl/S"; ! CLEAR SCREEN
1080 B$=" SAD,SALES"
1090 P$="MANAGER"
1100 DBOPEN (B$,P$,8,S(*)) ! OPEN FOR READ-ONLY ACCESS
1110 IF S(0) THEN Dberr
1120 !
1130 ! INITIALIZE VARIABLES & PRINT REPORT HEADER
1140 !
1150 Rep:Total=Master_total=0
1160 Eof=11
1170 PRINT TAB(20);"OUTSTANDING ORDERS LIST";LIN(1)
1180 PRINT "PRODUCT ORDER NUMBER 'CUSTOMER NAME";
SPA(14);"PRICE";LIN(1);RPT$("-",63);LIN(1)
1190 !
1200 ! PRODUCE THE REPORT
1210 !
1220 Start_report:DBGET (B$,"PRODUCT",2,S(*),"@",Buf$,0)
1230 IF S(0)=Eof THEN End_report
1240 IF S(0) THEN Dberr
1250 UNPACK USING Pf;Buf$
1260 Pf: PACKFMT Prod_no,Desc$
1270 !
1280 ! PRINT HEADER FOR PRODUCT
1290 !
1300 PRINT VAL$(Prod_no);" (";TRIM$(Desc$);")"
1310 !
1320 ! PRINT ORDERS
1330 !
1340 DBFIND (B$,"CUSTOMER",1,S(*),"PROD_NO",Prod_no)
1350 IF S(0) THEN Dberr
1360 FOR I=1 TO S(5)
1370 DBGET (B$,"CUSTOMER",5,S(*),"@"Buf$,0)
1380 IF S(0) THEN Dberr
1390 UNPACK USING Pf2;Buf$
1400 Pf2: PACKFMT Order no$,Name$,60X,16X,6X,12X,8X,2X,2X,6X,
2X,Price
1410 PRINT TAB(16);
1420 PRINT USING Itm_image;Order_no$,Name$,Price
1430 Itm_image:IMAGE 16A,22A,2X,5D.DD
1440 !
1450 ! ACCUMULATE TOTALS
1460 !
1470 Total=Total+Price
1480 Master_total=Master_total+Price
1490 NEXT I
1500 !
1510 ! PRINT TRAILER FOR PRODUCT
1520 !
1530 PRINT TAB(54);
1540 PRINT USING Tot_image;VAL$(Prod_no),Total
1550 Total=0
1560 GOTO Start_report
1570 !
1580 ! PRINT FINAL TOTALS
1590 !
1600 End_report:PRINT USING Mstr_image; Master_total
1610 END
1620 Tot_image:IMAGE 9("=") / 3X,"TOTAL ORDERS FOR ",10A,24X, 6D.DD /
1630 Mstr_image:IMAGE // 25X,"TOTAL ORDERS",14X,"$"8D.DD / 54X,9("=")
1640 !
1650 ! DATABASE ERROR HANDLER
1660 !
1670 Dberr:DISP LIN(1);"UNEXPECTED DATABASE ERROR ";
'VAL$(S(0));" IN LINE";S(6)
1680 END
In line 1070 of the above program, the characters Cr/H and Cl/S should be replaced by the cursor home and clear display special control characters respectively. This program is basically an expansion of the previous example. The options for each order are listed by inserting a chained-access DBGET through the OPTION set for each order found in CUSTOMER. The DBFIND on the OPTION set (line 1470) using the order number from CUSTOMER finds the head of the chain of options. The FOR-NEXT loop (line 1490) then chains through the entries in the OPTION set, doing chained-mode DBGETS.
A significant feature of this program is the replacement of the UNPACK USING statements with IN DATA SETs. Lines 1180 through 1200 set up a correspondence between variables in the Eloquence program and fields in the data sets. Thus, when the DBGET on PRODUCT is performed (line 1310), the values of the fields PRODUCT-NO and PRODUCT-DESC in the PRODUCT set are automatically assigned to the variables Prod_no and Desc$. Similarly, when the DBGET in line 1500 is executed, new values are assigned to Option_desc$ and P0.
The use of SKP in the IN DATA SET for the OPTION set (line 1200) instructs the system to ignore the value of the ORDER-NO field. It is not assigned to any variable since this field was read by DBGET on the CUSTOMER set and assigned to Order_no$; reassigning it would be superfluous.
The USE ALL option on the IN DATA SET for the CUSTOMER set (line 1190) specifies that only fields whose names correspond to variables already in the program are to be unpacked into their corresponding variables.
Only the variables Order_no$ and Name$ in this program correspond to fields in the CUSTOMER set. Thus, when the DBGET in line 1410 is executed, only the value of the fields ORDER-NO and NAME are assigned to variables (Order_no$ and Name$, respectively).
Another feature of example program 3 is error control and program termination. Lines 1080 and 1090 allow the program to trap the HALT key and any error conditions and wrap-up gracefully. Both termination conditions, as well as the database routine, then attempt to close the database (line 1900). In this instance, however, the DBCLOSE is not critical. Had any write operations been performed, the close would be necessary to properly record the changes made to the database.
A mode 4 DBCLOSE is automatically executed when the program ENDs when the database is not closed prior to program completion. This close updates the data stored on the disk, but leaves the database open for further access. Certain operations, such as DBERASE, require exclusive access to the database, and cannot be performed until a mode 1 DBCLOSE is executed.
OUTSTANDING ORDERS LIST
PRODUCT ORDER NUMBER CUSTOMER NAME OPTIONS PRICE
---------------------------------------------------------------------
50 (Tricycle)
110 Gissing, Malcomb 45.00
--------
45.00
========
TOTAL ORDERS FOR 50 45.00
1000 (10-Speed Bicycle)
102 Johnson, Sam 150.00
Chrome 12.50
--------
162.50
106 Heining, Heinz 150.00
Light 10.00
Basket 15.00
--------
175.00
107 Dalling, Jimmy 150.00
--------
150.00
========
TOTAL ORDERS FOR 1000 487.50
100 (Standard Bicycle)
101 Noname, Joseph 75.00
Horn 2.50
--------
77.50
103 Hernaned, Jose 75.00
Light 5.00
Mud Flaps 2.50
Horn 10.00
Stripes 2.50
Fan 10.00
--------
109.75
108 Arauja, Luciano A. 75.00
Horn 5.00
--------
80.00
========
TOTAL ORDERS FOR 100 267.25
300 (3-Speed Bicycle)
104 Houseman, Sean 110.00
Light 5.00
Super Tire 18.00
--------
133.00
========
TOTAL ORDERS FOR 300 133.00
500 (5-Speed Bicycle)
100 Smith, Thomas A. 125.00
Light 5.00
Basket 45.00
--------
175.50
105 Sono, Jomo A. 125.00
Horn 2.50
Reflector 7.50
--------
135.00
109 Bekker, Bart 125.00
--------
125.00
========
TOTAL ORDERS FRO 500 435.50
TOTAL ORDERS $1368.25
==========
1000 ! EXAMPLE PROGRAM 3
1010 !
1020 ! OUTSTANDING ORDERS REPORT (INCLUDING ALL DETAIL)
1030 !
1040 INTEGER S(9), Product_no,Prod_no
1050 DIM B$[12],P$[10],Buf$[170]
1060 DIM Desc$[30],Order_no$[30],Name$[30],
Option_desc$[10]
1070 DISP "Cr/H Cl/S"; ! CLEAR SCREEN
1080 ON ERROR GOTO Error ! SET UP ERROR AND HALT TRAPS
1090 ON HALT GOTO Halt
1100 B$=" SAD,SALES"
1110 P$="MANAGER"
1120 DBOPEN (B$,P$,1,S(*)) ! OPEN FOR SHARED ACCESS
1130 IF S(0) THEN Dberr
1140 !
1150 ! SET UP ALL APPROPRIATE RELATIONSHIPS
1160 !
1170 DBASE IS B$
1180 IN DATA SET "PRODUCT" USE Prod_no,Desc$
1190 IN DATA SET "CUSTOMER" USE ALL
1200 IN DATA SET "OPTION" USE SKP 1,Option_desc$,P0
1210 !
1220 ! INITIALIZE VARIABLES & PRINT REPORT HEADER
1230 !
1240 Rep:Total=Master_total=0
1250 Eof=11
1260 PRINT TAB(30);"OUTSTANDING ORDERS LIST";LIN(1)
1270 PRINT "PRODUCT";SPA(8);"ORDER NUMBER";SPA(10);
"CUSTOMER NAME";SPA(9);"OPTIONS";SPA(8);"PRICE";
LIN(1);RPT$("=",79);LIN(1)
1280 !
1290 ! PRODUCE THE REPORT
1300 !
1310 Start_report:DBGET (B$,"PRODUCT",2,S(*),"@",Buf$,0)
1320 IF S(0)=Eof THEN End_report
1330 IF S(0) THEN Dberr
1340 !
1350 ! PRINT HEADER FOR PRODUCT
1360 !
1370 PRINT VAL$(Prod_no);" (";TRIM$(Desc);")"
1380 DBFIND (B$,"CUSTOMER",1,S(*),"PRODUCT-NO,Prod_no)
1390 IF S(0) THEN Dberr
1400 FOR I=1 TO S(5)
1410 DBGET (B$,"CUSTOMER",5,S(*),"@",Buf$,0)
1420 IF S(0) THEN Dberr
1430 !
1440 ! PRINT HEADER FOR ORDER
1450 !
1460 PRINT TAB(20);Order_no$;TAB(38);Name$[1,21];
1470 DBFIND (B$,"OPTION",1,S(*),"ORDER-NO",Order_no$)
1480 IF S(0) THEN Dberr
1490 FOR J=1 TO S(5)
1500 DBGET (B$,"OPTION",5,S(*),"@",Buf$,0)
1510 IF S(0) Then Dberr
1520 !
1530 ! PRINT OPTIONS
1540 !
1550 PRINT TAB(60);
1560 PRINT USING Itm_image;Option_desc$,P0
1570 Itm_image:IMAGE 10A,2X,5D.DD
1580 !
1590 ! ACCUMULATE TOTALS
1600 !
1610 Total=Total+P0
1620 Sub_total=Sub_total+P0
1630 Master_total=Master_total+P0
1640 NEXT J
1650 PRINT TAB(71);
1660 PRINT USING Sub_image;Sub_total
1670 Sub_total=0
1680 NEXT I
1690 !
1700 ! PRINT TRAILER FOR PRODUCT
1710 !
1720 PRINT TAB(70);
1730 PRINT USING Tot_image;VAL$(Prod_no),Total
1740 Total=0
1750 GOTO Start_report
1760 !
1770 ! PRINT FINAL TOTALS
1780 !
1790 End_report:PRINT USING Mstr_image;Master_total
1800 GOTO Close
1810 Sub_image:IMAGE 8("-") / 71X,5D.DD /
1820 Tot_image:IMAGE 9("=") / 11X,"TOTAL ORDERS FOR ",10A,32X,6D.DD /
1830 Mstr_image:IMAGE // 31X,"TOTAL ORDERS",24X,"$"8D.DD / 70X,9("=")
1840 !
1850 ! ERROR AND HALT TERMINATION ROUTINES
1860 !!
1870 Dberr:DISP LIN(2);"STATUS ERROR ";VAL$(S(0));" IN LINE"; S(6)
1880 GOTO Close
1890 Error: DISP LIN(2);"UNEXPECTED ";ERRM$
1900 GOTO Close
1910 Halt:PRINT LIN(2)
1920 Close:DBCLOSE (B$," ",1,S(*))
1930 DISP LIN(2);"END OF OUTSTANDING ORDERS REPORT."
1940 END
In line 1070 of the above program, the characters Cr/H and Cl/S should be replaced by the cursor home and clear display special control characters respectively. When the program is first RUN it produces a screen like that shown below.
Press EXIT PROGRAM to terminate the program. Otherwise, a new product number is entered and the program prompts for a product description. Note that the set capacity and the current number of entries are displayed. This information is obtained via DBINFO in line 1330. Note also that since the result of DBINFO is left in the buffer, an UNPACK is used (line 1350) to extract these values into integer variables. Since integers range from -231 through +231-1 and capacities range from 1 through 999,999, a conversion is necessary. The FNCorrect function defined in line 1240 provides this conversion.
The same would be possible using a DINTEGER variable to unpack instead of 2 INTEGERS.
If a duplicate product number is entered, the program displays an error and prompts for a correction. For example:
This duplicity is detected by attempting a calculated access (line 1460) of the master for the product using the given product number.
If the specified product is not found, the product description is requested as shown here:
After the description is entered, a DBPUT (line 1600) is used to store the new product in the database. The program then reports that the DBPUT was successful and gives two options which are key selected.
The user can either add ANOTHER product or EXIT the program.
1000 ! EXAMPLE PROGRAM 4
1010 !
1020 ! ADD NEW PRODUCT
1030 !
1040 INTEGER S(9),Prod_no,Entries,Capacity,Entries2,Capacity2
1050 DIM B$[12],P$[10],Buf$[170]
1060 DIM Desc$[30]
1070 DISP "Cr/H Cl/S"; ! CLEAR SCREEN
1080 DISP TAB(32);"ADD NEW PRODUCT'
1090 ON ERROR GOTO Error !SET UP ERROR AND HALT TRAPS
1100 ON HALT GOTO Halt
1110 B$=" SAD,SALES"
1120 P$="MANAGER"
1130 DBOPEN (B$,P$,3,S(*)) ! OPEN FOR EXCLUSIVE ACCESS
1140 IF S(0) THEN Dberr
1150 !
1160 ! SET UP ALL APPROPRIATE RELATIONSHIPS
1170 !
1180 DBASE IS B$
1190 IN DATA SET "PRODUCT" USE Prod_no,Desc$
1200 !
1210 ! FUNCTION TO CONVERT TWO 16-BIT INTEGERS TO
1220 ! ONE 32-BIT INTEGER
1230 !
1240 DEF FNCorrect(INTEGER N,N2)=N2+N*65536
1250 !
1260 ! INITIALIZE
1270 !
1280 Not_found=17
1290 ON KEY #8:"EXIT" GOTO Halt
1300 ON KEY #16 GOTO Halt
1310 Cont:DISP "Cr/H";LIN(3);"Cl/S";LIN(10)
1320 OFF KEY #1,9
1330 DBINFO (B$,"PRODUCT",202,S(*),Buf$)
1340 UNPACK USING Fmt;Buf$
1350 Fmt:PACKFMT 28X,Entries,Entries2,Capacity,Capacity2
1360 DISP "CURRENT NUMBER OF ENTRIES :";FNCorrect(Entries,Entries2);
LIN(2)
1370 DISP "SET CAPACITY: ";FNCorrect(Capacity,Capacity2)
1380 !
1390 ! ASK FOR NEW PRODUCT NUMBER
1400 !
1410 Again:DISP "Cr/H";LIN(3)
1420 Badp=-1 ! ALLOW FOR A NULL USER RESPONSE.
1430 INPUT "Enter the number of the product you wish to add.",
Prod_no
1440 IF Prod_no%<1 THEN Badp
1450 DBGET (B$,"PRODUCT",7,S(*),"@",Buf$,Prod_no)
1460 IF S(0)=Not_found THEN Enter
1470 IF S(0) THEN Dberr
1480 DISP "PRODUCT ALREADY IN DATABASE."
1490 BEEP
1500 GOTO Again
1510 Badp:DISP "ILLEGAL PRODUCT NUMBER"
1520 BEEP
1530 GOTO Again
1540 !
1550 ! PUT THE NEW PRODUCT IN THE DATABASE
1560 !
1570 Enter:DISP "Cl/S"
1580 INPUT "Enter product description",Desc$
1590 DBPUT (B$,"PRODUCT",1,S(*),"@",Buf$)
1600 IF S(0) THEN Dberr
1610 DISP "NEW PRODUCT ADDED."
1620 ON KEY #1:"ANOTHER GOTO Cont
1630 ON KEY #9 GOTO Cont
1640 WAIT
1650 Dberr:DISP LIN(2);"STATUS ERROR ";VAL$(S(0));" IN LINE";
S(6)
1660 GOTO Close
1670 Error:DISP LIN(2);"UNEXPECTED ";ERRM$
1680 GOTO Close
1690 Halt:DISP " END OF ADD PRODUCT PROGRAM."
1700 Close:DBCLOSE (B$," ",1,S(*))
1710 END
In lines 1070, 1310, 1570 and 1690 of the above program, the characters Cr/H and Cl/S should be replaced by the cursor home and clear display special control characters respectively.
If a number is entered for a non-existent product, it is detected by the calculated access DBGET in line 1330, as shown by the following screen:
Note that the database was opened in mode 1. Line 1310 locks the database. It is essential that the database be locked before the DBGET. If it is locked afterwards, another user could lock the database anytime before the lock in this program and then make modifications to the record retrieved in line 1330. If such a user deleted the record, a subsequent DBUPDATE or DBDELETE would fail.
Once a correct product number has been provided, the old description is displayed for user edit:
The ANOTHER key can be pressed here to abort the modification and return to the initial display.
If the description is altered and RETURN is pressed, the DBUPDATE line (1520) alters the text of the product description in the database. In this case, either ANOTHER or EXIT PROGRAM is pressed to continue:
If the DELETE key is pressed, the product is removed from the database (see line 1670). The program then indicates that the delete was successful and waits for the user to respond with the appropriate key:
If the entry in the PRODUCT master had any entries associated with it in the CUSTOMER detail, an error would have been issued (see line 1690).
Note that extreme care must be taken so that DBUNLOCKs are performed either after a successful operation or following an error (see lines 1350, 1550 and 1600). The DBCLOSE in line 1780 automatically performs the unlock in case either HALT or EXIT PROGRAM is pressed or an unforeseen error occurs.
1000 ! EXAMPLE PROGRAM 5
1010 !
1020 ! PRODUCT EDITOR
1030 !
1040 INTEGER S(9),Prod_no
1050 DIM B$[12],Buf$[170]
1060 DIM Desc$[30]
1070 DISP "Cr/H Cl/S"; ! CLEAR SCREEN
1080 DISP TAB(34);"EDIT PRODUCT"
1090 ON ERROR GOTO Error ! SET UP ERROR AND HALT TRAPS
1100 ON HALT GOTO Halt
1110 B$=" SAD,SALES"
1120 P$="MANAGER"
1130 DBOPEN (B$,P$,1,S(*) ! OPEN FOR SHARED ACCESS
1140 IF S(0) THEN Dberr
1150 !
1160 ! SET UP ALL APPROPRIATE RELATIONSHIPS
1170 !
1180 DBASE IS B$
1190 IN DATA SET "PRODUCT" USE Prod_no,Desc$
1200 !
1210 ! INITIALIZE AND ASK FOR PRODUCT NUMBER
1220 !
1230 Not_found=17
1240 Chain_not_empty=44
1250 ON KEY #8:"EXIT" GOTO Halt
1260 ON KEY #16 GOTO Halt
1270 Cont:DISP "Cr/H";LIN(3);"Cl/S";
1280 OFF KEY #1,9
1290 Again:DISP "Cr/H";LIN(3);
1300 INPUT "Enter the number of the product you wish to edit.",
Prod_no
1310 DBLOCK (B$," ",1,S(*)) ! LOCK DATABASE BEFORE WRITE
1320 IF S(0) THEN Dberr
1330 DBGET (B$,"PRODUCT",7,S(*),"@",Buf$,Prod_no)
1340 IF S(0) %<> Not_found THEN Maybe
1350 DBUNLOCK (B$," ",1,S(*))!UNLOCK THE DATABASE AFTER AN ERROR
1360 IF S(0) THEN Dberr
1370 DISP "NO SUCH PRODUCT IN DATABASE."
1380 BEEP
1390 GOTO Again
1400 Maybe:IF S(0) THEN Dberr
1410 !
1420 ! GET NEW DESCRIPTION AND PERFORM THE UPDATE
1430 !
1440 DISP "Cl/S"
1450 Desc$=Trim$(Desc$)
1460 ON KEY #5:"DELETE" GOTO Del
1470 ON KEY #13 GOTO Del
1480 EDIT "Enter New description",Desc$
1490 OFF KEY #5,13
1500 DBUPDATE (B$,"PRODUCT",1,S(*),"@",Buf$)
1510 IF S(0) THEN Dberr
1520 DISP "UPDATE COMPLETE."
1530 WAIT:DBUNLOCK (B$," ",1,S(*)) ! UNLOCK DATABASE AFTER WRITE
1540 IF S(0) THEN Dberr
1550 ON KEY #1:"ANOTHER GOTO Cont
1560 ON KEY #9 GOTO Cont
1570 WAIT
1580 !
1590 ! DELETE THE ENTRY
1600 !
1610 Del:OFF KEY #5,13
1620 DBDELETE (B$,"PRODUCT',1,S(*))
1630 IF S(0) %<>Chain_not_empty THEN Del2
1640 DISP LIN(1);"THERE ARE STILL ORDERS FOR THIS PRODUCT."
1650 BEEP
1660 GOTO Wait
1670 De12:IF S(0) THEN Dberr
1680 DISP LIN(1);"PRODUCT DELETED."
1690 GOTO Wait ! GO DO UNLOCK.
1700 !
1710 ! TERMINATION ROUTINES
1720 !
1730 Dberr:DISP LIN(2);"STATUS ERROR ";VAL$(S(0));" IN LINE";
S(6)
1740 GOTO Close
1750 Error:DISP LIN(2);"UNEXPECTED ";ERRM$
1760 GOTO Close
1770 Halt:DISP "Cr/H END OF EDIT PRODUCT PROGRAM."
1780 Close:DBCLOSE (B$," ",1,S(*))
1790 END
In lines 1070, 1270, 1290, 1440 and 1770 of the above program, the characters Cr/H and Cl/S should be replaced by the cursor home and clear display special control characters respectively.