IMD 1.16: 29/05/2007 19:04:50 FOGCPM.089 --FOGCPM089IOMENU CMDIOPOST CMD IOREVIEWCMD JOBCOSTSCMD9 JOBCOSTSFRMJOBSINDXCMDMEDIA FRM NAMETESTCMDPAYBILLSCMDI !"#$%&PAYEMPS CMD'()PAYFIND CMD(*+,-.PAYMENU CMD/01PAYROLL CMDh23456789:;<=>PERSONNEDBF?POSTFILEDBF@APRINTOUTCMD BCREPORTMECMDDEFREVHDR CMD GHREVIEW CMDRIJKLMNOPQRSREVMRGN CMDTSALESTAXCMD*UVWXYZSUPPLIERDBF [\TIMECALCCMD ]^_`USETAX CMD#abcdeDBDIR COM fgDBDIR DOChDBDIR ASM8ijklmnoDBDIR CMD&pqrstDBUTILS DOCCuvwxyz{|}TEST DBF~AVE CMD BLANK CMDDATE CMDDBSC CMDDELDUP CMD JULIAN CMDLSQ CMDMAX CMD MIN CMDMLR CMD(PLOT CMD9PLOT0 CMD PLOT1 CMD PLOT2 CMD XSMOOTH CMDXSMOOTH DBF-07-00 86 -CPM089 DOC&This is the disk name. * ********** IOMENU COMMAND FILE ************ * Selects the appropriate action to be taken with insertion orders * (instructions from our ad agency to magazine publishers). ********************************************************************* STORE T TO Inserting DO WHILE Inserting ERASE @ 7,20 SAY ' 1> ENTER INSERTION ORDERS' @ 9,20 SAY ' 2> EDIT INSERTION ORDERS' @ 11,20 SAY ' 3> REVIEW/PRINT INSERTION ORDERS' @ 12,20 SAY ' BY CLIENT & MAGAZINE' @ 14,20 SAY ' ' WAIT TO Action IF Action = '1' DO IOPost ELSE IF Action = '2' STORE "Y" TO Changing DO WHILE !(Changing)='Y' USE B:Inserts IF EOF ? 'There are no entries in the INSERTION ORDER file.' STORE 'N' TO Changing ELSE STORE IO:Nmbr TO First GO BOTTOM STORE IO:Nmbr TO Last ERASE @ 3,15 SAY 'EDITING INSERTION ORDERS '+First+'thru '+Last @ 5,15 SAY '^W to SAVE, ^Q to CANCEL changes you make.' @ 6,15 SAY '^R for PREVIOUS, ^C for NEXT record if MORE = T' ? ? ACCEPT 'Which ORDER NUMBER do you want to EDIT?' TO Order USE B:Inserts INDEX B:Inserts FIND &Order IF # = 0 ? ? ? 'That insertion order is not in the file.' ? 'Do you want to continue (Y or N)?' WAIT TO Changing ELSE STORE STR(#,5) TO Number EDIT &Number REPLACE Client WITH !(Client), Ad WITH !(Ad),Magazine WITH; !(Magazine) ? ? 'Do you want to edit any other insertions orders (Y or N)?' WAIT TO Changing ENDIF ENDIF ENDDO Changing  RELEASE All ELSE IF Action = '3' DO IOReview ELSE RELEASE All RETURN ENDIF 3 ENDIF 2 ENDIF 1 STORE T TO Inserting ENDDO Inserting  DO ReportMe ELSE IF Action = '7' ERASE @ 5,10 SAY ' HELP file not ready yet.' ? ' to continue.'  ? 'Do you want to continue (Y or N)?' WAIT TO Changing ELSE STORE STR(#,5) TO Number EDIT &Number REPLACE Client WITH !(Client), Ad WITH !(Ad),Magazine WITH; !(Magazine) ? ? 'Do you want to edit any other insertions orders (Y or N)?' WAIT TO Changing ENDIF ENDIF ENDDO Changing * *********** IOPOST COMMAND FILE ***************** * Gets information for insertion orders (instruction to magazine * publishers from our ad agency). Works much like Postbills and * Posttime. ********************************************************************* RESTORE FROM B:Constant DO GetDate USE B:Inserts COPY STRUCTURE TO GetInser USE GetInser STORE Client TO MClient STORE ' ' TO New STORE 'Y' TO Inserting DO WHILE !(Inserting) <> 'F' APPEND BLANK STORE STR(#,5) TO Number REPLACE IO:Date WITH Date, IO:Nmbr WITH Next:IO ERASE * Next loop is used when there has been an error in the entry * (defined as no client or no rate). STORE 'T' TO Incorrect DO WHILE !(Incorrect) <> 'F' ERASE @ 4,0 SAY ' INSERTION ORDER: '+IO:Nmbr @ 4,30 SAY ' DATE:'+Date ? @ 6,0 SAY ' RECORD NUMBER: '-Number IF !(New) = 'S' @ 7,0 SAY ' OUR CLIENT :' + MClient ELSE @ 7,0 SAY ' OUR CLIENT ' GET MClient STORE !(MClient) TO MClient ENDIF @ 8,0 SAY ' JOB NUMBER ' GET Job:Nmbr @ 9,0 SAY ' AD DESCRIPTION ' GET Ad @ 10,0 SAY ' HOW MUCH SPACE ' GET Space @ 11,0 SAY ' WHICH MAGAZINE ' GET Magazine @ 12,0 SAY ' WHICH ISSUE ' GET Issue @ 13,0 SAY 'GROSS SPACE COST ' GET Gross:Cost @ 14,0 SAY ' DISCOUNT RATE ' GET Times READ REPLACE Net:Cost WITH Gross:Cost*0.8500, Client WITH MClient,; Ad WITH !(Ad), Magazine WITH !(Magazine), Issue WITH !(Issue) @ 7,18 SAY Client @ 9,18 SAY Ad @ 11,18 SAY Magazine @ 12,18 SAY Issue @ 15,18 SAY ' NET SPACE COST ' GET Net:Cost IF Client <> ' ' .AND. Gross:Cost > 0 .AND. Job:Nmbr > 99 @ 18,5 SAY ' C to CHANGE,' @ 19,5 SAY ' to continue.' ? WAIT TO New IF !(New) = 'C' STORE 'T' TO Incorrect ELSE @ 17,5 SAY ' F if FINISHED,' @ 18,5 SAY ' S for SAME insertion order,' @ 19,5 SAY ' for NEXT insertion order.' @ 21,0 SAY ' ' ACCEPT TO New IF !(New) <> 'S' IF VAL(Next:IO) < 9999 STORE STR(VAL(Next:IO)+1,4) TO Next:IO ELSE STORE '1001' TO Next:IO ENDIF ENDIF STORE 'F' TO Incorrect ENDIF STORE New TO Inserting ELSE ? ? ? ? ? ? ? ' CLIENT, JOB or RATE missing.' ? ? ' F if FINISHED,' ? ' to correct the record.' ? WAIT TO Inserting IF !(Inserting) = 'F' DELETE RECORD &Number STORE 'F' TO Incorrect ELSE STORE 'T' TO Incorrect ENDIF ENDIF ENDDO Incorrect ENDDO Inserting RELEASE Date, NoDate, Inserting, Number, Update, New, Incorrect SAVE TO B:Constant COUNT FOR .NOT. * TO Any ERASE IF Any = 0 ? 'No insertions to add to the file.' ? 'Press any key to continue.' USE WAIT ELSE @ 5,10 SAY 'To print the insertions you just entered,' @ 6,10 SAY 'press .' WAIT TO Number *"Number" determines the starting record number for the printout. SET PRINT ON ? 'IO # MAGAZINE ISSUE JOB AD '; +'SPACE GROSS NET X DATE' ? * "Output" and "Condition" needed in the Printout Command file STORE 'Y' TO Output STORE 'OFF' TO Condition DO Printout ERASE @ 5,20 SAY'UPDATING THE INSERTION ORDER FILE' USE B:Inserts Index B:Inserts APPEND FROM GetInserts ENDIF DELETE FILE GetInserts RELEASE All RETURN ect ELSE STORE 'T' TO Incorrect ENDIF ENDIF ENDDO Incorrect ENDDO Inserting RELE* *************** IOREVIEW COMMAND FILE ************ * Provides insertion insertion order displays and printout. * The operator can select all the insertions for the client. * or can select only those for a particular magazine. *************************************************************** SET TALK OFF USE B:Inserts STORE ' ' TO Again DO WHILE !(Again) <> 'F' STORE ' ' TO MClient STORE ' ' TO MMagazine STORE ' ' TO Hardcopy STORE ' ' TO Other ERASE @ 2,11 SAY ' MEDIA SUMMARY:' @ 4,11 SAY 'ENTER CLIENT CODE' GET MClient @ 5,11 SAY ' MAGAZINE NAME?' GET MMagazine @ 6,11 SAY ' P to PRINT' GET Hardcopy READ IF MClient = ' ' @ 9, 0 SAY ' ' ? ' CLIENT missing.' ? ' F if Finished,' ? ' to continue.' WAIT TO Again ELSE STORE !(MClient) TO MClient STORE !(MMagazine) TO MMagazine STORE !(Hardcopy) TO Hardcopy @ 4,29 SAY MClient @ 5,29 SAY MMagazine @ 6,29 SAY Hardcopy @ 9, 0 SAY ' ' ? ? ACCEPT 'Type C to CHANGE any entries' TO Changes IF !(Changes) = 'C' STORE ' ' TO Again ERASE ELSE IF MMagazine >' ' STORE TRIM(MMagazine) TO MMagazine STORE '.AND. Magazine=MMagazine' TO Condition ELSE STORE CHR(0) TO Condition ENDIF IF !(Hardcopy) = 'P' STORE 'TO PRINT' TO Hardcopy ELSE STORE CHR(0) TO Hardcopy ENDIF Hardcopy SET HEADING TO MEDIA SUMMARY FOR &MClient &MMagazine REPORT FORM Media &Hardcopy FOR Client=MClient &Condition ? ? ' F if Finished,' ? ' to continue.' WAIT TO Again ERASE ENDIF okay to do the report ENDIF ENDDO Again ERASE RELEASE All RETURN * *********** JOBCOSTS COMMAND FILE ***************** * Provides summaries of costs by client and job number. This can * also be used to summarize all office categories, since they fall * into these fields. * REPORTS ARE BY JOB NUMBER. Client code is used only in the heading. * The report is actually prepared based on the job number, so accuracy is * critical. * This file works with a partially indexed costbase, so "Unindexed" is * used to keep track of how many records are not in the index. If this gets * beyond a specific number, the operator is prompted to reindex the Costbase. ************************************************************************** SET TALK OFF RESTORE FROM B:Constant DO GetDate STORE 0 TO Unindexed STORE ' ' TO Again DO WHILE !(Again) <> 'F' STORE ' ' TO MClient STORE ' ' TO MJob:Nmbr STORE ' ' TO Hardcopy STORE 'N' TO Number ERASE @ 2,11 SAY ' JOB COST SUMMARY :' @ 4,11 SAY 'ENTER CLIENT CODE ' GET MClient @ 5,11 SAY ' ENTER JOB NUMBER ' GET MJob:Nmbr @ 6,11 SAY ' P to PRINT ' GET Hardcopy @ 7,11 SAY 'SHOW BILL NUMBERS ' GET Number READ ? IF MClient = ' ' .OR. MJob:Nmbr = ' ' @ 9, 0 ? ' CLIENT or JOB NUMBER missing.' ? ' F if Finished,' ? ' to continue.' WAIT TO Again ELSE @ 8,0 SAY CHR(27)+CHR(74) ACCEPT ' OPTIONAL JOB DESCRIPTION ' TO Message STORE TRIM(!(Message)) TO Message STORE !(MClient) TO MClient STORE !(Hardcopy) TO Hardcopy STORE !(Number) TO Number @ 4,30 SAY MClient @ 6,30 SAY Hardcopy @ 7,30 SAY Number @ 9,30 SAY Message ? ? ACCEPT 'Type C to CHANGE any entries' TO Changes IF !(Changes) = 'C' STORE ' ' TO Again ERASE ELSE ERASE IF !(Hardcopy) = 'P' STORE "TO PRINT" TO Hardcopy SET PRINT ON ENDIF Hardcopy IF Number = 'Y' STORE 'Bill #' TO Other ELSE STORE CHR(0) TO Other ENDIF ? $(Date,3,2)+'/'+$(Date,5,2)+'/'+$(Date,1,2)+': COST SUMMARY FOR '; +'&MClient-&MJob:Nmbr' ? ' ' + Message ? ? 'DATE NAME DESCRIPTION AMOUNT'; +' &Other' ? USE B:CostBase INDEX B:$Jobs IF Number = 'Y' STORE ',Bill:Nmbr' TO Other ELSE STORE CHR(0) TO Other ENDIF STORE 0 TO Sum STORE 0 TO HowMany STORE 0 TO LineCnt STORE 0 TO Spacer FIND &MJob:Nmbr IF # <> 0 DO WHILE Job:Nmbr = VAL(MJob:Nmbr) .AND. .NOT. EOF DISPLAY Next 1 Bill:Date,Name,Descrip+' ',Amount &Other OFF STORE Sum + Amount TO Sum STORE LineCnt + 1 TO LineCnt STORE Spacer + 1 TO Spacer IF Spacer = 10 ? STORE 0 TO Spacer ENDIF IF LineCnt = 50 ? CHR(12) STORE 0 TO LineCnt STORE 0 TO Spacer ? 'DATE NAME DESCRIPTION'; +' AMOUNT' ? ENDIF SKIP ENDDO ENDIF GO TOP IF Job:Nmbr <> 0 ? 'TIME OUT... MUST reindex COSTBASE' ? ' am switching you back to the menu' ? ' RUN item 5>... then come back and run this.' RELEASE ALL RETURN ENDIF STORE VAL(Name) TO LastReco USE B:CostBase STORE 0 TO Unindexed GOTO LastReco SKIP DO WHILE .NOT. EOF DISPLAY NEXT 1 Bill:Date, Name, Descrip+' ', Amount; FOR Job:Nmbr = VAL(MJob:Nmbr) OFF IF Job:Nmbr = &MJob:Nmbr STORE Sum + Amount TO Sum STORE LineCnt + 1 TO LineCnt STORE Spacer + 1 TO Spacer IF Spacer = 10 ? STORE 0 TO Spacer ENDIF IF LineCnt = 50 ? CHR(12) STORE 0 TO LineCnt STORE 0 TO Spacer ? 'DATE NAME DESCRIPTION'; +' AMOUNT' ? ENDIF ENDIF STORE Unindexed + 1 TO Unindexed SKIP ENDDO ? ? ' TOTAL COSTS TO DATE: ' -; STR(Sum,9,2) STORE LineCnt + 2 TO LineCnt STORE 0 TO Spacer IF LineCnt = 40 ? CHR(12) STORE 0 TO LineCnt ELSE ? ?  ? ENDIF USE B:Billings ? 'BILLED TO DATE FOR &MClient-&MJob:Nmbr' ? ? 'DATE INV# DESCRIPTION TAXABLE'+; ' TAX TAX FREE' ? STORE LineCnt + 4 TO LineCnt STORE 0 TO Sum STORE 0 TO T STORE 0 TO S STORE 0 TO F DO WHILE .NOT. EOF IF Job:Nmbr = &MJob:Nmbr DISPLAY Next 1 Inv:Date, Inv:Nmbr, Descrip,STR(Taxable,9,2)+' '; STR(Sales:Tax,9,2)+' ',TaxFree FOR Job:Nmbr = &MJob:Nmbr OFF STORE T + Taxable TO T STORE S + Sales:Tax TO S STORE F + TaxFree TO F STORE Sum + Taxable + Sales:Tax + TaxFree TO Sum STORE LineCnt + 1 TO LineCnt STORE Spacer + 1 TO Spacer IF Spacer = 10 ? STORE 0 TO Spacer ENDIF IF LineCnt = 50  ? CHR(12) STORE 0 TO LineCnt STORE 0 TO Spacer ? 'DATE INV# DESCRIPTION TAXABLE TAX TAX FREE' ? ENDIF ENDIF SKIP ENDDO ? ? ' SUB-TOTALS : '+STR(T,9,2) + ' '; + STR(S,9,2)+' ' + STR(F,9,2) ? ? ' TOTAL BILLED TO DATE: ' -; STR(Sum,9,2) ? CHR(12) SET PRINT OFF ? ' F if FINISHED,' ? ' to continue.' WAIT TO Again ENDIF ok to do the report ENDIF ENDDO Again IF Unindexed > 50 ERASE @ 5,0 ? ' There are ' - STR(Unindexed,9) + 'unindexed records' ? ' in the Costbase. To speed up the Job Costs procedure,' ? ' please reindex from the next menu.' ? ' to continue.' WAIT  ENDIF RELEASE All RETURN  INV# DESCRIPTION TAXABLE TAX TAX FREE' ? ENDIF ENDIF SKIP ENDDO ? ? ' SUB-TOTALS : '+STR(T,9,2) + ' '; + STR(S,9,2)+' ' + STR(F,9,2) ? ? ' TOTAL BILLED TO DATE: ' -; STR(Sum,9,2) ? CHR(12) SET PRINT OFF ? ' F if FINISHED,' ? ' to continue.' WAIT TO Again ENDIF ok to do the report ENDIF ENDDO Again IF Unindexed > 50 ERASE @ 5,0 ? ' There are ' - STR(Unindexed,9) + 'unindexed records' ? ' in the Costbase. To speed up the Job Costs procedure,' ? ' please reindex from the next menu.' ? ' to continue.' WAIT  N N Y N 9,BILL:DATE DATE 22,NAME SUPPLIER.............. 17,DESCRIP DESCRIPTION...... 12,AMOUNT AMOUNT Y * ************* JOBSINDX COMMAND FILE **************************** * Indexes the costbase on job numbers to B:Jobs.NDX. * The method of indexing here allows us to use the index to help * find job numbers for the Job Costs command files, but allows us to * do so without having to index the costbase every time we add a bill. * The strategy is: before we index the Costbase on job numbers, * we first store the number of the last record in a record with a job * number of zero. When the file is indexed, this record is at the top * of the indexed file ($Jobs) so that we can find it whenever we want to. ************************************************************************** USE B:CostBase GO BOTTOM STORE STR(#,5) TO Temp * HAVE TO ADD A PATCH HERE TO MAKE THIS RUN STORE ' ' TO Code GO TOP IF Job:Nmbr = 0 REPLACE Name WITH Temp ELSE * DO WHILE !(Code) <> 'H' ? "Uh, Oh-- trouble. Don't touch anything" GO TOP INSERT BEFORE BLANK REPLACE Job:Nmbr WITH 0 REPLACE Name WITH Temp * ENDDO ENDIF DELETE FILE B:$Jobs.NDX ERASE @ 5,0 SAY 'There are ' + Temp + ' records to index.' SET TALK ON INDEX ON Job:Nmbr TO B:$Jobs SET TALK OFF RELEASE Temp, Code RETURN  1932 0 0 6 0 7 ASAL FIT SDI SDISAL '+; 'SIT UISal' ? LIST OFF SET MARGIN TO 38 ? CHR(12) SET PRINT OFF ERASE @ 3,25 SAY "*** DO NOT INTERRUPT ***" @ 5,25 SAY " UPDATING THE COSTBASE" ? CHR(7) USE B:CTH Temp * ENDDO ENDIF DELETE FILE B:$Jobs.NDX ERASE @ 5,0 SAY 'There are ' + Temp + ' records to index.' SET TALK ON INDEX ON Job:Nmbr TO B:$Jobs SET TALK OFF RELEASE Temp, Code RETURN M=8 n n y n 6,IO:NMBR IO # 15,MAGAZINE MAGAZINE 7,ISSUE ISSUE 6,CLIENT+STR(JOB:NMBR,3) JOB # 15,AD AD 9,GROSS:COST $GROSS Y  RELEASE All ELSE IF Action = '3' DO IOReview ELSE RELEASE All RETURN ENDIF 3 ENDIF 2 ENDIF 1 STORE T TO Inserting ENDDO Inserting  DO ReportMe ELSE IF Action = '7' ERASE @ 5,10 SAY ' HELP file not ready yet.' ? ' to continue.'  ************* NAMETEST COMMAND FILE ************** * Checks names in the file in USE against the Suppliers file and gives * the operator the options of editing, adding them to the Suppliers file * or ignoring them. If a name is edited, it is presented again. ********************************************************************** GO TOP DO WHILE .NOT. EOF IF * SKIP ELSE STORE STR(#,5) TO Number STORE !(Name) TO Name ERASE @ 4,25 SAY 'CHECKING NAMES ' @ 6,25 SAY 'RECORD '+Number @ 7,25 SAY Name ? CHR(7) STORE $(Name,1,10) to Key SELECT SECONDARY USE B:Supplier INDEX B:Supplier FIND &Key STORE T TO Again STORE 'T' TO Decision IF # = 0 DO WHILE Again @ 9,20 SAY 'THIS SUPPLIER NAME IS NOT IN THE SUPPLIERS FILE. ' @ 11,20 SAY ' E to EDIT it. ' @ 12,20 SAY ' A to ADD it to the SUPPLIERS file. ' @ 13,20 SAY ' C to CONTINUE. ' ? WAIT TO Decision IF !(Decision) = 'A' APPEND SKIP-1 REPLACE Name WITH !(Name),Address WITH !(Address),City WITH; !(City) STORE F TO Again ELSE IF !(Decision) = 'E' SELECT PRIMARY EDIT &Number REPLACE Name WITH !(Name) SELECT SECONDARY STORE F TO Again ELSE IF !(Decision) = 'C' STORE F TO Again ELSE STORE T TO Again ENDIF C ENDIF E ENDIF A ENDDO ENDIF 0 SELECT PRIMARY IF !(Decision) <> 'E' SKIP ENDIF ENDIF deleted ENDDO RELEASE All RETURN  *********** PAYBILLS COMMAND FILE ********* * Before this proceedure can be accessed, the check number and balance must * be verified in the PAYMENU command file. * This is one of the longer files, but the individual portions of it are * not too complicated. Repetitive proceedures in the main loop (controlled * by the variable "Finished") could have been put in separate command files * to make this file easier to understand and maintain, but this way it * minimizes disk accesses and increases speed. * This file finds bills to be paid in the CostBase, generates the next * check number, writes a check in the CheckFil, and maintains the checkbook * balance. * The next check number and checkbook balance are recalled from a file * called Constant.MEM. The final values for both of these are stored in the * same file after all the bills have been paid. * The date is entered once at the start of the procedure, then * is automatically inserted into each entry. The date is checked to * see that i t is in the YYMMDD format, and that the values are within * possible limits (month from 1 to 12, day from 1 to 31, year=ThisYear). * Entries must include at least the name of the party being paid. * Balances are automatically computed and shown to the operator. * Check numbers are automatically assigned by the computer. * If several entries are made against a single check number (the * operator has this option), these are added and shown as a single * item in the printout. ************************************************************************* RESTORE FROM B:Constant DO GetDate SELECT PRIMARY USE B:CostBase INDEX B:$Supp * Initialize. "New" is used to determine whether the program should generate * a new check number or use the old one (where several bills to a single * supplier are being paid). "Finished" is the control variable that determines * whether we should run through the procedure again, or are done paying bills. STORE 'N' TO New STORE 'N' TO Finished DO WHILE !(Finished) <> 'F' STORE "C" TO Entering DO WHILE !(Entering) = 'C' ERASE @ 3, 0 SAY 'CHECK NUMBER: '+NextCheck+' BALANCE: '+STR(MBalance,9,2) ? CHR(7) @ 4,0 ACCEPT ' MAKE CHECK TO ' TO MName ACCEPT 'THEIR BILL NUMBER ' TO MBill:Nmbr ACCEPT ' ENTER AMOUNT ' TO Temp STORE !(MName) TO MName STORE !(MBill:Nmbr) TO MBill:Nmbr STORE VAL(Temp) TO MAmount STORE MAmount*1.00 TO MAmount @ 6,24 SAY ' ' @ 6,24 SAY MName @ 7,20 SAY ' ' @ 7,21 SAY MBill:Nmbr @ 8,19 SAY MAmount @ 11, 0 SAY ' C to CHANGE,' ? ' to continue.' WAIT TO Entering ENDDO Entering IF LEN(MName) > 10 STORE $(MName,1,10) TO Key ELSE STORE MName TO Key ENDIF IF KEY > ' ' STORE T TO Looking @ 11, 0 SAY "I'M LOOKING, I'M LOOKING!!" @ 12,0 @ 13,0 STORE 0 TO Start FIND &Key IF # = 0 ? ? " GEE, I CAN'T FIND THE NAME. Please check the spelling." ? " Or maybe it hasn't been posted to the COSTBASE yet." ? ' to continue.' WAIT ERASE ELSE DO PayFind ENDIF there is an unpaid bill for the supplier * "Start" is brought in from PayFind.CMD. If we started at the first * entry for a name (had only the name), Start=0. If we had more than * the name, Start contains the record number we started on. Since this * could be in the middle of the listing, we use "Counter" so that we can * come back to the top of the listing for the name once. IF Start > 0 STORE 0 TO Counter ELSE STORE 1 TO Counter ENDIF STORE ' ' TO Confirm DO WHILE !(Confirm) <> 'P' .AND. .NOT. Looking @ 9,0 ? 'RECORD NAME AMOUNT BILL #'; +' DATE' ? DISPLAY ' '+Name, Amount, Bill:Nmbr, Bill:Date ? ? CHR(7) ? ' P to PAY this bill,' ? ' Q to QUIT without paying,' ? ' to continue.' ACCEPT ' ' TO Confirm IF !(Confirm) = 'Q' IF !(New) = 'S' STORE STR(VAL(NextCheck)+1,4) TO NextCheck ENDIF STORE ' ' TO New STORE T TO Looking ELSE IF !(Confirm) = 'P' STORE STR(#,5) TO Found REPLACE Check:Date WITH Date, Check:Nmbr WITH NextCheck STORE (MBalance-Amount) TO MBalance SELECT SECONDARY USE B:CheckFil APPEND BLANK REPLACE Check:Date WITH P.Check:Date, Name WITH P.Name,; Check:Nmbr WITH P.Check:Nmbr, Balance WITH MBalance,; Amount WITH P.Amount, Bill:Nmbr WITH P.Bill:Nmbr SELECT PRIMARY ERASE @ 3, 0 SAY 'CHECK WRITTEN: '+NextCheck+; ' NEW BALANCE: '+STR(MBalance,9,2) ? DISPLAY 'PAYMENT MADE: '+Check:Date, Name, Amount, Bill:Nmbr,; Bill:Date OFF ? ? ' S for SAME SUPPLIER (Repeats check #)' ? CHR(7) ACCEPT ' to continue.' TO New IF !(New) <> 'S' STORE STR(VAL(NextCheck)+1,4) TO NextCheck ELSE STORE ' ' TO Confirm ENDIF ENDIF IF !(NEW) = 'S' .OR. !(CONFIRM) <> 'P' * If Confirm <> 'P', we rejected the first unpaid bill that was * shown. Rather than going back to the beginning, the loop * below SKIPs to the next INDEXed name until we find an unpaid * bill, or go beyond the records for the name we are paying. * The same applies if we want to pay another bill to the * same supplier (New='S'). Since we are in the file on the name * we want we SKIP to the next record until we find an unpaid * bill or run out of records for that name. * If we had only the name and started with the first unpaid * bill we stop now since we have looked at all the unpaid bills * for that supplier. * If we could have entered th e list of records for the * supplier in the middle (more than the name provided), we look * at the unpaid bills between where we are and the end of the * list, then go up to the first entry for that name and check * all of the unpaid bills that we had previously skipped past. * This is controlled by Counter. * After the second FIND in the command file (below), we * stop looking when the record number we are on is greater than * or equal to the number of the record we start on (Start). SKIP DO WHILE Check:Nmbr <> ' ' .AND. Name=Key .AND. .NOT. EOF SKIP ENDDO * We enter this loop when we reach the end of the records with * names that match the one we are looking for. If we started * with the first unpaid bill, the record number is greater than * Start (because Start=0) and Counter=1 (because we set it to * that value). The second IF below is True and we terminate the * search. * If Start>0, Counter=0 the first time we run out of * records with a matching name, so the program daes the ELSE * commands below. * Start is still >0 and Count is now 1, so the last term in * the first IF applies. On this second pass when we get to a * record number >=Start, we drop into the loop and do the IF to * terminate the search because we have now looked at all the * unpaid bills for the name we entered. IF EOF .OR. Name <> Key .OR. (# >= Start .AND. Start <> 0; .AND. Counter >0) IF (# >= Start .AND. Counter > 0) STORE T TO Looking @ 4, 0 ? CHR(27)+CHR(74) ? ' We have now looked at all the entries for '+ MName ? ' to continue.' ? CHR(7) IF !(New)='S' STORE STR(VAL(NextCheck)+1,4) TO NextCheck STORE 'N' TO New ENDIF WAIT ELSE STORE Counter +1 TO Counter @ 13, 0 @ 16, 0 SAY "I'M WORKING AS FAST AS I CAN -- HANG ON! " FIND &Key DO WHILE Check:Nmbr <> ' ' SKIP ENDDO ENDIF ENDIF ENDIF is it the right record ENDIF ENDDO Confirm the record ENDIF IF !(New) <> 'S' @ 4, 0 ? CHR(27)+CHR(74) ? ' F if FINISHED, ' ? CHR(7) ACCEPT ' to continue.' TO Finished ENDIF ENDDO Finished RELEASE MName, MBill:Nmbr, Key, MAmount, Start, Found, Looking, New, Change,; Entering, Counter, Temp, Abort, Continue, Finished, Confirm, Date SAVE TO B:Constant USE B:CheckFil COUNT FOR .NOT. * TO Any ERASE @ 3,0 IF Any=0 ? ' No new checks in the checkfile.' ? ' to continue.' WAIT ELSE ? 'There are '-STR(Any,5)+' new checks in the CheckFile.' ? 'Do you want to print the checkstubs now (Y or N)?' ? WAIT TO Hardcopy IF !(Hardcopy) = 'Y' DO NameTest DO CheckStu ENDIF ENDIF RELEASE ALL RETURN  ENDDO ENDIF ENDIF ENDIF is it the right record ENDIF ENDDO Confirm the record ENDIF IF !(New) <> 'S' @ 4, 0 ? CHR(27)+CHR(74) ? ' F if FINISHED, ' ? CHR(7) ACCEPT ' to continue.' TO Finished ENDIF ENDDO Finished RELEASE MName, MBill:Nmbr, Key, MAmount, Start, Found, Looking, New, Change,; Entering, Counter, Temp, Abort, Continue, Finished, Confirm, Date SAVE TO B:Constant USE B:CheckFil COUNT FOR .NOT. * TO Any ERASE @ 3,0 IF Any=0 ? ' No new checks in the checkfile.' ? ' to continue.' WAIT ELSE ? 'There are '-STR(Any,5)+' new checks in the CheckFile.' ? 'Do you want to print the checkstubs now (Y or N)?' ? WAIT TO Hardcopy IF !(Hardcopy) = 'Y' DO NameTest DO CheckStu ENDIF ENDIF RELEASE ALL RE*************** PAYEMPS.CMD COMMAND FILE *************************** * Does normal payroll processing or exceptions. ******************************************************************** SET TALK OFF STORE T TO Salaries DO WHILE Salaries ERASE @ 3,20 SAY ' PAYROLL FUNCTIONS ' @ 6,20 SAY ' 1> NORMAL PAYROLL ' @ 7,20 SAY ' 2> PARTIAL PAYMENT(S) ' @ 8,20 SAY ' 3> SKIP EMPLOYEE(S) ' @ 10,20 SAY ' ' WAIT TO Action IF Action = '1' DO Payroll ELSE IF Action = '2' ERASE ? ? ? ? 'This procedure allows you to pay less than a full salary if' ? 'for some reason an employee skipped days of work that are ' ? 'not to be paid for. Do you want to continue (Y or N)?' WAIT TO Continue IF !(Continue) = 'Y' RESTORE FROM B:Constant USE B:Personne ? 'Select the employee number for partial payment:' ? ' (Type 0 to quit.)' ? ?'NO. NAME % OF PAY' LIST Name, Ratio*100 FOR .NOT. * ?   INPUT 'Which number(0 to quit)?' TO Wipe STORE INT(Wipe) TO Wipe DO WHILE Wipe <> 0 GO Wipe ? 'How many days were worked' ? 'since last regular payday?' ? 'Use decimals if needed (1 hour = 0.1333).' ? INPUT TO Worked STORE Worked/11.0000 TO NewRatio REPLACE Ratio WITH NewRatio ? DISP Name, Ratio*100 ? INPUT 'Next (0 to quit)? ' TO Wipe STORE INT(Wipe) TO Wipe ENDDO ENDIF RELEASE All ? ? 'Do you want to SKIP any employees (Y or N)? ' WAIT TO Skip IF !(Skip) <> 'Y' DO Payroll ENDIF RELEASE Skip ELSE IF Action = '3' ERASE ? ? ? ? 'This procedure allows you to skip a paycheck in the payroll' ? 'procedure. Do you want to continue (Y or N)?' WAIT TO Continue IF !(Continue) = 'Y' RESTORE FROM B:Constant USE B:Personne ? 'Select the number of the employee to skip:' ? ' (Type 0 to quit.)'  ?'NO. NAME SKIP' ? LIST Name, Paid FOR .NOT. * ? INPUT 'Which number (0 to quit)? TO Wipe STORE INT(Wipe) TO Wipe DO WHILE Wipe <> 0 GO Wipe REPLACE Paid WITH T ? ?'NO. NAME SKIP' ? DISP Name, Paid ? INPUT 'Next? ("0" to quit) ' TO Wipe STORE INT(Wipe) TO Wipe ENDDO ENDIF RELEASE All ? ? 'Do you want to pay a partial salary' ? 'to any employees (Y or N)?' WAIT TO Part IF !(Part) <> 'Y' DO Payroll ENDIF RELEASE Part ELSE IF Action = '4' ? 'Something 4' WAIT ELSE RELEASE All RETURN ENDIF 4 ENDIF 3 ENDIF 2 ENDIF 1 STORE T TO Salaries ENDDO Salaries FROM B:Constant USE B:Personne ? 'Select the number of the employee to skip:' ? ' (Type 0 to quit.)'  *************** PAYFIND COMMAND FILE ************* * This file is called by the PAYBILLS command file after we have found at least * one cost entry for the supplier that we are looking for. * This file now looks for either the first unpaid bill for the supplier * (if only the name was specified) or looks for a complete match (if more than * the name was specified. * If an unpaid bill meeting the criteria is found, Looking is * set to False. Otherwise it remains True. * If only the name was used, at this point we are at the first * unpaid bill for the supplier name. * If more than the name was specified for the search, we could be anywhere * in the indexed list of records for this supplier. If we do not want to pay * this particular bill, or we want to pay more bills for this supplier, we use * a short cut in the PAYBILLS command file so that we do not have to start at * the first record for the name every time. To do this, we store the record * number that we start at to a variable called Start if we have more than the * name to look for. Otherwise, Start =0 ****************************************************************************** STORE T TO Looking IF MBill:Nmbr > ' ' .OR. MAmount > 0 * If we have more than the name, we first check for the bill number. * If this is not found or if the bill has already been paid, * the confirming procedure is skipped (Looking set TRUE). * In this case, we may have entered the list of supplier bills in the * middle of the indexed list. In a later procedure, we may need to go * back to the top and look at the names we skipped. To do this, if we * find a record here, we store its number to "Start". IF MBill:Nmbr > ' ' DO WHILE Name=Key .AND. .NOT. EOF .AND. Looking IF Bill:Nmbr <> MBill:Nmbr SKIP ELSE STORE F TO Looking ENDIF ENDDO * If we're on a new name of the end of the file, looking is TRUE * because we have not found the supplierr we were looking for. * Otherwise, we have a matcing bill number to confirm. IF Looking ? ' This BILL NUMBER is not in the CostBase.' ? ' to continue.' WAIT ELSE IF Check:Nmbr <> ' ' STORE T TO Looking ? ' This bill paid on '+Check:Date+', check '+Check:Nmbr ? ' to continue.' WAIT ENDIF ENDIF ELSE * If no bill number, look for the amount and an unpaid bill. * If not found, skip the confirmation procedure. DO WHILE Name=Key .AND. .NOT. EOF .AND. Looking IF Amount <> MAmount .OR. Check:Nmbr <> ' ' SKIP ELSE STORE F TO Looking ENDIF ENDDO * If we're on a new name or the end of the file, Looking is TRUE * Otherwise, we have an unpaid bill to confirm. IF Looking ? ' No unpaid bill for this amount and this supplier.' ? ' to continue.' WAIT ENDIF ENDIF * If we found a matching record, store i ts number to Start IF .NOT. Looking STORE # TO Start ENDIF ELSE * If we have only the name, find the next unpaid bill DO WHILE Name=Key .AND. .NOT. EOF .AND. Looking IF Check:Nmbr <> ' ' SKIP ELSE STORE F TO Looking ENDIF ENDDO * If we're on a new name or the end of the file, Looking is TRUE * because we did not find the supplier we were looking for. * Otherwise, we have an unpaid bill to confirm. IF Looking ? ' There are no unpaid bills for this supplier.' ? ' to continue.' WAIT ENDIF ENDIF RETURN  * find a record here, we store its number to "Start". IF MBill:Nmbr > ' ' DO WHILE Name=Key .AND. .NOT. EOF .AND. Looking IF Bill:Nmbr <> MBill:Nmbr SKIP ELSE STORE F TO Looking ENDIF ENDDO * If we're on a new name of the end of the file, looking is TRUE * because we have not found the supplierr we were looking for.  ? ' to continue.' WAIT ENDIF ENDIF RETURN  * find a record here, we store its number to "Start". IF MBill:Nmbr > ' ' DO WHILE Name=Key .AND. .NOT. EOF .AND. Looking IF Bill:Nmbr <> MBill:Nmbr SKIP ELSE STORE F TO Looking ENDIF ENDDO * If we're on a new name of the end of the file, looking is TRUE * because we have not found the supplierr we were looking for. unpaid bill for the supplier name. * If more than the name was specified for the search, we could be anywhere * in the indexed list of records for this supplier. If we do not want to pay * this particular bill, or we want to pay more bills for this supplier, we use * a short cut in the PAYBILLS command file so that we do not have to start at * the first record for the name every time. To do this, we store the record * number that we start at to a variable cal ************ PAYMENU COMMAND FILE ************* * This is a sub-module of the Accounts.CMD file and provides choices * as to which checks are to be prepared for posting and printing. * Paying salaries has another menu level to allow partial payments * to selected employees (e.g., leave of absence, when an employee does not * work a full two week stretch, etc.) * The checkbook balance and next check number must be confirmed before * either of these proceedures can be preformed. *********************************************************************** RESTORE FROM B:Constant ERASE @ 3, 0 SAY 'CHECK NUMBER: '+NextCheck+' BALANCE: '+str(MBalance,9,2) ? ? ' Do these match the checkbook?' ? ' C to CONTINUE,' ? ' to change.' ? WAIT TO Continue IF !(Continue) <> 'C' RELEASE ALL RETURN ENDIF STORE T TO Paying DO WHILE Paying ERASE @ 5,20 SAY ' 1> PAY BILLS ' @ 7,20 SAY ' 2> PAY SALARIES' @ 10,20 SAY ' ' WAIT TO Action IF Action = '1' USE B:PostFile * Can abort it any entries are in the PostFile. COUNT FOR .NOT. * TO Any IF Any = 0 DO PayBills ELSE ? ? 'The POSTING file has '-STR(Any,5)+' bills in it.' ? 'Do you still want to pay bills now (Y or N)?' WAIT TO Continue If !(Continue) = 'Y' DO Paybills ELSE RELEASE ALL ENDIF ENDIF ELSE IF Action = '2' DO PayEmps ELSE RELEASE ALL RETURN ENDIF 2 ENDIF 1 STORE T TO Paying ENDDO Paying******************************************* RESTORE FROM B:Constant ERASE @ 3, 0 SAY 'CHECK NUMBER: '+NextCheck+' BALANCE: '+str(MBalance,9,2) ? ? ' Do these match the checkbook?' ? ' C to CONTINUE,' ? ' to change.' ? WAIT TO Continue IF !(Continue) <> 'C' RELEASE ALL RETURN ENDIF STORE T TO Paying DO WHILE Paying ERASE @ 5,20 SAY ' 1> PAY BILLS @ 7,20 SAY ' 2> PAY SALARIES @ 10,20 SAY ' ' WAIT TO Action  * *************** PAYROLL COMMAND FILE ******************************** * This command file generates payroll check stubs showing all deductions; gets * the next check number and writes a check in the CheckFile, showing the new * balance; and stores the salaries and deductions in a database called Hold81. * This file is used to store monthly, quarterly and annual FIT, FICA, SDI * and SIT deductions. The deductions are not picked up from tax tables because * there are so few employees. Instead, they are obtained from the individual * employee records in the Personnel database. * Constants.MEM keeps track of the FICA and SDI percentages and their * maximums, as well as the constant for ThisYear. Changes can be thus * made in a single spot and will be correct in all the programs in the * accounting system. * The file is quite long, but breaks down into simpler modules: * I: Get the date and End of Month, Quarter and Year flags. * II: Compute all deductions and net pay for an individual employee, then * place this in the employee record in Personne.DBF * III: Operator verifies deductions and payroll stub is printed. * IV: Paycheck is written to the Checkfil and all amounts are placed into * the Hold81 summary file. * V: When all individuals have been paid, the Hold81 summary file is * updated if it is the end of the month, quarter or year. * VI: Print out the summary file and data so that the physical checkbook * can be updated (computer does not print our checks). * VII: Delete transient constants, save others back to Constant.MEM for * system use. **************************************************************************** ********************************************************** ************* I: Get date and pay period flags ********* RESTORE FROM B:Constant DO GetDate STORE 'Y' TO GetWhen DO WHILE !(GetWhen) = "Y" ERASE @ 1,18 SAY "PAYROLL PROCESSING" STORE " " TO EOY @ 4,8 SAY 'Want to change the date?' GET Date @ 5,8 SAY '(Press if okay.)' READ @ 7,6 SAY "Is it the end of the YEAR?" GET EOY @ 7,35 SAY "(Y or N)" ? CHR(7) READ STORE !(EOY) TO EOY IF EOY = "Y" STORE "Y" TO EOQ STORE "Y" TO EOM ELSE STORE "N" TO EOY STORE " " TO EOQ @ 8, 3 SAY "Is it the end of the QUARTER?" GET EOQ @ 8,35 SAY "(Y or N)" ? CHR(7) READ STORE !(EOQ) TO EOQ IF EOQ = "Y" STORE "Y" TO EOM ELSE STORE "N" TO EOQ STORE " " TO EOM @ 9, 5 SAY "Is it the end of the MONTH?" GET EOM @ 9,35 SAY "(Y or N)" ? CHR(7) READ STORE !(EOM) TO EOM IF EOM <> "Y" STORE "N" TO EOM ENDIF monthly ENDIF quarterly ENDIF year ERASE @ 4,25 SAY $(Date,1,2)+'/'+$(Date,3,2)+'/'+$(Date,5,2) @ 6,0 SAY "End of YEAR: "+EOY" End of QUARTER: "+EOQ+; " End of MONTH: "+EOM STORE " " TO GetWhen ? ? @ 8,6 SAY 'The above information MUST be correct. '  ? CHR(7) * 2nd chance at date and flags ACCEPT ' Any CHANGES (Y or N)?' TO GetWhen STORE 'B:Hold'+STR(ThisYear,2) TO Header * Computer now does a date and flag check IF !(GetWhen) <> 'Y' IF $(Date,5,2)<'26' .AND. EOM = 'Y' ? ? ? "CHECK THE INFO AGAIN. It's the end of the month, but the" ? 'date is '+Date-'. Do you want to make changes (Y or N)?' ? CHR(7) WAIT TO GetWhen ENDIF IF EOY = 'Y' SELECT SECONDARY USE &Header GO BOTTOM IF Marker = 'Y' ? CHR(7) ? 'You blew it--the end of the year has been done!' WAIT RELEASE ALL STORE T TO Paying RETURN ENDIF ENDIF ENDIF ENDDO GetWhen RELEASE GetWhen *************************************************************************** *********** II: Calculate deductions and net pay for each individual ****** * Compute deductions. Deductions for FICA, FIT, SDI and SIT are kept in the * individual employee's Personnel record, rather than getting them from tax * tables, because there are so few employees. (You have to decide what should * and should not be computerized.) The "YTDxxx" are the year-to-date * totals for these items. Limits and percentages for FICA and SDI are obtained * from a file called Constant.MEM. These are the variables FICACut, FICAMax, * FICAEnd, SDICut, SDIMax, and SDIEnd. SELECT PRIMARY USE B:Personne REPLACE ALL FICA WITH (Pay:Rate*FICACUT+0.005); SDI WITH (Pay:Rate*SDICUT+0.005) STORE 0 TO Count GO TOP DO WHILE .NOT. EOF IF Paid .OR. * SKIP ELSE STORE Count + 1 TO Count *** Save the employee record in case the procedure is ended *** STORE STR(#,5) TO Payee COPY Record &Payee TO Bak *** Deductions for partial salary based on number of days worked *** *** Ratio is computed in PayMenu.CMD IF Ratio < 1.0000 REPLACE Pay:Rate WITH Pay:Rate*Ratio, FICA WITH FICA*Ratio, FIT; WITH FIT*Ratio, SDI WITH SDI*Ratio, SIT WITH SIT*Ratio ENDIF * Deductions and totals are computed then stored in the employee * record FedTemp, Statemp and EmpTemp are used to carry forward * values for salaries subject to FICA, SDI and state unemployment * insurance to Hold81, the summary file. IF YTDSAL > FICAEnd STORE 0 TO FedTemp REPLACE FICA WITH 0 ELSE IF (YTDSal + Pay:Rate) <= FICAEnd REPLACE YTD WITH (YTDFICA + FICA) STORE Pay:Rate TO FedTemp ELSE REPLACE FICA WITH (MAXFICA - YTDFICA), YTDFICA WITH MAXFICA STORE (FICAEnd - YTDSal) TO FedTemp ENDIF ENDIF IF YTDSal > SDIEnd STORE 0 TO StaTemp REPLACE SDI WITH 0 ELSE IF (YTDSAL + Pay:Rate) <= SDIEnd REPLACE YTDSDI WITH (YTDSDI + SDI) STORE Pay:Rate TO StaTemp ELSE REPLACE SDI WITH (MAXSDI - YTDSDI), YTDSDI WITH MAXSDI STORE (SDIEnd-YTDSal) TO StaTemp ENDIF ENDIF * In California,the employer pays an Unemployment Insurance * contribution on employee salary up to the amount of UIEnd.There is * nothing deducted form the employee salary for this, so we keep track * only of the employer obligation as UISal. IF YTDSal > UIEnd STORE 0 TO EmpTemp ELSE IF (YTDSal + Pay:Rate) <= UIEnd STORE Pay:Rate TO EmpTemp ELSE STORE (UIEnd - YTDSal) TO EmpTemp ENDIF ENDIF REPLACE Net:Pay WITH (Pay:Rate-FICA-FIT-SDI-SIT) REPLACE YTDFIT WITH (YTDFIT + FIT) REPLACE YTDSIT WITH (YTDSIT + SIT) REPLACE QTDSal WITH (QTDSal + Pay:Rate) REPLACE YTDSal WITH (YTDSal + Pay:Rate) *********************************************************************** ***************** III: Print employee stub ******************** ERASE SET PRINT ON ? ' '+$(DATE,3,2)+'/'+$(Date,5,2)+'/'+$(Date,1,2)+': '+Name; + ' '+$(SS:Nmbr,1,3)+'-'+$(SS:Nmbr,4,2)+'-'+$(SS:Nmbr,6,4) ? ' GROSS PAY: $'-STR(Pay:Rate,7,2)+' NET PAY: $'; -STR(NET:PAY,7,2) ? ? ' FICA FIT SDI SIT' ? ' THIS CHECK: '+STR(FICA,6,2)+' '+STR(FIT,7,2); +' '+STR(SDI,5,2)+' ' +STR(SIT,7,2) ? ' THIS YEAR: '+STR(YTDFICA,7,2)+' '+STR(YTDFIT,8,2); +' '+STR(YTDSDI,6,2) +' '+STR(YTDSIT,7,2) ? ' TOTAL SALARY THIS QUARTER: $'-STR(QTDSal,9,2) ? ' TOTAL SALARY THIS YEAR: $'-STR(YTDSal,9,2) ? ? ? * Pagefeed after every six employee stubs IF Count >= 6 ? CHR(12) STORE 0 TO COUNT ENDIF SET PRINT OFF IF EOQ = 'Y' .AND. Paid REPLACE QTDSal WITH 0 ENDIF ******************************************************************** ******** IV: Record paycheck in Checkfil and Hold81 **************** * Now a check is "written" in the CheckFil. SELECT SECONDARY USE B:CheckFil APPEND BLANK REPLACE Check:Nmbr WITH NextCheck, Check:Date WITH date,; Name WITH P.Name, Amount WITH Net:Pay, Emp:Nmbr; WITH P.Emp:Nmbr, Client WITH 'OFC', Job:Nmbr WITH 31,; Descrip WITH 'SALARY', Balance WITH (MBalance - Amount) STORE (MBalance - Amount) TO MBalance STORE STR(VAL(NextCheck)+1,4) TO NextCheck ERASE @ 3,25 SAY "** DO NOT INTERRUPT **" @ 5,25 SAY "UPDATING MASTER RECORD" ? CHR(7) * We keep an aggretate record of payroll and deductions. The amounts * for each employee are added to the amounts already in the last * record in the file represented by "Header". (This was set up at the * start of the "GetWhen" loop earlier, and has the name "B:Hold81" or * "B:Hold82" or whatever "ThisYear" is.) * This last record is either a blank (if this is the first * payroll of the month), or has data from previous salary payments * made during the current month. At the end of the month, quarter and * year, totals and a new blank record (except at the end of the year) * are added. This is done in the next loop. USE &Header * If this is a new year, there are no records in the file so we add a * blank record. Otherwise, we go to the last record in the file. IF EOF APPEND BLANK ELSE GO BOTTOM ENDIF REPLACE Check:date WITH Date, Payroll WITH (Payroll+Pay:Rate),; FICA WITH (FICA+P.FICA), FICASal WITH (FICASal + FedTemp),; FIT WITH (FIT + P.FIT), SDI WITH (SDI+P.SDI),; SDISal WITH (SDISal + Statemp), SIT WITH (SIT + P.SIT),; UISal WITH (UISal + EmpTemp) SELECT PRIMARY *** Reset the employee record if he was paid for part time. *** *** The Bak file is not deleted here, as each copy command *** *** above wipes out the previous contents. *** IF Ratio <> 1.0000 REPLACE Ratio WITH 1.0000 UPDA FROM Bak on Emp:Nmbr REPL Pay:Rate,FICA,FIT,SDI,SIT,Net:Pay ENDIF ENDIF SKIP ENDDO personnel file ********************************************************************* ******* V: Personnel records are reset and Holdxx is updated ******** STORE ' ' TO Completed REPLACE ALL Paid WITH F USE &Header GO BOTTOM IF EOM = 'Y' REPLACE Marker WITH 'M' * If it's the end of the quarter, we total the amounts for the * previous three months to a new record and mark it with a 'Q'. IF EOQ = 'Y' STORE STR(#,5) TO Number TOTAL ON Marker TO Quarter FOR # >= (VAL(Number)-2) APPEND FROM Quarter DELETE FILE Quarter IF $(Date,3,2) = '03' REPLACE Check:Date WITH '1ST' ELSE IF $(DATE,3,2) = '06' REPLACE Check:Date WITH '2ND' ELSE IF $(Date,3,2) = '09' REPLACE Check:Date WITH '3RD' ELSE IF $(Date,3,2) = '12' REPLACE Check:Date WITH '4TH' ENDIF ENDIF ENDIF ENDIF REPLACE Marker WITH 'Q' * If it's the end of the year, we total all the quarterly amounts to * a new record and mark it with a 'Y'. IF EOY = 'Y' TOTAL ON Marker TO Annual FOR Marker = 'Q' APPEND FROM Annual REPLACE Marker WITH 'Y', Check:Date WITH 'END' DELETE FILE Annual ENDIF ENDIF * If it's the end of a month but not the end of the year, we add a new * blank record for next month's payroll records. IF EOY <> 'Y' APPEND BLANK ENDIF ENDIF ************************************************************************* ******** VI: Print payroll summary, transfer checks to costbase ********* USE B:CheckFil COUNT FOR .NOT. * TO Any IF Any = 0 ? ' No new checks written.' ? ' to continue.' WAIT ELSE USE &Header ERASE @ 12,25 SAY "CHECK THE PRINTER, THEN PRESS ." ? CHR(7) WAIT ERASE SET PRINT ON * SET MARGIN TO 45 SET MARGIN TO 17 ? ' MASTER PAYROLL FILE SUMMARY: '+$(Date,3,2) +'/'; +$(Date,5,2)+'/'+$(Date,1,2) ? ? ?'DATE PAYROLL FICA FICASAL FIT SDI SDISAL '+; 'SIT UISal' ? LIST OFF * SET MARGIN TO 38 SET MARGIN TO 10 ? CHR(12) SET PRINT OFF ERASE @ 3,25 SAY "*** DO NOT INTERRUPT ***" @ 5,25 SAY " UPDATING THE COSTBASE" ? CHR(7) USE B:CostBase INDEX B:$Supp APPEND FROM B:Checkfil DO CheckStu ENDIF *********************************************************************** ****** VII: Dump transient variables, save necessary ones ************ RELEASE Payee,Number,Date,Ratio,Aborted,Printed,EOY,EOQ,EOM,Any,Header,; Count, FedTemp, StaTemp, EmpTemp, Marker, Paying, Salaries SAVE TO B:Constant USE RELEASE ALL DELETE FILE Bak RETURN  RLEMP:NMBRNNAMECADDRESSCCITY:STATECZIPCPH:NMBRC SS:NMBRC M:S:HCDEDUCTSNPAY:RATENFICANYTDFICANFITN YTDFITN SDINYTDSDINSITN YTDSITN NET:PAYN QTDSALN YTDSALN PAIDLSTART:DATECRATION ^CHECK:DATEClCHECK:NMBRClCLIENTClJOB:NMBRNl-ClNAMECl-ClDESCRIPClAMOUNTN m-CmBILL:DATECmBILL:NMBRCmHOURSN%mEMP:NMBRN+m  OFC 1 PAPER INC USE TAX ENTRY 25.00 840101 3590 0.00 0* OFC 1 PAPER INC USE TAX ENTRY 25.00 840601 4355 0.00 0* OFC 1 PAPER INC USE TAX ENTRY 25.00 841001 7750 0.00 0* OFC 1 RIBBONS INC USE TAX ENTRY 35.00 840201 1950 0.00 0* OFC 2 DSKS INC USE TAX ENTRY 40.00 840101 350 0.00 0* OFC 2 DSKS INC  USE TAX ENTRY 40.00 840501 570 0.00 0* OFC 2 DSKS INC USE TAX ENTRY 40.00 841101 1005 0.00 0* CL1101 COMPUTERS INC NEW COMPUTER 5000.00 840301 1234 0.00 0* CL1102 PRINTERS INC NEW PRINTER 2250.00 840901 7770 0.00 0*840131 ---- CL1103 GARFIELD 0.00 840131 120.00 1* CL1103 SOFTWARE INC PROGRAM PURCHASE 7000.00 840401 233 0.00 0lCHECK:NMBRClCLIENTClJOB:NMBRNl-ClNAMECl-ClDESCRIPClAMOUNTN m-CmBILL:DATECmBILL:NMBRCmHOURSN%mEMP:NMBRN+m  ***************** PRINTOUT COMMAND FILE **************** * This file is used by several other command files. It prints out a * listing of the records in a file without the record number. The * output is spaced every 10 records and the printer is positioned back * at the left margin after the printout. * The calling command file determined where the printout starts by * specifying a value for the variable "Number". * This does not show the record numbers. To do so, use the * Review.CMD file. ********************************************************************** IF VAL(Number) > 0 GOTO RECORD &Number ELSE GO TOP ENDIF STORE 0 TO Count DO WHILE .NOT. EOF IF * SKIP ELSE DISPLAY &Condition SKIP STORE Count + 1 TO Count IF Count = 10 STORE 0 TO Count * Spaces one line every 10 records, then waits. Turns the printer * off so that "WAIT" does not print. ? SET PRINT OFF  WAIT IF !(Output) = 'Y' SET PRINT ON ENDIF ENDIF ENDIF ENDDO * The next 2 lines reposition the printer at the * left margin. ? SET PRINT OFF RELEASE Count, Output RETURN er is positioned back * at the left margin after the printout. * The calling command file determined where the printout starts by * specifying a value for the variable "Number". * This does not show the record numbers. To do so, use the * Review.CMD file. ********************************************************************** IF VAL(Number) > 0 GOTO RECORD &Number ELSE GO TOP ENDIF STORE 0 TO Count DO WHILE .NOT. EOF IF * SKIP ELSE DISPLAY &Condition SKIP STORE Count + 1 TO Count IF Count = 10 STORE 0 TO Count * Spaces one line every 10 records, then waits. Turns the printer * off so that "WAIT" does not print. ? SET PRINT OFF * *************** REPORTMENU COMMAND FILE ************ * This command file is a sub-module of the ACCOUNTS.CMD control * module. It provides detailed choices that relate to reports * that the user might choose to see or print from the cost * database. The functions are set up as sub-sub-procedures * under the control of this module. ****************************************************************** ERASE STORE T TO Reporting DO WHILE Reporting @ 3,20 SAY ' 1> COSTS BY JOB' @ 5,20 SAY ' 2> FIND & EDIT BILLS' @ 7,20 SAY ' 3> REVIEW A DATABASE' @ 9,20 SAY ' 4> Quarterly Sales Tax Summary' @ 11,20 SAY ' 5> RE-INDEX THE COSTBASE ON JOB NUMBERS' @ 12,20 SAY " Make sure you won't need the computer" @ 13,20 SAY ' for a while: this takes a long time.' @ 17,20 SAY ' ' WAIT TO Action IF Action = '1' USE B:PostFile COUNT FOR .NOT. * TO Any IF Any > 0  @ 15, 0 SAY CHR(27)+CHR(74) ? 'There are '+STR(Any,5)+' entries in the Postfile.' ? 'Do you still want to do the Job Costs (Y or N)?' WAIT TO Continue IF !(Continue) = 'Y' DO JobCosts ENDIF ELSE DO JobCosts ENDIF RELEASE Any ELSE IF Action = '2' DO FindBills ELSE IF Action = '3' ERASE DISPLAY FILES ON B ? ? ? 'Which file do you want to review?' ACCEPT TO Database IF FILE("B:"+DATABASE) > 0 USE B:&Database DO Review ELSE * Erases IBM 3101 to end of Screen @ 17,0 SAY CHR(27)+CHR(74) @ 17,0 SAY !(Database) + " isn't on the list, is it? Check "; + 'your spelling, then hit '  ? 'and try again. Or not, as the case may be.' WAIT ENDIF ELSE IF Action = '4' DO SalesTax ELSE IF Action = '5' DO JobsIndx ELSE RELEASE All RETURN ENDIF 5 ENDIF 4 ENDIF 3 ENDIF 2 ENDIF 1 ERASE STORE T TO Reporting ENDDO Reporting ase IF FILE("B:"+DATABASE) > 0 USE B:&Database DO Review ELSE * Erases IBM 3101 to end of Screen @ 17,0 SAY CHR(27)+CHR(74) @ 17,0 SAY !(Database) + " isn't on the list, is it? Check "; + 'your spelling, then hit ' * **************** REVHDR COMMAND FILE ******************* * Used by Review.CMD to print headings for different database listings. ************************************************************************* IF !(Database) = 'INSERTS' ? 'IO# MAGAZINE ISSUE JOB AD SPACE '+; ' GROSS NET X DATE' ELSE IF !(Database) = 'BILLINGS' ? 'INV# JOB DATE TAXABLE TAX NO:TAX PO# DESCRIPTION' ELSE IF !(Database) = 'INVOICES' ? 'INV# CLT DATE TAXABLE TAX NO:TAX '+; 'TOTAL AMT:RCD DATE' ELSE IF !(Database) = 'COSTBASE' ? 'DATE CHECK JOB AMOUNT NAME '+; 'DESCRIPTION DATE BILL# HOURS EMP' ELSE IF !(Database) = 'DEPOSITS' ? 'DATE RECEIVED FROM CHECK AMOUNT '+; 'INV# COMMENTS' ENDIF ENDIF ENDIF ENDIF ENDIF tings. ************************************************************************* IF !(Database) = 'INSERTS' ? 'IO# MAGAZINE ISSUE JOB AD SPACE '+; ' GROSS NET X DATE' ELSE IF !(Database) = 'BILLINGS' ? 'INV# JOB DATE TAXABLE TAX NO:TAX PO# DESCRIPTION' ELSE IF !(Database) = 'INVOICES' ? 'INV# CLT DATE TAXABLE TAX NO:TAX '+; 'TOTAL AMT:RCD DATE' ELSE IF !(Database) = 'COSTBASE' ? 'DATE CHECK JOB AMOUNT NAME '+; 'DESCRIPTION DATE BILL# HOURS EMP' ELSE IF !(Database) = 'DEPOSITS' ? 'DATE RECEIVED FROM CHECK AMOUNT '+; 'INV# COMMENTS' ENDIF ENDIF  **************** REVIEW.CMD FILE *********************** * this is used to list entries in any .DBF file. The database muse be named in * the command file calling the procedure. Records may be listed conditionally. * with or without the record numbers. * Records are listed in groups of 10 with a line space between each group. * Processing can be continuous, or can stop after every group of 10. * The listing can start on a specified record number. * The files can be re-listed as many times as desired. * Printing is optional. The "CHR(X)" commands are for a Diablo 1650 * printer. ************************************************************************** STORE 'Y' TO Reviewing DO WHILE !(Reviewing)='Y' COPY STRUCTURE EXTENDED TO Temp GO BOTTOM STORE STR(#,5) TO Last ERASE ? ? 'The '+!(Database)+' database has '-Last+' entries. They will be shown' ? 'in groups of 10 records, 50 records to a page if printed.' ? 'Enter new values for defaults or press :' ? ? '*** DISPLAY [Field list] [FOR [OFF] ***' ? STORE 1 TO First STORE 1 TO PageCnt STORE VAL(Last) TO RecoCnt STORE 'N' TO Pause STORE 'N' TO Partial STORE 'N' TO Conditions STORE 'N' TO Tally STORE 'C' TO Changing DO WHILE !(Changing) = 'C' @ 8,10 SAY 'START ON RECORD NUMBER ' GET First @ 9,10 SAY ' STOP ON RECORD NUMBER ' GET RecoCnt @ 10,10 SAY ' START PAGE NUMBERS ON ' GET PageCnt @ 11,10 SAY 'PAUSE EVERY 10 RECORDS ' GET Pause @ 12,10 SAY ' SHOW SELECTED FIELDS ' GET Partial @ 13,10 SAY 'DISPLAY FOR EXPRESSION ' GET Conditions @ 14,10 SAY ' SHOW RECORD NUMBERS ' GET Tally ? ? ' C to CHANGE the defaults,' ? ' to continue.' WAIT TO Changing IF !(Changing) = 'C' * Clear to end of screen on IBM 3101-CHR(27)&(74) @ 15,0 SAY CHR(27)+CHR(74) READ ELSE IF First > VAL(Last) .OR. First <= 0 .OR. RecoCnt > VAL(Last); .OR. RecoCnt <= 0 @ 15,0 SAY CHR(27)+CHR(74) @ 16,0 SAY 'Sorry, wrong number: '-!(Database)+' contains '+; 'records 1 through'+Last+'.' ? ' to correct your entry.' WAIT @ 15,0 SAY CHR(27)+CHR(74) STORE 'C' TO Changing STORE 1 TO First STORE VAL(Last) TO RecoCnt ENDIF ENDIF * Clear to end of screen on IBM 3101-CHR(27)&(74) @ 15,0 SAY CHR(27)+CHR(74) ENDDO ? ? ? ? ? ? ? ? ? ? ? ? ? ? IF !(Partial) = 'Y' @ 11,0 SAY CHR(27)+CHR(74) @ 11,0 SAY 'The '+!(Database)+' database consists of these FIELDS:' USE Temp ? STORE ' ' TO Choices DO WHILE .NOT. EOF STORE Choices+Trim(Field:Name)+', ' TO Choices SKIP ENDDO STORE $(Choices,2,LEN(Choices)-3) TO Choices STORE 'Y' TO Unfinished DO WHILE !(Unfinished) = 'Y' @ 13, 0 SAY Choices USE B:&Database ? ? 'List FIELDS to display ( to show all).' ? ACCEPT ' DISPLAY ' TO Partial STORE !(Partial) TO Partial STORE Partial TO String STORE LEN(String) TO Size IF Size = 0 .OR. (Size = 1 .AND. Partial = ' ') STORE CHR(0) TO Partial STORE 'N' TO Unfinished ELSE ? ? 'Want to change it (Y or N)?' WAIT TO Unfinished IF !(Unfinished) = 'Y' @ 12, 0 SAY CHR(27) + CHR(74) ELSE @ 10, 0 SAY CHR(27) + CHR(74) ? '*** Checking fields ['+Partial+'] : ' ? STORE 0 TO F STORE 0 TO Counter DO WHILE Size >0 STORE Counter + 1 TO Counter ?? ' *'+STR(Counter,2) STORE @(',', String) TO Mark IF Mark = 1 .OR. Mark = Size ? 'Uh, oh--trouble: comma cannot be at the '; +'start or end of a list of values.' ? ' and try again.' STORE 0 TO Size STORE 'Y' TO Unfinished WAIT ELSE IF Mark > 0 STORE (Mark - 1) TO Size ENDIF STORE T TO Blank STORE 1 TO Start DO WHILE Blank .AND. (.NOT. Start > Size) IF $(String,Start, 1)= ' ' STORE (Start + 1) TO Start ELSE STORE (.NOT. Blank) TO Blank ENDIF ENDDO IF Start > Size ? 'How on earth can I find a blank field?' ? ' and try again.' STORE 0 TO Size STORE 'Y' TO Unfinished WAIT ELSE STORE (F + 1) TO F IF F < 10 STORE STR(F,1) TO Suffix ELSE STORE SRT(F,2) TO Suffix ENDIF STORE 'FIELD'+Suffix TO Field STORE 'TRIM($(String,Start,(Size,-Start+1)))' TO &Field IF Mark > 0 STORE TRIM($(String, (Size + 2))) TO String STORE LEN(String) TO Size ELSE STORE 'N' TO Unfinished STORE 0 TO Size ENDIF ENDIF ENDIF ENDDO ENDIF  ENDIF ENDDO IF LEN(Partial) > 0 * DO Headings ? "WE'D DO THE HEADINGS HERE (need to write this .cmd file)." WAIT ENDIF ELSE STORE CHR(0) TO Partial ENDIF IF !(Conditions) = 'Y' STORE 'Y' TO Unfinished DO WHILE !(Unfinished) = 'Y' @ 11, 0 SAY CHR(27)+CHR(74) @ 11, 0 SAY 'Specify the EXPRESSION or to skip.' ? ? 'DISPLAY &Partial FOR ' ACCEPT TO Expression ? ? 'Do you want to change the expression (Y or N)?' WAIT TO Unfinished ENDDO IF Expression > ' ' STORE 'FOR '+ Expression TO Conditions ELSE STORE CHR(0) TO Conditions ENDIF ELSE STORE CHR(0) TO Conditions ENDIF IF !(Tally) <> 'Y' STORE 'OFF' TO Tally ELSE STORE CHR(0) TO Tally ENDIF STORE [DISPLAY Next 1 &Partial &Conditions &Tally] TO Command @ 11, 0 SAY CHR(27)+CHR(74) @ 11, 0 SAY '*** '+[DISPLAY &Partial &Conditions &Tally]+' ***' ? ? 'is the command that will be performed on the '+!(Database)+' database.' ? ' C to CHANGE it,' ? ' Q to QUIT with no action,' ? ' to review the database.' WAIT TO Abort IF !(Abort) = 'Q' STORE CHR(0) TO Reviewing ELSE IF !(Abort) <> 'C' ERASE ? 'Enter a one-line heading or press to skip.' ACCEPT TO Message STORE !(Message) TO Message ? STORE 0 TO Count STORE 0 TO PageMark STORE STR(First,5) TO Number GO &Number ERASE ? 'Do you want to print the listing now (Y or N)?' ACCEPT TO Hardcopy IF !(Hardcopy) = 'Y' SET PRINT ON DO RevMrgn ENDIF ERASE ? Message ? 'Page '+ STR(PageCnt,3) IF Tally = 'OFF'  ?? 'starts on Record #'-STR(#,5) ? IF .NOT. (Partial > ' ' .OR. Conditions > ' ') DO RevHdr ENDIF ENDIF ? DO WHILE .NOT. EOF .AND. # <= RecoCnt &Command IF !(Conditions) > CHR(0) IF &Expression STORE (Count + 1) TO Count ENDIF ELSE STORE (Count + 1) TO Count ENDIF SKIP IF Count=10 STORE 0 TO Count * Inserts a space every ten records, then waits. The printer * is turned off so that "WAIT" does not print out on the hardcopy. ? SET PRINT OFF IF !(Pause) = 'Y' WAIT ENDIF IF !(Hardcopy) = 'Y' SET PRINT ON ENDIF * The following routine prints 50 entries to a page, * then moves to the next page and prints a heading STORE (PageMark + 1) TO PageMark IF PageMark = 5 ? CHR(12) STORE (PageCnt + 1) TO PageCnt IF INT(PageCnt/7) = PageCnt/7 ? ENDIF ? Message ? 'Page '+STR(PageCnt,3) IF Tally = 'OFF' ?? 'starts on Record #'-STR(#,5) ? IF .NOT.( Partial > ' ' .OR. Conditions > ' ') DO RevHdr ENDIF ENDIF ? STORE 0 TO PageMark ENDIF ENDIF ENDDO * Formfeed on Diablo 1650 printer = CHR(12) ? CHR(12) SET PRINT OFF SET RAW ON * SET MARGIN TO 38 SET MARGIN TO 10 ? 'Do you want to see the '+!(Database)+' again (Y or N)?'  WAIT TO Reviewing ELSE STORE 'Y' TO Reviewing ENDIF ENDIF ? ENDDO Reviewing USE DELETE FILE Temp RELEASE All RETURN /7 ? ENDIF ? Message ? 'Page '+STR(PageCnt,3) IF Tally = 'OFF' ?? 'starts on Record #'-STR(#,5) ? IF .NOT.( Partial > ' ' .OR. Conditions > ' ') DO RevHdr ENDIF ENDIF ? STORE 0 TO PageMark ENDIF ENDIF ENDDO * Formfeed on Diablo 1650 printer = CHR(12) ? CHR(12) SET PRINT OFF SET RAW ON * SET MARGIN TO 38 SET MARGIN TO 10 ? 'Do you want to see the '+!(Database)+' again (Y or N)?' * *********************** REVMRGN COMMAND FILE ******************** * Used by Review.CMD to set margins for different database listings. ************************************************************************* IF !(Database) = 'INSERTS' * SET MARGIN TO 38 SET MARGIN TO 10 ELSE IF !(Database) = 'COSTBASE' * SET MARGIN TO 36 SET MARGIN TO 8 ELSE * SET MARGIN TO 45 SET MARGIN TO 17 ENDIF ENDIF RETURN PRINTOUTCMD BCREPORTMECMDDEFREVHDR CMD GHREVIEW CMDRIJKLMNOPQRSREVMRGN $$$************************** SALES TAX COMMAND FILE ********************* * This file summarizes the invoice file for a specified period. * It shows the invoices and the type of billing (taxable or * service) along with the totals for the two types and the total * sales tax liability for the period. * It also includes materials and equipment subject to a use tax * that has not been paid. These are entered in the invoices database * when they come in as well as in the Postfile. ************************************************************************* USE B:Invoices ERASE ? 'This file summarizes the data you need to prepare the End-of-Quarter' ? 'report to the State Board of Equalization for SALES TAX collected by' ? 'the agency. It includes use tax on materials bought out of state or' ? 'bought with our resale number without paying a use tax.' STORE 'C' TO Dating DO WHILE !(Dating) = 'C' STORE 'YYMMDD' TO Start STORE 'YYMMDD' TO Finish @ 7, 0 SAY 'This summary is for the period FROM 'GET Start @ 7,45 SAY ' TO ' GET Finish READ @ 9,0 SAY ' ' ? ' C to CHANGE,' ? ' to continue.' WAIT TO Dating @ 7,0 ? CHR(27) + CHR(74) ENDDO Dating ERASE @ 5,10 SAY '*********** DO NOT INTERRUPT ***********' @ 7,10 SAY 'COMPUTING THE QUARTERLY SALES TAX REPORT' ? COPY TO Temp FIELDS Inv:Nmbr, Inv:Date, Taxable, Sales:Tax, taxFree, Amount; FOR Inv:Date >= Start .AND. Inv:Date <= Finish USE Temp SORT ON Inv:Nmbr TO Temp2 USE Temp2 REPLACE Inv:Nmbr WITH ' USED' FOR VAL(Inv:Nmbr) < 1000 STORE $(Start,3,2)+'/'+$(Start,5,2)+'/'+$(Start,1,2) TO Start STORE $(Finish,3,2)+'/'+$(Finish,5,2)+'/'+$(Finish,1,2) TO Finish @ 5,0 * SET MARGIN TO 45 SET MARGIN TO 17 SET PRINT ON STORE 1 TO PageCnt ? 'SALES TAX SUMMARY FROM '+Start+' TO '+Finish+': Page '+STR(PageCnt,3) ? ? 'INV# DATE TAXABLE TAX SERVICE TOTAL' ? STORE 0 TO Count STORE 0 TO PageMark GO TOP DO WHILE .NOT. EOF DISPLAY Inv:Nmbr,Inv:Date,Taxable,Sales:Tax,TaxFree,' '+STR(Amount,9,2) OFF STORE (Count + 1) TO Count SKIP IF Count = 10 STORE 0 TO Count * Inserts a space every ten records, then waits. The printer * is turned off so that "WAIT" does not print on the hardcopy. ? * The following routine prints 50 entries to a page, * then moves to the next page and prints a heading. STORE (PageMark + 1) TO PageMark IF PageMark = 5 STORE 0 TO PageMark ? CHR(12) STORE (PageCnt + 1) TO PageCnt * Compensates for an offset caused by the 7 lines/inch printing IF INT(PageCnt/7) = PageCnt/7 ? ENDIF ? 'SALES TAX SUMMARY FROM ' + Start + ' TO ' + Finish+': Page ' +; STR(PageCnt,3) ? ? 'INV# DATE TAXABLE TAX SERVICE TOTAL' ? ENDIF ENDIF ENDDO ? SET PRINT OFF ? ? ' COMPUTING TOTALS NOW.' ? REPLACE ALL Inv:Nmbr WITH ' ' FOR VAL(Inv:Nmbr) > 1000 TOTAL ON Inv:Nmbr TO Other USE Other REPLACE All Inv:Date WITH 'TOTAL' REPLACE All Inv:Nmbr WITH 'SALES' FOR Inv:Nmbr = ' ' SUM Taxable TO Used FOR Inv:Nmbr = ' USED' SUM Amount TO Sold STORE Sold + Used TO Gross SUM Sales:Tax TO Collected SUM TaxFree TO Service STORE Collected + Service TO Exempt STORE Gross - Exempt TO Subject STORE 0.06*Subject + 0.005 TO Payable * Print totals of all the invoices GO TOP SET PRINT ON DO WHILE .NOT. EOF DISPLAY Inv:Nmbr,Inv:Date,Taxable,Sales:Tax,TaxFree,' '+STR(Amount,9,2) OFF STORE Count + 1 TO Count SKIP ENDDO IF PageMark > 3 * Formfeed if not enough room to print the following list = CHR(12) ? CHR(12) ENDIF ? ? ? 'ENTER THE FOLLOWING DATA ON THE BOARD OF EQUALIZATION FORM:' ? * The following segment is not the final, but the state auditor is in right now * and I've got to get the info out to him, and to the state for this month. * The final version will include all lines in the form, to allow for changes * in the way we do our business. Obviously, this is also the palce to * print the form if ypu want to do that. Since the form is used only once * every three months, we won't automate it entirely. ? ' LINE 1> TOTAL GROSS SALES: ' + STR(Sold,9,2) ? ' LINE 2> SUBJECT TO USE TAX: ' + STR(Used,9,2) ? ' LINE 3> TOTAL TRANSACTIONS: ' + STR(Gross,9,2) ? ? ' LINE 9> SALES TAX INCLUDED: ' + STR(Collected,9,2) ? ' LINE 10> ADVERTISING SERVICES: ' + STR(Service,9,2) ? ' LINE 11> TOTAL EXEMPTIONS: ' + STR(Exempt,9,2) ? ' LINE 12> SUBJECT TO STATE TAX: ' + STR(Subject,9,2) ? ' LINE 13> AMOUNT OF STATE TAX: ' + STR(0.05*Subject+0.005,9,2) ? ' LINE 14> SUBJECT TO LOCAL TAX: ' + STR(Subject,9,2) ? ? ' LINE 19> AMOUNT OF LOCAL TAX: ' + STR(0.01*Subject+0.005,9,2) ? ? ' LINE 21> TOTAL TAXES: ' + STR(Payable,9,2) ? ? ' LINE 28> TOTAL DUE AND PAYABLE: ' + STR(Payable,9,2) ? CHR(12) * SET MARGIN TO 38 SET MARGIN TO 10 SET PRINT OFF RELEASE All USE DELETE FILE Temp DELETE FILE Temp2 DELETE FILE Other RETURN  TOTAL GROSS SALES: ' + STR(Sold,9,2) ? ' LINE 2> SUBJECT TO USE TAX: ' + STR(Used,9,2) ? ' LINE 3> TOTAL TRANSACTIONS: ' + STR(Gross,9,2) ? ? ' LINE 9> SALES TAX INCLUDED: ' + STR(Collected,9,2) ? ' LINE 10> ADVERTISING SERVICES: ' + STR(Service,9,2) ? ' LINE 11> TOTAL EXEMPTIONS: ' + STR(Exempt,9,2) ? ' LINE 12> SUBJECT TO STATE TAX: ' + STR(Subject,9,2) ? ' LINE 13> AMOUNT OF STATE TAX: ' + STR(0.05*Subject+0.005,9,2) ? ' LINE 14> SUBJECT TO LOCAL TAX: ' + STR(Subject,9,2) ? ? ' LINE 19> AMOUNT OF LOCAL TAX: ' + STR(0.01*Subject+0.005,9,2) ? ? ' LINE 21> TOTAL TAXES: ' + STR(Payable,9,2) ? ? ' LINE 28> TOTAL DUE AND PAYABLE: ' + STR(PayaYSUPPLIERCrADDRESSCrCITYCrSTATECsZIPC sPHONE:NMBRCsAREA:CODECs PAPER INC 123 PAPER ST PAPER PA11223344-5566777 RIBBONS INC 234 1ST ST RIBTOWN CA12121232-3434303 DSKS INC 34 DSK ST DISKY TX77777444-5555713 COMPUTERS INC 234 C ST SILTY NV33356456-7890207 PRINTERS INC 333 PRNT ST PRINTOWN PA44455234-5678123 GARFIELD 123 HERE ST THAT WAY TX99999333-6666713 SOFTWARE INC 333 SOFT ST PANIC CO80804444-6890303 234 1ST ST RIBTOWN CA12121232-3434303 DSKS INC 34 DSK ST DISKY TX77777444-5555713 COMPUTERS INC 234 C ST SILTY NV33356456-7890207 PRINTERS INC 333 PRNT ST PRINTOWN PA44455234-5678123 PAPER INC 123 PAPER ST PAPER PA11223344-5566777 RIBBONS INC 234 1ST ST RIBTOWN CA12121232-3434303 DSKS INC 34 DSK ST DISKY TX77777444-5555713 COMPUTERS INC 234 C ST SILTY NV33356456-7890207 PRINTERS INC 333 PRNT ST PRINTOWN PA44455234-5678123 GARFIELD 123 HERE ST THA ************** TIMECALC COMMAND FILE ****************** * Verifies that employee name and number match, then * calculates billing charges for employee time. ************************************************************* SET TALK OFF ERASE SELECT PRIMARY RESTORE FROM B:Constant GO TOP DO WHILE .NOT. EOF ERASE @ 4,20 SAY ' ** DO NOT INTERRUPT ** ' @ 5,20 SAY ' PROCESSING TIME CHARGES ' IF * .OR. Job:Nmbr = 31 .OR. Check:Nmbr <> '---' SKIP ELSE REPLACE Client WITH !(Client), Name WITH !(Name) STORE STR(#,4) TO Number @ 7,20 SAY ' Record # '+Number @ 8,20 SAY ' '+Name ? CHR(7) IF Emp:Nmbr<=0 .OR. Emp:Nmbr>MaxEmpl .OR. Hours = 0 ERASE REPLACE Hours WITH Hours*1.00 REPLACE Emp:Nmbr WITH Emp:Nmbr*1 @ 4,0 SAY ' ' DISPLAY @ 6,3 SAY 'HOURS=' @ 6,18 SAY '=EMPLOYEE NUMBER' ? ? 'Press ANY KEY to correct the EMPLOYEE NUMBER,' ? 'or press H to correct HOURS.' WAIT TO Decision IF !(Decision) <> 'H' @ 6,14 GET Emp:Nmbr ELSE @ 6,8 GET Hours ENDIF READ ELSE SELECT SECONDARY USE B:Personne STORE T TO Looking DO WHILE Looking .AND. .NOT. EOF IF $(Name,1,10)=$(P.Name,1,10) IF Emp:Nmbr=P.Emp:Nmbr SELECT PRIMARY * Formula optimistically assumes 65 billable hours out * of 75 hours possible in two weeks. Eff. mult.=3.23 REPLACE Amount WITH Pay:Rate*2.8*Hours/65 SELECT SECONDARY STORE F TO Looking ELSE SELECT PRIMARY STORE T TO Fixing DO WHILE Fixing ERASE @ 4,0 SAY ' ' DISPLAY @ 6,16 SAY '=EMPLOYEE NUMBER' ? ? 'The correct Employee Number is' ?? S.Emp:Nmbr ?? ' for '+S.Name ? 'Press ANY KEY to change the EMPLOYEE NUMBER' ? 'press N to change the NAME.' WAIT TO Choice IF !(Choice) <> 'N' @ 6,12 GET Emp:Nmbr READ STORE F TO Fixing ELSE @ 5,25 GET Name REPLACE Name WITH !(Name) READ STORE F TO Fixing ENDIF Employee number ERASE ENDDO Fixing SELECT SECONDARY GO TOP ENDIF Numbers match ELSE SKIP ENDIF IF EOF ERASE SELECT PRIMARY  @ 4,0 SAY ' ' DISPLAY @ 6,16 'SAY '=EMPLOYEE NUMBER' ? ? 'This name is not listed in the Personnel file,' ? 'so time charge were not calculated.' ? 'Press any key to change the name, or write the' ? 'record number down and press D to DELETE.' WAIT TO Change IF !(Change) <> 'D' @ 5,25 GET Name REPLACE Name WITH !(Name) READ SKIP-1 ELSE ERASE DELETE DISPLAY ? ? 'THIS RECORD HAS BEEN DELETED.' WAIT ENDIF Change SELECT SECONDARY ENDIF no name ENDDO Looking SELECT PRIMARY SKIP ENDIF ENDIF deleted ENDDO billing calculations RELEASE All RETURN * ******** USETAX COMMAND FILE ********** * This file accepts inputs for supplier bills when the agency has bought * an item without paying a use tax on it. * The item or items are added to the INVIOCES file (not Billings), * then are used by the SalesTax program so that the Quarterly Sales Tax * report can be prepared by the computer. * * A temporary file called GETBILLS is used for data entry, because the operator * can decide to quit on an incomplete entry, which is marked for deletion. * When the data is APPENDed to the POSTFILE, these entries are eliminated (the * APPEND command does not transfer records marked for deletion). An entry must * include at least the name of a supplier and the amountof the bill. If these * are not BOTH supplied, the entry is flagged for correction or deletion. ******************************************************************************* ERASE @ 5,20 SAY 'AGENCY USE-TAX PROCEEDURE' ? USE B:PostFile COPY STRUCTURE TO GETBILLS USE GetBills STORE 'Y' TO Bills DO WHILE !(BILLS) <> 'F' APPEND BLANK STORE STR(#,5) TO Number REPLACE Client WITH 'OFC' STORE T TO Entering DO WHILE Entering ERASE @ 1,0 SAY 'ENTER ONLY UNTAXED ITEMS NOT USED FOR CLIENT JOBS.' @ 3,0 SAY ' RECORD NUMBER:' + Number @ 4,0 SAY ' CLIENT:' + Client + ':' @ 5,0 SAY ' JOB NUMBER' GET Job:Nmbr @ 6,0 SAY ' AMOUNT' GET Amount @ 7,0 SAY ' BILL NUMBER' GET Bill:Nmbr @ 8,0 SAY ' BILL DATE' GET Bill:Date @ 9,0 SAY ' SUPPLIER NAME' GET Name READ REPLACE Name WITH !(Name),Descrip WITH 'USE TAX ENTRY'; Bill:Nmbr WITH !(Bill:Nmbr) @ 7,17 SAY Bill:Nmbr @ 9,17 SAY Name @ 10,17 SAY Descrip STORE ' ' TO Getting IF Job:Nmbr <= 0 .OR. Job:Nmbr > 99 @ 12,0 ? ' The JOB NUMBER entry is wrong!' ? ' Agency jobs are from 1 through 99.' ? ' F if FINISHED,' ACCEPT ' to change.' TO Getting ELSE IF Amount = 0 .OR. Name <= ' ' ? ? ? ' AMOUNT or NAME missing.' ? ' F if FINISHED,' ACCEPT ' to change.' TO Getting ELSE @ 12,5 SAY ' C to CHANGE,' @ 13,5 SAY ' F if FINISHED,' ACCEPT ' to continue.' TO Bills IF !(Bills) = 'C' STORE T TO Entering ELSE STORE F TO Entering ENDIF ENDIF amount or name ENDIF client or job number IF !(Getting) = 'F' DELETE RECORD &Number STORE F TO Enteriing STORE 'F' TO Bills ENDIF ENDDO Entering ENDDO Bills COUNT FOR .NOT. * TO Any IF Any = 0 ? ? ' No valid entries to add to the files.' ? ' to the menu.' WAIT ELSE RESTORE FROM B:CONSTANT STORE 'Bill:Date' TO Date DO DateTest * Checks names against a list of suppliers to catch spelling and * abbreviation inconsistencies. DO NameTest ERASE @ 3,25 SAY ' *** DO NOT INTERRUPT ***' @ 5,25 SAY ' UPDATING THE POSTING FILE' USE B:PostFile APPEND FROM GetBills * The following loop transfers the bills just entered into the INVOICES * file. The amount of the bill is entered in the "Taxable" column. The * job number is entered into the Invoice Number column. Since invoices * have 5 digits, while job numbers are under 1000, we use this to separate * the two types of entries later in the SALESTAX.CMD file..IF < 1000 THEN.. * PRIMARY and SECONDARY work areas are used to step through the GETBILLS * file one entry at a time. USE GetBills SELECT SECONDARY USE B:Invoices SELECT PRIMARY DO WHILE .NOT. EOF IF * SKIP ELSE SELECT SECONDARY  APPEND BLANK REPLACE Inv:Nmbr WITH STR(Job:Nmbr,3), Inv:Date WITH Bill:Date,; Taxable WITH Amount, Date:Rcd WITH 'USE TAX' SELECT PRIMARY SKIP ENDIF ENDDO ENDIF USE DELETE FILE GetBills RELEASE ALL RETURN lls just entered into the INVOICES * file. The amount of the bill is entered in the "Taxable" column. The * job number is entered into the Invoice Number column. Since invoices * have 5 digits, while job numbers are under 1000, we use this to separate * the two types of entries later in the SALESTAX.CMD file..IF < 1000 THEN.. * PRIMARY and SECONDARY work areas are used to step through the GETBILLS * file one entry at a time. USE GetBills SELECT SECONDARY USE B:Invoices SELECT PRIMARY DO WHILE .NOT. EOF IF * SKIP ELSE SELECT SECONDARY !*!S???????????end of storage used by dbdirsB1A:*ḁ̊;C7Rʺd&̥dF: 2\!] :7̥<27!K:  ͓Ͱ͟Ͱ͙ ۥ|ۥ.ۥ27^ۥ# ðs̥̥{B : _ \2:<2:< dBASEII directory routine Version 1.3 01-20-83 $++ Entry not found ++$ User number has been altered $++ Invalid function passed ++ $ Press any key to continue $ $+after old stack Press any key to continue $ ???????????end of storage used by dbdir The DBDIR routines demonstrate how to call an assembler subroutine from dBASEII. There are a number of restrictions! Briefly, you can load an assembler routine above location A400 hex, as long as you don't do any sorts!!!!! You have available to you the memory space from A400 hex to the top of your TPA (on mine it is E400 hex, on a 64K system). The following files are required: - dbdir.cmd - asciidec.cmd - dbdir.asm The .asm file is Z80 code which was assembled using M80/L80, and does a not very efficient method of getting the directory entries, but it works. Hope this helps explain a not too well documented command in dBASE. Any comments concerning these routines can be left on this BBS, and if you make any wonderous enhancements, and would like to share them, please leave them on this BBS also. Mike Kelly 02/25/83  page 58 ; dbdir.asm ; ; ; THIS PROGRAM WILL ... ; produce a directory list on the ; console and will be called from dBASEII. ; - Mike Kelly ; ; 08-20-82 v1.0 written ; ; 08-22-82 v1.0 updated ; 08-30-82 v1.1 Add routine to load the program to upper memory ; when it has been assembled in lower memory. To ; do this requires adding a base number (offset) ; to all labels and variables so that after the ; move to upper memory, all addresses will have ; been adjusted properly. ; 09-20-82 v1.2 Changed routine to add function byte to ; select which function of this routine. ; Expanded routine to add set user function. ; ; Function: ; 00h = alter user number ; 01h = show directory ; 01-20-83 v1.3 Added seperator between filenames in display. ; ; ; global tcmd,tfcb,bldfcb,loop1,prtit global srchnxt,end global linecnt,diroffset,prtfn global srchfrst,prtspace,prtdot,prtcrlf global nohit,findme,notfound,count global function,setusr,showdir,badfunc global badbyte,user,usrmsg ; ;SYSTEM EQUATES ; cr equ 0dh ;carriage return lf equ 0ah ;line feed esc equ 1bh ;escape exitcpm equ 0 ;warmboot exit point base equ 0 ;find wboot jmp address at rst0 dumyadr equ 0 tfcb equ 5ch ;default fcb tcmd equ 80h ;default command line and DBA addr tbuf equ 80h ;default buffer bdos equ 5 ;CP/M function calls entry point entsize equ 13 ;bytes per sorted directory entry ; ; includes: 1-2 for user number ; ; 3-13 for fn,ft (no period) pagesize equ 20 ;# of lines to print on a page dirsect equ 26 ;# of sectors in directory track tpa equ 100h dbasetop equ 00400h ;free memory above dBASEII (a400h-a000h) dbload equ 00500h ;load asm. routine here x equ 0a000h ;offset to add to all labels and ; variables ; ; aseg org tpa ; ; ;this routine will move the code at ; ; 400h to a400h ; ld hl,st1 ;from address ld de,x+dbasetop ;to address ld bc,fini1-st1 ;length ldir ;move it ; ; ;this routine will move the code at ; ; 500h to a500h ; ld hl,start ;from address ld de,x+dbload ;to address ld bc,fini-start ;length ldir ;do the move ; jp x+start ;then jump to the newly moved code ; jp exitcpm ; org dbasetop ;put variables here ; st1: ;start of variables ; function: db 01h ;function byte ; ; 0 = set user ; ; 1 = show directory findme: db '???????????' ;directory entry to look for userno: db 00h ;user number drive: db 00h ;drive to search junk: db 'end of storage used by dbdir' ; fini1: ;end of variables ; ; org dbload ; ; start: ld (x+oldstack),sp ;save current stack pointer ld sp,x+stack ;set stack pointer to my stack ; push psw ;save the world push bc push de push hl ; ld a,(x+function) ;get function cp 00h ;=00h then set user jp z,x+setusr cp 01h ;=01h then show directory jp z,x+showdir jp x+badfunc ;bad function passed ; setusr: call x+user ld de,x+usrmsg call x+sout call bdos jp x+end ; showdir: ld de,x+dirmsg ;print signon msg call x+sout ld bc,0000h ;init count ld (x+count),bc ; call x+setdma ;set dma to addr of tbuf(80h) call x+bldfcb call x+srchfrst ;get 1st entry jp z,x+nohit ;=z,no entry found call x+prtit loop1: call x+srchnxt ;get n+1 entry jp z,x+end ;=z,all done call x+prtit ;print the entry jp x+loop1 ;loop til done ; bldfcb: ld a,(x+drive) ;get drive byte ld (tfcb),a ;put in fcb ; ld hl,x+findme ;sending addr (search string) ld de,tfcb+1 ;receiving addr ld bc,000bh ;count of 11 ldir ;do move ret ; prtit: ld a,(x+count) ;check how many entries have cp 05h ; printed-only 5 per line call z,x+prtcrlf inc a ;up count ld (x+count),a ; ld hl,tbuf+1 ;addr of buffer ld bc,(x+diroffset) ;offset into directory entry ld b,00h add hl,bc ld bc,000bh ;count of 11 ; call x+prtspace ;format print of each entry ld bc,0008h call x+prtfn call x+prtdot ld bc,0003h call x+prtfn call x+prtgate ret ; prtspace: ld e,' ' call x+conout ret ; prtgate: ld e,'|' call x+conout ret ; prtdot: ld e,'.' call x+conout ret ; prtcrlf: ld de,x+crlf call x+sout xor a ;put zero in A ld (x+count),a ;zero out count ret ; prtfn: ld e,(hl) ;get a char call x+conout ;print it inc hl ;point to next char dec c ;dec count ret z ;return if done jp x+prtfn ;loop til done ; nohit: ld de,x+notfound call x+sout jp x+end ; badfunc: ld de,x+badbyte call x+sout jp x+end ; end: pop hl ;put the world back as you pop de ; found it pop bc pop psw ld sp,(x+oldstack) ;dont forget the stack ret ;ret, not jp to 0 ; ; ; ; conin: ld c,1 call bdos ret conout: push psw push bc push de push hl ld c,2 call bdos pop hl pop de pop bc pop psw ret dirin: ld c,6 ld e,0ffh call bdos cp 00h ;=00h, then char not ready jp z,x+dirin ; will want to wait for it ret sout: ld c,9 ;write string to console call bdos ret ; setdma: ld c,1ah ;set dma addr to 80h ld de,tbuf call bdos ret user: ld a,(x+userno) ;set user number ld e,a ld c,20h call bdos ret ; srchfrst: ;do search first call x+user ;alter user # ; ld c,11h ;bdos search 1st ld de,tfcb ;de with addr of fcb call bdos push psw ;save A register and z flag add a,a ;adjust A to get offset to add a,a ; the found entry add a,a add a,a add a,a ld (x+diroffset),a ;save the offset pop psw ;get the original value of A inc a ;to detect 0ffh ret ; srchnxt: ;do search next ; ; will only set srcheof flag ; ; when have checked all users ld c,12h call bdos push psw ;save A register and z flag add a,a ;adjust A to get offset to add a,a ; the found entry add a,a add a,a add a,a ld (x+diroffset),a ;save the offset pop psw ;get the original value of A inc a ;to detect 0ffh ret ; ; ; ; Variables ; count: db 00h,00h linecnt: db 00h ;count of # of lines printed ; init at 2 for heading diroffset: db 00h ;offset into directory entry ; ; returned by bdos search, ; ; incremented by 32, max. ; ; should be 255 ; dirmsg: db cr,lf db 'dBASEII directory routine' db cr,lf db 'Version 1.3 ' db '01-20-83' db cr,lf db '$' notfound: db '++ Entry not found ++' db '$' usrmsg: db cr,lf db 'User number has been altered' db cr,lf db '$' badbyte: db '++ Invalid function passed ++' db cr,lf db '$' anykey: db ' ' db 'Press any key to continue' db cr db '$' crlf: db cr,lf db '$' stktop: ds 64 ;top of stack stack: ds 1 ;stack oldstack: ;saves old stack pointer dw 0000h junk2: db 'after old stack' ; fini: end * * dbdir.cmd * * This command module is used to display the directory * of a disk while in dBASE. This is accomplished by * calling an assembler routine that has been loaded * into memory, prior to executing dBASE, at hex * location A500. This routine uses variables which * reside at hex location A400. They are 1)search string * (11-bytes used to do directory search, initially set * to "???????????", which will return the whole directory) * 2) user number (1-byte, initially set to zero, which * indicates the user number to do the directory search * for; can be from 0-F). * - Mike Kelly * * * 08-19-82 v1.0 written * 08-19-82 v1.0 updated * 09-19-82 v1.1 Added routine to implement a function * byte to be passed to the assembler * routine. Function 00h will alter * the user number, function 01h will * show the directory. * * set echo off set talk off set colon off * erase store 57344+1024 to e400 store 40960+1024 to a400 store 40960+1280 to a500 store a500 to addrdir store a400 to addrfunc store addrfunc+1 to addrsearch store addrfunc+12 to addrusr store addrfunc+13 to addrdrv store '3,68,73,82,0' to dir store 59162 to e71a store '0123456789ABCDEF' to hextbl store 'B' to drive1 store 0 to userno store '????????.???' to findme store ' !"#$%&' +; chr(39) +; '()' +; '*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`' +; 'abcdefghijklmnopqrstuvwxyz{|}~' to asciitbl * erase store t to badrv store t to badusr store t to badstr do while badusr .or. badstr .or. badrv @ 1,0 say 'dBASEII Directory display' @ 3,0 say 'Enter User number to use (0-15) ===>'; get userno; picture '99' @ 5,0 say 'Enter the Disk Drive to search' @ 6,0 say ' A: or B: ===>'; get drive1; picture '!' @ 8,0 say 'Enter type of search to do' @ 9,0 say ' ie. ????????.??? will display entire directory' @ 10,0 say ' ????????.CMD will display all files with' @ 11,0 say ' CMD as a file type' @ 13,0 say ' Enter search string ===>'; get findme; picture '!!!!!!!!!!!!' * read * if userno < 0 .or.; userno > 15 store t to badusr @ 22,0 say 'ERROR - the user number must be from 0 to 15' else store f to badusr @ 22,0 endif userno * * if drive1 = 'A' .or.; drive1 = 'B' store f to badrv @ 21,0 say '  ' else store t to badrv @ 21,0 say 'ERROR - the selected drive must be A: or B:' endif drive1 * * store @('.',findme) to dotpos * if dotpos = 0 store t to badstr @ 23,0 say 'ERROR - search string not appropriate ' else store f to badstr @ 23,0 say ' ' endif findme * enddo badusr/badstr * * take the '.' out of the search string * store $(findme,1,dotpos-1)+$(findme,dotpos+1,len(findme)-dotpos); to stringin * * convert ascii to decimal (value returned in "stringout") * do asciidec * * poke the function (01h = show dir) * poke addrfunc,1 * * poke in search string to memory * poke addrsearch,&stringout * * convert the user number 0-15 to 0-F * store $(hextbl,userno+1,1) to stringin * * convert ascii to decimal * do asciidec * * now make the user number hex 0-F binary * store val(stringout)-48 to num1 store str(num1,2) to stringout * * poke in the user number * * poke addrusr,&stringout * * convert ascii to decimal * store drive1 to stringin * do asciidec * * now make drive 0-F binary * store val(stringout)-64 to num1 store str(num1,2) to stringout * * poke the drive to memory * poke addrdrv,&stringout * * set up the call address to the assembler routine that * has been pre-loaded into high memory at addrdir * set call to addrdir store 'dummy' to adress * * do the call * erase call return  poke in search string to memory * poke addrsearch,&stringout * * convert the user number 0-15 to 0-F * store $(hextbl,userno+1,1) to stringin * * convert ascii to decimal * do asciidec * * now make the user number h DBUTIL.DOC DBASE II UTILITIES 8/27/84 This disk is a series of DBASE II (DB) .CMD files which allow DB to be used as a limited data analysis package, in conjunction with SC, WS and XMODEM. Operation of most of the programs is very simple, if you already understand the (statistical) operation involved. If you don't know what the operation is, any good statistics text will explain it much better than I can in a DOC file. Two of the files are of general interest; DBSC which allows DB to transfer data into a SuperCalc spreadsheet; and PLOT, which allows limited plotting (X vs Y) direct from DB data files. The latter will require customization to allow hard copies on your printer, if you do not have an Epson MX-80 with block graphics  characters for the high ASCII numbers. More on that below. All of the .CMD files can be tested using the TEST.DBF file included on this disk. The programs assume that both the .DBF and .CMD files are on your B: drive, and that the first thing you do when entering DB is to SET DEFA TO B. Records marked for deletion are ignored by all .CMD files. The record number can be used as a field input by just typing # when prompted for the field name. This is handy in PLOT for the X axis in many cases. DBSC.CMD This file allows one to ten fields in a DB .DBF file to be transfered to a SuperCalc spreadsheet. This is done indirectly by having DBSC create an intermediate file which is then eXecuted from SC. Your SC must have the eXecute command (early versions did not contain this facility). DBSC assumes that the data file is on the B: drive, and that the intermediate (SC eXecutable) file will be written to B:. The files are transfered as a rectangular block, which can have the upper left hand corner in a specified SuperCalc cell. After running DBSC, you will then need to QUIT, and load SuperCalc. Supercalc then does the data loading for you when you eXecute the intermediate file (fun to watch, looks like you are typing 2000 words per minute!) 1 PLOT.CMD This is the driver .CMD file which uses three other files (PLOT0, PLOT1 and PLOT2) for parts of the operation. PLOT produces X vs Y plots of two fields in a DB .DBF file. The plots are either scatter diagrams, or bar charts. The latter requires that the data be indexed or sorted on the X axis field, so that the bars can be drawn from left to right. The four PLOT*.CMD files are assumed to reside on the default drive (SET DEFA TO B), and the data file is assumed to be on B:. The files provided assume that you have an 80 column display, and are using an Epson MX-80 model with block graphics capability. If you are using a 52 column Osborne, change line 157 in PLOT.CMD from STORE 75 TO PLOT:RT to STORE 51 TO PLOT:RT. This will put all of the initial preview plot within view. For hardcopy with other printers, you will need to modify the case statements starting at line 232 of PLOT.CMD to produce block characters which correspond to the Osborne screen characters for your printer. Another option is to produce a plot using only ASCII chars (+,-,|,*). This produces a rather poor hardcopy, and also loses the nice feature of PLOT of getting resolution greater that one char wide by using graphics symbols for the upper left corner of a char space, etc. Also note that PLOT uses the Epson convention of ESC + 'E' to start emphasized printing. You may need to eliminate this line if your printer does not support this function (line 217). The hardcopy portion uses the entire 32 logical lines of the Osborne screen and 80 chars wide before starting printing. You will not be able to see all of the plot once it starts printing. This is not a problem, as the preview plot is within the screen bounds. ******* The following files are utilities which assume that a .DBF file is already in USE. ******* JULIAN.CMD Writes the julian date (a 9 char wide integer) for every occurance of the date in a data base. Assumes that each record has a field consisting of the date in MM/DD/YY format, and that a blank field is already present to write the julian date number on. The algorithm is the same one shown in the example files provided with DBASE II. Note that Jan 1, 1984 would have to be input as 01/01/84 not 1/1/84 to satisfy this program. 2 (Julian dates are handy for computing the number of days between dates - you just subtract the two julian days. The also allow you to plot a field vs. the date using PLOT. PLOT only plots numerical values, so it will not accept plotting a field directly vs. the MM/DD/YY date.) DATE.CMD Writes a MM/DD/YY field from the julian numeric filed. The output field is a 8 char wide character field. BLANK.CMD Appends a user specified number of blank records to the bottom of a data base. This is handy when you wish to use the BROWSE command instead of APPEND for adding new data. BROWSE allows you to see the previous records, frequently making it easier to add the next ones. DELDUP.CMD Marks records for deletion if they duplicate the previous record in a given field. DELDUP will only find all duplicates if the file is indexed or sorted on the field. Also, DELDUP only checks one field, differences in other fields are not detected. MIN.CMD and MAX.CMD These allow you to find the minimum and maximum value in a numeric or character field of a data base, and the number of repetitions of this min (max) value. This is much faster than indexing or sorting the file for the same purpose. AVE.CMD Calculates the average of a given field, and the variance (square fo the standard deviation). In this and all other statistical commands, the numerical accuracy limits of DBASE II must be kept in mind. DBASE was never meant for high accuracy numeric work. LSQ.CMD Calculates the best fit line using the equation y = A + Bx by the least squares method. 3 MLR.CMD Calculates the best fit with two free variables using the equation y = A + Bx + Cy. XSMOOTH.CMD Exponential smoothing of one variable. Assumes the file XSMOOTH.DBF (provided) is on the B: drive. Writes the smoothed Y variable and the (unaffected) X variable to this file. Smoothing constants between 0 and 1 can be entered. Final notes: These files have been in use by the author for over one year. However, I'm sure there are still some bugs (author's have a way of not finding their own bugs!). Let me know if you find any more. Jim Conger 4 Conger MLR.CMD Calculates the best fit with two free variables using the equation y = A + Bx + Cy. XSMOOTH.CMD Exponential smoothing of one variable. Assumes the file XSMOOTH.DBF (provided) is on the B: drive. Writes the smoothed Y variable and the (unaffected) X variable to this file. Smoothing constants between 0 and 1 can be entered. Final notes: These files have been in use by the author for over one year. However, I'm sure there are still some bugs (author's haveT.DATEClJULINAN lFIRSTNlSECONDNlTHIRDNlSTRINGC l 01/01/84 724291 1 1 1THIS IS A 02/01/84 724322 2 2 1TEST OF 03/01/84 724351 3 1 2THE DBASE 04/01/84 724382 4 2 2UTILITIES 05/01/84 724412 5 4 2FILES. be o blan record t th botto o dat base Thi i hand whe yo wis t us th BROWS comman instea o APPEN fo addin ne data BROWS allow yo t se th previou records frequentl makin i easie t ad th nex ones. DELDUP.C* AVE.DMD Finds the average and variance of a given field * SET TALK OFF * STORE ' ' TO FIELD STORE 0 TO NN STORE 0 TO SMM STORE 0 TO SSQ * ? DO WHILE T ACCEPT 'Enter field name (? for list)->' TO FIELD IF FIELD = ' ' RETURN ENDIF IF FIELD = '?' DISPLAY STRUCTURE LOOP ENDIF * Check that the variable type is numeric GO TOP DO WHILE TYPE(&FIELD)<>'N' DISPLAY OFF 'Field ',FIELD,' is not numeric or not in file.' RETURN ENDDO ? * Collect sum and sum of squares data for field DO WHILE .NOT. EOF IF .NOT. (*) STORE NN+1 TO NN STORE (&FIELD)+SMM TO SMM STORE (&FIELD*&FIELD)+SSQ TO SSQ ENDIF SKIP ENDDO * * Data in, do clacs STORE SMM/NN TO MEAN STORE (SSQ-(SMM*SMM)/NN)/(NN-1) TO VARIANCE * * Display results STORE '%' TO HARDCOPY DO WHILE T DISPLAY OFF 'For the field ',FIELD,' (',NN,' undeleted occurances)' DISPLAY OFF 'Average: ',STR(MEAN,12,4),' Variance: ',STR(VARIANCE,12,4)  ? SET PRINT OFF IF HARDCOPY<>'%' RELEASE FILED,NN,SMM,SSQ,HARDCOPY,MEAN,VARIANCE RETURN ENDIF ACCEPT 'Hardcopy (Y/N)->' TO HARDCOPY * * Loop for hardcopy of output if desired IF !(HARDCOPY)='Y' SET PRINT ON LOOP ENDIF * SET TALK ON RELEASE FIELD,NN,SMM,SSQ,HARDCOPY,MEAN,VARIANCE RETURN ENDDO ENDDO DO WHILE TYPE(&FIELD)<>'N' DISPLAY OFF 'Field ',FIELD,' is not numeric or not in file.' RETURN ENDDO ? * Collect sum and sum of squares data for field DO WHILE .NOT. EOF IF .NOT. (*) STORE NN+1 TO NN STORE (&FIELD)+SMM TO SMM STORE (&FIELD*&FIELD)+SSQ TO SSQ ENDIF SKIP ENDDO * * Data in, do clacs STORE SMM/NN TO MEAN STORE (SSQ-(SMM*SMM)/NN)/(NN-1) TO VARIANCE * * Display results STORE '%' TO HARDCOPY DO WHILE T DISPLAY OFF 'For the field ',FIELD,' (',NN,' undeleted occurances)' DISPLAY OFF 'Average: ',STR(MEAN,12,4),' Variance: ',STR(VARIANCE,12,4) * BLANK.CMD Adds user specified number of blank fields to bottom of file * 12/21/83 jlc SET TALK OFF STORE 1 TO NUMB GO BOTT ? INPUT 'Enter the number of blank fields to add ->' TO NUMB DO WHILE NUMB>0 APPEND BLANK STORE NUMB-1 TO NUMB ENDDO ? SET TALK ON RETURN *DATE.CMD Computes MM/DD/YY from psuedo Julian date * SET TALK OFF STORE ' ' TO DATER STORE ' ' TO JULIAR STORE 0 TO M STORE 0 TO D STORE 0 TO Y STORE 0 TO X ? ? 'Fills date field with MM/DD/YY from psudo julian date' ? STORE T TO LOOKFOR DO WHILE LOOKFOR ACCEPT 'Enter field name for date (? for list)->' TO DATER IF DATER=' ' RELEASE ALL RETURN ENDIF IF DATER='?' DISP STRU LOOP ENDIF IF TYPE(&DATER)<>'C' DISP OFF 'Non character variable, or no match in file. Try again.' LOOP ENDIF STORE F TO LOOKFOR ENDDO * STORE T TO LOOKFOR DO WHILE LOOKFOR ACCEPT 'Enter julian variable name (? for list)->' TO JULIAR IF JULIAR=' ' RELEASE ALL RETURN ENDIF IF JULIAR='?' DISP STRU LOOP ENDIF IF TYPE(&JULIAR)<>'N' DISP OFF 'Non numeric variable, or no match in file. Try again.' LOOP ENDIF STORE F TO LOOKFOR ENDDO ? GO TOP DO WHILE .NOT. EOF STORE INT(&JULIAR/365.26)+1 TO Y STORE &JULIAR+INT(395.25-365.25*Y) TO D IF INT(Y/4)*4=Y STORE 1 TO D1 ELSE STORE 2 TO D1 ENDIF IF D>(91-D1) STORE D+D1 TO D ENDIF STORE INT(D/30.57) TO M STORE D-INT(30.57*M) TO D IF M>12 STORE 1 TO M STORE Y+1 TO Y ENDIF STORE Y-1900 TO Y STORE STR(M,2)+'/'+STR(D,2)+'/'+STR(Y,2) TO DATEST REPLACE &DATER WITH DATEST SKIP ENDDO ? RELEASE ALL RETURN es MM/DD/YY from psuedo Julian date * STORE ' ' TO DATER STORE ' ' TO JULIAR STORE 0 TO M STORE 0 TO D STORE 0 TO Y STORE 0 TO X ? ? 'Fills date field with MM/DD/YY from psudo julian date' ? STORE T TO LOOKFOR DO WHILE LOOKFOR ACCEPT 'Enter field name for date (? for list)->' TO DATER IF DATER=' ' RELEASE ALL RETURN ENDIF IF DATER='?' DISP STRU LOOP ENDIF IF TYPE(&DATER)<>'C' DISP OFF 'Non character variable, or no ma* DBSC.CMD CLEAR SET TALK OFF SET DEFA TO B ERASE ? ' DBSC.CMD' ? ? 'Converts DBASEII .DBF data files to SuperCalc eXecutable .PRN' ? 'files. Up to 10 fields can be transfered to the .PRN file.' ? STORE '0' TO RDFIL DO WHILE RDFIL='0' ACCEPT 'Enter data file name (? for list, no B:)->' TO RDFIL IF RDFIL = ' ' CLEAR SET TALK ON RETURN ENDIF IF RDFIL = '?' DISP FILES ON B STORE '0' TO RDFIL ENDIF ENDDO STORE 'B:'+RDFIL TO RDFIL USE &RDFIL * * Get field names from RDFIL into VAR0,VAR1... STORE 10 TO MAXVAR STORE 0 TO NUMVAR STORE 0 TO COUNT DO WHILE COUNT when done)->' TO FLD DO CASE CASE FLD = '?' DISP STRU CASE FLD = ' ' IF COUNT=0 SET TALK ON CLEAR RETURN ELSE STORE MAXVAR+1 TO COUNT ENDIF OTHERWISE STORE TYPE(&FLD) TO TP IF TP<>'N' .AND. TP<>'C' ? 'Not in file, or Logical data type; try again.' ELSE STORE 'VAR'+STR(COUNT,1) TO VAR STORE FLD TO &VAR STORE COUNT+1 TO COUNT STORE NUMVAR+1 TO NUMVAR ENDIF ENDCASE ENDDO * * Get Write file name STORE '0' TO WTFIL DO WHILE WTFIL = '0' ? ? 'The write file should be type .PRN to be SuperCalc readable.' ACCEPT 'Enter write file name (? for help, no B:)->' TO WTFIL IF WTFIL = ' ' CLEAR SET TALK ON RETURN ENDIF IF WTFIL = '?' ? ? 'Enter any < 8 charachter name, followed by .PRN. For example,' ? 'TEST.PRN would be a SuperCalc eXecutable file name.' STORE '0' TO WTFIL ENDIF ENDDO STORE 'B:'+WTFIL TO WTFIL * * Get cell for upper left corner STORE '0' TO CELL ? ? 'Enter the cell name for the upper left hand corner of the SC spreadsheet' ? 'where you wish the data block to be placed. Range A1 to Z99. Default' ACCEPT 'is A1. Cell No.->' TO CELL IF CELL=' ' ? 'Cell defaulted to A1' STORE 'A' TO CELCOL STORE '1' TO CELROW ELSE DO CASE CAS LEN(TRIM(CELL))<2 ? 'Cell defauted to A1' STORE 'A' TO CELCOL STORE '1' TO CELROW CAS LEN(TRIM(CELL))=2 STORE $(CELL,1,1) TO CELCOL STORE $(CELL,2,1) TO CELROW OTHERWISE STORE $(CELL,1,1) TO CELCOL STORE $(CELL,2,2) TO CELROW ENDCASE ENDIF * * Decode ASCII value of column IF CELCOL<'A' .OR CELCOL>'z' STORE 65 TO ASCCOL ELSE STORE 65 TO COUNT DO WHILE COUNT<122 IF CHR(COUNT)=CELCOL STORE COUNT TO ASCCOL STORE 130 TO COUNT ELSE STORE COUNT+1 TO COUNT ENDIF ENDDO ENDIF * * Create output file SET ALTERNATE TO &WTFIL SET ALTERNATE ON STORE 0 TO COUNT ? 'v' DO WHILE COUNT'z' STORE 65 TO ASCCOL ELSE STORE 65 TO COUNT DO WHILE COUNT<122 IF CHR(COUNT)=CELCOL STORE COUNT TO ASCCOL STORE 130 TO COUNT ELSE STORE COUNT+1 TO COUNT ENDIF ENDDO ENDIF * * Create output file SET ALTERNATE TO &WTFIL SET ALTERNATE ON STORE 0 TO COUNT ? 'v' DO WHILE COUNT' TO FIELD IF FIELD = ' ' RETURN ENDIF IF FIELD = '?' DISPLAY STRUCTURE LOOP ENDIF * Check that the variable type not logical or missing GO TOP IF TYPE(&FIELD)<>'N' IF TYPE(&FIELD)<>'C' DISPLAY OFF 'Field ',FIELD,' is logical or not in file.' LOOP ENDIF ENDIF ? STORE &FIELD TO OLDVAL SKIP DO WHILE .NOT. EOF IF &FIELD=OLDVAL DELETE ENDIF STORE &FIELD TO OLDVAL SKIP ENDDO ? "Duplicates marked for deletion. PACK to compress file." RELEASE FIELD,OLDVAL RETURN * ENDDO  SANQlBC TlCL^l TO &FIELD TO OLDVAL SKIP DO WHILE .NOT. EOF IF &FIELD=OLDVAL DELETE ENDIF STORE &FIELD TO OLDVAL SKIP ENDDO ? "Duplicates marked for deletion. PACK to compress file." RELEASE FIELD,OLDVAL RETURN * ENDDO *JULIAN.CMD Computes julian day from MM/DD/YY * SET TALK OFF STORE ' ' TO DATER STORE ' ' TO JULIAR STORE 0 TO M STORE 0 TO D STORE 0 TO Y STORE 0 TO X ? ? ' Fills julian field from MM/DD/YY (date) field.' ? STORE T TO LOOKFOR DO WHILE LOOKFOR ACCEPT 'Enter field name for date (? for list)->' TO DATER IF DATER=' ' RELEASE ALL RETURN ENDIF IF DATER='?' DISP STRU LOOP ENDIF IF TYPE(&DATER)<>'C' DISP OFF 'Non character variable, or no match in file. Try again.' LOOP ENDIF STORE F TO LOOKFOR ENDDO * STORE T TO LOOKFOR DO WHILE LOOKFOR ACCEPT 'Enter julian variable name (? for list)->' TO JULIAR IF JULIAR=' ' RELEASE ALL RETURN ENDIF IF JULIAR='?' DISP STRU LOOP ENDIF IF TYPE(&JULIAR)<>'N' DISP OFF 'Non numeric variable, or no match in file. Try again.' LOOP ENDIF STORE F TO LOOKFOR ENDDO ? GO TOP DO WHILE .NOT. EOF STORE VAL($(&DATER,1,2)) TO M STORE VAL($(&DATER,4,2)) TO D STORE VAL($(&DATER,7,2)) + 1900 TO Y STORE INT(30.57*M)+INT(365.25*Y-395.25)+D TO X IF M>2 IF INT(Y/4)=Y/4 STORE X-1 TO X ELSE STORE X-2 TO X ENDIF ENDIF REPLACE &JULIAR WITH X SKIP ENDDO ? RELEASE ALL RETURN DIF IF JULIAR='?' DISP STRU LOOP ENDIF IF TYPE(&JULIAR)<>'N' DISP OFF 'Non numeric variable, or no match in file. Try again.' LOOP ENDIF STORE F TO LOOKFOR ENDDO ? GO TOP DO WHILE .NOT. EOF STORE I IF INT(Y/4)*4=Y STORE 1 TO D1 ELSE STORE 2 TO D1 ENDIF IF D>(91-D1) STORE D+D1 TO D ENDIF STORE INT(D/30.57) TO M STORE D-INT(30.57*M) TO D IF M>12 STORE 1 TO M STORE Y+1 TO Y ENDIF STORE Y-1900 TO Y STORE STR(M,2)+'/'+STR(D,2)+'/'+STR(Y,2) TO DATEST REPLACE &DATER WITH DATEST SKIP ENDDO ? RELEASE ALL RETURN  STORE F TO LOOKFOR ENDDO ? GO TOP DO WHILE .NOT. EOF STORE I*LSQ.CMD Finds least squares fit for x vs. y * SET TALK OFF STORE ' ' TO XVAR STORE ' ' TO YVAR STORE 0 TO NN STORE 0 TO SMM STORE 0 TO SSQ STORE 0 TO XSUM STORE 0 TO YSUM STORE 0 TO X2SUM STORE 0 TO Y2SUM STORE 0 TO XYSUM * ? STORE 'X' TO LOOKFOR DO WHILE LOOKFOR='X' ACCEPT 'Enter X variable name (? for lest)->' TO XVAR IF XVAR=' ' RELEASE ALL RETURN ENDIF IF XVAR='?' DISP STRU LOOP ENDIF IF TYPE(&XVAR)<>'N' DISP OFF 'Non numeric variable, or no match in file. Try again.' LOOP ENDIF STORE 'Y' TO LOOKFOR ENDDO * DO WHILE LOOKFOR='Y' ACCEPT 'Enter Y variable name (? for list)->' TO YVAR IF YVAR=' ' RELEASE ALL RETURN ENDIF IF YVAR='?' DISP STRU LOOP ENDIF IF TYPE(&YVAR)<>'N' DISP OFF 'Non numeric variable, or no match in file. Try again.' LOOP ENDIF STORE 'DONE' TO LOOKFOR ENDDO ? * First pass for least squares fie GO TOP DO WHILE .NOT. EOF IF .NOT. * STORE NN+1 TO NN STORE (&XVAR+XSUM) TO XSUM STORE (&YVAR+YSUM) TO YSUM STORE (&XVAR*&YVAR+XYSUM) TO XYSUM STORE (&XVAR*&XVAR+X2SUM) TO X2SUM STORE (&YVAR*&YVAR+Y2SUM) TO Y2SUM ENDIF SKIP ENDDO * * Data in, do least squares calcs STORE XYSUM-(XSUM*YSUM/NN) TO NOM STORE X2SUM-(XSUM*XSUM/NN) TO DNOM STORE NOM/DNOM TO B STORE (YSUM/NN)-(B*XSUM/NN) TO A STORE (NOM*NOM)/(DNOM*(Y2SUM-(YSUM*YSUM)/NN)) TO R2 * * Initialize for pass two GO TOP DO WHILE .NOT. EOF IF .NOT. * STORE (A+B*&XVAR) TO YBAR STORE &YVAR-YBAR TO DELY STORE SMM+DELY TO SMM STORE DELY*DELY+SSQ TO SSQ ENDIF SKIP ENDDO * Compute variance for estimate STORE (SSQ-(SMM*SMM)/NN)/(NN-1) TO VARI * * Display results STOR '%' TO HARDCOPY DO WHILE T ? DISP OFF 'Best fit:' DISP OFF YVAR,' = ' ,STR(A,12,4),' + ',STR(B,12,4),' * ',XVAR DISP OFF 'Index of determination (r2)=',STR(R2,6,4) DISP OFF 'Variance of the estimate = ',STR(VARI,12,4) ? SET PRINT OFF IF HARDCOPY<>'%' RELEASE ALL RETURN ENDIF ACCEPT 'Hardcopy (Y/N)->' TO HARDCOPY * * Loop for hard copy if desired IF !(HARDCOPY)='Y' SET PRINT ON LOOP ENDIF ? SET TALK ON RELEASE ALL RETURN STORE (YSUM/NN)-(B*XSUM/NN) TO A STORE (NOM*NOM)/(DNOM*(Y2SUM-(YSUM*YSUM)/NN)) TO R2 * * Initialize for pass two GO TOP DO WHILE .NOT. EOF IF .NOT. * STORE (A+B*&XVAR) TO YBAR STORE &YVAR-YBAR TO DELY STORE SMM+DELY TO SMM STORE DELY*DELY+SSQ TO SSQ ENDIF SKIP ENDDO * Compute variance for estimate STORE (SSQ-(SMM*SMM)/NN)/(NN-1) TO VARI * * Display results STOR '%' TO HARDCOPY DO WHILE T ? DISP OFF 'Best fit:' DISP OFF YVAR,' = ' ,STR(A,12,4),' + ',STR(B,12,4),' * ',XVAR DISP OFF 'Index of determination (r2)=',STR(R2,6,4) DISP OFF 'Variance of the estimate = ',STR(VARI,12,4 * MAX.CMD Finds maximum value of given field * SET TALK OFF STORE ' ' TO FIELD STORE 0 TO MAXREPT STORE 1 TO RECORD ? DO WHILE T ACCEPT 'Enter field name (? for list)->' TO FIELD IF FIELD = ' ' RELEASE FIELD,MAXREPT,RECORD RETURN ENDIF IF FIELD='?' DISP STRU LOOP ENDIF * Check that variable exists and is not 'logical' IF TYPE(&FIELD)<>'N' IF TYPE(&FIELD)<>'C' DISP OFF 'Field ',FIELD,' is not in file, or is logical.' RELEASE FIELD,MAXREPT,RECORD RETURN ENDIF ENDIF ? * Begin looking for MAX value, first guess is first value GO TOP DO WHILE * SKIP ENDDO STORE &FIELD TO MAX DO WHILE .NOT. EOF SKIP IF * LOOP ENDIF IF &FIELD > MAX STORE &FIELD TO MAX STORE 0 TO MAXREPT STORE # TO RECORD ENDIF IF &FIELD = MAX STORE MAXREPT+1 TO MAXREPT ENDIF ENDDO * * Display results STORE '%' TO HARDCOPY DO WHILE T DISP OFF 'Record No.',STR(RECORD,5,0),' has largest value of ',FIELD DO CASE CASE TYPE(MAX)='N' DISP OFF 'Value is: ',STR(MAX,12,4),'(',STR(MAXREPT,5,0),' other '; 'occurances.)' CASE TYPE(MAX)='C' DISP OFF 'Value is: ',MAX,' (',STR(MAXREPT,5,0),' other '; 'occurances.)' ENDCASE ? SET PRINT OFF IF HARDCOPY<>'%' RELEASE FIELD,MAXREPT,RECORD,MAX,HARDCOPY RETURN ENDIF ACCEPT 'Hardcopy (Y/N)->' TO HARDCOPY * * Loop for hardcopy if desired IF !(HARDCOPY)='Y' SET PRINT ON LOOP ENDIF * SET TALK ON RELEASE FIELD,MAXREPT,RECORD,MAX,HARDCOPY RETURN ENDDO ENDDOHILE * SKIP ENDDO STORE &FIELD TO MAX DO WHILE .NOT. EOF SKIP IF * LOOP ENDIF IF &FIELD > MAX STORE &FIELD TO MAX STORE 0 TO MAXREPT STORE # TO RECORD ENDIF IF &FIELD = MAX STORE MAXREPT+1 TO MAXREPT ENDIF ENDDO * * Display results STORE '%' TO HARDCOPY DO WHILE T DISP OFF 'Record No.',STR(RECORD,5,0),' has largest value o* MIN.CMD Finds minimum value of given field * SET TALK OFF STORE ' ' TO FIELD STORE 0 TO MINREPT STORE 1 TO RECORD ? DO WHILE T ACCEPT 'Enter field name (? for list)->' TO FIELD IF FIELD = ' ' RELEASE FIELD,MINREPT,RECORD RETURN ENDIF IF FIELD='?' DISP STRU LOOP ENDIF * Check that variable exists and is not 'logical' IF TYPE(&FIELD)<>'N' IF TYPE(&FIELD)<>'C' DISP OFF 'Field ',FIELD,' is not in file, or is logical.' RELEASE FIELD,MINREPT,RECORD RETURN ENDIF ENDIF ? * Begin looking for min value, first guess is first value GO TOP DO WHILE * SKIP ENDDO STORE &FIELD TO MIN DO WHILE .NOT. EOF SKIP IF * LOOP ENDIF IF &FIELD < MIN STORE &FIELD TO MIN STORE 0 TO MINREPT STORE # TO RECORD ENDIF IF &FIELD = MIN STORE MINREPT+1 TO MINREPT ENDIF ENDDO * * Display results STORE '%' TO HARDCOPY DO WHILE T DISP OFF 'Record No.',STR(RECORD,5,0),' has smallest value of ',FIELD DO CASE CASE TYPE(MIN)='N' DISP OFF 'Value is: ',STR(MIN,12,4),'(',STR(MINREPT,5,0),' other '; 'occurances.)' CASE TYPE(MIN)='C' DISP OFF 'Value is: ',MIN,' (',STR(MINREPT,5,0),' other '; 'occurances.)' ENDCASE ? SET PRINT OFF IF HARDCOPY<>'%' RELEASE FIELD,MINREPT,RECORD,MIN,HARDCOPY RETURN ENDIF ACCEPT 'Hardcopy (Y/N)->' TO HARDCOPY * * Loop for hardcopy if desired IF !(HARDCOPY)='Y' SET PRINT ON LOOP ENDIF * SET TALK ON RELEASE FIELD,MINREPT,RECORD,MIN,HARDCOPY RETURN ENDDO ENDDOILE TYPE(&FILED)<>'C' DISP OFF 'Field ",FIELD,' is not in file, or is logical.' RETURN ENDDO ENDDO ? * BIN.CMD Finds minimum value of given field * SET TALK OFF STORE ' ' TO FIELD STORE 0 TO MINREPT STORE 1 TO RECORD ? DO WHILE T ACCEPT 'Enter field name (? for list)->' TO FIELD IF FIELD = ' ' RETURN ENDIF IF FIELD='?' DISP STRU lue OOP ENDIF * SET TALK ON RELEASE FIELD,MINREPT,RECORD,MIN,HARDCOPY RETURN ENDDO ENDDOILE TYPE(&FILED)<>'C' DISP OFF 'Field ",FIELD,' is not in file, or is logical.' RETURN ENDDO ENDDO ? * B!*MLR.CMD Multiple linear regression of three variables * SET TALK OFF STORE ' ' TO XVAR STORE ' ' TO YVAR STORE ' ' TO ZVAR STORE 0 TO NN STORE 0 TO SMM STORE 0 TO SSQ STORE 0 TO XSUM STORE 0 TO YSUM STORE 0 TO ZSUM STORE 0 TO X2SUM STORE 0 TO Y2SUM STORE 0 TO Z2SUM STORE 0 TO XYSUM STORE 0 TO XZSUM STORE 0 TO YZSUM * ? DISP OFF 'Multiple Linear Regression Analysis' DISP OFF ' Format: Z = a + b*X + c*Y' DISP OFF '-----------------------------------' ? STORE 'X' TO LOOKFOR DO WHILE LOOKFOR='X' ACCEPT 'Enter X variable name (? for list)->' TO XVAR IF XVAR=' ' RELEASE ALL RETURN ENDIF IF XVAR='?' DISP STRU LOOP ENDIF IF TYPE(&XVAR)<>'N' DISP OFF 'Non numeric variable, or no match in file. Try again.' LOOP ENDIF STORE 'Y' TO LOOKFOR ENDDO * DO WHILE LOOKFOR='Y' ACCEPT 'Enter Y variable name (? for list)->' TO YVAR IF YVAR=' ' RELEASE ALL RETURN ENDIF IF YVAR='?' DISP STRU LOOP ENDIF IF TYPE(&YVAR)<>'N' DISP OFF 'Non numeric variable, or no match in file. Try again.' LOOP ENDIF STORE 'Z' TO LOOKFOR ENDDO * DO WHILE LOOKFOR='Z' ACCEPT 'Enter Z variable name (? for list)->' TO ZVAR IF ZVAR=' ' RELEASE ALL RETURN ENDIF IF ZVAR='?' DISP STRU LOOP ENDIF IF TYPE(&ZVAR)<>'N' DISP OFF 'Non numeric variable, or no match in file. Try again.' LOOP ENDIF STORE 'DONE' TO LOOKFOR ENDDO ? * First pass for least squares fit GO TOP DO WHILE .NOT. EOF IF .NOT. * STORE NN+1 TO NN STORE (&XVAR+XSUM) TO XSUM STORE (&YVAR+YSUM) TO YSUM STORE (&ZVAR+ZSUM) TO ZSUM STORE (&XVAR*&XVAR+X2SUM) TO X2SUM STORE (&YVAR*&YVAR+Y2SUM) TO Y2SUM STORE (&ZVAR*&ZVAR+Z2SUM) TO Z2SUM STORE (&XVAR*&YVAR+XYSUM) TO XYSUM STORE (&XVAR*&ZVAR+XZSUM) TO XZSUM STORE (&YVAR*&ZVAR+YZSUM) TO YZSUM ENDIF SKIP ENDDO * * Data in, do least squares calcs STORE (NN*X2SUM)-(XSUM*XSUM) TO CP STORE (NN*Y2SUM)-(YSUM*YSUM) TO DP STORE (NN*XYSUM)-(XSUM*YSUM) TO EP STORE CP*(NN*YZSUM-YSUM*ZSUM) TO AP STORE (NN*XZSUM)-(XSUM*ZSUM) TO FP STORE EP*FP TO BP STORE (AP-BP)/(CP*DP-EP*EP) TO C STORE (FP-C*EP)/(NN*X2SUM-XSUM*XSUM) TO B STORE (ZSUM-C*YSUM-B*XSUM)/NN TO A STORE A*ZSUM+B*XZSUM+C*YZSUM-(ZSUM*ZSUM)/NN TO NOM STORE Z2SUM-(ZSUM*ZSUM)/NN TO DNOM STORE NOM/DNOM TO R2 * * Initialize for pass two GO TOP DO WHILE .NOT. EOF IF .NOT. * STORE A+B*&XVAR+C*&YVAR TO ZBAR STORE &ZVAR-ZBAR TO DELZ STORE SMM+DELZ TO SMM STORE DELZ*DELZ+SSQ TO SSQ ENDIF SKIP ENDDO * Compute variance for estimate STORE (SSQ-(SMM*SMM)/NN)/(NN-1) TO VARI * * Display results STOR '%' TO HARDCOPY DO WHILE T ? DISP OFF 'Best fit:' DISP OFF ZVAR,' = ' ,STR(A,12,4),' + ',STR(B,12,4),' * ',XVAR DISP OFF ' + ',STR(C,12,4),' * ',YVAR DISP OFF 'Index of determination (r2)=',STR(R2,6,4) DISP OFF 'Variance of the estimate = ',STR(VARI,12,4) ? SET PRINT OFF IF HARDCOPY<>'%' RELEASE ALL RETURN ENDIF ACCEPT 'Hardcopy (Y/N)->' TO HARDCOPY * * Loop for hard copy if desired IF !(HARDCOPY)='Y' SET PRINT ON LOOP ENDIF ? SET TALK ON RELEASE ALL RETURNR.CMD Multiple linear regression of three variables * SET TALK OFF STORE ' ' TO XVAR STORE ' ' TO YVAR STORE ' ' TO ZVAR STORE 0 TO NN STORE 0 TO SMM STORE 0 TO SSQ STORE 0 TO XSUM STORE 0 TO YSUM STORE 0 TO ZSUM STORE 0 TO X2SUM STORE 0 TO Y2SUM STORE 0 TO Z2SUM STORE 0 TO XYSUM STORE 0 TO XZSUM STORE 0 TO YZSUM * ? DISP OFF 'Multiple Linear Regression Analysis' DISP OFF ' Format: Z = a + b*X + c*Y' DISP OFF '-----------------------------------' ? STORE 'X' TO LOOKFOR DO WHI LOOKFOR='X' ACCEPT 'Enter X variable name (? for list)->' TO XVAR IF XVAR=' ' RELEASE ALL RETURN ENDIF IF XVAR='?' DISP STRU LOOP ENDIF IF TYPE(&XVAR)<>'N' DISP OFF 'Non numeric variable, or no match in file. Try again.' LOOP ENDIF STORE 'Y' TO LOOKFOR ENDDO * DO WHILE LOOKFOR='Y' ACCEPT 'Enter Y variable name (? for list)->' TO YVAR IF YVAR=' ' RELEASE ALL RETURN ENDIF IF YVAR='?' DIS"* PLOT.CMD X,Y plots on screen and printer * Uses PLOT0,PLOT1,PLOT2 * CLEAR SET DEFA TO A SET TALK OFF SET BELL OFF * STORE 0 TO LEVEL DO WHILE LEVEL=0 * ERASE ? ' PLOT.CMD' ? ? ' --- X vs Y Plots on Screen and Printer ---' ? ? ' (Assumes data (DBF) file is on the B: drive.)' ? ? ? STORE '0' TO FILNM DO WHILE FILNM='0' ACCEPT 'Enter data file name (? for list),(no B:)->' TO FILNM IF FILNM=' ' RELEASE ALL RETURN ENDIF IF FILNM='?' DISP FILES ON B STORE '0' TO FILNM ENDIF ENDDO STORE 'B:'+FILNM TO FILNM USE &FILNM * STORE 1 TO LEVEL DO WHILE LEVEL=1 * STORE ' ' TO XVAR STORE ' ' TO YVAR STORE '.' TO TYPL * ERASE STORE '_' TO TYPL @ 5,15 SAY 'Plot Types Are:' @ 6,10 SAY 'P(oints - Scatter Diagram' @ 7,10 SAY 'B(ar - Bar Chart' @ 8,10 SAY ' - Return to DBASE II' DO WHILE TYPL<>'B' .AND. TYPL<>'P' .AND. TYPL<>' ' @ 10,10 SAY 'Enter plot type P,B, ->' GET TYPL PICTURE 'X' READ ENDDO ERASE IF TYPL=' ' RELEASE ALL RETURN ENDIF * STORE 2 TO LEVEL DO WHILE LEVEL = 2 * IF TYPL='B' ? 'Note: The B(ar chart option requires that the X axis field data be in' ? ' assending order with no duplications. The record number can be' ? ' used as the X axis by typing # for the X variable name.' ? ENDIF STORE 'X' TO LOOKFOR DO WHILE LOOKFOR='X' ACCEPT 'Enter X variable name (? for list)->' TO XVAR IF XVAR=' ' RELEASE ALL RETURN ENDIF IF XVAR='?' DISP STRU LOOP ENDIF IF TYPE(&XVAR)<>'N' DISP OFF 'Non numeric variable, or no match in file. Try again.' LOOP ENDIF STORE 'Y' TO LOOKFOR ENDDO * DO WHILE LOOKFOR='Y' ACCEPT 'Enter Y variable name (? for list)->' TO YVAR IF YVAR=' ' RELEASE ALL RETURN ENDIF IF YVAR='?' DISP STRU LOOP ENDIF IF TYPE(&YVAR)<>'N' DISP OFF 'Non numeric variable, or no match in file. Try again.' LOOP ENDIF STORE 'DONE' TO LOOKFOR ENDDO * * Find min and max of fields GO TOP DO WHILE * SKIP ENDDO STORE &XVAR TO MINX STORE &XVAR TO MAXX STORE &YVAR TO MINY STORE &YVAR TO MAXY * DO WHILE .NOT. EOF SKIP IF .NOT. * IF &XVARMAXX STORE &XVAR TO MAXX ENDIF IF &YVARMAXY STORE &YVAR TO MAXY ENDIF ENDIF ENDDO * STORE 3 TO LEVEL DO WHILE LEVEL=3 ERASE STORE 0 TO XMARKS STORE 0 TO YMARKS @ 2,12 SAY '-- Specify Plot Bounds ---' @ 3,12 SAY '--------------------------' @ 5,14 SAY '(Default Values Shown)' @ 9,9 SAY XVAR USING 'XXXXXXXXXX' @ 10,1 SAY 'Min X ' GET MINX PICT '99999999.999999' @ 11,1 SAY 'Max X ' GET MAXX PICT '99999999.999999' @ 12,1 SAY 'Divisions ' GET XMARKS PICT '99' @ 14,9 SAY YVAR USING 'XXXXXXXXXX' @ 15,1 SAY 'Min Y ' GET MINY PICT '99999999.999999' @ 16,1 SAY 'Max Y ' GET MAXY PICT '99999999.999999' @ 17,1 SAY 'Divisions ' GET YMARKS PICT '9' @ 11,30 SAY 'Max Y |' @ 12,30 SAY ' |' @ 13,30 SAY ' |' @ 14,30 SAY 'Min Y |' @ 15,30 SAY ' -------------------' @ 16,30 SAY ' Min X Max X' READ * * Plot border and points STORE 6 TO PLOT:LF STORE 75 TO PLOT:RT STORE 21 TO PLOT:BT STORE YVAR TO SIDTI DO PLOT0 STORE (PLOT:RT+PLOT:LF)/2 - LEN(TRIM(XVAR))/2 TO XPOS @ PLOT:BT+1,XPOS SAY XVAR DO CASE CASE TYPL='B' DO PLOT2 OTHERWISE DO PLOT1 ENDCASE * STORE N TO HARDCOPY STORE PLOT:BT+2 TO YPOS @ YPOS,1 SAY 'Points Out of Bounds: ' @ YPOS,23 SAY OUTBND USING '9999' @ YPOS,32 SAY 'Hard Copy (Y/N)?' GET HARDCOPY PICTURE 'X' READ * DO WHILE HARDCOPY ERASE @ 1,17 SAY 'Enter plot tiles:' STORE ' ' TO TOPTI @ 5,1 SAY 'Top: ' GET TOPTI PICTURE 'XXXXXXXXXXXXXXXXXXXXXXXXX' STORE ' ' TO SIDTI @ 6,1 SAY 'Side Title: ' GET SIDTI PICTURE 'XXXXXXXXXXXXXXXX' STORE ; ' ' ; TO BOT1 @ 7,1 SAY 'Bot1: ' ; GET BOT1 PICTURE ; 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX' STORE ' ' TO BOT2 @ 8,1 SAY 'Bot2: ' ; GET BOT2 PICTURE 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX' STORE ' ' TO BOT3 @ 9,1 SAY 'Bot3: ' ; GET BOT3 PICTURE 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX' STORE T TO PTRRDY @ 12,1 SAY 'Ready printer, then hit return.' GET PTRRDY PICTURE 'X' READ IF .NOT.(PTRRDY) STORE F TO HARDCOPY LOOP ENDIF * ERASE STORE 30 TO PLOT:BT STORE 72 TO PLOT:RT STORE 6 TO PLOT:LF DO PLOT0 DO CASE CASE TYPL='P' DO PLOT1 CASE TYPL='B' DO PLOT2 ENDCASE * SET FORMAT TO PRINT @ 0,0 SAY CHR(27)+'E' @ 0,1 SAY CHR(14) @ 0,24-LEN(TRIM(TOPTI))/2 S#AY TOPTI ? ? STORE 1 TO YPOS STORE 0 TO XPOS DO WHILE YPOS31 STORE LINPRN+CHR(SCRC) TO LINPRN CASE SCRC=11 STORE LINPRN+CHR(202) TO LINPRN CASE SCRC=24 STORE LINPRN+CHR(172) TO LINPRN CASE SCRC=26 STORE LINPRN+CHR(174) TO LINPRN CASE SCRC=3 STORE LINPRN+CHR(174) TO LINPRN CASE SCRC=12 STORE LINPRN+CHR(206) TO LINPRN CASE SCRC=18 STORE LINPRN+CHR(161) TO LINPRN CASE SCRC=20 STORE LINPRN+CHR(162) TO LINPRN CASE SCRC=6 STORE LINPRN+CHR(176) TO LINPRN CASE SCRC=7 STORE LINPRN+CHR(192) TO LINPRN CASE SCRC=1 STORE LINPRN+CHR(181) TO LINPRN CASE SCRC=4 STORE LINPRN+CHR(202) TO LINPRN CASE SCRC=5 STORE LINPRN+CHR(203) TO LINPRN CASE SCRC=17 STORE LINPRN+CHR(183) TO LINPRN CASE SCRC=23 STORE LINPRN+CHR(163) TO LINPRN OTHERWISE STORE LINPRN+CHR(32) TO LINPRN ENDCASE STORE XPOS+1 TO XPOS ENDDO @ YPOS,0 SAY LINPRN STORE YPOS+1 TO YPOS STORE 0 TO XPOS ENDDO * @ PLOT:BT+3,(40-LEN(TRIM(BOT1))/2) SAY BOT1 @ PLOT:BT+4,(40-LEN(TRIM(BOT2))/2) SAY BOT2 @ PLOT:BT+5,(40-LEN(TRIM(BOT3))/2) SAY BOT3 EJECT SET FORMAT TO SCREEN ERASE STORE N TO HARDCOPY ENDDO * ERASE @ 2,20 SAY '--Options--' @ 5,10 SAY 'Q - Quit to DBASE II' @ 6,10 SAY 'F - Change data file' @ 7,10 SAY 'B - Change plot bounds' @ 8,10 SAY 'V - Change variables (fields)' @ 9,10 SAY 'T - Change plot type (Bar, Points)' STORE ' ' TO OPT @ 13,15 SAY 'Option ->' GET OPT PICTURE 'X' READ * DO CASE CASE !(OPT)='B' STORE 3 TO LEVEL CASE !(OPT)='V' STORE 2 TO LEVEL CASE !(OPT)='T' STORE 1 TO LEVEL CASE !(OPT)='F'  STORE 0 TO LEVEL OTHERWISE SET DEFA TO B RELEASE ALL RETURN ENDCASE ERASE ENDDO ENDDO ENDDO ENDDON+CHR(163) TO LINPRN OTHERWISE STORE LINPRN+CHR(32) TO LINPRN ENDCASE STORE XPOS+1 TO XPOS ENDDO @ YPOS,0 SAY LINPRN STORE YPOS+1 TO YPOS STORE 0 TO XPOS ENDDO * @ PLOT:BT+3,(40-LEN(TRIM(BOT1))/2) SAY BOT1 @ PLOT:BT+4,(40-LEN(TRIM(BOT2))/2) SAY BOT2 @ PLOT:BT+5,(40-LEN(TRIM(BOT3))/2) SAY BOT3 EJECT SET FORMAT TO SCREEN ERASE STORE N TO HARDCOPY ENDDO * ERASE @ 2,20 SAY '--Options--' @ 5,10 SAY 'Q - Quit to DBASE II' @ 6,10 SAY 'F - Change data file' @ 7,10 SAY 'B - Change plot bounds' @ 8,10 SAY 'V - Change variables (fields)' @ 9,10 SAY 'T - Change plot type (Bar, Points)' STORE ' ' TO OPT @ 13,15 SAY 'Option ->' GET OPT PICTURE 'X' READ * DO CASE CASE !(OPT)='B' STORE 3 TO LEVEL CASE !(OPT)='V' STORE 2 TO LEVEL CASE !(OPT)='T' STORE 1 TO LEVEL CASE !(OPT)='F' * PLOT0.CMD Plots border for PLOT.CMD * ERASE STORE 0 TO XPOS STORE 0 TO YPOS STORE 0 TO CNTR * Set graphics chrs on ? CHR(27)+CHR(103) * * vert axis DO WHILE YPOS=100 .OR. PRVAR<=-100 @ YPOS,XPOS SAY PRVAR USING '999999' CASE PRVAR>=1 .OR. PRVAR<=-1 @ YPOS,XPOS SAY PRVAR USING '999.99' OTHERWISE @ YPOS,XPOS SAY PRVAR USING '9.9999' ENDCASE STORE CNTR+1 TO CNTR ENDDO * * Put left side title on plot STORE 1 TO CNTR DO WHILE CNTR <= LEN(TRIM(SIDTI)) STORE PLOT:BT/2 - LEN(TRIM(SIDTI))/2 + CNTR TO YPOS @ YPOS,2 SAY $(SIDTI,CNTR,1) STORE CNTR+1 TO CNTR ENDDO * RETURN  TO CHRN ENDIF @ PLOT:BT,XPOS SAY CHR(CHRN) STORE XPOS+1 TO XPOS ENDDO * * Put numeric values on axis STORE 1 TO CNTR DO WHILE CNTR<5 DO CASE CASE CNTR=1 STORE MAXY TO PRVAR STORE 0 TO YPOS STORE 0 TO XPOS CASE CNTR=2 STORE MINY TO PRVAR STORE PLOT:BT-1 TO YPOS CASE CNTR=3 STORE MINX TO PRVAR STORE PLO$* PLOT1.CMD Plots points for PLOT.CMD * STORE 0 TO OUTBND GO TOP DO WHILE .NOT. EOF IF .NOT. * STORE (&XVAR-MINX)/(MAXX-MINX) TO XFRAC STORE (&YVAR-MINY)/(MAXY-MINY) TO YFRAC STORE PLOT:LF+1+INT((XFRAC*(PLOT:RT-PLOT:LF-1))+.5) TO XPOS STORE PLOT:BT-1-INT((YFRAC*(PLOT:BT-1))+.5) TO YPOS * check if point is in bounds IF XPOS > PLOT:RT .OR. XPOS < PLOT:LF+1 .OR. YPOS > PLOT:BT-1; .OR. YPOS<0 STORE OUTBND+1 TO OUTBND ELSE * Point is in bounds so plot it IF YFRAC*(PLOT:BT-1) > INT(YFRAC*(PLOT:BT-1))+.5 STORE T TO VF ELSE STORE F TO VF ENDIF IF XFRAC*(PLOT:RT-PLOT:LF-1) > INT(XFRAC*(PLOT:RT-PLOT:LF-1))+.5 STORE T TO HF ELSE STORE F TO HF ENDIF * DO CASE CASE VF .AND. HF STORE 6 TO CHRN CASE VF .AND. (.NOT. HF) STORE 7 TO CHRN CASE HF .AND. (.NOT. VF) STORE 18 TO CHRN OTHERWISE STORE 20 TO CHRN  ENDCASE * @ YPOS,XPOS SAY CHR(CHRN) * ENDIF ENDIF SKIP ENDDO * * Turn graphics off @ 1,115 SAY ' ' ? CHR(27)+CHR(71) RETURN S STORE PLOT:BT-1-INT((YFRAC*(PLOT:BT-1))+.5) TO YPOS * check if point is in bounds IF XPOS > PLOT:RT .OR. XPOS < PLOT:LF+1 .OR. YPOS > PLOT:BT-1; .OR. YPOS<0 STORE OUTBND+1 TO OUTBND ELSE * Point is in bounds so plot it IF YFRAC*(PLOT:BT-1) > INT(YFRAC*(PLOT:BT-1))+.5 STORE T TO VF ELSE STORE F TO VF ENDIF IF XFRAC*(PLOT:RT-PLOT:LF-1) > INT(XFRAC*(PLOT:RT-PLOT:LF-1))+.5 STORE T TO HF ELSE STORE F TO HF ENDIF * DO CASE CASE VF .AND. HF STORE 6 TO CHRN CASE VF .AND. (.NOT. HF) STORE 7 TO CHRN CASE HF .AND. (.NOT. VF) STORE 18 TO CHRN OTHERWISE STORE 20 TO CHRN * PLOT2.CMD Plots bar charts for PLOT.CMD * STORE 0 TO OUTBND STORE -1 TO OLDX STORE -1 TO OLDY GO TOP DO WHILE .NOT. EOF IF .NOT. * STORE (&XVAR-MINX)/(MAXX-MINX) TO XFRAC STORE (&YVAR-MINY)/(MAXY-MINY) TO YFRAC STORE PLOT:LF+1+INT((XFRAC*(PLOT:RT-PLOT:LF-1))+.5) TO TEMPX STORE PLOT:BT-1-INT((YFRAC*(PLOT:BT-1))+.5) TO TEMPY * check if point is in bounds IF TEMPX>PLOT:RT .OR. TEMPXPLOT:BT-1; .OR. TEMPY<1 STORE OUTBND+1 TO OUTBND ELSE * Point is in bounds, so plot bar STORE TEMPX TO XPOS STORE TEMPY TO YPOS @ YPOS,XPOS SAY CHR(17) * Put in vert line STORE YPOS+1 TO TEMP DO WHILE TEMP-1 STORE XPOS-OLDX TO DELX STORE OLDX+1 TO TEMP DO WHILE TEMP 1 STORE XPOS+1 TO XPOS STORE DELX-1 TO DELX @ YPOS,XPOS SAY CHR(23) ENDDO ENDIF DO WHILE YPOS-1 STORE XPOS-OLDX TO DELX STORE OLDX+1 TO TEMP DO WHILE TEMP' TO PFIL IF PFIL = ' ' RETURN ENDIF IF PFIL='?' DISP FILES ON B ENDIF ENDDO USE &PFIL ? ? '------ From Read file ------' ? STORE 'X' TO LOOKFOR DO WHILE LOOKFOR='X' ACCEPT 'Enter X variable name (? for list)->' TO XVAR IF XVAR=' ' RELEASE ALL RETURN ENDIF IF XVAR='?' DISP STRU LOOP ENDIF IF TYPE(&XVAR)<>'N' DISP OFF 'Non numeric variable, or no match in file. Try again.' LOOP ENDIF STORE 'Y' TO LOOKFOR ENDDO * DO WHILE LOOKFOR='Y' ACCEPT 'Enter Y variable name (? for list)->' TO YVAR IF YVAR=' ' RELEASE ALL RETURN ENDIF IF YVAR='?' DISP STRU % LOOP ENDIF IF TYPE(&YVAR)<>'N' DISP OFF 'Non numeric variable, or no match in file. Try again.' LOOP ENDIF STORE 'Z' TO LOOKFOR ENDDO ? STORE -1 TO COEF DO WHILE ((COEF<0) .OR. (COEF>1)) INPUT 'Enter exponential smoothing constant (0 to 1)->' TO COEF ENDDO ? SELECT SECONDARY USE XSMOOTH DELETE ALL PACK SELECT PRIMARY * STORE 0 TO NN GO TOP STORE &YVAR TO OLDY SKIP DO WHILE .NOT. (EOF) IF .NOT. (*) STORE (OLDY*(1-COEF)) + (&YVAR*COEF) TO OLDY STORE &XVAR TO OLDX SELECT SECONDARY APPEND BLANK REPLACE X WITH OLDX REPLACE Y WITH OLDY SELECT PRIMARY STORE NN+1 TO NN ENDIF SKIP ENDDO * DISP OFF NN' Records copied to file XSMOOTH.DBF.' ? CLEAR RETURN w@}for list)->' TO XVAR IF XVAR=' ' RELEASE ALL RETURN ENDIF IF XVAR='?' DISP STRU LOOP ENDIF IF TYPE(&XVAR)<>'N' DISP OFF 'Non numeric variable, or no match in file. Try again.' LOOP ENDIF STORE 'Y' TO LOOKFOR ENDDO * DO WHILE LOOKFOR='Y' ACCEPT 'Enter Y variable name (? for list)->' TO YVAR IF YVAR=' ' RELEASE ALL RETURN ENDIF IF YVAR=@}for list)->' TO XVAR IF XVAR=' ' RELEASE ALL RETURN ENDIF IF XVAR='?' DISP STRU LOOP ENDIF IF TYPE(&XVAR)<>'N' DISP OFF 'Non numeric variable, or no match in file. Try again.' LOOP ENDIF STORE 'Y' TO LOOKFOR ENDDO * DO WHILE LOOKFOR='Y' ACCEPT 'Enter Y variable name (? for list)->' TO YVAR IF YVAR=' ' RELEASE ALL RETURN ENDIF IF YV SXN rYN r 2.000 2.000 3.000 2.000 4.000 1.000 5.000 3.000 6.000 4.000 7.000 4.000 8.000 5.000 9.000 6.000 10.000 3.000 10.000 3.000w@} This is the release date of the disk. !K"K$K%K&K'K(K)K+K,K-K.K/K2K3K4K5K6K7K8K9K:K;KK?K@KAKBKCKDKEKFKGKHKIKJKKKLKMKNKOKPKQKRKSKTKUKVKWKXKYKZK[K\K]K^K_K`KaKbKcKdKeKfKgKhKiKjKkKlKmKnKoKpKqKrKsKtKuKvKwKxKyKzK{K|K}K~KKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKKLPAYEMPS .CMD EB E7 2944 23 PAYFIND .CMD 97 48 5120 40 PAYMENU .CMD D9 14 3072 24 PAYROLL .CMD 6A 79 13312 104 PERSONNE.DBF C1 52 1024 8 POSTFILE.DBF 49 A0 2048 16 PRINTOUT.CMD 21 17 1280 10 REPORTME.CMD 53 0C 2688 21 REVHDR .CMD 78 57 1152 9 REVIEW .CMD 1F DF 10496 82 REVMRGN .CMD 28 EE 512 4 SALESTAX.CMD F1 33 5376 42 SUPPLIER& Fog Library Disk FOG-CPM.089 Copyright (1986) by Fog International Computer Users Group to the extent not copyrighted by the original author for the exclusive use and enjoyment of its members. Any reproduction or distribution for profit or personal gain is strictly forbidden. For information, contact FOG, P. O. Box 3474, Daly City, CA. 94015-0474. as part of the description of a file indicates that the program is distributed on a "try first, pay if you like it" basis. If you find the program(s) meet your need, please refer to the author's documentation for information on becoming a registered user. Only by registering and paying for the programs you like and use will the authors of such programs continue development. Often, more complete documentation, additional modules, and new releases are available only to registered users. Disk 2 of 2. dBASE II accounting program plus several very useful utilities for dBASE users. Filename Description -07-00 .86 This is the release date of the disk. -CPM089 .DOC This is the description of the disk contents. IOMENU .CMD C1E7 4K [Accounting 34 of 57] IOPOST .CMD 89E6 4K [Accounting 35 of 57] IOREVIEW.CMD 8756 2K [Accounting 36 of 57] JOBCOSTS.CMD C87E 8K [Accounting 37 of 57] JOBCOSTS.FRM 4925 1K [Accounting 38 of 57] JOBSINDX.CMD D7F2 3K [Accounting 39 of 57] MEDIA .FRM 976A 2K [Accounting 40 of 57] NAMETEST.CMD B9A6 2K [Accounting 41 of 57] PAYBILLS.CMD 52FC 10K [Accounting 42 of 57] PAYEMPS .CMD EBE7 3K [Accounting 43 of 57] PAYFIND .CMD 9748 5K [Accounting 44 of 57] PAYMENU .CMD D914 3K [Accounting 45 of 57] PAYROLL .CMD 6A79 13K [Accounting 46 of 57] PERSONNE.DBF C152 1K [Accounting 47 of 57] POSTFILE.DBF 49A0 2K [Accounting 48 of 57] PRINTOUT.CMD 2117 2K [Accounting 49 of 57] REPORTME.CMD 530C 3K [Accounting 50 of 57] REVHDR .CMD 7857 2K [Accounting 51 of 57] REVIEW .CMD 1FDF 11K [Accounting 52 of 57] REVMRGN .CMD 28EE 1K [Accounting 53 of 57] SALESTAX.CMD F133 6K [Accounting 54 of 57] SUPPLIER.DBF D4C0 2K [Accounting 55 of 57] TIMECALC.CMD 4E62 4K [Accounting 56 of 57] USETAX .CMD 94B6 5K [Accounting 57 of 57] DBDIR .COM 6D1F 2K [DBDIR 1 of 4] Demonstrates how to call an assembler routine from dBASE II and helps explain this poorly documented command. DBDIR .DOC 2B67 1K [DBDIR 2 of 4] DBDIR .ASM AC4B 7K [DBDIR 3 of 4] DBDIR .CMD D52A 5K [DBDIR 4 of 4] DBUTILS .DOC 246A 9K [dBASE Utilities 1 of 18] A collection of handy dBASE utilities. TEST .DBF 73FF 1K [dBASE Utilities 2 of 18] DATE .CMD 3C9E 3K [dBASE Utilities 3 of 18] AVE .CMD CABE 2K [dBASE Utilities 4 of 18] Finds the average and variance of a given field. BLANK .CMD 55E6 1K [dBASE Utilities 5 of 18] Adds blank fields to the bottom of a data file. DBSC .CMD 9F0F 4K [dBASE Utilities 6 of 18] Converts dBASE II data files to SuperCalc 1.12 (or higher) files. DELDUP .CMD 655A 2K [dBASE Utilities 7 of 18] Marks duplicate records for deletion. JULIAN .CMD 73A6 3K [dBASE Utilities 8 of 18] Writes the Julian date for every occurrence in a file. LSQ .CMD EDF1 3K [dBASE Utilities 9 of 18] Calculates best fit line by least squares method. MAX .CMD 76BB 2K [dBASE Utilities 10 of 18] Finds the maximum values of a field. MIN .CMD 51E9 3K [dBASE Utilities 11 of 18] Finds the minimum value in a numeric or character field. MLR .CMD 3AA7 5K [dBASE Utilities 12 of 18] Calculates best fit with two free variables. PLOT .CMD 5C6A 8K [dBASE Utilities 13 of 18] Allows you to make X-Y plots on an Epson printer. PLOT0 .CMD 4BC8 2K [dBASE Utilities 14 of 18] PLOT1 .CMD 39DC 2K [dBASE Utilities 15 of 18] PLOT2 .CMD 8B2A 2K [dBASE Utilities 16 of 18] XSMOOTH .CMD 68FF 4K [dBASE Utilities 17 of 18] Exponential smoothing of one variable. XSMOOTH .DBF 25FC 1K [dBASE Utilities 18 of 18]  SET ALTE TO &malt SET ALTE ON ? filedesc SET ALTE OFF SET ALTE TO SELE A STOR diskf-"-"-SUBST(dfile,5,3)-"&mdiskno"-".DOC" TO malt SET ALTE TO &malt SET ALTE ON DO WHILE diskno="&mdiskno".AND. .NOT. EOF() IF diskno="000" IF dfile="FOG-DOS" ? " '