home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Overload
/
ShartewareOverload.cdr
/
database
/
manage1.zip
/
TENANT.PRG
< prev
Wrap
Text File
|
1986-05-30
|
17KB
|
540 lines
* Last revision: May 26, 1986 at 11:43
* tenant.prg main command program of tenant database
STOR .t. TO first
* set up the loop
STOR .T. to more
DO WHIL more
* if first time this trip
IF first
DO t_first
STOR .f. TO first
ENDI
STOR '<B>ackward, <D>elete/Recall, <E>dit, <F>orward, <H>elp, <P>rint' TO prompt1
STOR '<S>earch by code number, search a<N>y part of database' TO prompt2
STOR 'b<u>ilding records or <R>eturn to main Menu SELECT: ' TO prompt3
STOR 'Main Tenant Database ' TO mode
STOR '?' TO command
* find out if the current record is marked for deletion
IF DELETE()
STOR 'Deleted' TO deleted
ELSE
STOR ' ' TO deleted
ENDI *
STOR trent TO trentx
IF ttype = 'P'
IF (trentpc*(trentpcr/100)/12)>trent
STOR (trentpc*(trentpcr/100)/12) TO trentx
ENDI (trentpc)
ENDI ttype = 'P'
IF ttype = 'O'
STOR ((trentpc*(trentpcr/100)/12)+trent) TO trentx
ENDI ttype = 'O'
STOR (trentx + taddl + trente + trentm) TO trentxx
* show the current record, and find out what to do next
@ 0, 0 SAY deleted
@ 1,26 SAY mode
@ 3,10 SAY tenant
@ 3,62 SAY bcode
@ 4,10 SAY tunit
@ 4,36 SAY baddr
@ 5,10 SAY tcontac
@ 5,62 SAY tphone
@ 6,36 SAY alt
@ 7,10 SAY altad
@ 8,10 SAY altcty
@ 10,10 SAY ttype
@ 10,36 SAY trentpc PICTURE '99.9999'
@ 10,62 SAY tfirst
@ 11,10 SAY trentpcr PICTURE '999,999,999'
@ 11,62 SAY texpir
@ 12,10 SAY tsec PICTURE '99,999.99'
@ 12,36 SAY tsecb
@ 12,62 SAY tlate
@ 13,10 SAY trent PICTURE '99,999.99'
@ 13,36 SAY tlatec PICTURE '99,999.99'
@ 13,62 SAY taddl PICTURE '99,999.99'
@ 14,10 SAY trente PICTURE '99,999.99'
@ 14,36 SAY trentm PICTURE '99,999.99'
@ 14,62 SAY trentxx PICTURE '99,999.99'
@ 15,10 SAY trentd PICTURE '99,999.99'
@ 15,36 SAY trentpd PICTURE '99/99/99'
@ 15,62 SAY trentp PICTURE '99,999.99'
@ 16,10 SAY trenty PICTURE '99,999.99'
@ 16,36 SAY tflag
@ 16,62 SAY trentt PICTURE '99,999.99'
@ 18,10 SAY tnotes
@ 18,61 SAY tupdate
@ 20, 7 SAY prompt1
@ 21, 7 SAY prompt2
@ 22, 7 SAY prompt3
@ 22,70 GET command PICTURE '!'
READ
* perform selected function
DO CASE
CASE (command = 'B' .OR. command = ',' )
* move backwards one record
SKIP -1
LOOP
CASE command = 'D'
* switch the current record from deleted to recalled
IF DELETE()
RECA
ELSE
DELE
ENDI DELETE()
LOOP
CASE command = 'E'
SET DELIMITER OFF
SET INTENSITY ON
* store field variables into mem variables for editing
STOR tenant TO mtenant
STOR bcode TO mbcode
STOR tunit TO mtunit
STOR baddr TO mbaddr
STOR tcontac TO mtcontac
STOR tphone TO mtphone
STOR alt TO malt
STOR altad TO maltad
STOR altcty TO maltcty
STOR ttype TO mttype
STOR trentpc TO mtrentpc
STOR texpir TO mtexpir
STOR trentpcr TO mtrenpcr
STOR tfirst TO mtfirst
STOR tsec TO mtsec
STOR tsecb TO mtsecb
STOR tlate TO mtlate
STOR trent TO mtrent
STOR taddl TO mtaddl
STOR trente TO mtrente
STOR trentm TO mtrentm
STOR trentp TO mtrentp
STOR trentpd TO mtrentpd
STOR tlatec TO mtlatec
STOR trentd TO mtrentd
STOR trenty TO mtrenty
STOR trentt TO mtrentt
STOR tflag TO mtflag
STOR tnotes TO mtnotes
STOR tupdate TO mtupdate
* set up screen and prompt for editing
STOR 'Edit Tenant Data ' TO mode
STOR ' Enter the new or corrected information ' TO prompt1
STOR " Control 'Q'or 'W' to end edit session " TO prompt2
STOR SPACE(70) TO prompt3
@ 1,26 SAY mode
@ 3,10 GET mtenant
@ 3,62 GET mbcode PICTURE '99999'
@ 4,10 GET mtunit
@ 4,36 GET mbaddr
@ 5,10 GET mtcontac
@ 5,62 GET mtphone PICTURE '(999)999-9999'
@ 6,36 GET malt PICTURE '!'
@ 7,10 GET maltad
@ 8,10 GET maltcty
@ 10,10 GET mttype PICTURE '!'
@ 10,36 GET mtrentpc
@ 10,62 GET mtfirst PICTURE '99/99/99'
@ 11,10 SAY SPACE(16)
@ 11,10 GET mtrenpcr
@ 11,62 GET mtexpir PICTURE '99/99/99'
@ 12,10 GET mtsec
@ 12,36 GET mtsecb
@ 12,62 GET mtlate PICTURE '99'
@ 13,10 GET mtrent
@ 13,36 GET mtlatec
@ 13,62 GET mtaddl
@ 14,10 GET mtrente
@ 14,36 GET mtrentm
@ 15,10 GET mtrentd
@ 15,36 GET mtrentpd PICTURE '99/99/99'
@ 15,62 GET mtrentp
@ 16,10 GET mtrenty
@ 16,36 GET mtflag PICTURE '99/99/99'
@ 16,62 GET mtrentt
@ 18,10 GET mtnotes
@ 18,61 GET mtupdate PICTURE '99/99/99'
@ 20,07 SAY prompt1
@ 21,07 SAY prompt2
@ 22,07 SAY prompt3
READ
CLEA GETS
* test if there is a bad field validation
DO CASE
CASE mbcode = ' '
STOR .t. TO error
CASE .NOT.(malt = 'Y' .OR. malt = 'N')
STOR .t. TO error
CASE .NOT.(mttype = 'R'.OR.mttype='P'.OR. mttype='O')
STOR .t. TO error
CASE (mttype = 'P'.OR. mttype = 'O') .AND.(.NOT.(mtrentpc >0.AND. mtrenpcr >0))
STOR .t. TO error
OTHE
STOR .f. TO error
ENDC
* if test for error was true then fix the fields that need fixing
IF error
* erase the lines to be used for prompts
@ 01,00
@ 20,00
@ 21,00
@ 22,00
* tell them to correct it
@ 1,18 SAY 'Please Correct the Indicated Data'
* keep looping until all fields are fixed
STOR .t. to an_error
DO WHIL an_error
DO CASE
CASE mbcode = ' '
@ 20,01 SAY SPACE(75)
@ 21,01 SAY SPACE(75)
@ 20,15 SAY 'Must have a tenant code '
@ 03,62 GET mbcode PICTURE '99999'
READ
CASE .NOT.(malt = 'Y' .OR. malt = 'N')
@ 20,01 SAY SPACE(75)
@ 21,01 SAY SPACE(75)
@ 20,15 SAY "Must answer 'Y' or 'N' to alternate address"
@ 06,36 GET malt PICTURE '!'
READ
CASE .NOT.(mttype = 'R'.OR.mttype='P'.OR. mttype='O')
@ 20,01 SAY SPACE(75)
@ 21,01 SAY SPACE(75)
@ 20,05 SAY "Type must be 'R' for Regular, 'P' for Percentage which uses the higher of"
@ 21,05 SAY "the percentage or the base rent or 'O' for Overage plus base rent"
@ 10,10 GET mttype PICTURE '!'
READ
CASE (mttype = 'P'.OR. mttype = 'O').AND.(.NOT.(mtrentpc>0.AND. mtrenpcr> 0))
@ 20,01 SAY SPACE(75)
@ 21,01 SAY SPACE(75)
@ 20,05 SAY 'If a percentage or overage lease, you must state the percentage'
@ 21,05 SAY 'AND the base for calculating the percentage rent'
@ 10,36 GET mtrentpc
@ 11,10 GET mtrenpcr
READ
OTHE
STOR .f. TO an_error
ENDC
ENDD while an:error
ENDI error
STOR 'N' TO command
SET DELIMITER ON
SET INTENSITY OFF
@ 20,01 SAY SPACE(75)
@ 21,01 SAY SPACE(75)
@ 20,23 SAY 'Are there any more changes ? '
@ 20,50 GET command picture '!'
READ
SET INTENSITY ON
SET DELIMITER OFF
IF command = 'Y'
@ 1,00
@ 1,26 SAY mode
@ 3,10 GET mtenant
@ 3,62 GET mbcode PICTURE '99999'
@ 4,10 GET mtunit
@ 4,36 GET mbaddr
@ 5,10 GET mtcontac
@ 5,62 GET mtphone PICTURE '(999)999-9999'
@ 6,36 GET malt PICTURE '!'
@ 7,10 GET maltad
@ 8,10 GET maltcty
@ 10,10 GET mttype PICTURE '!'
@ 10,36 GET mtrentpc
@ 10,62 GET mtfirst PICTURE '99/99/99'
@ 11,10 GET mtrenpcr
@ 11,62 GET mtexpir PICTURE '99/99/99'
@ 12,10 GET mtsec
@ 12,36 GET mtsecb
@ 12,62 GET mtlate PICTURE '99'
@ 13,10 GET mtrent
@ 13,36 GET mtlatec
@ 13,62 GET mtaddl
@ 14,10 GET mtrente
@ 14,36 GET mtrentm
@ 15,10 GET mtrentd
@ 15,36 GET mtrentpd PICTURE '99/99/99'
@ 15,62 GET mtrentp
@ 16,10 GET mtrenty
@ 16,36 GET mtflag PICTURE '99/99/99'
@ 16,62 GET mtrentt
@ 18,10 GET mtnotes
@ 18,61 GET mtupdate PICTURE '99/99/99'
@ 20,01 SAY SPACE(75)
@ 21,01 SAY SPACE(75)
@ 22,01 SAY SPACE(75)
@ 20,07 SAY prompt1
@ 21,07 SAY prompt2
@ 22,07 SAY prompt3
* let user enter data
READ
CLEA GETS
ENDI command = 'Y'
REPL tenant WITH mtenant, bcode WITH mbcode, tunit WITH mtunit
REPL baddr WITH mbaddr, tcontac WITH mtcontac, tphone WITH mtphone
REPL alt WITH malt, altad WITH maltad, altcty WITH maltcty
REPL ttype WITH mttype, texpir WITH mtexpir
REPL trentpc WITH mtrentpc, trentpcr WITH mtrenpcr
REPL tfirst WITH mtfirst, tsec WITH mtsec, tsecb WITH mtsecb
REPL tlate WITH mtlate, trent WITH mtrent, taddl WITH mtaddl
REPL trente WITH mtrente, trentm WITH mtrentm, trentp WITH mtrentp
REPL trentpd WITH mtrentpd, tlatec WITH mtlatec, trentd WITH mtrentd
REPL trenty WITH mtrenty, trentt WITH mtrentt
REPL tflag WITH mtflag, tnotes WITH mtnotes
* ask if an automatic update of the date is wanted
IF SUBSTR(DTOC(DATE()),1,2) <> '00'
STOR 'Y' TO command
@ 20,01 SAY SPACE(75)
@ 21,01 SAY SPACE(75)
@ 22,01 SAY SPACE(75)
@ 20,12 SAY 'Do You wish to UpDate to Todays Date (Y/N) ?'
@ 20,57 GET command PICTURE '!'
READ
IF command = 'Y'
REPL tupdate WITH DTOC(DATE())
ELSE
REPL tupdate WITH mtupdate
ENDI $(date)
ENDI command = 'Y'
SET DELIMITER ON
SET INTENSITY OFF
STOR .t. TO first
CASE (command = 'F' .OR. command = '.' )
* move forward one record
SKIP
LOOP
CASE (command = 'H' .OR. command = '?' )
* display a screen full of instructions
STOR .t. TO first
CLEA
TEXT
M A I N T E N A N T M E N U H E L P F I L E
Welcome to the SIG/M PROPERTY MANAGER main tenant data base file.
I am here to help you and you can call me anytime by just entering
a ? mark at any place where this program asks for a command.
When you go back to the screen you will see two lines - on top of
the first line it says 'Main Tenant Database Menu' - thus, the
program always tells you where you are!
Between the two lines we have the information you or someone else
entered into the computer. This information tells you all about a
particular tenant.
If you press any key I will tell you more.
ENDT
SET CONSOLE OFF
WAIT
SET CONSOLE ON
CLEA
TEXT
This is a multiple data base - by that I mean - you can have one screen of
information about the building and another screen of information about any of
the tenants in that building. To find the information about the building the
tenant resides in, hit 'U' for b<U>ilding records.
The information on screen in clear, so let's look below the line. This shows
what you can do. To look at the next record - hit 'F' (or a period). To go
back one record - hit 'B' (or a comma). To delete a record hit 'D' and a sign
will appear at the upper right corner. To remove the delete - hit 'D' again.
Don't worry - you cannot accidentally delete a record just by hitting 'D'.
You must run another program on the Maintenance Menu (purge) to delete.
To find a file - hit 'S' for search if you know the code number.Otherwise you
can find any string in the file by using the 'N' search option. To add more
tenants, however, you must go back to the building data base and hit 'A' for
Add. The Add option allows you to enter new buildings and tenants or just new
tenants. To Edit a file, use the 'E' option.
Please hit any key to continue
ENDT
SET CONSOLE OFF
WAIT
SET CONSOLE ON
CLEA
TEXT
The Type of tenancy can be either 'R' for regular, 'P' for per-
centage rent (in which the higher of the percentage or base becomes the
base or 'O' for overage, where an overage rent is added to the base rent.
To use different methods of calculation, the code in the files ending in
'TNT' should be changed.
-------------------------------------------------------------------------
WHATEVER YOU DO - NEVER SHUT OFF THE MACHINE OR REMOVE A DISK UNTIL YOU
FIRST RETURN TO THE MAIN MENU AND THEN QUIT TO THE OPERATING SYSTEM.
If you ever get a SYNTAX error that just hitting ENTER does not correct,
hit the ESCAPE key and type Quit. Then try all over again.
EVERY SO OFTEN YOU WILL FIND YOU WANT TO USE THE ESCAPE KEY AND WHEN YOU
TRY TO TYPE 'QUIT' NOTHING HAPPENS. AT A FEW POINTS IN THIS PROGRAN SCREEN
ACCESS HAS BEEN ELIMINATED. THEREFORE, TYPE 'QUIT' EVEN THOUGH IT DOES NOT
APPEAR ON THE SCREEN - AND UNLESS THE MACHINE IS LOCKED UP - YOU WILL EXIT
TO THE OPERATING SYSTEM.
-------------------------------------------------------------------------
Please hit any key to get back to the data base
ENDT
SET CONSOLE OFF
WAIT
SET CONSOLE ON
LOOP
CASE command = 'P'
* Screen print
@ 20,00
@ 21,00
@ 22,00
@ 20,0 SAY 'PRINT OPTIONS: S (SINGLE SPACE), D (DOUBLE SPACE), N (NO PRINTING) '
STOR 'Y' TO PRNTSCRN
STOR 'N' TO PRNTOPT
@ 20,67 GET PRNTOPT PICTURE '!'
READ
DO WHIL AT(PRNTOPT, 'SDN') = 0
@ 20,67 GET PRNTOPT PICTURE '!'
READ
ENDD
IF PRNTOPT = 'S'
STOR 1 TO LINEMULT
ENDI
IF PRNTOPT = 'D'
STOR 2 TO LINEMULT
ENDI
IF PRNTOPT = 'N'
STOR 'N' TO PRNTSCRN
ENDI
IF PRNTSCRN = 'Y'
STOR trent TO trentx
IF ttype = 'P'
IF (trentpc*(trentpcr/100)/12)>trent
STOR (trentpc*(trentpcr/100)/12) TO trentx
ENDI (trentpc)
ENDI ttype = 'P'
IF ttype = 'O'
STOR ((trentpc*(trentpcr/100)/12)+trent) TO trentx
ENDI ttype = 'O'
STOR (trentx + tlatec + taddl + trente + trentm) TO trentxx
SET DEVICE TO PRINT
EJEC
@ LINEMULT*4,3 SAY 'Tenant:'
@ LINEMULT*4,12 SAY TENANT
@ LINEMULT*4,54 SAY 'Code:'
@ LINEMULT*4,61 SAY BCODE
@ LINEMULT*5,5 SAY 'Unit:'
@ LINEMULT*5,12 SAY TUNIT
@ LINEMULT*5,27 SAY 'Building:'
@ LINEMULT*5,38 SAY BADDR
@ LINEMULT*6,2 SAY 'Contact:'
@ LINEMULT*6,12 SAY TCONTAC
@ LINEMULT*6,53 SAY 'Phone:'
@ LINEMULT*6,61 SAY TPHONE
@ LINEMULT*7,9 SAY 'Alternate mailing address:'
@ LINEMULT*7,36 SAY ALT
@ LINEMULT*8,1 SAY 'Address:'
@ LINEMULT*8,10 SAY ALTAD
@ LINEMULT*9,4 SAY 'City:'
@ LINEMULT*9,10 SAY ALTCTY
@ LINEMULT*11,5 SAY 'Type:'
@ LINEMULT*11,12 SAY TTYPE
@ LINEMULT*11,20 SAY 'Addl Percentage:'
@ LINEMULT*11,38 SAY TRENTPC PICTURE '99.9999'
@ LINEMULT*11,49 SAY '1st Lease:'
@ LINEMULT*11,61 SAY TFIRST
@ LINEMULT*12,5 SAY 'Base:'
@ LINEMULT*12,12 SAY TRENTPCR PICTURE '$999,999,999'
@ LINEMULT*12,25 SAY 'Expiration:'
@ LINEMULT*12,38 SAY TEXPIR
@ LINEMULT*13,1 SAY 'Security:'
@ LINEMULT*13,12 SAY TSEC PICTURE '$99,999.99'
@ LINEMULT*13,31 SAY 'Bank:'
@ LINEMULT*13,38 SAY TSECB
@ LINEMULT*13,49 SAY 'Late Date:'
@ LINEMULT*13,61 SAY TLATE
@ LINEMULT*14,5 SAY 'Rent:'
@ LINEMULT*14,12 SAY TRENT PICTURE '$99,999.99'
@ LINEMULT*14,26 SAY 'Late Chgs:'
@ LINEMULT*14,38 SAY TLATEC PICTURE '$99,999.99'
@ LINEMULT*14,49 SAY 'Addl Rent:'
@ LINEMULT*14,61 SAY TADDL PICTURE '$99,999.99'
@ LINEMULT*15,4 SAY 'G & E:'
@ LINEMULT*15,12 SAY TRENTE PICTURE '$99,999.99'
@ LINEMULT*15,26 SAY 'Other Chgs:'
@ LINEMULT*15,38 SAY TRENTM PICTURE '$99,999.99'
@ LINEMULT*15,49 SAY 'Total Rent:'
@ LINEMULT*15,61 SAY TRENTXX PICTURE '$99,999.99'
@ LINEMULT*16,1 SAY 'Rent Due:'
@ LINEMULT*16,12 SAY TRENTD PICTURE '$99,999.99'
@ LINEMULT*16,23 SAY 'Last Payment:'
@ LINEMULT*16,38 SAY TRENTPD
@ LINEMULT*16,50 SAY 'Amt Paid:'
@ LINEMULT*16,61 SAY TRENTP PICTURE '$99,999.99'
@ LINEMULT*17,01 SAY 'Total Yr:'
@ LINEMULT*17,12 SAY TRENTY PICTURE '$99,999.99'
@ LINEMULT*17,31 SAY 'Flag:'
@ LINEMULT*17,38 SAY TFLAG
@ LINEMULT*17,53 SAY 'Total:'
@ LINEMULT*17,61 SAY TRENTT PICTURE '$99,999.99'
@ LINEMULT*19,4 SAY 'Notes:'
@ LINEMULT*19,12 SAY TNOTES
@ LINEMULT*19,52 SAY 'Update:'
@ LINEMULT*19,61 SAY TUPDATE
@ LINEMULT*21,1 SAY DTOC(DATE())
@ 52,0 SAY ' '
SET DEVICE TO SCREEN
ENDI
RELE PRNTSCRN, PRNTOPT, LINEMULT
@ 20,00
@ 21,00
@ 22,00
LOOP
CASE command = 'Q' .OR. command = 'R'
STOR .f. TO more
LOOP
CASE command = 'U'
STOR SUBSTR(bcode,1,2) TO findt
SELE A
USE &dr:build index &dr.:code
SEEK TRIM(findt)
DO build
CASE command = 'S'
@ 20,00
@ 21,00
@ 22,00
STOR ' ' TO findt
@ 20,27 SAY 'Enter Code Number'
@ 20,48 GET findt PICTURE '99999'
READ
SEEK TRIM(findt)
IF .NOT. FOUND()
@ 20,00
@ 20,16 SAY 'Unable to locate tenant with that Code Number'
@ 21,20 SAY 'PLEASE HIT ANY KEY TO CONTINUE'
SET CONSOL OFF
WAIT
SET CONSOL ON
GO TOP
ENDI
LOOP
CASE command= 'N'
DO search1t
STOR .t. TO first
LOOP
ENDC
* loop back again
ENDD WHILE more
RETU