Liren Large Software Subsidy 5

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

/ Liren Large Software Subsidy 5 / 05.iso / a / a070 / 3.ddi / FOXPRO / SAMPLE / PAYMENTS.PRG < prev next >

Wrap

Text File | 1989-11-08 | 6.6 KB | 263 lines

* ┌─────────────────────────────────────────────────────────────────────┐ * * │ PROG NAME: PAYMENTS.PRG - Payments file Maintenance. │ * * │ Copyright (c) 1989 Tech III, Inc. All rights reserved. │ * * │ Tech III of San Pedro, California (213) 547-2191. │ * * │ "The bridge connecting people and technology."(tm) │ * * └─────────────────────────────────────────────────────────────────────┘ * ACTIVATE WINDOW screensim DO setup SELECT invoice SET ORDER TO inv_cus SELECT customer IF BOF() .OR. EOF() GO TOP IF EOF() DO standby WITH "Customer file is Empty." RETURN ENDIF ENDIF SET ORDER TO cus_cus IF EOF() GO TOP ENDIF STORE cust_id TO mcust_id mtotal=0.00 STORE ' CUSTOMER ' TO bar_label1 STORE ' PAYMENTS ' TO bar_label2 SELECT payments SET ORDER TO pmt_cus SEEK mcust_id DO disp_scrn DO disp_pmt STORE .t. TO paymnts DO WHILE paymnts ACTIVATE MENU paymnts PAD pbrowse IF .NOT. in_prodemo DEACTIVATE MENU ENDIF ENDDO DO shutdown RETURN PROCEDURE add_pmt SELECT payments ACTIVATE WINDOW screensim BOTTOM APPEND BLANK REPLACE cust_id WITH mcust_id, DATE WITH DATE() DO brow_paym SEEK mcust_id IF FOUND() DELETE REST FOR amount = 0 WHILE cust_id = mcust_id ENDIF DO disp_pmt RETURN PROCEDURE brow_paym && Browse & Change SELECT payments ACTIVATE WINDOW w_payments BOTTOM SHOW WINDOW browhelp ON KEY LABEL F10 keyboard CHR(23) SHOW WINDOW w_payments TOP BROWSE KEY mcust_id ; NOAPPEND NODELETE NOMENU NOCLEAR SAVE; WINDOW w_payments ; FIELDS date:15, reference:15, amount:15 SHOW WINDOW w_payments SAVE ON KEY LABEL F10 HIDE WINDOW browhelp RETURN PROCEDURE brow_pmt && Browse to scroll only SELECT payments ACTIVATE WINDOW screensim BOTTOM SHOW WIND w_payments TOP SHOW WINDOW browhelp ON KEY LABEL F10 keyboard CHR(23) BROWSE KEY mcust_id ; NOMODIFY NOAPPEND NODELETE NOMENU NOCLEAR SAVE; WINDOW w_payments ; FIELDS date:15, reference:15, amount:15 SHOW WINDOW w_payments SAVE ON KEY LABEL F10 HIDE WINDOW browhelp RETURN PROCEDURE chg_pmt SELECT payments DO brow_paym SEEK mcust_id IF FOUND() DELETE ALL FOR amount = 0 WHILE cust_id = mcust_id ENDIF SEEK mcust_id DO disp_pmt RETURN PROCEDURE del_pmt SELECT payments DO msg2user WITH 'DELETION INSTRUCTIONS', ; 'Edit amount to equal zero.', 'System will then remove the item.' DO brow_paym DO msg2user WITH 'CLOSE'k SEEK mcust_id IF FOUND() DELETE REST FOR amount = 0 WHILE cust_id = mcust_id ENDIF SEEK mcust_id DO disp_pmt RETURN PROCEDURE disp_pmt SELECT customer ACTIVATE WINDOW w_customer mcust_id = cust_id @ 00,18 SAY mcust_id @ 02,01 SAY company @ 03,01 SAY address1 @ 04,01 SAY city @ 04,27 SAY state @ 04,31 SAY zip SELECT payments @ 02,58 SAY ' <calculating>' @ 03,58 SAY ' <calculating>' @ 04,58 SAY ' <calculating>' mtotsale = CUSTSALES() @ 02,58 SAY mtotsale PICT '999,999,999.99' mtotpaym = CUSTPAYM() @ 03,58 SAY mtotpaym PICT '999,999,999.99' mdiff = mtotsale - mtotpaym @ 04,58 SAY mdiff PICT '999,999,999.99' SELECT payments ACTIVATE WINDOW screensim BOTTOM @ 20,00 GET bar_label1 COLOR SCHEME 3 @ 20,39 GET bar_label2 COLOR SCHEME 3 CLEAR GETS BROWSE KEY mcust_id ; NOWAIT NOMENU WINDOW w_payments ; FIELDS date:15, reference:15, amount:15 RETURN PROCEDURE disp_scrn ACTIVATE WINDOW w_customer CLEAR @ 00,01 SAY "Customer number: " @ 02,42 SAY "Total Invoices:" @ 03,42 SAY "Total Payments:" @ 04,42 SAY " Amount Owed:" CLEAR GETS RETURN PROCEDURE last_cus SELECT customer GO BOTTOM DO disp_pmt RETURN PROCEDURE next_cus SELECT customer IF .NOT. EOF() SKIP ENDIF IF EOF() GO BOTTOM DO standby WITH "End of file: there is no NEXT record." ELSE DO disp_pmt ENDIF RETURN PROCEDURE prev_cus SELECT customer SKIP -1 IF BOF() GO TOP DO standby WITH "Beginning of file: there is no PREVIOUS record." ELSE DO disp_pmt ENDIF RETURN PROCEDURE quit_pay STORE .f. TO paymnts DEACTIVATE MENU RETURN PROCEDURE setup DEFINE WINDOW w_customer FROM 02,02 TO 09,76 COLOR SCHEME 10 DEFINE WINDOW w_payments FROM 11,02 TO 20,76 CLOSE COLOR SCHEME 10 DEFINE WINDOW browhelp FROM 09,17 TO 09,63 NONE CLOSE COLOR SCHEME 7 ACTIVATE WINDOW browhelp NOSHOW @ 00,01 SAY 'When finished editing, press [F10].' HIDE WINDOW browhelp DEFINE MENU paymnts COLOR SCHEME 3 DEFINE PAD pnext OF paymnts PROMPT '\<Next' AT 21,00 DEFINE PAD pprev OF paymnts PROMPT '\<Prev' AT 21,07 DEFINE PAD pfirst OF paymnts PROMPT '\<First' AT 21,14 DEFINE PAD plast OF paymnts PROMPT '\<Last' AT 21,22 DEFINE PAD psearch OF paymnts PROMPT '\<Search' AT 21,29 DEFINE PAD pbrowse OF paymnts PROMPT '\<Browse' AT 21,39 DEFINE PAD pnew OF paymnts PROMPT '\<Add' AT 21,48 DEFINE PAD pchange OF paymnts PROMPT '\<Change' AT 21,54 DEFINE PAD pdelete OF paymnts PROMPT '\<Delete' AT 21,63 DEFINE PAD pquit OF paymnts PROMPT '\<Quit' AT 21,72 ON SELECTION PAD pnext OF paymnts DO next_cus ON SELECTION PAD pprev OF paymnts DO prev_cus ON SELECTION PAD pfirst OF paymnts DO top_cus ON SELECTION PAD plast OF paymnts DO last_cus ON SELECTION PAD psearch OF paymnts DO srch_cus ON SELECTION PAD pbrowse OF paymnts DO brow_pmt ON SELECTION PAD pnew OF paymnts DO add_pmt ON SELECTION PAD pchange OF paymnts DO chg_pmt ON SELECTION PAD pdelete OF paymnts DO del_pmt ON SELECTION PAD pquit OF paymnts DO quit_pay RETURN PROCEDURE shutdown IF WEXIST('Payments') HIDE WINDOW payments ENDIF USE USE payments IN 5 INDEX pmt_cus, pmt_dat ALIAS payments RELEASE WINDOW w_payments RELEASE WINDOW w_customer SELECT invoice SET ORDER TO inv_inv CLEAR DEACTIVATE WINDOW screensim ACTIVATE SCREEN RETURN PROCEDURE srch_cus SELECT customer ACTIVATE WINDOW w_customer last_rec=RECNO() STORE SPACE(LEN(mcust_id)) TO mcust_id @ 00,18 GET mcust_id PICTURE '!!!!!!' READ STORE PADL(TRIM(mcust_id),6) TO mcust_id SEEK mcust_id IF .NOT. FOUND() DO standby WITH 'The customer id you have entered is not on file.' GO last_rec mcust_id = customer->cust_id ENDIF DO disp_pmt RETURN PROCEDURE top_cus SELECT customer GO TOP DO disp_pmt RETURN * EOF