These programs are sample solutions to the problems given in the text. They are not meant to be the only way to solve a problem, instead they should give guidelines on how to write programs.
PROBLEM 1
/* list magazine subscriptions available */
FILE master IS "mag"
FIELDS IN master ARE
magazine, title,
subscribers;
MAIN
BEGIN
AT TOP OF PAGE
DO headings;
SELECT FROM master
SORTED BY magazine;
FOR EACH master
DO details;
END
PROCEDURE headings /* print page headings */
BEGIN
PRINT TAB(15), "M a g a z i n e L i s t",
TAB(60), $todays_date, TAB(70), "Page ",
$page, NL;
PRINT "Magazine", TAB(16), "Magazine Title",
TAB(55), "Number Subscribers", NL, NL;
END
PROCEDURE details /* print one magazine */
BEGIN
PRINT magazine, TAB(16), title, TAB(55),
subscribers, NL;
END
PROBLEM 2
/* list subscriptions by magazine */
FILE scripts IS "script" /* subscriptions file */
FILE sub IS "sub" /* subscriber file */
FILE mag IS "mag" /* magazine master file */
FIELDS IN scripts ARE
subscriber, magazine,
started, issues;
FIELDS IN sub ARE
subscriber, name;
FIELDS IN mag ARE
magazine, title;
MAIN
BEGIN
AT TOP OF PAGE
DO headings;
CHECK scripts, AT TOP OF magazine
DO new_magazine;
SELECT FROM scripts
SORTED BY magazine, subscriber;
FOR EACH scripts
DO details;
END
PROCEDURE headings /* print page headings */
BEGIN
PRINT TAB(20), "S u b s c r i p t i o n L i s t",
TAB(60), $todays_date:10, "Page ", $page, NL;
PRINT "Magazine Title", TAB(36), "Subscriber name",
TAB(72), "Issues", NL, NL;
END
PROCEDURE new_magazine /* lookup new magazine */
BEGIN
FIND IN mag
WHERE magazine EQ scripts.magazine;
PRINT NL, title;
END
PROCEDURE details /* print one subscription */
BEGIN
FIND IN sub
WHERE subscriber EQ scripts.subscriber
PRINT TAB(36), name, TAB(72), issues, NL;
END
PROBLEM 3
/* list subscription by magazine */
FILE scripts IS "script" /* subscriptions file */
FILE mag IS "mag" /* magazine file */
FILE sub IS "sub" /* subscriber file */
FIELDS IN scripts ARE
subscriber, magazine,
started;
FIELDS IN mag ARE
magazine, title,
subscribers;
FIELDS IN sub ARE
subscriber, name;
MAIN
BEGIN
AT TOP OF PAGE
DO headings;
SELECT FROM mag
WHERE subscribers GT 3
SORTED BY magazine;
FOR EACH mag
DO details;
END
PROCEDURE headings /* print page headings */
BEGIN
PRINT TAB(20), "M a g a z i n e L i s t",
TAB(60), $todays_date:10, "Page ", $page, NL;
PRINT "Magazine Title", TAB(36), "Subscriber Name",
TAB(72), "Started", NL, NL;
END
PROCEDURE details /* print one subscriber */
BEGIN
PRINT NL, title;
SELECT FROM scripts
WHERE magazine EQ mag.magazine;
FOR EACH scripts
DO a_magazine;
END
PROCEDURE a_magazine /* print one subscription */
BEGIN
FIND IN sub
WHERE subscriber EQ scripts.subscriber;
PRINT TAB(36), name, TAB(72), started, NL;
END
PROBLEM 4
/* produce mailing labels for a given magazine */
FILE scripts IS "script"
FILE sub IS "sub"
FIELDS IN scripts ARE
subscriber, magazine,
started, issues;
FIELDS IN sub ARE
subscriber, name,
address, city,
state, zip;
MAIN
BEGIN
SET PAGELENGTH := 9,
PAGEWIDTH := 40,
FIRSTLINE := 2,
LASTLINE := 8;
SELECT FROM scripts
WHERE magazine EQ "rd"
SORTED BY subscriber;
FOR EACH scripts
DO details;
END
PROCEDURE details
BEGIN
FIND IN sub
WHERE subscriber EQ scripts.subscriber;
PRINT magazine, TAB(20), issues, NL, NL;
PRINT name, NL,
address[1], NL;
IF address[2] NE "" THEN
PRINT address[2], NL;
PRINT city, ", ", state, " ", zip, BP;
END
PROBLEM 5
/* produce mailing labels for a given magazine */
FILE scripts IS "script"
FILE sub IS "sub"
FIELDS IN scripts ARE
subscriber, magazine,
started, issues;
FIELDS IN sub ARE
subscriber, name,
address, city,
state, zip;
MAIN
BEGIN
SET PAGELENGTH := $LABELLENGTH,
PAGEWIDTH := $LABELWIDTH,
FIRSTLINE := 2,
LASTLINE := $LABELLENGTH-1;
SELECT FROM scripts
WHERE magazine EQ $MAGAZINE
SORTED BY subscriber;
FOR EACH scripts
DO details;
END
PROCEDURE details
BEGIN
FIND IN sub
WHERE subscriber EQ scripts.subscriber;
PRINT magazine, TAB(20), issues, NL, NL;
PRINT name, NL,
address[1], NL;
IF address[2] NE "" THEN
PRINT address[2], NL;
PRINT city, ", ", state, " ", zip, BP;
END
PROBLEM 6
/* generate sequence numbers */
FILE mag IS "mag"
FILE script IS "script"
FIELDS IN mag ARE magazine, year_rate;
FIELDS IN script ARE subscriber, magazine;
VARIABLES ARE
digits, /* string of digits in $FIRSTINV */
fmtString, /* string to format sequence #'s */
prefix, /* constant invoice prefix */
sequence, /* sequence number counter */
key, /* next sequence key */
amount, /* amount of one subscription */
sub_total TOTAL OF amount,
grand_total TOTAL OF amount;
MAIN
BEGIN
/* look for all digits */
IF MATCH ($FIRSTINV, "^[0-9]\{1,\}$")
THEN BEGIN
prefix = ""
digits = RESULT (0);
END
/* look for prefix and digits */
ELSE IF MATCH($FIRSTINV, "\(.*[^0-9]\)\([0-9][0-9]*\)$")
THEN BEGIN
prefix = RESULT (1);
digits = RESULT (2);
END
/* don't know how to increment this one */
ELSE BEGIN
PRINT "Starting invoice '", $FIRSTINV,
"' does not end with digits.", NL;
RETURN;
END
/* establish formatting string */
fmtString = STRLEFT ("0000000000000000",
STRLEN (digits));
sequence = digits +0;
/* adding zero makes sequence a real */
CHECK script, AT END OF subscriber
DO print_invoice;
SELECT FROM script
SORTED BY subscriber, magazine;
FOR EACH script
DO accumulate_subscription
DO last_invoice;
END
/* compute charge for one subscription */
PROCEDURE accumulate_subscription
BEGIN
FIND IN mag
WHERE magazine EQ script.magazine;
IF ERROR (mag) THEN BEGIN
PRINT "No magazine master for: ",
script.magazine, NL;
RETURN;
END
/* charge one year for each subscription */
amount = year_rate;
END
/* print next invoice and subscriber amount */
PROCEDURE print_invoice
BEGIN
DO next_invoice;
PRINT "Invoice: ", key,
", Amount: ", sub_total, NL;
END
/* print final summary */
PROCEDURE last_invoice
BEGIN
DO next_invoice;
PRINT "Next invoice to use is: ",
key, NL;
END
/* generate next invoice number */
PROCEDURE next_invoice
BEGIN
key = prefix @ FORMAT (sequence, fmtString);
IF key EQ prefix THEN BEGIN
PRINT "WARNING: sequence number has",
" overflowed, adding extra digit",
" to sequence.", NL;
fmtString = fmtString @ "0"
key = prefix @ FORMAT (sequence, fmtString);
END
sequence = sequence + 1;
END
PROBLEM 7
/* print invoices */
FILE scripts IS "script" /* subscriptions file */
FILE cust IS "sub" /* subscriber file */
FILE mags IS "mag" /* magazine file */
FIELDS IN scripts ARE
subscriber, magazine, started;
FIELDS IN cust ARE
subscriber, name, address,
city, state, zip;
FIELDS IN mags ARE
magazine, title, year_rate;
VARIABLES ARE
amount_due,
invoice_total TOTAL OF amount_due,
first_script;
MAIN
BEGIN
/* set up for invoice forms */
SET PAGELENGTH := 56,
FIRSTLINE := 2,
LASTLINE := 54;
AT TOP OF PAGE
DO headings;
CHECK scripts, AT TOP OF subscriber
DO new_sub;
CHECK scripts, AT BOTTOM OF subscriber
DO close_invoice;
SELECT FROM scripts
SORTED BY subscriber, magazine;
FOR EACH scripts
DO details;
END
PROCEDURE headings /* print form headings */
BEGIN
PRINT "Invoice"
SKIP TO LINE (5);
PRINT "From:", NL,
TAB(3), "Marvelous Magazines Subscription House", NL,
TAB(3), "2709 Demo Rd", NL,
TAB(3), "Suite 1309", NL,
TAB(3), "Bellingham WA, 98225"
SKIP TO LINE(16);
PRINT TAB(4), "To:", TAB(10), name,
TAB(54), "Date: ", $todays_date, NL,
TAB(10), address[1],
TAB(54), "Cust#: ", cust.subscriber, NL;
IF address[2] NE "" THEN
PRINT TAB(10), address[2], NL;
PRINT TAB(10), city, ", ", state, " ", zip;
SKIP TO LINE(25);
PRINT "Terms: Net 30 Days"
SKIP TO LINE(31);
PRINT "Date", TAB(13), "Magazine", TAB(64), "Amount", NL,
"Ordered"
SKIP TO LINE(36);
first_script := $TRUE;
END
PROCEDURE new_sub /* look up new subscriber */
BEGIN
FIND IN cust
WHERE subscriber EQ scripts.subscriber;
END
PROCEDURE details /* print one subscription */
BEGIN
FIND IN mags
WHERE (magazine EQ scripts.magazine);
amount_due := year_rate;
PRINT started, TAB(13), title, TAB(64);
IF first_script THEN
PRINT amount_due USING "$#,##0.00", NL;
ELSE
PRINT amount_due USING "##,##0.00", NL;
first_script := $FALSE;
END
PROCEDURE close_invoice /* finish current invoice */
BEGIN
PRINT NL, TAB(63), "----------", NL,
TAB(13), "Total Amount Due", TAB(64),
invoice_total USING "$#,##0.00", NL;
PRINT BP;
END