home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
xbase
/
tools
/
foxdecom
/
test.prg
< prev
Wrap
Text File
|
1990-12-04
|
17KB
|
526 lines
* PROGRAM.: test.PRG
* Author..: Barry Doyle
* DATE....: 05/21/90
* NOTES...: Example program source for FOXDCOMP.
* initialize new variables
usermsg="Enter transaction number or data "
fkeys="[ESC] Exit [^End] Retrieve/Add "
data_flag = "N"
* open database
SELECT A
USE sequence
SELECT B
USE tranhist INDEX tranhist, trancli, tranver
SELECT C
USE client INDEX client
DO WHILE .T.
* The DO WHILE will be terminated by an EXIT command
IF data_flag = "E" && edit error were found
IF action = "ADD"
SET FORMAT TO tru30s1
ELSE
SET FORMAT TO tru30s2
ENDIF
IF w_tran_nbr = 00000
data_flag = "N"
fkeys="[ESC] Exit [^End] Retrieve/Add "
@ 23 , 43 SAY fkeys
ELSE
data_flag = "Y"
ENDIF
ELSE
ctime=TIME()
if data_flag = "Y" && amount and type can't change
SET FORMAT TO tru30s2
ELSE
SET FORMAT TO tru30s1
ENDIF
IF data_flag= "N" && no data to modify is on screen
CLEAR
fkeys="[ESC] Exit [^End] Retrieve/Add "
prv_tran = 00000
w_tran_nbr = 00000
w_client = 00000
w_type = space(2)
w_amount = 0000000.00
w_typedesc = space(20)
w_pay_name = space(40)
w_pay_str = space(30)
w_pay_city = space(25)
w_pay_st = space(2)
w_pay_zip = space(15)
w_desc = space(50)
w_stat = "AC"
w_statmean = space(20)
w_prt_chk = " "
w_cancel = " "
w_chk_nbr = 000000
w_cname = space(51)
w_add_dt = CTOD(" / / ")
w_fund_dt = CTOD(" / / ")
w_chk_pdte = CTOD(" / / ")
w_chk_ptme = space(5)
w_rule = 00000
w_inv_reas = space(30)
w_bef_bal = 0000000.00
w_aft_bal = 0000000.00
ELSE && data is on screen to modify
fkeys="[ESC] Exit [^End] Retrieve/Modify "
ENDIF && If data_flag = "N"
ENDIF && If data_flag = "E"
READ
w_type=UPPER(w_type)
w_prt_chk=UPPER(w_prt_chk)
w_cancel=UPPER(w_cancel)
usermsg=SPACE(40)
* get key pressed
keyhit = READKEY()
* process user response
action="NO "
IF keyhit = 12 .OR. keyhit = 268 && escape
EXIT
ENDIF
IF keyhit = 14 .OR.;
keyhit = 15 .OR.;
keyhit = 270 .OR.;
keyhit = 271
IF data_flag = "N"
IF w_tran_nbr = 00000
action = "ADD"
ELSE
action = "GET"
ENDIF && w_tran_nbr not = 0
ELSE && data_flag was "Y"
IF w_tran_nbr = 00000
action = "ADD"
ELSE
IF w_tran_nbr = prv_tran
action = "MOD"
ELSE
action = "GET"
ENDIF
ENDIF && w_tran_nbr = 0
ENDIF && If data_flag = 'N'
ELSE && If keyhit was enter
usermsg="Bad key hit - control data not updated "
action = "NO "
ENDIF && If keyhit was enter
passedit = "Y"
* perform action as determined above
IF action = "GET"
SELECT B
SEEK w_tran_nbr
IF FOUND()
data_flag = "Y"
usermsg="Transaction retrieved - Enter changes"
prv_tran = tran_nbr
w_tran_nbr = tran_nbr
w_client = client_nbr
w_type = tran_type
DO CASE
CASE w_type = "MW"
w_typedesc = "Manual Withdrawal "
CASE w_type = "MD"
w_typedesc = "Manual Deposit "
CASE w_type = "AW"
w_typedesc = "Automatic Withdrawal"
CASE w_type = "AD"
w_typedesc = "Automatic Deposit "
CASE w_type = "PA"
w_typedesc = "Positive Adjustment "
CASE w_type = "NA"
w_typedesc = "Negative Adjustment "
CASE w_type = "CW"
w_typedesc = "W/D Cancel Adj. "
CASE w_type = "CD"
w_typedesc = "Deposit Cancel Adj. "
CASE w_type = "CP"
w_typedesc = "Pos/Adj Cancel Adj. "
CASE w_type = "CN"
w_typedesc = "Neg/Adj Cancel Adj. "
OTHERWISE
w_typedesc = space(20)
ENDCASE
w_amount = tran_amt
w_pay_name = tran_name
w_pay_str = tran_str
w_pay_city = tran_city
w_pay_st = tran_state
w_pay_zip = tran_zip
w_desc = tran_desc
w_stat = tran_stat
DO CASE
CASE w_stat = "AC"
w_statmean = "Accepted "
CASE w_stat = "RJ"
w_statmean = "Rejected "
CASE w_stat = "UV"
w_statmean = "Unverified "
CASE w_stat = "CA"
w_statmean = "Cancelled "
OTHERWISE
w_statmean = space(20)
ENDCASE
w_prt_chk = " "
w_cancel = " "
w_chk_nbr = chk_nbr
w_add_dt = tran_date
w_fund_dt = fund_date
w_chk_pdte = chk_pdate
w_chk_ptme = chk_ptime
w_rule = tran_rule
w_inv_reas = inv_reason
w_bef_bal = before_bal
w_aft_bal = after_bal
SELECT C
SEEK w_client
w_cname = TRIM(first_name) + " " + last_name
w_balance = bal_amount
ELSE
usermsg="Transaction " + LTRIM(STR(w_tran_nbr)) + " not found"
data_flag = "N"
ENDIF
ELSE && (action = "GET")
IF action = "ADD" && add edits start
SELECT C
SEEK w_client
IF .NOT. FOUND()
usermsg="Client number is not on file "
data_flag = "E"
passedit = "N"
ENDIF
IF passedit = "Y"
IF (w_type <> "MD") .AND.;
(w_type <> "MW") .AND.;
(w_type <> "PA") .AND.;
(w_type <> "NA")
usermsg="Type must be MD, MW, PA, or NA "
data_flag = "E"
passedit = "N"
ENDIF
ENDIF
IF passedit = "Y"
IF (w_amount = 0) .OR.;
(w_amount < 0)
usermsg="Amount must be greater than zero "
data_flag = "E"
passedit = "N"
ENDIF
ENDIF
IF passedit = "Y"
IF (w_type = "MW") .OR.;
(w_type = "NA")
IF (w_amount > bal_amount)
usermsg="Insufficient client balance - rejected "
data_flag = "E"
passedit="N"
ENDIF
ENDIF
ENDIF
IF passedit = "Y"
IF (w_type <> "MW") .AND.;
(w_chk_nbr <> 000000)
usermsg="Check # is only valid for withdrawal"
data_flag = "E"
passedit="N"
ENDIF
ENDIF
IF passedit = "Y" && add edits passed.
SELECT A && modify sequence.
w_tran_nbr = tran_seq + 1
prv_tran = w_tran_nbr
REPLACE tran_seq WITH w_tran_nbr
SELECT C && modify client.
SEEK w_client
w_bef_bal = bal_amount
IF (w_type = "MD") .OR.;
(w_type = "PA")
w_aft_bal = w_bef_bal + w_amount
ELSE
w_aft_bal = w_bef_bal - w_amount
ENDIF
w_balance = w_aft_bal
REPLACE bal_amount WITH w_aft_bal
SELECT B && add tranhist
APPEND BLANK
REPLACE tran_nbr WITH w_tran_nbr
REPLACE tran_type WITH w_type
REPLACE client_nbr WITH w_client
REPLACE tran_date WITH DATE()
REPLACE fund_date WITH DATE()
REPLACE chk_pdate WITH CTOD(" / / ")
REPLACE chk_ptime WITH space(5)
REPLACE tran_rule WITH 00000
REPLACE tran_amt WITH w_amount
REPLACE tran_stat WITH "AC"
REPLACE before_bal WITH w_bef_bal
REPLACE after_bal WITH w_aft_bal
w_statmean = "Accepted"
DO CASE
CASE w_type = "MW"
w_typedesc = "Manual Withdrawal "
CASE w_type = "MD"
w_typedesc = "Manual Deposit "
CASE w_type = "PA"
w_typedesc = "Positive Adjustment "
CASE w_type = "NA"
w_typedesc = "Negative Adjustment "
OTHERWISE
w_typedesc = space(20)
ENDCASE
action = "MOA"
data_flag = "Y"
ENDIF
ENDIF
ENDIF
IF action = "MOD"
SELECT B
SEEK w_tran_nbr
passedit = "Y"
IF w_stat = "CA" .AND. w_prt_chk = "Y"
usermsg="Check not printed - cancelled trans. "
data_flag = "E"
passedit="N"
ENDIF
IF w_stat <> "AC" .AND. w_prt_chk = "Y"
usermsg="Check not printed - status must be AC"
data_flag = "E"
passedit="N"
ENDIF
IF passedit = "Y"
IF w_prt_chk <> "Y" .AND. w_prt_chk <> " "
usermsg="Print check must be Y or blank "
data_flag = "E"
passedit="N"
ENDIF
ENDIF
IF passedit = "Y"
IF w_prt_chk = "Y" .AND.;
w_type <> "MW" .AND.;
w_type <> "AW"
usermsg="Can only print check for withdrawal"
data_flag = "E"
passedit="N"
ENDIF
ENDIF
IF passedit = "Y"
IF w_stat = "CA" .AND. w_cancel = "Y"
usermsg="Transaction is already cancelled "
data_flag = "E"
passedit="N"
ENDIF
ENDIF
IF passedit = "Y"
IF w_type = "CN" .OR.;
w_type = "CP" .OR.;
w_type = "CD" .OR.;
w_type = "CW"
usermsg="Cancel adj. trans. can't be cancelled"
data_flag = "E"
passedit="N"
ENDIF
ENDIF
IF passedit = "Y"
IF w_cancel <> "Y" .AND. w_cancel <> " "
usermsg="Cancel must be Y or blank "
data_flag = "E"
passedit="N"
ENDIF
ENDIF
IF passedit = "Y"
IF w_cancel <> " " .AND. w_prt_chk <> " "
usermsg="Both cancel and print selected "
data_flag = "E"
passedit="N"
ENDIF
ENDIF
IF passedit = "Y"
IF w_type = "PA" .OR.;
w_type = "MD" .OR.;
w_type = "AD"
IF w_cancel = "Y" .AND.;
tran_amt > w_balance .AND.;
w_stat = "AC"
usermsg="Not cancelled - insufficient funds "
data_flag = "E"
passedit="N"
ENDIF
ENDIF
ENDIF
IF passedit = "Y"
IF ((w_type <> "MW") .AND.;
(w_type <> "AW")) .AND.;
(w_chk_nbr <> 000000)
usermsg="Check # is only valid for withdrawal"
data_flag = "E"
passedit="N"
ENDIF
ENDIF
ENDIF
IF passedit = "Y"
IF action = "MOD" .OR. action = "MOA"
REPLACE tran_name WITH w_pay_name
REPLACE tran_str WITH w_pay_str
REPLACE tran_city WITH w_pay_city
REPLACE tran_state WITH w_pay_st
REPLACE tran_zip WITH w_pay_zip
REPLACE tran_desc WITH w_desc
REPLACE tran_stat WITH w_stat
REPLACE chk_nbr WITH w_chk_nbr
IF w_cancel = "Y"
REPLACE tran_stat WITH "CA"
ENDIF
IF action = "MOD"
usermsg="Transaction " + LTRIM(STR(w_tran_nbr))
IF w_cancel = "Y"
SELECT C && modify client balance
SEEK w_client
w_bef_bal = bal_amount
w_aft_bal = bal_amount
IF (w_type = "MD") .OR.;
(w_type = "PA") .OR.;
(w_type = "AD")
IF w_stat = "AC"
w_aft_bal = w_bef_bal - w_amount
ENDIF
ELSE
IF w_stat = "AC"
w_aft_bal = w_bef_bal + w_amount
ENDIF
ENDIF
w_balance = w_aft_bal
REPLACE bal_amount WITH w_aft_bal
SELECT A && modify sequence for adjusting txn
w_tran_nbr = tran_seq + 1
REPLACE tran_seq WITH w_tran_nbr
SELECT B && add adjusting tranhist
APPEND BLANK
REPLACE tran_nbr WITH w_tran_nbr
IF w_type = "AW" .OR. w_type = "MW"
REPLACE tran_type WITH "CW"
ELSE
IF w_type = "AD" .OR. w_type = "MD"
REPLACE tran_type WITH "CD"
ELSE
IF w_type = "PA"
REPLACE tran_type WITH "CP"
ELSE
REPLACE tran_type WITH "CN"
ENDIF
ENDIF
ENDIF
REPLACE client_nbr WITH w_client
REPLACE tran_date WITH DATE()
REPLACE fund_date WITH DATE()
REPLACE tran_rule WITH 00000
REPLACE tran_amt WITH w_amount
REPLACE tran_stat WITH "AC"
REPLACE before_bal WITH w_bef_bal
REPLACE after_bal WITH w_aft_bal
REPLACE tran_name WITH w_pay_name
REPLACE tran_str WITH w_pay_str
REPLACE tran_city WITH w_pay_city
REPLACE tran_state WITH w_pay_st
REPLACE tran_zip WITH w_pay_zip
REPLACE tran_desc WITH usermsg + " cancel adjustment"
usermsg = usermsg + " cancelled"
ELSE
usermsg = usermsg + " modified"
ENDIF
data_flag = "N"
ELSE && if w_cancel = "Y"
usermsg="Transaction " + LTRIM(STR(w_tran_nbr)) + " added"
data_flag = "N"
ENDIF && "MOD" or "MOA"
* Print check logic
IF w_prt_chk = "Y"
SET PRINT ON
IF chk_pdate = CTOD(" / / ")
REPLACE chk_pdate WITH DATE()
REPLACE chk_ptime WITH SUBSTR(TIME(), 1, LEN(TIME()) - 3)
ENDIF
w_line = 1
DO WHILE w_line < w_chkdtrow
? " "
w_line = w_line + 1
ENDDO
? SPACE(w_chkdtcol - 1) + DTOC(fund_date)
w_line = w_line + 1
DO WHILE w_line < w_chkptrow
? " "
w_line = w_line + 1
ENDDO
? SPACE(w_chkptcol - 1) + tran_name
p_tran_amt = "$" + LTRIM(STR(tran_amt,10,2))
w_leadsp = 12 - LEN(p_tran_amt)
p_tran_amt = SPACE(w_leadsp) + p_tran_amt
?? SPACE(w_chkamcol - LEN(tran_name)) + p_tran_amt
DO WHILE w_line < w_chkdorow
? " "
w_line = w_line + 1
ENDDO
p_tran_dol = LTRIM(STR(INT(tran_amt))) + " AND "
p_tran_cnt = LTRIM(STR((tran_amt - INT(tran_amt)) * 100))
p_tran_dol = p_tran_dol + p_tran_cnt + "/100"
p_tran_dol = SPACE(w_chkdocol - 1) + p_tran_dol
? p_tran_dol
w_stars = w_chkdolen - LEN(p_tran_dol)
?? REPLICATE("*", w_stars)
w_line = w_line + 1
DO WHILE w_line < w_chkderow
? " "
w_line = w_line + 1
ENDDO
? SPACE(w_chkdecol-1) + LTRIM(STR(tran_nbr))
IF tran_rule <> 0
?? "-" + LTRIM(STR(tran_rule))
ENDIF
DO WHILE w_line <= w_chklines
? " "
w_line = w_line + 1
ENDDO
SET PRINT OFF
ENDIF && w_prt_chk = "Y"
ENDIF && "MOD"
ENDIF && passedit
ENDDO
* Re-Set working environment
CLOSE DATABASES
RETURN
* Eof: test.prg