Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive   : DBT123S.ZIP
Filename : SETACCT.PRG

* Program : SETACCT.PRG - Set up account balances
* : (c) 1989 BERNATH COMPUTER
* : 14:26:36 11/7/1989
*
EXITNOW = .F.
EDITING = .F.
SELECT B
USE ACCOUNTS INDEX ACCOUNTS
gFG = 0
gBG = 3
mBAR = CHR(195)+REPLICATE("Ä",62)+CHR(180)
mACCTNUM = SPACE(5)

DO WHILE .NOT. EXITNOW
IF .NOT. EDITING
mACCTNUM = SPACE(5)
mYTD = 0.00
mQTD = 0.00
mMTD = 0.00
mCURRENT = 0.00
mBAL_FWD = 0.00
DO SCRHEAD WITH "SAMPLE DATA ENTRY PROGRAM","Setup Account Balances",0,1
CALL DBTOOLS WITH "3,7,7,20,70,14,2,1,0,1"
CALL DBTOOLS WITH "1,8,13,14,2,0,Initial balances for"
CALL DBTOOLS WITH "1,8,34,15,2,0,detail"
CALL DBTOOLS WITH "1,8,41,14,2,0,accounts can be set up"
CALL DBTOOLS WITH "1,9,13,14,2,0,with this module if the account has a zero balance."
CALL DBTOOLS WITH "1,10,7,14,2,0,"+mBAR
SET COLOR TO +W/G,+GR/N,,G
CALL DBTOOLS WITH "1,11,14,14,2,0,Account Number:"
CALL DBTOOLS WITH "1,13,13,14,2,0,Balance Forward:"
CALL DBTOOLS WITH "1,14,21,14,2,0,Current:"
CALL DBTOOLS WITH "1,15,25,14,2,0,MTD:"
CALL DBTOOLS WITH "1,16,25,14,2,0,QTD:"
CALL DBTOOLS WITH "1,17,25,14,2,0,YTD:"
ENDIF

OKACCT = .F.
DO WHILE .NOT. OKACCT
@ 11,30 GET mACCTNUM PICTURE "99999"
READ
DO KEYTRAP
IF EXITNOW
EXIT
ENDIF
SEEK mACCTNUM
IF .NOT. FOUND()
DO ERRMSG WITH "Account not found."
LOOP
ELSE
IF BAL_FWD+CURRENT+MTD+QTD+YTD = 0
IF GEN_DET = "D"
OKACCT = .T.
CALL DBTOOLS WITH "1,11,40,15,2,0,"+ACCTNAME
mBAL_FWD = BAL_FWD
mCURRENT = CURRENT
mMTD = MTD
mQTD = QTD
mYTD = YTD
ELSE
DO ERRMSG WITH "Account is not a detail account."
ENDIF
ELSE
DO ERRMSG WITH "Account balance is not zero."
LOOP
ENDIF
ENDIF
ENDDO
IF EXITNOW
EXIT
ENDIF
@ 13,30 GET mBAL_FWD PICTURE "9999999.99"
@ 14,30 GET mCURRENT PICTURE "9999999.99"
@ 15,30 GET mMTD PICTURE "9999999.99"
@ 16,30 GET mQTD PICTURE "9999999.99"
@ 17,30 GET mYTD PICTURE "9999999.99"
READ
DO KEYTRAP
IF EXITNOW
EXIT
ENDIF
mOPTION = 1
DO ACQ WITH mOPTION
DO CASE mOPTION
CASE mOPTION = 1
REPLACE BAL_FWD WITH mBAL_FWD,;
CURRENT WITH mCURRENT,;
MTD WITH mMTD,;
QTD WITH mQTD,;
YTD WITH mYTD
EXITNOW = .F.
EDITING = .F.

CASE mOPTION = 2
EDITING = .T.
EXITNOW = .F.

CASE mOPTION = 3 .OR. mOPTION = 0
EXITNOW = .T.
EDITING = .F.
ENDCASE
ENDDO
EXITNOW = .F.
RELEASE ALL EXCEPT g*
CLOSE DATABASES
gNUMOPT = 3
RETURN