3 Program Examples

Itemized Order List Programs

The remaining three programs are all extensions to the previous programs, in that the report is essentially the same, but each order has its option listed along with it. In example programs 3 and 4 the options are listed in sorted order. A report that could be printed by these programs is shown on page 3-7/8. Example program 5 lists the options in the order they occur along the chain in the OPTION detail. The report produced this program is shown on pages 3-14/15.

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).

Itemized Options List Report (sorted order)


                     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
                                                                  ---------

Example Program 3: A Four-set Thread

   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

Example Program 4: Using Only One Set Instead of Four


   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

Itemized Options List Report (unsorted order)


                     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
                                                                  =========

Example 5: Listing Options in Unsorted Order

   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

Eloquence Sort Manual - 19 DEC 2002