home *** CD-ROM | disk | FTP | other *** search
/ World of Shareware - Software Farm 2 / wosw_2.zip / wosw_2 / DATABASE / DBT123S.ZIP / CHARACCT.PRG < prev    next >
Text File  |  1989-02-27  |  3KB  |  112 lines
  1. * Program : CHARACT.PRG - Chart of Accounts
  2. *         : (c) 1989 BERNATH COMPUTER
  3. *         : 12:59:54  2/27/1989
  4.  
  5. EXITNOW = .F.
  6. mRPTDATE = DATE()
  7. mPGNUM = 0
  8. gWIDE = .F.
  9. mOUTPUT = " "
  10. mTITLE = "Chart of Accounts"
  11. mHEAD1 = "  Account Number           Name                           Level G/D Type"
  12. mHEAD2 = "  ───────────────────────  ────────────────────────────── ───── ─── ────"
  13.  
  14. USE ACCOUNTS INDEX ACCOUNTS
  15. SET COLOR TO +W/G,+G/N,,G
  16.  
  17. DO WHILE .NOT. EXITNOW
  18.     DO SCRHEAD WITH "SAMPLE DATA ENTRY PROGRAM",mTITLE,0,1
  19.     CALL DBTOOLS WITH "3,7,25,16,65,10,2,3,0,1"
  20.     CALL DBTOOLS WITH "1,8,28,15,2,0,Lowest Account to process:"
  21.     CALL DBTOOLS WITH "1,9,27,15,2,0,Highest Account to process:"
  22.     CALL DBTOOLS WITH "1,11,28,15,2,0,Include General Accounts (Y/N)?"
  23.     CALL DBTOOLS WITH "1,12,28,15,2,0,Report Date:"
  24.     CALL DBTOOLS WITH "1,12,41,10,0,0,"+DTOC(mRPTDATE)
  25.     CALL DBTOOLS WITH "1,13,28,15,2,0,Output to S)creen  P)rinter:"
  26.     CALL DBTOOLS WITH "1,13,38,10,0,0,S"
  27.     CALL DBTOOLS WITH "1,13,47,10,0,0,P"
  28.     mLOACCT = "0    "
  29.     mHIACCT = "99999"
  30.     @ 8,55 GET mLOACCT PICTURE "99999"
  31.     @ 9,55 GET mHIACCT PICTURE "99999"
  32.     READ
  33.     DO KEYTRAP
  34.     IF EXITNOW
  35.        EXIT
  36.     ENDIF
  37.     mPR_GEN = "Y"
  38.     @ 11,60 SAY mPR_GEN
  39.     DO YESNO WITH mPR_GEN
  40.     @ 12,41 GET mRPTDATE PICTURE "@D"
  41.     READ
  42.     DO KEYTRAP
  43.     IF EXITNOW
  44.        EXIT
  45.     ENDIF
  46.     mOUTPUT = "P"
  47.     @ 13,60 SAY mOUTPUT
  48.     DO GETKEY WITH mOUTPUT, "SP"
  49.     CALL DBTOOLS WITH "15,30,10,2"
  50.     mLINES = 99
  51.     DO CASE mOUTPUT
  52.        CASE mOUTPUT = "S"
  53.           mPGLEN = 20
  54.           CLEAR
  55.        CASE mOUTPUT = "P"
  56.           mPGLEN = 56
  57.           SET PRINTER ON
  58.           SET CONSOLE OFF
  59.     ENDCASE
  60.     GO TOP
  61.     SET COLOR TO N/G
  62.     SET FILTER TO ACCTNUM >= mLOACCT .AND. ACCTNUM <= mHIACCT
  63.     DO WHILE .NOT. EOF()
  64.        IF mLINES > mPGLEN
  65.           DO PAGEHEAD WITH mTITLE,mRPTDATE,mPGNUM,mOUTPUT
  66.           ? mHEAD1
  67.           ? mHEAD2
  68.           mLINES = 7
  69.        ENDIF
  70.        IF EXITNOW
  71.           EXIT
  72.        ENDIF
  73.        IF (mPR_GEN = "N" .AND. GEN_DET = "D") .OR. mPR_GEN = "Y"
  74.           IF LEVEL = 1
  75.              ?
  76.              mLINES = mLINES + 1
  77.              IF  mOUTPUT = "S"
  78.                    SET COLOR TO +W/G
  79.              ENDIF
  80.           ENDIF
  81.  
  82.           mSTUFF = SPACE(2+(LEVEL-1)*4)+ACCTNUM
  83.           mL = LEN(TRIM(mSTUFF))
  84.           mSTUFF = TRIM(mSTUFF)+SPACE(28-mL)+ACCTNAME+"        "+STR(LEVEL,1)+"    "+GEN_DET+"   "+ACCT_TYPE
  85.           ? mSTUFF
  86.           mLINES = mLINES + 1
  87.           IF mOUTPUT = "S"
  88.                 SET COLOR TO N/G
  89.           ENDIF
  90.  
  91.        SKIP
  92.     ENDDO
  93.     IF EXITNOW
  94.        EXIT
  95.     ENDIF
  96.     DO CASE mOUTPUT
  97.        CASE mOUTPUT = "S"
  98.           CALL DBTOOLS WITH "10,24,25,14,10"
  99.        CASE mOUTPUT = "P"
  100.          EJECT
  101.          SET PRINTER OFF
  102.          SET CONSOLE ON
  103.     ENDCASE
  104. ENDDO
  105.  
  106. SET FILTER TO
  107. CLOSE DATABASES
  108. EXITNOW = .F.
  109. RELEASE ALL EXCEPT g*
  110. gNUMOPT = 2
  111. RETURN
  112.