3 Program Examples
Note that there is a blank option following the customer name. There is actually an entry with a blank option number field in ORDER for each order placed. This record contains the price of the product, and the all-blank field is used to force this entry to occur before any of the options to guarantee that it will be the first in the chain.
The blank entry also serves another function. If it were not included, then any order sold with no options would have no record in the OPTION set. This would generate an incomplete hierarchy for such orders, so they would not occur in the workfile generated by programs 3 and 4, though program 5 could be modified to handle such orders.
Example program 3 uses a four-set thread (see line 1320). The construction of this thread is discussed in Chapter 1. Note, that although four pointers must be read from the workfile (see line 1480), the third pointer, R3, is never used. This third pointer is just the place holder to skip over the information in the automatic set, ORDER. Again, the change in record number pertaining to the PRODUCT set is used to trigger the headers and trailers for new products (via variables R1 and S1). A similar technique is used to detect the change in order number (via variables R2 and S2).
Example program 3 is another case of bad programming. Example program 4 cleans up these problems. It adds status checks for data base calls, error trapping (see line 1070) and HALT key trapping (see line 1080). Also, all the previous examples have assumed that the data file "XYZ:" exists for use as a workfile. Example program 4 now checks to see if the workfile exists and creates it if it does not. It stops if the file is protected or is of the wrong type.
For reasons detailed in Chapter 4, long threads are undesirable and should be avoided when possible. As in example program 2, the PRODUCT set can be eliminated from the thread by use of a calculated-access DBGET. This reduces the thread length to three. Also, if it is not particularly important to have the options listed in sorted order, a DBFIND on the OPTION set using the order number from the CUSTOMER set may be done. This allows chained mode DBGETs to be used to get the options. Listing will thus be in the chain order (the order the options appeared in on the original order). This reduces the thread length to only one set, the CUSTOMER set. Program example 5 shows how this could be done.
In example program 5, as in example 2, the actual product number is used to determine when headers and trailers are required. However, since each record in the workfile corresponds to a new order, no special logic is needed to detect change in order number; The header and trailer each occur every time through the loop. A special imbedded FOR loop is added, however, to print out the options (see lines 1835 through 1945).
OUTSTANDING ORDERS LIST
PRODUCT ORDER NUMBER CUSTOMER NAME PRICE
50 (Tricycle)
110 Gissing, Malcom 45,00
--------
45,00
---------
TOTAL ORDERS FOR 50 45,00
100 (Standard Bicycle)
101 Noname, Joseph 75,00
Horn 2,50
--------
77,50
103 Hernandes, Jose 75,00
Fan 10,00
Horn 10,00
Light 5,00
Mud Flaps 7,25
Stripes 2,50
--------
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 Tire18,00
--------
133,00
---------
TOTAL ORDERS FOR 300 133,00
500 (5-Speed Bicycle)
100 Smith, Thomas A. 125,00
Basketle 45,00
Light 5,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 FOR 500 435,50
1000 (10-Speed Bicycle)
102 Johnson, Sam 150,00
Chrome 12,50
--------
162,50
106 Heining, Heinz 150,00
Basket 15,00
Light 10,00
--------
175,00
107 Dalling, Jimmy 150,00
--------
150,00
---------
TOTAL ORDERS FOR 1000 487,50
TOTAL ORDERS $1368,25
---------
1000 !
1010 ! OUTSTANDING ORDERS REPORT (INCLUDING ALL DETAIL)
1020 !
1030 INTEGER S(9),Prod_no
1040 DIM B$[12],P$[10],Buf$[170]
1050 DIM Desc$[30],Order_no$[30],Name$[30],Option_desc$[10]
1060 DISP " "; ! CLEAR SCREEN
1090 B$=" SAD,SALES"
1100 P$="MANAGER"
1110 DBOPEN (B$,P$,1,S(*)) ! OPEN DATA BASE
1120 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 IN DATA SET "CUSTOMER" USE ALL
1210 IN DATA SET "OPTION" USE SKP 1,Option_desc$,PO
1220 !
1230 ! SET UP THE WORKFILE
1240 !
1310 ASSIGN "XYZ" TO #1
1320 WORKFILE IS #1;THREAD IS "PRODUCT","CUSTOMER",
"ORDER","OPTION"
1330 !
1340 ! SORT THE STRUCTURE
1350 !
1360 SORT BY Prod_no,Order_no$,Option_desc$
1400 !
1410 ! INITIALIZE VARIABLES & PRINT REPORT HEADER
1420 !
1430 Rep:Sub_total=Total=Master_total=0
1440 S1=S2=0
1450 PRINT TAB(30);"OUTSTANDING ORDERS LIST";LIN(1)
1460 PRINT "PRODUCT";SPA(8);"ORDER NUMBER";SPA(10);"CUSTOMER
NAME";SPA(9);"OPTIONS";SPA(8);"PRICE";LIN(1);
RPT$("-",79);LIN(1)
1461 !
1462 ! PRODUCE THE REPORT
1463 !
1470 FOR Z=1 TO WFLEN(1)
1480 READ #1;R1,R2,R3,R4
1490 !
1500 ! PRINT TRAILER FOR ORDER (IF NEEDED)
1510 !
1520 ! (SKIP IF SAME ORDER AS BEFORE, OR FIRST TIME THRU LOOP)
1530 !
1540 IF (R2=S2) OR NOT S2 THEN Nosub
1550 PRINT USING Sub_image;Sub_total
1560 Sub_total=0
1570 !
1580 ! PRINT TRAIILER FOR PRODUCT (IF NEEDED)
1590 !
1600 ! (SKIP IF SAME PRODUCT AS BEFORE, OR FIRST TIME THRU LOOP)
1610 !
1620 Nosub:IF (R1=S1) OR NOT S1 THEN Notot
1630 PRINT USING Tot_image;VAL$(Prod_no),Total
1640 Total=0
1650 !
1660 ! PRINT HEADER FOR PRODUCT (IF NEEDED)
1670 !
1680 Notot:IF R1=S1 THEN Skip1
1690 DBGET (B$,"PRODUCT",4,S(*),"@",Buf$,R1)
1710 S1=R1
1720 PRINT VAL$(Prod_no);" (";TRIM$(Desc$);")"
1730 !
1740 ! PRINT HEADER FOR ORDER (IF NEEDED)
1750 !
1760 Skip1:IF R2=S2 THEN Skip2
1770 DBGET (B$,"CUSTOMER",4,S(*),"@",Buf$,R2)
1790 PRINT TAB(20);Order_no$;TAB(38);Name$[1,21];
1800 S2=R2
1810 !
1820 ! PRINT OPTIONS
1830 !
1840 Skip2:DBGET (B$,"OPTION",4,S(*),"@",Buf$,R4)
1860 PRINT TAB(60);
1870 PRINT USING Itm_image;Option_desc$,PO
1880 Itm_image:IMAGE 10A,2X,5DRDD
1890 !
1900 ! ACCUMULATE TOTALS
1910 !
1920 Total=Total+PO
1930 Sub_total=Sub_total+PO
1940 Master_total=Master_total+PO
1950 NEXT Z
1960 !
1970 ! PRINT FINAL TOTALS
1980 !
1990 PRINT USING Sub_image;Sub_total
2000 PRINT USING Tot_image;VAL$(Prod_no),Total
2010 PRINT USING Mstr_image;Master_total
2030 Sub_image:IMAGE 71X,8("-") / 71X,5DRDD /
2040 Tot_image:IMAGE 70X,9("-") / 11X,"TOTAL ORDERS FOR ",10A,
32 X,6DRDD /
2050 Mstr_image:IMAGE // 31X,"TOTAL ORDERS",24X,"$"8DRDD / 70X,
9("-")
2160 END
1000 !
1010 ! OUTSTANDING ORDERS REPORT (INCLUDING ALL DETAIL)
1020 !
1030 INTEGER S(9),Prod_no
1040 DIM B$[12],P$[10],Buf$[170]
1050 DIM Desc$[30],Order_no$[30],Name[30],Option_desc$[10]
1060 DISP " "; ! CLEAR SCREEN
1070 ON ERROR GOTO Error ! SET UP ERROR AND HALT TRAPS
1080 ON HALT GOTO Halt
1090 B$=" SAD,SALES"
1100 P$="MANAGER"
1110 DBOPEN (B$,P$,1,S(*)) ! OPEN DATA BASE
1120 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 IN DATA SET "CUSTOMER" USE ALL
1210 IN DATA SET "OPTION" USE SKP 1, Option_desc$,PO
1220 !
1230 ! SET UP THE WORKFILE
1240 !
1250 ASSIGN "XYZ" TO #1,Z
1260 IF Z%<2 THEN Ok
1270 DISP "CAN'T ASSIGN THE WORKFILE!"
1280 STOP
1290 Ok: IF NOT Z THEN Aok ! CREATE WORKFILE IF NECESSARY
1300 FCREATE "XYZ" ,0
1310 ASSIGN "XYZ" TO #1
1320 Aok:WORKFILE IS #1;THREAD IS "PRODUCT","CUSTOMER","ORDER",
"OPTION"
1330 !
1340 ! SORT THE STRUCTURE
1350 !
1360 SORT BY Prod_no,Order_no$,Option_desc$
1370 IF WFLEN(1) THEN Rep
1380 DISP "THERE ARE NO ENTRIES IN THE STRUCTURE TO REPORT ON."
1390 STOP
1400 !
1410 ! INITIALIZE VARIABLES & PRINT REPORT HEADER
1420 !
1430 Rep:Sub_total=Total=Master_total=0
1440 S1=S2=0
1450 PRINT TAB(30);"OUTSTANDING ORDERS LIST";LIN(1)
1460 PRINT "PRODUCT";SPA(8);"ORDER NUMBER";SPA(10);"CUSTOMER
NAME";SPA(9);"OPTIONS";SPA(8);"PRICE";LIN(1);
RPT$("-",79);LIN(1)
1461 !
1462 ! PRODUCE THE REPORT
1463 !
1470 FOR Z=1 TO WFLEN(1)
1480 READ #1;R1,R2,R3,R4
1490 !
1500 ! PRINT TRAILER FOR ORDER (IF NEEDED)
1510 !
1520 ! (SKIP IF SAE ORDER AS BEFORE, OR FIRST TIME THRU LOOP)
1530 !
1540 IF (R2=S2) OR NOT S2 THEN Nosub
1550 PRINT USING Sub_image;Sub_total
1560 Sub_total=0
1570 !
1580 ! PRINT TRAILER FOR PRODUCT (IF NEEDED)
1590 !
1600 ! (SKIP IF SAME PRODUCT AS BEFORE,OR FIRST TIME THRU LOOP)
1610 !
1620 Nosub:IF (R1=S1) OR NOT S1 THEN Notot
1630 PRINT USING Tot_image;VAL$(Prod_no),Total
1640 Total=0
1650 !
1660 ! PRINT HEADER FOR PRODUCT (IF NEEDED)
1670 !
1680 Notot:IF R1=S1 THEN Skip1
1690 DBGET (B$,"PRODUCT",4,S(*),"@",Buf$,R1)
1700 IF S(0) THEN Dberr
1710 S1=R1
1720 PRINT VAL$(Prod_no);" (";TRIM$(Desc$);")"
1730 !
1740 ! PRINT HEADER FOR ORDER (IF NEEDED)
1750 !
1760 Skip1:IF R2=S2 THEN Skip2
1770 DBGET (B$,"CUSTOMER",4,S(*),"@",Buf$,R2)
1780 IF S(0) THEN Dberr
1790 PRINT TAB(20);Order_desc$;TAB(38);Name$[1,21];
1800 S2=R2
1810 !
1820 ! PRINT OPTIONS
1830 !
1840 Skip2:DBGET (B$,"OPTION",4,S(*),"@",Buf$,R4)
1850 IF S(0) THEN Dberr
1860 PRINT TAB(60);
1870 PRINT USING Itm_image;Option_no$,PO
1880 Itm_image:IMAGE 10A,2X,5DRDD
1890 !
1900 ! ACCUMULATE TOTALS
1910 !
1920 Total=Total+PO
1930 Sub_total=Sub_total+PO
1940 Master_total=Master_total+PO
1950 NEXT Z
1960 !
1970 ! PRINT FINAL TOTALS
1980 !
1990 PRINT USING Sub_image;Sub_total
2000 PRINT USING Tot_image;VAL$(Prod_no),Total
2010 PRINT USING Mstr_image;Master_total
2020 DISP "REPORT COMPLETE."
2030 Sub_image:IMAGE 71X,8("-") / 71X,5DRDD /
2040 Tot_image:IMAGE 70X,9("=") / 11X,"TOTAL ORDERS FOR ",10A,
32 X,6DRDD /
2050 Mstr_image:IMAGE // 31X,"TOTAL ORDERS",24X,"$"8DRDD /
70X,9("=")
2060 STOP
2070 !
2080 ! ERROR AND HALT TERMINATION ROUTINES
2090 !
2100 Dberr:DISP LIN(2);"STATUS ERROR ";VAL(S(0));" IN LINE";S(6)
2110 STOP
2120 Error:DISP LIN(2);"UNEXPECTED ";ERRM$
2130 STOP
2140 Halt:PRINT LIN(2)
2150 DISP LIN(2);"PROGRAM TERMINATED."
2160 END
OUTSTANDING ORDERS LIST
PRODUCT ORDER NUMBER CUSTOMER NAME PRICE
50 (Tricycle)
110 Gissing, Malcom 45,00
--------
45,00
=========
TOTAL ORDERS FOR 50 45,00
100 (Standard Bicycle)
101 Noname, Joseph 75,00
Horn 2,50
--------
77,50
103 Hernandes, Jose 75,00
Light 5,00
Mud Flaps 7,25
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
SuperTire 18,00
Light 5,00
--------
133,00
=========
TOTAL ORDERS FOR 300 133,00
500 (5-Speed Bicycle)
100 Smith, Thomas A. 125,00
Light 5,00
Basketle 45,50
--------
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 FOR 500 435,50
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
TOTAL ORDERS $1368,25
=========
1000 !
1010 ! OUTSTANDING ORDERS REPORT (INCLUDING ALL DETAIL)
1020 !
1030 INTEGER S(9),Product_no,Prod_no
1040 DIM B$[12],P$[10],Buf$[170]
1050 DIM Desc$[30],Order_no$[30],Name$[30],Option_desc$[10]
1060 DISP " "; ! CLEAR SCREEN
1070 ON ERROR GOTO Error ! SET UP ERROR AND HALT TRAPS
1080 ON HALT GOTO Halt
1090 B$=" SAD,SALES"
1100 P$="MANAGER"
1110 DBOPEN (B$,P$,1,S(*)) ! OPEN DATA BASE
1120 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 IN DATA SET "CUSTOMER" USE ALL
1210 IN DATA SET "OPTION" USE SKIP 1,Option_desc$,PO
1220 !
1230 ! SET UP THE WORKFILE
1240 !
1250 ASSIGN "XYZ" TO #1,Z
1260 IF Z%<2 THEN Ok
1270 DISP "CAN'T ASSIGN THE WORKFILE!"
1280 STOP
1290 Ok: IF NOT Z THEN Aok ! CREATE WORK FILE IF NECESSARY
1300 FCREATE "XYZ",0
1310 ASSIGN "XYZ" TO #1
1320 Aok:WORKFILE IS #1;THREAD IS "CUSTOMER"
1330 !
1340 ! SORT THE STRUCTURE
1350 !
1360 SORT BY Product_no,Order_no$
1370 IF WFLEN(1) THEN Rep
1380 DISP "THERE ARE NO ENTRIES IN THE STRUCTURE TO REPORT ON."
1390 STOP
1400 !
1410 ! INITIALIZE VARIABLES & PRINT REPORT HEADER
1420 !
1430 Rep:Total=Master_total=0
1440 Prod_no=-1
1450 PRINT TAB(30);"OUTSTANDING ORDERS LIST";LIN(1)
1460 PRINT "PRODUCT";SPA(8);"ORDER NUMBER";SPA(10);"CUSTOMER
NAME";SPA(9);"OPTIONS";SPA(8);"PRICE";LIN(1);
RPT$("-",79);LIN(1)
1461 !
1462 ! PRODUCE THE REPORT
1463 !
1470 FOR Z=1 TO WFLEN(1)
1480 READ #1;R1
1490 DBGET (B$,"CUSTOMER",4,S(*),"@",Buf$,R1)
1500 IF S(0) THEN Dberr
1520 ! (SKIP IF SAME ORDER AS BEFORE, OR FIRST TIME THRU LOOP)
1530 !
1570 !
1580 ! PRINT TRAILER FOR PRODUCT (IF NEEDED)
1590 !
1600 ! (SKIP IF SAME PRODUCT AS BEFORE, OR FIRST TIME THRU LOOP)
1610 !
1620 Nosub:IF (Prod_no=Product_no) OR (Prod_no%<0) THEN Notot
1630 PRINT USING Tot_image;VAL$(Prod_no),Total
1640 Total=0
1650 !
1660 ! PRINT HEADER FOR PRODUCT (IF NEEDED)
1670 !
1680 Notot:IF Prod_no=Product_no THEN Skip1
1690 DBGET (B$,"PRODUCT",7,S(*),"@",Buf$,Product_no)
1700 IF S(0) THEN Dberr
1720 PRINT VAL$(Prod_no);" (";TRIM$(Desc$);")"
1730 !
1740 ! PRINT HEADER FOR ORDER
1750 !
1790 Skip1:PRINT TAB(20);Order_no$;TAB(38);Name$[1,21];
1810 !
1820 ! PRINT OPTIONS
1830 !
1835 DBFIND (B$,"OPTION",1,S(*),"ORDER-NO",Order_no$)
1836 IF S(0) THEN Dberr
1840 FOR C=1 TO S(5)
1845 DBGET (B$,"OPTION",5,S(*),"@",Buf$,0)
1850 IF S(0) THEN Dberr
1860 PRINT TAB(60);
1870 PRINT USING Itm_image;Option_desc$,PO
1880 Itm_image:IMAGE 10A,2X,5DRDD
1890 !
1900 ! ACCUMULATE TOTALS
1910 !
1920 Total=Total+PO
1930 Sub_total=Sub_total+PO
1940 Master_total=Master_total+PO
1945 NEXT C
1946 PRINT USING Sub_image;Sub_total
1947 Sub_total=0
1950 NEXT Z
1960 !
1970 ! PRINT FINAL TOTALS
1980 !
2000 PRINT USING Tot_image;VAL$(Prod_no),Total
2010 PRINT USING Mstr_image;Master_total
2020 DISP "REPORT COMPLETE."
2030 Sub_image:IMAGE 71X,8("-") / 71X,5DRDD /
2040 Tot_image:IMAGE 70X,9("=") / 11X,"TOTAL ORDERS FOR ",10A,
32X,6DRDD /
2050 Mstr_image:IMAGE // 31X,"TOTAL ORDERS",24X,
"$"8DRDD / 70X,9("=")
2060 STOP
2070 !
2080 ! ERROR AND HALT TERMINATION ROUTINES
2090 !
2100 Dberr:DISP LIN(2);"STATUS ERROR ";VAL$(S(0));" IN LINE";S(6)
2110 STOP
2120 Error:DISP LIN(2);"UNEXPECTED ";ERRM$
2130 STOP
2140 Halt:PRINT LIN(2)
2150 DISP LIN(2);"PROGRAM TERMINATED."
2160 END