Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive   : PTOFSALE.ZIP
Filename : TESTRENT.PRG
*:
*: Program: TESTRENT.PRG
*:
*: System: RIALTO CINEMA VIDEO P.O.S. PROGRAM
*: Author: SCOTT BAXTER
*: Copyright (c) 1988, SCOTT BAXTER
*: Last modified: 11/08/88 23:53
*:
*: Calls: HELP.PRG
*: : NEWCUST.PRG
*: : GET_OPTN.PRG
*: : DISP_MSG.PRG
*: : RNTMNU.PRG
*: : TAPRNT.PRG
*: : SELLEM.PRG
*: : INITARAY.PRG
*: : RNTDEL.PRG
*: : TAPSRCH.PRG
*: : RNTRSRV.PRG
*: : RRNT.PRG
*: : RNTPRT.PRG
*: : VCRGAME.PRG
*:
*: Uses: NAMES.DBF Alias: CUST
*: : FILMS.DBF Alias: TAPES
*: : MERCH.DBF Alias: MERCH
*: : TEMPLINE.DBF Alias: TMP
*: : VIDSETUP.DBF Alias: PROMO
*:
*: Indexes: MEMNUM.NDX
*: : NAMES.NDX
*: : LASTRENT.NDX
*: : FILMNAME.NDX
*: : LIB.NDX
*: : IDNUM.NDX
*:
*: Documented: 11/09/88 at 17:27 SNAP! version 3.00
*:*********************************************************************
** you can escape from cust# entry to terminate program
** if testing
LOAD curon
LOAD curoff
PUBLIC var,MESSAGE,choice,choices,cr,contmsg,fl,nd,r_proc,;
stdrent,option,ln1,ln2
IF xdrive='D'
SET PATH TO \data\db\vid\
SET DBF TO \data\db\vid\
SET NDX TO \data\db\vid\
ENDI
SET USERHELP ON
SET SAFETY OFF
SET SCOREBOARD OFF
SET EXACT OFF
WSET FRAME ON
SET BELL OFF
SET DELETED ON
SET TALK OFF
SET STATUS OFF
mchoice = ' '
cr=CHR(13)+CHR(10)
STORE ' ..PRESS ANY KEY TO CONTINUE.. ' TO contmsg
CLEA
LOAD curoff
LOAD curon
CALL curoff
CLEA
SET udf TO vidudf
** endi
WCLO ALL
CLEA
PUBLIC getnew,r_proc,option,cr,contmsg,r_rentcust,r_newrec,numlines,;
firstline,nownum,norents,ptype,r_retnum,menuck,vcrgood,isnorml,big,;
realtape,vcrnum,big10flag
SET USERHELP TO 0,0,0,0
SET TYPEAHEAD TO 40
ptype=' '
menuck=.F.
isnorml=.T.
r_retnum=0
vcrnum=0
big=0
vcrgood=.F.
r_proc='R'
STOR .F. TO gotnew,bailout,norents
STOR .T. TO firstline
invnum=''
big10flag=.F.
SELE 1
USE names INDE memnum,names,lastrent ALIAS cust
SELE 2
USE films INDE filmname,lib ALIAS tapes
SELE 3
USE merch INDE idnum ALIAS merch
SELE 4
USE templine ALIAS tmp AUTOMEM
SELE 5
USE vidsetup ALIAS promo AUTOMEM
STOR AUTO
STOR fullprice TO realtape
* USE renthed INDE custhed,inv ALIAS SUMMARY
RELE ALL LIKE scratch*
declare scratch[12,11]
***************************************
*** line assignments for scratch ****
** 1 part number
** 2 ticket number
** 3 description
** 4 quantity
** 5 unit price
** 6 days
** 7 ext. price
** 8 taxable or not
** 9 part number
** 10 promo or not
** 11 big10 or not
***************************************
FOR X=1 TO 12
STOR SPAC(7) TO scratch[x,1]
STOR SPAC(12) TO scratch[x,2]
STOR SPAC(40) TO scratch[X,3]
STOR 0 TO scratch[x,4]
STOR SPAC(5) TO scratch[x,5]
STOR 0 TO scratch[x,6]
STOR SPAC(5) TO scratch[x,7]
STOR .F. TO scratch[x,8]
STOR ' ' TO scratch[x,9]
STOR .F. TO scratch[x,10]
STOR .F. TO scratch[x,11]
NEXT
LOAD curon
LOAD curoff
@ 01,0 SAY 'ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿'
@ 02,0 SAY '³ ID#: BIG10: YTD RENTS: HOME PHONE: ³'
@ 03,0 SAY '³ NAME: LAST RENT: ³'
@ 04,0 SAY '³ ADDRESS: ³'
@ 05,0 SAY '³ CITY: STATE: ZIP: ³'
@ 06,0 SAY '³ COMMENT: ³'
@ 07,0 SAY 'ÆÍÍÍÍÍÍÍÍÍÑÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÑÍÍÍÍÍÍÑÍÍÍÍÍÑÍÍÍÍÍÍ͵'
@ 08,0 SAY '³ ITEM # ³ DESCRIPTION ³ DAYS ³ QTY ³ PRICE ³'
@ 09,0 SAY 'ÆÍÍÍÍÍÍÍÍÍÏÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÏÍÍÍÍÍÍÏÍÍÍÍÍÏÍÍÍÍÍÍ͵'
* 0 11 57 64 69
@ 10,0 SAY '³ ³'
@ 11,0 SAY '³ ³'
@ 12,0 SAY '³ ³'
@ 13,0 SAY '³ ³'
@ 14,0 SAY '³ ³'
@ 15,0 SAY '³ ³'
@ 16,0 SAY '³ ³'
@ 17,0 SAY '³ ³'
@ 18,0 SAY '³ ³'
@ 19,0 SAY '³ ³'
@ 20,0 SAY '³ ³'
@ 21,0 SAY '³ ³'
@ 22,0 SAY '³ ³'
@ 23,0 SAY 'ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ'
DO WHIL .NOT. bailout
CALL curon
invnum=SPAC(12)
zazz=DTOC(DATE())
frab=TIME()
nownum=SUBSTR(zazz,1,2)+SUBSTR(zazz,4,2)+SUBSTR(zazz,7,2)+SUBSTR(frab,1,2)+;
SUBSTR(frab,4,2)+SUBSTR(frab,7,2)
getnew=.F.
option=''
SELE cust
@ 2,7 SAY SPAC(7)
@ 2,23 SAY SPAC(3)
@ 2,40 SAY SPAC(3)
@ 2,61 SAY SPAC(15)
@ 3,8 SAY SPAC(33)
@ 3,60 SAY SPAC(12)
@ 4,11 SAY SPAC(33)
@ 4,60 SAY SPAC(14)
@ 5,8 SAY SPAC(17)
@ 5,32 SAY SPAC(2)
@ 5,42 SAY SPAC(12)
@ 6,11 SAY SPAC(55)
SET EXACT ON
r_rentcust=SPAC(5)
@ 2,7 GET r_rentcust PICT '99999' HELP scrl("NAMEÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄPHONE",;
"LNAME+FNAME+PHONE","MEMNUM+CHR(13)",'2') VALID rntnam(r_rentcust)
READ
@ 2,7 SAY SPAC(5)
IF READKEY()=12
EXIT
ENDI
IF getnew
r_rentcust=SPAC(5)
GO TOP
IF .NOT. '!!' $ lname
r_newrec=.T.
STORE LTRIM(STR(RECCOUNT()+1)) TO r_rentcust
ELSE
r_newrec=.F.
STORE memnum TO r_rentcust
ENDI
DO newcust
WSELE 0
WCLO 1
getnew=.F.
ELSE
STOR memnum TO r_rentcust
ENDI
SET COLO TO n/W
STOR big10 TO big
@ 2,7 SAY memnum
@ 2,23 SAY big10 PICT '99'
@ 2,40 SAY ytdrents PICT '99'
@ 2,61 SAY phone PICT '(999) 999-9999'
@ 3,8 SAY TRIM(fname)+' '+TRIM(lname)
lrnt=LEFT(invnum,2)+'/'+SUBSTR(invnum,3,2)+'/'+SUBSTR(invnum,5,2)
@ 3,60 SAY lrnt
@ 4,11 SAY TRIM(address)
@ 5,8 SAY TRIM(city)
@ 5,32 SAY st
@ 5,42 SAY TRIM(zip)
@ 6,11 SAY TRIM(comments)
flush
SET COLO TO
WSET FRAME OFF
WSET WINDOW goods TO 10,1,22,75
WSELE 1
WUSE goods
numlines=0
IF TIME() <= rentback
WSET FRAME ON
WSET WINDOW howmany TO 12,19,12,59 COLOR n/W, W+/n, W*/n DOUBLE
WSELE 2
WUSE howmany
r_retnum=0
@ 0,0 SAY 'Did the customer RETURN any tapes? ' GET r_retnum PICT '9'
READ
WSET FRAME OFF
WSELE 1
WCLO 2
ELSE
r_retnum=0
ENDI
fines=0.00
MESSAGE=' SCAN LATE REPORTS NOW. FIND ANYTHING? (Y/N) '
choices='YN'
choice='N'
DO get_optn
IF choice='Y'
WSET FRAME OFF
WSET WINDOW info TO 12,10,15,66
WSELE 2
WUSE info
@ 0,1 SAY "REMEMBER, THE FIRST 6 NUMBERS OF THE TICKET NUMBER ARE"
@ 1,1 SAY "THE DATE THEY RENTED. 072388 = '07/23/88'. THE LAST"
@ 2,1 SAY "SIX NUMBERS ARE THE TIME RENTED. 142234 = '2:22 P.M'."
@ 3,1 SAY " PRESS A KEY TO GO ON"
SET CONS OFF
WAIT TO KEY
SET CONS ON
WSELE 1
WCLO 2
WSET FRAME ON
WSET WINDOW lates TO 15,08,15,68 COLOR n/W, W+/n, W*/n DOUBLE
WSELE 3
WUSE lates
CALL curon
@ 0,1 SAY 'ENTER THE AMOUNT THEY WILL PAY' GET fines PICT '99.99'
READ
CALL curoff
CLEA
@ 0,1 SAY CENTER('BE SURE TO CROSS OUT THE LATE TAPES THEY PAID ON.',60)
SLEEP 3
numlines=numlines+1
WSET FRAME OFF
WSELE 1
WCLO 3
IF .NOT. firstline
DOWNSCROLL 1
ELSE
firstline=.F.
ENDI
@ 0,0 SAY 'FINES'
@ 0,11 SAY 'FINES PAID ON LATE TAPE RETURNS'
@ 0,57 SAY '0'
@ 0,64 SAY '0'
@ 0,69 SAY STR(fines,5,2)
STOR 'FINES ' TO scratch[NUMLINES,1]
STOR nownum TO scratch[numlines,2]
STOR 'FINES ON LATE TAPE RETURNS ' TO scratch[numlines,3]
STOR 0 TO scratch[NUMLINES,4]
STOR STR(fines,5,2) TO scratch[NUMLINES,5]
STOR 0 TO scratch[NUMLINES,6]
STOR STR(fines,5,2) TO scratch[numlines,7]
STOR .F. TO scratch[numlines,8]
STOR 'F' TO scratch[numlines,9]
STOR .F. TO scratch[NUMLINES,10],scratch[NUMLINES,11]
ENDI
DO WHIL .T.
IF numlines=12
MESSAGE='MAX # OF ITEMS REACHED. EITHER PRINT TICKET OR DELETE ITEM.'
DO disp_msg
ENDI
** RNTMNU IS IN A WINDOW, #2
DO rntmnu
WSELE 1
WCLO 2
DO CASE
CASE option = 'F2'
DO taprnt
CASE option = 'F3'
DO sellem
CASE option = 'F4'
MESSAGE='Delete O)ne item or W)hole ticket? '
choices='OW'
choice='O'
DO get_optn
IF choice='W'
IF .NOT. EMPTY(scratch[1,1])
DO initaray
ENDI
CLEA
EXIT
ELSE
DO rntdel
ENDI
CASE option = 'F5'
DO tapsrch
CASE option = 'F6'
DO rntrsrv
CASE option = 'F7'
DO rrnt
CASE option = 'F8'
DO rntprt
EXIT
** the help on F9 is in rntmnu code
CASE option = 'F10'
DO vcrgame
CASE option = 'ESC'
bailout=.T.
ON ESCAPE
EXIT
ENDC
ENDD
WSELE 0
ENDD
CLOS ALL
*: EOF: TESTRENT.PRG
Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!
This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.
But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/