home *** CD-ROM | disk | FTP | other *** search
/ World of Shareware - Software Farm 2 / wosw_2.zip / wosw_2 / DATABASE / DBT123S.ZIP / SETACCT.PRG < prev    next >
Text File  |  1989-02-27  |  3KB  |  107 lines
  1. * Program : SETACCT.PRG - Set up account balances
  2. *         : (c) 1989 BERNATH COMPUTER
  3. *         : 14:26:36  11/7/1989
  4. *
  5. EXITNOW = .F.
  6. EDITING = .F.
  7. SELECT B
  8. USE ACCOUNTS INDEX ACCOUNTS
  9. gFG = 0
  10. gBG = 3
  11. mBAR = CHR(195)+REPLICATE("─",62)+CHR(180)
  12. mACCTNUM = SPACE(5)
  13.  
  14. DO WHILE .NOT. EXITNOW
  15.    IF .NOT. EDITING
  16.       mACCTNUM = SPACE(5)
  17.       mYTD = 0.00
  18.       mQTD = 0.00
  19.       mMTD = 0.00
  20.       mCURRENT = 0.00
  21.       mBAL_FWD = 0.00
  22.       DO SCRHEAD WITH "SAMPLE DATA ENTRY PROGRAM","Setup Account Balances",0,1
  23.       CALL DBTOOLS WITH "3,7,7,20,70,14,2,1,0,1"
  24.       CALL DBTOOLS WITH "1,8,13,14,2,0,Initial balances for"
  25.       CALL DBTOOLS WITH "1,8,34,15,2,0,detail"
  26.       CALL DBTOOLS WITH "1,8,41,14,2,0,accounts can be set up"
  27.       CALL DBTOOLS WITH "1,9,13,14,2,0,with this module if the account has a zero balance."
  28.       CALL DBTOOLS WITH "1,10,7,14,2,0,"+mBAR
  29.       SET COLOR TO +W/G,+GR/N,,G
  30.       CALL DBTOOLS WITH "1,11,14,14,2,0,Account Number:"
  31.       CALL DBTOOLS WITH "1,13,13,14,2,0,Balance Forward:"
  32.       CALL DBTOOLS WITH "1,14,21,14,2,0,Current:"
  33.       CALL DBTOOLS WITH "1,15,25,14,2,0,MTD:"
  34.       CALL DBTOOLS WITH "1,16,25,14,2,0,QTD:"
  35.       CALL DBTOOLS WITH "1,17,25,14,2,0,YTD:"
  36.    ENDIF
  37.  
  38.    OKACCT = .F.
  39.    DO WHILE .NOT. OKACCT
  40.       @ 11,30 GET mACCTNUM PICTURE "99999"
  41.       READ
  42.       DO KEYTRAP
  43.       IF EXITNOW
  44.          EXIT
  45.       ENDIF
  46.       SEEK mACCTNUM
  47.       IF .NOT. FOUND()
  48.          DO ERRMSG WITH "Account not found."
  49.          LOOP
  50.       ELSE
  51.          IF BAL_FWD+CURRENT+MTD+QTD+YTD = 0
  52.             IF GEN_DET = "D"
  53.                OKACCT = .T.
  54.                CALL DBTOOLS WITH "1,11,40,15,2,0,"+ACCTNAME
  55.                mBAL_FWD = BAL_FWD
  56.                mCURRENT = CURRENT
  57.                mMTD = MTD
  58.                mQTD = QTD
  59.                mYTD = YTD
  60.             ELSE
  61.                DO ERRMSG WITH "Account is not a detail account."
  62.             ENDIF
  63.          ELSE
  64.             DO ERRMSG WITH "Account balance is not zero."
  65.             LOOP
  66.          ENDIF
  67.       ENDIF
  68.    ENDDO
  69.    IF EXITNOW
  70.       EXIT
  71.    ENDIF
  72.    @ 13,30 GET mBAL_FWD PICTURE "9999999.99"
  73.    @ 14,30 GET mCURRENT PICTURE "9999999.99"
  74.    @ 15,30 GET mMTD PICTURE "9999999.99"
  75.    @ 16,30 GET mQTD PICTURE "9999999.99"
  76.    @ 17,30 GET mYTD PICTURE "9999999.99"
  77.    READ
  78.    DO KEYTRAP
  79.    IF EXITNOW
  80.       EXIT
  81.    ENDIF
  82.    mOPTION = 1
  83.    DO ACQ WITH mOPTION
  84.    DO CASE mOPTION
  85.       CASE mOPTION = 1
  86.          REPLACE BAL_FWD WITH mBAL_FWD,;
  87.                  CURRENT WITH mCURRENT,;
  88.                  MTD WITH mMTD,;
  89.                  QTD WITH mQTD,;
  90.                  YTD WITH mYTD
  91.          EXITNOW = .F.
  92.          EDITING = .F.
  93.  
  94.       CASE mOPTION = 2
  95.          EDITING = .T.
  96.          EXITNOW = .F.
  97.  
  98.       CASE mOPTION = 3 .OR. mOPTION = 0
  99.          EXITNOW = .T.
  100.          EDITING = .F.
  101.    ENDCASE
  102. ENDDO
  103. EXITNOW = .F.
  104. RELEASE ALL EXCEPT g*
  105. CLOSE DATABASES
  106. gNUMOPT = 3
  107. RETURN