home *** CD-ROM | disk | FTP | other *** search
/ World of Shareware - Software Farm 2 / wosw_2.zip / wosw_2 / DATABASE / DBT123S.ZIP / ACCTDE.PRG < prev    next >
Text File  |  1990-07-20  |  6KB  |  220 lines
  1. * Program : ACCTDE.PRG - Account Data Entry
  2. *         : (c) 1990 BERNATH COMPUTER
  3. *         : 07/20/1990
  4.  
  5. EXITNOW = .F.
  6. EDITING = .F.
  7. mADDIT = " "
  8. gFG=0
  9. gBG=3
  10. select B
  11.    USE ACCOUNTS INDEX ACCOUNTS
  12. mLEVEL = 0
  13. Mgen_det = "G"
  14.  
  15. DO WHILE .NOT. EXITNOW
  16.    DO SCRHEAD WITH "SAMPLE DATA ENTRY","Accounts Data Entry",0,1
  17.    SET COLOR TO N/G,+GR/N,,G
  18.    CALL DBTOOLS WITH "3,7,10,20,70,0,2,1,0,1"
  19.    CALL DBTOOLS WITH "1,9,10,0,2,0,╞═══════════════════════════════════════════════════════════╡"
  20.    CALL DBTOOLS WITH "1,8,12,0,2,0,Account number:"
  21.    CALL DBTOOLS WITH "1,8,39,0,2,0,Name:"
  22.    CALL DBTOOLS WITH "1,10,12,0,2,0,General or Detail (G/D)?"
  23.    CALL DBTOOLS WITH "1,10,45,0,2,0,Level (1-5):"
  24.    CALL DBTOOLS WITH "1,10,60,0,2,0,Type:"
  25.    CALL DBTOOLS WITH "1,12,12,0,2,0,General (parent) Account:"
  26.    CALL DBTOOLS WITH "1,13,10,0,2,0,╞═══════════════════════════════════════════════════════════╡"
  27.    CALL DBTOOLS WITH "1,14,23,15,2,0,H I S T O R Y"
  28.    CALL DBTOOLS WITH "1,15,20,0,2,0,Previous balance:"
  29.    CALL DBTOOLS WITH "1,16,29,0,2,0,Current:"
  30.    CALL DBTOOLS WITH "1,17,33,0,2,0,MTD:"
  31.    CALL DBTOOLS WITH "1,18,33,0,2,0,QTD:"
  32.    CALL DBTOOLS WITH "1,19,33,0,2,0,YTD:"
  33.    IF .NOT. EDITING
  34.       mACCTNUM = SPACE(5)
  35.       mDESC = SPACE(24)
  36.       mPARENT = SPACE(5)
  37.       mBAL_FWD = 0.00
  38.       mCURRENT = 0.00
  39.       mMTD = 0.00
  40.       mQTD = 0.00
  41.       mYTD = 0.00
  42.       mACCT_TYPE = " "
  43.       mHISTFLAG = .F.
  44.       CALL DBTOOLS WITH "1,8,45,14,0,0,"+SPACE(24)
  45.       CALL DBTOOLS WITH "1,10,39,14,0,0, "
  46.       CALL DBTOOLS WITH "1,10,58,14,0,0, "
  47.       CALL DBTOOLS WITH "1,10,66,14,0,0, "
  48.       CALL DBTOOLS WITH "1,12,39,14,0,0,     "
  49.       mNEWREC = .F.
  50.    ENDIF
  51.    OKACCT = .F.
  52.    DO WHILE .NOT. OKACCT
  53.       @ 8,28 GET mACCTNUM PICTURE "99999"
  54.       READ
  55.       DO KEYTRAP
  56.       IF EXITNOW
  57.          EXIT
  58.       ENDIF
  59.       SEEK mACCTNUM
  60.       IF FOUND()
  61.          mDESC = ACCTNAME
  62.          mGEN_DET = GEN_DET
  63.          mLEVEL = LEVEL
  64.          mPARENT = PARENT
  65.          mBAL_FWD = BAL_FWD
  66.          mCURRENT = CURRENT
  67.          mMTD = MTD
  68.          mQTD = QTD
  69.          mYTD = YTD
  70.          mACCT_TYPE = ACCT_TYPE
  71.          mHISTFLAG = HISTFLAG
  72.          mNEWREC = .F.
  73.          CALL DBTOOLS WITH "1,8,45,14,0,0,"+mDESC
  74.          CALL DBTOOLS WITH "1,10,39,14,0,0,"+mGEN_DET
  75.          CALL DBTOOLS WITH "1,10,58,14,0,0,"+STR(mLEVEL,1)
  76.          CALL DBTOOLS WITH "1,10,66,14,0,0,"+mACCT_TYPE
  77.          CALL DBTOOLS WITH "1,12,39,14,0,0,"+mPARENT
  78.          CALL DBTOOLS WITH "1,15,38,15,2,0,"+TRANSFORM(mBAL_FWD,"9,999,999.99")
  79.          CALL DBTOOLS WITH "1,16,38,15,2,0,"+TRANSFORM(mCURRENT,"9,999,999.99")
  80.          CALL DBTOOLS WITH "1,17,38,15,2,0,"+TRANSFORM(mMTD,"9,999,999.99")
  81.          CALL DBTOOLS WITH "1,18,38,15,2,0,"+TRANSFORM(mQTD,"9,999,999.99")
  82.          CALL DBTOOLS WITH "1,19,38,15,2,0,"+TRANSFORM(mYTD,"9,999,999.99")
  83.          OKACCT = .T.
  84.       ELSE
  85.          IF gADDBEEP
  86.             ? CHR(7)
  87.          ENDIF
  88.          DO CLRSTAT WITH gFG,gBG
  89.          CALL DBTOOLS WITH "1,24,20,14,4,0,Account not found. Add it (Y/N)?"
  90.          mADDIT = " "
  91.          @ 24,53 SAY mADDIT
  92.          DO YESNO WITH mADDIT
  93.          DO CLRSTAT WITH gFG,gBG
  94.          IF EXITNOW
  95.             EXIT
  96.          ENDIF
  97.          mNEWREC = .T.
  98.          IF mADDIT = "Y"
  99.             OKACCT = .T.
  100.          ENDIF
  101.       ENDIF
  102.       IF EXITNOW
  103.          EXIT
  104.       ENDIF
  105.  
  106.    ENDDO  (OKACCT)
  107.    IF EXITNOW
  108.       EXIT
  109.    ENDIF
  110.    @ 8,45 GET mDESC
  111.    READ
  112.    DO KEYTRAP
  113.    IF EXITNOW
  114.       EXIT
  115.    ENDIF
  116.    @ 10,39 SAY mGEN_DET
  117.    DO VALIDKEY WITH mGEN_DET,"DG"
  118.    DO GETACTYPE WITH mACCTNUM,mACCT_TYPE
  119.    @ 10,58 GET mLEVEL PICTURE "9" RANGE 1,5
  120.    READ
  121.    DO KEYTRAP
  122.    IF EXITNOW
  123.       EXIT
  124.    ENDIF
  125.    CALL DBTOOLS WITH "21,5,11,50,18,72,15,3,1,1"
  126.    CALL DBTOOLS WITH "1,12,52,15,3,0,ACCOUNT TYPE:"
  127.    CALL DBTOOLS WITH "1,13,52,0,3,0,A - Asset"
  128.    CALL DBTOOLS WITH "1,14,52,0,3,0,L - Liability"
  129.    CALL DBTOOLS WITH "1,15,52,0,3,0,C - Capital/Equity"
  130.    CALL DBTOOLS WITH "1,16,52,0,3,0,R - Revenues"
  131.    CALL DBTOOLS WITH "1,17,52,0,3,0,E - Expense"
  132.    @ 10,66 SAY mACCT_TYPE
  133.    DO VALIDKEY WITH mACCT_TYPE,"ALCRE"
  134.    CALL DBTOOLS WITH "19,5"
  135.    IF EXITNOW
  136.       EXIT
  137.    ENDIF
  138.    IF mLEVEL > 1
  139.       IF .NOT. EDITING
  140.          mL = LEN(TRIM(mACCTNUM))
  141.          IF mLEVEL - 1 > 0
  142.             mP = SUBSTR(mACCTNUM,1,mLEVEL-1)
  143.          ELSE
  144.             mP = SPACE(5)
  145.          ENDIF
  146.          IF LEN(TRIM(mP))<5
  147.             mPARENT = mP + SPACE(5-LEN(mP))
  148.          ELSE
  149.             mPARENT = mP
  150.          ENDIF
  151.       ENDIF
  152.       GOODPRNT = .F.
  153.          mRECNO = RECNO()
  154.       DO WHILE .NOT. GOODPRNT
  155.          @ 12,39 GET mPARENT PICTURE "99999"
  156.          READ
  157.          DO KEYTRAP
  158.          IF EXITNOW
  159.             EXIT
  160.          ENDIF
  161.          mGOODACT = .F.
  162.  
  163.          SEEK mPARENT
  164.          IF FOUND()
  165.             IF GEN_DET = "G"
  166.                GOODPRNT = .T.
  167.                CALL DBTOOLS WITH "5,12,46,12,62,2"
  168.             ELSE
  169.                CALL DBTOOLS WITH "1,12,46,14,4,0,Not a General account."
  170.                CALL DBTOOLS WITH "2"
  171.             ENDIF
  172.          ELSE
  173.             CALL DBTOOLS WITH "1,12,46,14,4,0,Invalid account."
  174.             CALL DBTOOLS WITH "2"
  175.          ENDIF
  176.       ENDDO   (GOODPRNT)
  177.       IF EXITNOW
  178.          EXIT
  179.       ENDIF
  180.       IF .NOT. mNEWREC
  181.          GO mRECNO
  182.       ENDIF
  183.    ENDIF
  184.    mOPT = 1
  185.    DO ACQ WITH mOPT
  186.    DO CASE mOPT
  187.       CASE mOPT = 1
  188.          IF mADDIT = "Y"
  189.             APPEND BLANK
  190.          ENDIF
  191.          REPLACE ACCTNUM WITH mACCTNUM,;
  192.                  ACCTNAME WITH mDESC,;
  193.                  GEN_DET WITH mGEN_DET,;
  194.                  LEVEL WITH mLEVEL
  195.          REPLACE PARENT WITH mPARENT,;
  196.                  BAL_FWD WITH mBAL_FWD,;
  197.                  CURRENT WITH mCURRENT,;
  198.                  MTD WITH mMTD
  199.          REPLACE QTD WITH mQTD,;
  200.                  YTD WITH mYTD,;
  201.                  ACCT_TYPE WITH mACCT_TYPE,;
  202.                  HISTFLAG WITH mHISTFLAG
  203.          mADDIT = " "
  204.          mNEWREC = .F.
  205.          EDITING = .F.
  206.       CASE mOPT = 2
  207.          EDITING = .T.
  208.       CASE mOPT = 3 .OR. mOPT = 0
  209.          EXITNOW = .T.
  210.          EXIT
  211.    ENDCASE
  212. ENDDO
  213.  
  214. CLOSE DATABASES
  215. RELEASE ALL EXCEPT g*
  216. gNUMOPT = 1
  217. EXITNOW = .F.
  218. ON KEY
  219. RETURN
  220.