Would you like to make this site your homepage? It's fast and easy...
Yes, Please make this my home page!
****************************************************************
** IN_ITEM.PRG - generalized item receiving function
** J Osako 29 Jan 1996 'This code is cursed'
** Copyright 1996 The Used Computer Store, All Rights Reserved
**
** Revision History
** ----------------
** pre v1.00 :
** 11 Mar 1996 - seperated the item_scr() and summary()
** functions for debugging and generality purposes
** 1 Mar 1996 - main coding complete, begin
** debugging
** 29 Jan 1996 - began writing as seperate from
** sale.prg
****************************************************************
**********
** in_item() - sales item receiving function
** Builds item screen, inputs items and generates
** transaction records and subrecords as appropriate
** for the transaction type (as determined by the
** global chosen). Returns false if transaction is
** cancelled.
** Currently, this depends heavily on the state
** of the calling function, particularly the global
** memvars for 'atoms'. I can't see a reasonable
** alternative at the moment.
**********
*****************
** part 1 - SCATTER in the permanent data for item N,
** if any, to Atemp
M.itemno = 0
SELECT Atom
SET ORDER TO particle
DO WHILE next()
DO load_item WITH 'Atom'
DO store_item WITH 'Atemp'
ENDDO
*****************
** part 2 - the main loop.
SELECT Atemp
M.itemno = 1
DO load_item WITH 'Atemp'
orientation = .F.
DO WHILE !orientation
DO item_scr
@1,item_pos+7 SAY '#' && indictate which item
@1,COL() SAY M.itemno SIZE 1,4 && is being worked on
@1,price_pos+5 SAY '/Unit'
** indicate that price is for each item
** begin reading in the sale items
@ spaced+1, qty_pos GET M.qty;
SIZE 1, qty_len-1
@ spaced+1, item_pos EDIT M.item;
SIZE listing_line-3, item_len-1;
VALID chk_item() ERROR 'Unknown Item Code'
** look for instacodes
** note that, in the case of PCs and other unit items,
** the instacode system will insert the serial numbers
** and prices as well as the item info.
@ spaced+1, ser_pos EDIT M.serialnum;
SIZE listing_line-3,ser_len-1
@ spaced+1,stock_pos+1 GET M.stocknum;
SIZE 1,stock_len-1
@ spaced+1,war_pos+1 GET M.warranty;
SIZE 1,war_len-1
@ spaced+1,price_pos GET M.price;
FUNCTION '$' SIZE 1,price_len+2
** pushbutton to choose what to do next
@lower-3, 2 GET direction;
FUNCTION '*H Next;Prev;Kill;Done;Cancel';
DEFAULT 'Next'
READ CYCLE
orientation = walk_thru(direction)
ENDDO
DEACTIVATE WINDOW sheet
IF direction = 'Cancel'
RETURN .F.
ELSE
RETURN .T.
ENDIF && IN_ITEM()
FUNCTION newp
** determines if a record already exists for a given item
RETURN !(SEEK(DTOS(M.tr_date)+M.timestamp+(STR(M.itemno))))
***********
** chk_item() - checks item to see if it is on record
** This function 'parses' (well, not really) the first three
** tokens in the Item memo field to see if they match the
** 'instant' codes for any given items in the PC_inv, Mac_inv
** and item .DBFs. If a code is given, but it doesn't match
** any known item, the function returns false. If a match
** is found, the function replaces the instacode in the ITEM
** and SERIALNUM memo fields with the matched item's information
** and returns true. If no code is given, the function returns
** true and the memo fields are left unchanged.
** This currently just returns true, as there are no records
** of the equipment yet.
FUNCTION chk_item
RETURN .T. && CHK_ITEM()
**********
** load_item() - puts the existing data, if any, from the
** the record into the memvars and returns .T.; if there's
** no existing record, it initializes the memvars and
** returns .F. . 'dbfile' is a string of the alias of the record
** altered (whew!)
FUNCTION load_item
PARAMETERS dbfile
oldDbf = SELECT(0)
SELECT (dbfile)
n = newp()
IF n
M.qty = 1 && nothing loaded, item memvars cleared
M.item = NULL
M.serialnum = NULL
M.stocknum = 0
M.warranty = SPACE(2)
M.price = 0.00
ELSE
SCATTER MEMO MEMVAR
ENDIF
SELECT (oldDbf)
RETURN !n && load_item()
FUNCTION store_item
PARAMETERS dbfile
**********
** store_item(dbfile) - stores an item into the .DBF named in dbfile.
** Returns .T. if a new record was created, .F. otherwise.
** 'dbfile' is a string of the alias of the record altered
** (whew!)
oldDbf = SELECT(0)
SELECT (dbfile)
IF newp()
INSERT INTO (dbfile) FROM MEMVAR
SELECT(oldDbf)
RETURN .T.
ELSE
GATHER MEMVAR MEMO
ENDIF
SELECT (oldDbf)
RETURN .F. && store_item()
**********
** walk_thru() - traverses the list of items and
** saves them as needed
** Determines what to do next after a popup button is
** selected in in_item. There are four possible states
** for where2 - Next (item), Prev(ious item), Kill (the
** current item), Done (with the transaction), and Cancel
** (the transaction).
FUNCTION walk_thru
PARAMETERS where2
retup = .F. && most operations continue on sales page
IF .F. && dummy code for the project mangler
DO oops IN oops
DO summary IN summary
ENDIF
DO CASE
CASE INLIST(where2,'Next','Prev') && both next and prev
IF alldonep()
DO store_item WITH 'Atemp'
IF where2 = 'Next'
DO next
ELSE
DO prev
ENDIF
DO load_item WITH 'Atemp'
ENDIF
CASE where2 = 'Kill'
** this subfunction deletes the existing Atemp
** record, and restores the Atom record if there
** is one. If there is no permanent record, it
** closes up the gap, if any, between the other
** records
pos = M.itemno && save current place
SELECT Atom
IF confirm('Kill record?') AND !(load_item('Atom'))
** note the shortcircuit : if its an existing
** record, then load_item does all the work
** that needs to be done.
SELECT Atemp && just a precaution...
DELETE && now get rid of Atemp record
PACK
M.itemno = pos
DO WHILE next()
tmppos = M.itemno
M.itemno = M.itemno - 1
GATHER MEMVAR FIELD itemno
M.itemno = tmppos
** WARNING : this alters the RECORDS,
** not the memvars! M.itemno is
** unchanged, and loops through.
ENDDO
M.itemno = pos
DO prev
DO load_item WITH 'Atemp'
ENDIF
CASE where2 = 'Done'
DO store_item WITH 'Atemp'
** put the items, totals and payment form
SELECT Atemp
IF confirm('Done ?') AND alldonep() AND summary() = 'Finished'
M.itemno = 0
DO WHILE next()
DO load_item WITH 'Atemp'
DO store_item WITH 'Atom'
ENDDO
retup = .T.
ELSE
retup = .F.
ENDIF
CASE where2 = 'Cancel'
IF confirm('Cancel ?')
** get rid of all the permanent records matching
** this time and date
DELETE ALL;
FOR (tr_date = M.tr_date AND timestamp = M.timestamp)
SELECT Atom && are there any permanent records?
M.itemno = 1
IF newp() && if not, then get rid of whole transaction
SELECT trans_re
DELETE ALL;
FOR (tr_date = M.tr_date AND timestamp = M.timestamp)
ENDIF
retup = .T.
ENDIF
OTHERWISE && where2 was scribbled on, panic
DO oops WITH 'Popup selector #1 corrupted'
ENDCASE
&& a few cleanup actions
* DO item_scr && redraw the screen
RETURN retup && WALK_THRU()
**********
** next() and prev() - fairly obvious itemno manipulation
** functions, simply to abstract the process. Returns .F.
** if there is no existing function at new position.
FUNCTION next
M.itemno = M.itemno + 1
RETURN !newp()
PROCEDURE prev
IF M.itemno > 1
M.itemno = M.itemno - 1
RETURN .T.
ENDIF && can't go back any further
RETURN .F.
FUNCTION alldonep
** really grotty function which checks on whether
** all the fields are filled out. If not, it asks
** if they should be left that way, or if you
** want to go back and finish them. This function
** is an appalling kludge, and should be redone
** when I have the time.
i = 0
DECLARE chklist[5]
IF M.item = NULL
i = i + 1
chklist[i] = 'item'
ENDIF
IF M.serialnum = NULL
i = i + 1
chklist[i] = 'serial number'
ENDIF
IF M.stocknum = 0
i = i + 1
chklist[i] = 'stock number'
ENDIF
IF M.price = 0
i = i + 1
chklist[i] = 'price'
ENDIF
IF i = 0
RETURN .T.
ELSE
DEFINE WINDOW confirm2 FROM 1,1 TO 10,30
MOVE WINDOW confirm2 CENTER
ACTIVATE WINDOW confirm2
@1,1 SAY 'You have left the'
** You are not expected to understand this. ;-)
** What follows is a fairly intricate formatting
** of a fairly limited window. Treat it as magic.
IF i = 1
@ROW(),COL() SAY ' field '
@ROW(),COL() SAY chklist[1] SIZE 1, LEN(chklist[1])
@ROW(),COL() SAY ' blank.'
ELSE
@ROW(),COL() SAY ' fields '
FOR j = 1 TO (i-1)
IF j <= 2
@2, COL() SAY chklist[j] SIZE 1, LEN(chklist[j])
ELSE
@3, COL() SAY chklist[j] SIZE 1, LEN(chklist[j])
ENDIF
@ROW(),COL() SAY ','
ENDFOR
IF i = 3
@ROW()+1, 1 SAY 'and '
ELSE
@ROW(),COL() SAY 'and '
ENDIF
@ROW(),COL() SAY chklist[i] SIZE 1, LEN(chklist[j])
@ROW() + 1, 1 SAY ' blank.'
ENDIF
** now get the answer
@ROW()+1, 1 SAY 'Is that right? '
@ROW()+1, 1 GET confp FUNCTION '*H Yes;No';
DEFAULT 'No'
READ
DEACTIVATE WINDOW confirm2
ENDIF
RETURN IIF(confp = 'Yes',.T.,.F.) && ALLDONEP()
FUNCTION confirm
PARAMETERS checkout
DEFINE WINDOW confirm1 FROM 1,1 TO 7,15
MOVE WINDOW confirm1 CENTER
ACTIVATE WINDOW confirm1
@2,1 SAY checkout
@4,1 GET q_n_a1 FUNCTION '*H YES;NO' DEFAULT 'NO'
READ
DEACTIVATE WINDOW confirm1
RETURN IIF(q_n_a1 = 'YES',.T.,.F.)
