Liren Large Software Subsidy 5

home *** CD-ROM | disk | FTP | other *** search

/ Liren Large Software Subsidy 5 / 05.iso / a / a031 / samples.exe / INVOICES.PRG < prev next >

Wrap

Text File | 1992-03-10 | 11.9 KB | 397 lines

****************************************************************************** * PROGRAM NAME: INVOICES.PRG * SAMPLE CUSTOM REPORT - INVOICES * GENERATES INVOICES & UPDATES ACCT_REC.DBF * SAMPLE BUSINESS APPLICATION * LAST CHANGED: 09/25/89 09:26AM * WRITTEN BY: Borland International Inc. ****************************************************************************** * Logic and some variable names modeled after reports generator ****************************************************************************** * SET PROCEDURE TO Library SET COLOR TO &c_normal. CLEAR inv_month = 0 ll_ans = NodShake(" ; INVOICE PRINTING ; ;" + ; " ************************************************************** ;" + ; " This will process and alter current data in: Acct_rec,Orders ; ;" + ; " Are you sure you want to print invoices?", ; 6, 6, 7, 65, .T. ) answer = IIF( ll_ans, "Y", "N" ) IF answer = "N" RETURN TO Business ELSE ?? CHR(7) inv_month = MONTH(DATE())-1 @ 10, 8 CLEAR TO 14,72 @ 12,12 SAY "What month do want to process orders for (01-12)?" ; GET inv_month PICTURE "99" RANGE 1,12 READ ENDIF * Open database files and choose active indexes SELECT 1 USE Orders ORDER Order USE Cust ORDER Cust_id IN 2 USE Acct_rec ORDER Cust_id IN 3 USE Goods ORDER part_id IN 4 * Relate database files and activate the relation SET RELATION TO cust_id INTO Cust, cust_id INTO Acct_rec, part_id INTO Goods GO TOP * Error message window DEFINE WINDOW err_wndo FROM 16,3 TO 23,60 COLOR &c_pop. * If user presses Esc during printing, exit ON ESCAPE DO Stop_rpt * Process errors ON ERROR DO Err_msg * Set up environment SET SPACE OFF _plineno = 0 _peject = "NONE" _pageno = 1 * Initialize variables continu_on = .T. && Continue printing flag - set by Esc to .F. complete = .F. on_pg_line = 0 && Line at which ON PAGE works STORE 0 TO amt_of_bil, amt_of_cur, inv_amount, oldbalance STORE 0 TO inv_count, ord_count, grand_tot, tot_price STORE "" TO invoice_no, mcust_id, today, this_year, this_month today = DTOC(DATE()) this_year = RIGHT(today,2) this_month = LEFT(today,2) * Calculate line no. to break page on on_pg_line = INT(_plength - 6) && Height minus footer and margin * Set up line number where page break procedure executes ON PAGE AT LINE on_pg_line DO Page_brk SET CONSOLE off SET PRINTER on *================================ Begin Print Job ============================ PRINTJOB * ======= File loop - process records in index order to end of file ======= * or until user presses Esc (continu_on = .F.) * Process all uninvoiced records for a particular customer SCAN FOR .NOT. invoiced .AND. inv_month = MONTH(date_trans) ; WHILE continu_on mcust_id = cust_id DO Pg_head && Print standard page heading DO Inv_head && Print invoice heading complete = .F. && Flag customer's invoices not completely processed * Print orders for this customer SCAN FOR .NOT. invoiced .AND. inv_month = MONTH(date_trans) ; WHILE cust_id = mcust_id .AND. continu_on DO Detail ENDSCAN complete = .T. && Flag customer's invoices are completely processed SKIP -1 && Return to last record for customer DO Inv_calc && Print invoice total for last customer EJECT PAGE && Print invoice footer - Inv_foot called by ON PAGE DO Updat_ar && Update Acct_rec database file with processed data DO Reinit && Re-initialize summary variables ENDSCAN IF continu_on * End of file - User did not press Esc to stop printing message = "Invoices were completely processed and printed for month " ; + STR(inv_month,2) ELSE * Not EOF - User pressed Esc to stop printing message = "Invoices were NOT COMPLETED - stopped by user at " + TIME() ENDIF DO Rpt_end WITH message ON PAGE ENDPRINTJOB *============================= End Print Job ================================= EJECT PAGE ON PAGE SET CONSOLE on SET PRINTER off CLEAR ll_ans = NodShake(" ; ARCHIVE ORDERS ; ;" + ; " ************************************************************** ;" + ; " (Copy processed orders to archive file and delete from Orders); ;" + ; " Do you want to archive the processed orders?", ; 6, 6, 7, 65, .F. ) answer = IIF( ll_ans, "Y", "N" ) IF answer = "Y" ?? CHR(7) @ 10,12 SAY "COPYING processed orders...please wait " @ 12,10 SAY SPACE(61) @ 13,10 SAY SPACE(63) CLOSE DATABASES * Create an archive database file for processed orders. * Records will be copied to it, then erased from Orders. IF .NOT. FILE("Archiv_o.dbf") USE Orders COPY STRUCTURE TO Archiv_o ENDIF USE Archiv_o APPEND FROM Orders FOR invoiced *-- Remove the archived records from Orders USE Orders SET TALK on DELETE ALL FOR invoiced @ 10,10 SAY "ERASING processed orders...please wait " PACK SET TALK off ELSE ?? CHR(7) DO Err_Box WITH "Processed orders will not be erased" ENDIF ON ESCAPE ON ERROR CLOSE ALL SET PROCEDURE TO RETURN TO Business ********************* END OF MAIN REPORT PROCEDURE *************************** * UTILITY PROCEDURES PROCEDURE Detail * Print report detail ?? date_trans AT 0, ?? part_id AT 10, ?? Goods->part_name AT 21, ?? part_qty AT 53 PICTURE "999", ?? Goods->price AT 58 PICTURE "99,999.99", * Extend price tot_price = ROUND(part_qty * Goods->price,2) ?? tot_price AT 70 PICTURE "99,999.99" ? * Accumulate total amount of current invoice amt_of_cur = amt_of_cur + tot_price * Accumulate number of orders processed ord_count = ord_count + 1 * Update the posted flag "invoiced" to .T. in Orders dbf for this order REPLACE invoiced WITH .T. RETURN PROCEDURE Err_msg * Error messages SET PRINTER off SET CONSOLE on ACTIVATE WINDOW err_wndo CLEAR ? "--------------------- ERROR WARNING --------------------" IF .NOT. PRINTSTATUS() * Printer caused error msg = "Printer error - fix paper or select ONLINE button" ELSE * Unknown cause of error - show system message msg = MESSAGE() ENDIF ? " Error Number ", LTRIM(STR(ERROR(),4)) ? " " + msg WAIT " Press spacebar to continue..." DEACTIVATE WINDOW err_wndo SET CONSOLE off SET PRINTER on RETURN PROCEDURE Inv_calc * Print calculated summary data on details at cust_id break amt_of_bil = amt_of_cur + oldbalance ?? "----------" AT 69 ? ?? "CURRENT ORDERS" AT 0, ?? "$" AT 66, ?? amt_of_cur PICTURE "999,999.99" AT 69 ? IF oldbalance <> 0 ?? "----------" AT 69 ? "+ OLD BALANCE" ?? oldbalance PICTURE "999,999.99" AT 69, ? ENDIF ?? "==========" AT 69 ? ?? "TOTAL AMOUNT DUE" STYLE "B" AT 0, ?? "$" STYLE "B" AT 66, ?? amt_of_bil PICTURE "999,999.99" STYLE "B" AT 69 ? ?? "==========" AT 69 * Accumulate total billings for end of report grand_tot = grand_tot + amt_of_bil ? ? RETURN PROCEDURE Inv_foot * Print invoice page footer ? ? "TERMS: " AT 27,Cust->terms ? ? Acct_rec->notes AT 18 * Start new page EJECT PAGE RETURN PROCEDURE Inv_head * Encode new unique invoice number invoice_no = cust_id + this_year + this_month * Increment invoice count inv_count = inv_count + 1 ? ?? "INVOICE NO.: " STYLE "B" AT 0, ?? invoice_no STYLE "B" FUNCTION "T" PICTURE "XXXXXXXXXX" , ?? DATE() AT 69 ? ? ?? "CUSTOMER NO.: " AT 0, ?? cust_id FUNCTION "T" PICTURE "XXXXXX" ? ? ?? Cust->customer AT 0 ? ?? Cust->address1 AT 0, Cust->address2 AT LEN(TRIM(Cust->address1))+2 ? ?? Cust->city PICTURE "@T XXXXXXXXXXXXXXXXXXXX" AT 0, ?? ", ", ?? Cust->state," ", ?? Cust->zip ? ?? "ATTENTION: " AT 0 , ?? Cust->contact PICTURE "@T XXXXXXXXXXXXXXXXXXXX"," ", ?? Cust->phone_cont ? ? REPLICATE(CHR(205),80) && Draw double line 80 characters wide ? ? ?? "PREVIOUS ACTIVITY:" STYLE "BU" AT 0 ? ?? "INVOICE NO.:" AT 4, Acct_rec->invoic_old AT 15 ?? "SENT:" AT 31, Acct_rec->dat_lstbil AT 37 ? ?? "AMOUNT $ " AT 4, Acct_rec->amt_lstbil PICTURE "999,999.99" AT 15 ? ?? "PAID $ " AT 4, Acct_rec->amt_lst_pd PICTURE "999,999.99" AT 15 ? ?? "----------" AT 15 ? ?? "BALANCE $ " AT 4 oldbalance = Acct_rec->oldbalance ?? oldbalance PICTURE "999,999.99" AT 15 ? ? ?? "CURRENT ACTIVITY:" STYLE "BU" AT 0 ? REPLICATE(CHR(196),80) && Draw single line 80 characters wide ? "Ordered" AT 0 ?? "Part no." AT 10 ?? "Part name" AT 21 ?? "Qty" AT 53 ?? "Price" AT 59 ?? "Total" AT 74 ? REPLICATE(CHR(196),80) && Draw single line 80 characters wide ? RETURN PROCEDURE Page_brk * Page break logic - occurs when report detail line = on_pg_line DO Inv_foot * Print heading if customer's invoices were not completed on prior page IF .NOT. EOF() .AND. .NOT. complete DO Pg_head ENDIF RETURN PROCEDURE Pg_head * Print information at top of each invoice page ? ? "Page " , ?? _pageno PICTURE "999" ? ? ? "A-T FURNITURE INDUSTRIES" STYLE "B" AT 27 ? DEFINE BOX FROM 34 TO 45 HEIGHT 3 SINGLE ? ?? "INVOICE" STYLE "B" AT 36 ? ? ? REPLICATE(CHR(205),80) && Draw double line 80 characters wide ? RETURN PROCEDURE Reinit * Re-initialize summary/calculation variables at customer breaks STORE 0 TO amt_of_cur, inv_amount _pageno = 1 RETURN PROCEDURE Rpt_end PARAMETERS message * Print end-of-report summary data ? ? ? "A-T FURNITURE INDUSTRIES" STYLE "BU" AT 27 ? ? ? "INVOICE SUMMARY PAGE" STYLE "B" AT 30 ? inv_date = CTOD(STR(inv_month,2)+RIGHT(DTOC(DATE()),6)) ? "FOR MONTH of " AT 31, CMONTH(inv_date) ? ? ? ? REPLICATE(CHR(205),80) && Draw double line 80 characters wide ? DATE() AT 0 , ?? TIME() AT 69 ? REPLICATE(CHR(205),80) && Draw double line 80 characters wide ? ? ? ? ?? "===========" AT 67, ? ?? "GRAND TOTAL for " AT 0, ?? inv_count PICTURE "999", ?? " invoices " AT 21, ?? "and ", ord_count PICTURE "9,999", ?? " orders:", ?? "$" AT 66, ?? grand_tot PICTURE "999,999.99" , ? ?? "===========" AT 67 ? ? ? ? message AT 6 ? RETURN PROCEDURE Stop_rpt continu_on = .F. && Set stop printing flag to .F. when user presses Esc RETURN PROCEDURE Updat_ar * Update the related Acct_rec database record for this customer with data * processed/calculated during invoicing and prior data SELECT Acct_rec IF Orders->cust_id <> cust_id * If customer has never been invoiced, create an AR record for customer APPEND BLANK REPLACE cust_id WITH Orders->cust_id ENDIF REPLACE invoic_old WITH invoice_no, dat_lstbil WITH dat_of_bil, ; amt_lst_pd WITH amt_cur_pd, amt_lstbil WITH amt_of_cur, ; oldbalance WITH amt_lstbil - amt_lst_pd, comments WITH "", ; notes WITH "", invoice_no WITH m->invoice_no, ; dat_of_bil WITH DATE(), amt_of_cur WITH m->amt_of_cur, ; amt_of_bil WITH m->amt_of_bil SELECT Orders RETURN ****************************************** END OF INVOICES.PRG ***************