Liren Large Software Subsidy 5/05.iso/a/a070/3.ddi/FOXPRO/SAMPLE/INVOICE.PRG

Text File | 1989-11-09 | 14.6 KB | 533 lines

* ┌─────────────────────────────────────────────────────────────────────┐ *
* │  PROG NAME: INVOICE.PRG   What else, but the INVOICE PROGRAM.       │ *
* │  Copyright (c) 1989 Tech III, Inc. All rights reserved.             │ *
* │  Tech III of San Pedro, California      [phone].             │ *
* │  "The bridge connecting people and technology."(tm)                 │ *
* └─────────────────────────────────────────────────────────────────────┘ *
* setup objects: windows, menus, etc.
STORE ' INVOICE HEADING                       ' TO bar_label1
STORE ' LINE ITEMS                          ' TO bar_label2
DO setup_inv
STORE 0 TO startqty
STORE invoice TO minvoice

* Display invoice form & data
DO disp_inv
DO show_inv

* Main module loop: see setup_inv, DEFINE MENU INVOICE for logic
STORE .t. TO invoicing
DO WHILE invoicing
  ACTIVATE MENU invoice
  IF .NOT. in_prodemo
    DEACTIVATE MENU
  ENDIF
ENDDO

* Housekeeping
DO shutdn_inv
RETURN

PROCEDURE add_inv
  ACTIVATE WINDOW invc_wind
  SELECT invoice
  SET ORDER TO inv_inv
  GO BOTTOM
  STORE invoice+1 TO minvoice
  APPEND BLANK
  REPLACE NEXT 1 invoice WITH minvoice
  DO disp_inv
  DO show_inv
  ACTIVATE WINDOW invc_wind
  @ 00,69 SAY minvoice PICTURE '99999'
  SELECT customer
  SET ORDER TO cus_com
  ACTIVATE SCREEN
  CLEAR
  DEFINE POPUP getcust FROM 03,20 TO 20,50 COLOR SCHEME 4 PROMPT FIELD company ;
  MESSAGE 'Press <ENTER> to select, or <ESC> to add a new company.'
  ON SELECTION POPUP getcust DEACTIVATE POPUP
  ACTIVATE POPUP getcust
  IF EMPTY(PROMPT())
    RELEASE POPUP getcust
    SAVE WINDOWS invc_wind, line_wind TO invscr1
    DEACTIVATE WINDOW invc_wind
    HIDE WINDOW line_wind
    HIDE WINDOW lines
    HIDE MENU invoice
    KEYBOARD 'A'
    DO customer
    SELECT invoice
    RESTORE WINDOW ALL FROM invscr1
    ACTIVATE SCREEN
    @ 23,00 GET bar_label1 COLOR SCHEME 3
    @ 23,43 GET bar_label2 COLOR SCHEME 3
    CLEAR GETS
    SHOW WINDOW line_wind
    SHOW WINDOW lines
    SHOW MENU invoice
  ELSE
    SEEK PROMPT()
    RELEASE POPUP getcust
  ENDIF
  SELECT invoice
  SEEK minvoice
  REPLACE NEXT 1 ;
  cust_id  WITH customer->cust_id, ;
  company  WITH customer->company, ;
  contact  WITH customer->contact, ;
  address1 WITH customer->address1, ;
  city     WITH customer->city, ;
  state    WITH customer->state, ;
  zip      WITH customer->zip, ;
  s_company  WITH customer->company, ;
  s_contact  WITH customer->contact, ;
  s_address1 WITH customer->address1, ;
  s_city     WITH customer->city, ;
  s_state    WITH customer->state, ;
  s_zip      WITH customer->zip, ;
  inv_date   WITH DATE() , ;
  taxrate  WITH customer->taxrate
  DO edit_inv
  DO add_line
  SELECT invoice
  RETURN

PROCEDURE add_line
  SELECT lines
  APPEND BLANK
  REPLACE NEXT 1 invoice WITH minvoice
  DO browsing
  REPLACE NEXT 1 taxable WITH items->taxable
  DELETE NEXT 1 FOR quantity = 0 WHILE invoice = minvoice
  RETURN

PROCEDURE brow_line
  SELECT lines
  SHOW WINDOW browhelp
  ON KEY LABEL F10 KEYBOARD CHR(23)
  SET SHADOW OFF
  SEEK minvoice
  ACTIVATE SCREEN
  SHOW WINDOW line_wind TOP

  BROWSE KEY minvoice ;
  NOEDIT NOAPPEND NODELETE NOMENU NOCLEAR ;
  WINDOW line_wind ;
  FIELDS ;
  item:9,;
  descript:36,;
  price:p='999,999.99',;
  quantity:4,;
  extension = TRANSFORM(lines->price*lines->quantity,'999,999,999.99')

  ON KEY LABEL F10
  SHOW WINDOW line_wind SAVE
  HIDE WINDOW browhelp
  SET SHADOW ON
  ACTIVATE SCREEN
  GO TOP
  SELECT invoice
  SELECT lines
  RETURN

PROCEDURE browsing
  SELECT lines
  SHOW WINDOW browhelp
  ON KEY LABEL F10 KEYBOARD CHR(23)

  SET SHADOW OFF
  ACTIVATE SCREEN
  SHOW WINDOW line_wind TOP

  BROWSE KEY minvoice ;
  NOAPPEND NODELETE NOMENU NOCLEAR ;
  WINDOW line_wind ;
  FIELDS ;
  item:9:v=GETITEM(item):F,;
  descript:36,;
  price:p='999,999.99',;
  quantity:4:v=ADJINV():E='QTY or adjustment to QTY exceeds inventory on hand.':w=STOREVAL(),;
  extension = TRANSFORM(lines->price*lines->quantity,'999,999,999.99')

  SHOW WINDOW line_wind SAVE
  ON KEY LABEL F10
  HIDE WINDOW browhelp
  SET SHADOW ON
  ACTIVATE SCREEN
  GO TOP
  SELECT invoice
  subtot = INVSUB()
  subtax = INVTAX()
  invtot = subtot + subtax
  @ 22,00 SAY 'SUB-TOTAL:'
  @ 22,11 SAY subtot PICT '999,999,999.99'
  @ 22,31 SAY 'TAX:'
  @ 22,36 SAY subtax PICT '999,999,999.99'
  @ 22,57 SAY 'TOTAL:'
  @ 22,64 SAY invtot PICT '9,999,999,999.99'
  @ 23,00 GET bar_label1 COLOR SCHEME 3
  @ 23,43 GET bar_label2 COLOR SCHEME 3
  CLEAR GETS
  SELECT lines
  RETURN

PROCEDURE del_inv
  IF YESNO('Are you sure you want to delete this invoice?')
    SELECT lines
    SEEK minvoice
    SCAN WHILE lines->invoice = invoice->invoice
      SELECT items
      SEEK lines->item
      REPLACE items->quantity WITH items->quantity + lines->quantity
      SELECT lines
      DELETE NEXT 1
    ENDSCAN
    SELECT invoice
    DELETE NEXT 1
    IF .NOT. EOF()
      SKIP
    ENDIF
    IF EOF()
      GO BOTTOM
    ENDIF
  ENDIF
  DO standby WITH 'Invoice has been deleted.'
  DO show_inv
  RETURN

PROCEDURE del_line
  DO msg2user WITH 'DELETION INSTRUCTIONS', ;
  'Edit item quantity to equal zero.', 'System will then remove the item.'
  SELECT lines
  DO browsing
  SEEK minvoice
  DELETE REST FOR quantity = 0 WHILE invoice = minvoice
  DO msg2user WITH 'CLOSE'
  DO show_inv
  RETURN

PROCEDURE disp_inv
  ACTIVATE WINDOW invc_wind
  CLEAR
  @ 00,00 SAY '┌──────[ Customer        ]─────────────────────────────────[ Invoice       ]─┐'
  @ 01,00 SAY '│  ⌐                                  ┐   ⌐                                 ┐│'
  @ 02,00 SAY '│B                                      S                                    │'
  @ 03,00 SAY '│I                                      H                                    │'
  @ 04,00 SAY '│L                                      I                                    │'
  @ 05,00 SAY '│L                                      P                                    │'
  @ 06,00 SAY '│  └                                  ┘   └                                 ┘│'
  @ 07,00 SAY '├──────────┬──────────────────┬───────┬────────────┬─────────────────────────┤'
  @ 08,00 SAY '│  Date    │       P.O #      │ Slsmn │  Ship via  │                         │'
  @ 09,00 SAY '├──────────┼──────────────────┼───────┼────────────┼─────────────────────────┤'
  @ 10,00 SAY '│          │                  │       │            │                         │'
  @ 11,00 SAY '└──────────┴──────────────────┴───────┴────────────┴─────────────────────────┘'
  RETURN

PROCEDURE edit_inv
  SELECT invoice
  ACTIVATE WINDOW invc_wind
  @ 00,69 SAY invoice PICT '99999'
  @ 00,18 SAY cust_id
  @ 02,04 GET contact
  @ 03,04 GET company
  @ 04,04 GET address1
  @ 05,04 GET city
  @ 05,25 GET state
  @ 05,28 GET zip        PICTURE '99999X9999'
  @ 02,43 GET s_contact
  @ 03,43 GET s_company
  @ 04,43 GET s_address1
  @ 05,43 GET s_city
  @ 05,64 GET s_state
  @ 05,67 GET s_zip      PICTURE '99999X9999'
  @ 10,02 GET inv_date
  @ 10,13 GET po
  @ 10,33 GET soldby     PICTURE '!!!' VALID VAL_SREP()
  @ 10,40 GET shipvia
  READ
  DO show_inv
  RETURN

PROCEDURE edit_line
  SELECT lines
  DO browsing
  SEEK minvoice
  DELETE REST FOR quantity = 0 WHILE invoice = minvoice
  SEEK minvoice
  RETURN

PROCEDURE next_inv
  SELECT invoice
  IF .NOT. EOF()
    SKIP
  ENDIF
  IF EOF()
    GO BOTTOM
    DO standby WITH "End of file: there is no NEXT invoice."
  ELSE
    DO show_inv
  ENDIF
  RETURN

PROCEDURE prev_inv
  SELECT invoice
  IF .NOT. BOF()
    SKIP -1
  ENDIF
  IF BOF()
    GO TOP
    DO standby WITH "Beginning of file: there is no PREVIOUS invoice."
  ELSE
    DO show_inv
  ENDIF
  RETURN

PROCEDURE pull_inv
  SELECT invoice
  DEFINE POPUP pullinv FROM 7,50 TO 11,78 COLOR SCHEME 4
  DEFINE BAR 1 OF pullinv PROMPT 'By an Invoice Number'
  DEFINE BAR 2 OF pullinv PROMPT 'First one written'
  DEFINE BAR 3 OF pullinv PROMPT 'Last one written'
  ON SELECTION POPUP pullinv DEACTIVATE POPUP
  ACTIVATE POPUP pullinv
  subchoice=BAR()
  RELEASE POPUP pullinv
  DO CASE
    CASE subchoice=1
      oldrec=RECNO()
      SET ORDER TO inv_inv
      DEFINE WINDOW get_inv FROM 10,12 TO 14,68 DOUBLE COLOR SCHEME 6
      ACTIVATE WINDOW get_inv
      STORE 0 TO mpullinv
      @ 1,3 SAY 'What invoice number do you want?' GET mpullinv PICT '99999' COLOR SCHEME 7
      READ
      RELEASE WINDOW get_inv
      IF mpullinv=0 .OR. LASTKEY()=27
        GOTO oldrec
      ELSE
        SEEK mpullinv
        IF .NOT. FOUND()
          DO standby WITH "That invoice was not found."
          GOTO oldrec
        ELSE
          DO show_inv
        ENDIF
      ENDIF
    CASE subchoice = 2
      GO TOP
      DO show_inv
    CASE subchoice=3
      GO BOTTOM
      DO show_inv
  ENDCASE
  RETURN

PROCEDURE quit_inv
  STORE .f. TO invoicing
  DEACTIVATE MENU
  RETURN

PROCEDURE setup_inv
  ACTIVATE SCREEN
  CLEAR
  * Set up files
  SELECT lines
  SET ORDER TO lns_inv
  SELECT invoice
  SET ORDER TO inv_inv

  DEFINE WINDOW invc_wind FROM 00,00 TO 13,79 DOUBLE ;
  TITLE 'Invoice Header' COLOR SCHEME 10

  DEFINE WINDOW line_wind FROM 14,00 TO 21,79 ZOOM CLOSE system ;
  COLOR SCHEME 10
  * title 'Invoice Line Items' ;

  DEFINE WINDOW browhelp FROM 09,17 TO 12,63 DOUBLE CLOSE COLOR SCHEME 7
  ACTIVATE WINDOW browhelp NOSHOW
  @ 00,01 SAY 'When finished editing, press [F10].'
  HIDE WINDOW browhelp

  ACTIVATE SCREEN

  DEFINE MENU invoice COLOR SCHEME 3
  DEFINE PAD ifind   OF invoice PROMPT '\<Find'   AT 24,00
  DEFINE PAD inext   OF invoice PROMPT '\<Next'   AT 24,07
  DEFINE PAD iprev   OF invoice PROMPT '\<Prev'   AT 24,14
  DEFINE PAD iadd    OF invoice PROMPT '\<Add'    AT 24,21
  DEFINE PAD iedit   OF invoice PROMPT '\<Edit'   AT 24,27
  DEFINE PAD idelete OF invoice PROMPT 'De\<l'    AT 24,34
  DEFINE PAD lbrowse OF invoice PROMPT '\<Browse' AT 24,43
  DEFINE PAD ladd    OF invoice PROMPT 'A\<dd'    AT 24,52
  DEFINE PAD ledit   OF invoice PROMPT 'Ed\<it'   AT 24,58
  DEFINE PAD ldelete OF invoice PROMPT 'Dele\<te' AT 24,65
  DEFINE PAD QUIT    OF invoice PROMPT '\<Quit'   AT 24,74

  ON SELECTION PAD ifind     OF invoice DO pull_inv
  ON SELECTION PAD inext     OF invoice DO next_inv
  ON SELECTION PAD iprev     OF invoice DO prev_inv
  ON SELECTION PAD iadd      OF invoice DO add_inv
  ON SELECTION PAD iedit     OF invoice DO edit_inv
  ON SELECTION PAD idelete   OF invoice DO del_inv
  ON SELECTION PAD lbrowse   OF invoice DO brow_line
  ON SELECTION PAD ladd      OF invoice DO add_line
  ON SELECTION PAD ledit     OF invoice DO edit_line
  ON SELECTION PAD ldelete   OF invoice DO del_line
  ON SELECTION PAD QUIT      OF invoice DO quit_inv

  DEFINE POPUP getitem FROM 03,20 TO 20,50 COLOR SCHEME 4 PROMPT FIELD item ;
  MESSAGE 'Press <ENTER> to select, or <ESC> to add a new item.'
  ON SELECTION POPUP getitem DEACTIVATE POPUP

  RETURN

PROCEDURE shutdn_inv
  RELEASE    MENU   invoice
  SELECT lines
  USE
  USE lineitms IN 3 INDEX lns_inv,lns_itm  ALIAS lines
  RELEASE    WINDOW line_wind
  RELEASE    WINDOW invc_wind
  RELEASE    WINDOW browhelp
  RELEASE    POPUP  getitem
  ACTIVATE   SCREEN
  RESTORE    SCREEN FROM mainscrn
  RETURN

PROCEDURE show_inv
  SELECT invoice
  ACTIVATE WINDOW invc_wind
  @ 00,18 SAY invoice->cust_id
  @ 00,69 SAY invoice->invoice PICTURE '99999'
  @ 02,04 SAY invoice->contact
  @ 02,43 SAY invoice->s_contact
  @ 03,04 SAY invoice->company
  @ 03,43 SAY invoice->s_company
  @ 04,04 SAY invoice->address1
  @ 04,43 SAY invoice->s_address1
  @ 05,04 SAY invoice->city
  @ 05,25 SAY invoice->state
  @ 05,28 SAY invoice->zip
  @ 05,43 SAY invoice->s_city
  @ 05,64 SAY invoice->s_state
  @ 05,67 SAY invoice->s_zip
  @ 10,02 SAY invoice->inv_date
  @ 10,13 SAY invoice->po
  @ 10,33 SAY invoice->soldby
  @ 10,40 SAY invoice->shipvia
  minvoice=invoice->invoice
  * Show line-items
  SELECT lines
  SEEK minvoice
  ACTIVATE SCREEN
  SET SHADOW OFF
  BROWSE KEY minvoice ;
  NOWAIT NOMENU NOCLEAR ;
  WINDOW line_wind ;
  FIELDS ;
  item:9, ;
  descript:36, ;
  price:p='999,999.99', ;
  quantity:4, ;
  extension = TRANSFORM(lines->price*lines->quantity,'999,999,999.99')
  ACTIVATE SCREEN
  SET SHADOW ON
  SELECT invoice
  subtot = INVSUB()
  subtax = INVTAX()
  invtot = subtot + subtax
  @ 22,00 SAY 'SUB-TOTAL:'
  @ 22,11 SAY subtot PICT '999,999,999.99'
  @ 22,31 SAY 'TAX:'
  @ 22,36 SAY subtax PICT '999,999,999.99'
  @ 22,57 SAY 'TOTAL:'
  @ 22,64 SAY invtot PICT '9,999,999,999.99'
  @ 23,00 GET bar_label1 COLOR SCHEME 3
  @ 23,43 GET bar_label2 COLOR SCHEME 3
  CLEAR GETS
  SELECT lines
  RETURN

FUNCTION adjinv
  SELECT items
  SEEK lines->item
  IF quantity < lines->quantity - startqty
    SELECT lines
    RETURN .f.
  ELSE
    REPLACE quantity WITH quantity - (lines->quantity - startqty)
    SELECT lines
    KEYBOARD CHR(13)
    RETURN .t.
  ENDIF

FUNCTION getitem
  * looks up item in inventory and if found, gets description and price
  PARAMETER mitem
  SELECT items
  SEEK mitem
  IF .NOT. FOUND()
    ACTIVATE SCREEN
    ACTIVATE POPUP getitem
    IF EMPTY(PROMPT())
      HIDE POPUP getitem
      SAVE WINDOWS invc_wind, line_wind TO invscr1
      DEACTIVATE WINDOW invc_wind
      HIDE WINDOW line_wind
      HIDE WINDOW lines
      HIDE MENU invoice
      KEYBOARD 'A'
      ACTIVATE WINDOW screensim
      DO inventry
      DEACTIVATE WINDOW screensim
      SELECT invoice
      RESTORE WINDOW ALL FROM invscr1
      ACTIVATE SCREEN
      @ 23,00 GET bar_label1 COLOR SCHEME 3
      @ 23,43 GET bar_label2 COLOR SCHEME 3
      CLEAR GETS
      SHOW WINDOW browhelp
      ACTIVATE WINDOW line_wind
      SHOW WINDOW lines
      SHOW MENU invoice
    ELSE
      SEEK PROMPT()
    ENDIF
  ENDIF
  SELECT lines
  REPLACE NEXT 1 item WITH items->item, descript WITH items->descript ;
  price WITH items->price, cost WITH items->cost
  RETURN .t.

FUNCTION storeval
  STORE quantity TO startqty
  RETURN .t.

FUNCTION val_srep
  SELECT salesrep
  SET ORDER TO sal_sal
  SEEK invoice->soldby
  IF FOUND()
    SELECT invoice
    RETURN .t.
  ELSE
    GO TOP
  ENDIF
  SET ORDER TO sal_nam
  IF .NOT. FOUND()
    DEFINE POPUP salesrep FROM 03,40 PROMPT FIELD salename
    ON SELECTION POPUP salesrep DEACTIVATE POPUP
    DO WHILE .NOT. FOUND()
      ACTIVATE POPUP salesrep
      SEEK PROMPT()
    ENDDO
    RELEASE POPUP salesrep
  ENDIF
  SELECT invoice
  REPLACE invoice->soldby WITH salesrep->soldby
  SET ORDER TO sal_sal
  RETURN .t.

  * EOF