Shareware Overload/ShartewareOverload.cdr/database/manage.zip/STATEM.PRG

Text File | 1987-08-16 | 10KB | 319 lines

**    Last revision: April 6, 1986 at 15:54
* statement module
SELE C
USE &dr.:account
SET index TO &dr.:account
CLEA
STOR .t. TO more2
DO WHIL more2
 STOR 'Y' TO printer
 STOR 'N' TO disk
 STOR '        ' TO filename
 STOR 0 TO rec_no
 STOR '?' TO comm
 STOR 'N' TO nowprint
 STOR '?' to command
 CLEA
 IF clipper
  @ 0,0, 22, 79 BOX frame
  @ 4,1 SAY line1
  @ 19,1 SAY line1
 ELSE
 @ 0,0 TO 4,79
 @ 0,0 TO 19,79
 @ 0,0 TO 22,79 DOUBLE
 ENDI
 @ 20,5 SAY 'Please select one of the above options. You may also leave this menu'
 @ 21,5 SAY "by typing 'Q' and get on-line HELP by typing '?'."
 @ 2,04 SAY dconame + ' -  STATEMENT PRINTING MENU'
 @ 2,65 SAY DTOC(date())
 @ 7,11 SAY "A.  Prepare a new Trial Balance"
 @ 8,11 SAY "B.  Prepare a new Balance Sheet and Profit & Loss Statement"
 @ 9,11 SAY "C.  Print a previously prepared Trial Balance"
 @ 10,11 SAY "D.  Print a previously prepared Balance Sheet and P&L Statement"
 @ 11,11 SAY "E.  Return to main accounting menu"
 @ 13,23 SAY "PLEASE SELECT ONE OF THE OPTIONS"
 @ 13,58 GET comm PICTURE '!'
 READ
 DO WHIL AT(COMM, 'ABCDE?Q') = 0
  STOR '?' TO comm
  @ 13,58 GET comm PICTURE '!'
  READ
 ENDD WHILE @(comm)
 DO CASE
 CASE comm = 'A' .OR. comm = 'B'
  STOR DTOC(DATE()) TO stdate
  STOR '12' TO mfyr
  STOR '99' TO build1
  STOR ',' TO bl
  STOR bl TO mcode1
  STOR bl TO mcode2
  STOR bl TO mcode3
  STOR bl TO mcode4
  STOR bl TO mcode5
  STOR bl TO mcode6
  STOR bl TO mcode7
  STOR bl TO mcode8
  STOR bl TO mcode9
  STOR bl TO mcode0
  STOR bl TO mcodea
  STOR 'N' to stub1
  STOR '        ' TO stubdate
  STOR .t. TO maybe
  @ 13,01 SAY line1
  @ 14,01 SAY "                   What is the statement date ?  "
  @ 14,58 GET stdate PICTURE '99/99/99'
  READ
  STOR SUBSTR(stdate,7,2) + SUBSTR(stdate,1,2) + SUBSTR(stdate,4,2) TO stdat
  @ 15,01 SAY "        What is the ending month of the fiscal or calendar year ?  "
  @ 15,68 GET mfyr PICTURE '99'
  READ
  IF comm = 'B'
   @ 16,01 SAY "        Do you want a one month report included ?    "
   @ 16,60 GET stub1 PICTURE '!'
   READ
  ENDI comm= 'B'
  IF stub1 = 'Y'
   STOR .t. TO stub
   STOR bl TO mcode6a
   STOR bl TO mcode7a
   STOR bl TO mcode8a
   STOR bl TO mcode9a
   STOR bl TO mcode0a
   STOR bl TO mcodeaa
   IF SUBSTR(stdat,3,2) = '01'
    STOR (VAL(stdat) -10000)  TO stdat1
    STOR STR(stdat1,6) TO stdat
    STOR SUBSTR(stdat,1,2) + '12' + SUBSTR(stdat,5,2) TO stubdate
   ELSE
    STOR (VAL(stdat) -100) TO stdat1
    STOR STR(stdat1,6) TO stubdate
   ENDI $(stdat)
  ELSE
   STOR .f. TO stub
  ENDI stub1
  @ 17,01 SAY "        What building shall we do ('99' for all) ?                  "
  @ 17,60 GET build1 PICTURE '99'
  READ
  @ 18,01 SAY "        Do you want to print the statement now ?                    "
  @ 18,60 GET nowprint PICTURE '!'
  READ
  STOR 1 TO countit
  @ 17,01 SAY SPACE(75)
  @ 18,01 SAY SPACE(75)
  @ 14,01 SAY SPACE(75)
  @ 15,01 SAY "       This will take a while - so please be patient                      "
  @ 16,01 SAY "          I am examining record number.......                       "
  @ 16,40 SAY countit
  STOR 0 TO tempamt
  STOR 0 TO tempamt1
  GO top
  STOR SUBSTR(data,7,4) TO tempcr
  STOR SUBSTR(data,5,2) TO build
  STOR .t. TO range
  STOR .t. TO more
  STOR 1 TO planct
  STOR '10115220321323425530640750856957060A' TO plan
  DO WHIL more
*******************************************************************************
*  NOTE - if you change the ranges in the Chart of Accounts the three         *
*  number groupings in 'plan' may require changing to caculate the statements *
*  'plan' appears again later on under IF STUB                                *
*******************************************************************************
   STOR .t. TO LOOPING
   DO WHIL looping
    STOR SUBSTR(plan,planct,3) TO nu
    STOR SUBSTR(nu,1,2) TO nu1
    STOR SUBSTR(nu,3,1) TO nu2
    IF range .AND. planct = 19
     STOR RECNO() TO rec_no
     STOR .f. TO range
     STOR tempcr TO tempcr1
    ENDI range
    IF SUBSTR(tempcr,1,2) = '&nu1'
     DO WHIL SUBSTR(data,7,2) = '&nu1' .AND. (.NOT. EOF())
      IF (build1 = '99' .OR. build1 = build) .AND. date <= stdat
       STOR SUBSTR(data,7,4) TO cr
       IF tempcr = cr
        STOR .t. TO maybe
        STOR tempamt + amount TO tempamt
       ELSE
        STOR STR(tempamt,12,2) TO tempam
        STOR 0 TO tempamt
        STOR 1 TO blank
        DO WHIL SUBSTR(tempam,blank,1)=' '
         STOR blank+1 TO blank
        ENDD
        STOR SUBSTR(tempam,blank) TO tempam
        STOR (tempcr +',' + tempam +',') TO mtemp
        STOR (mcode&nu2 + mtemp) TO mcode&nu2
        STOR cr TO tempcr
        STOR .f. TO maybe
       ENDI tempcr = cr
      ELSE
       SKIP
      ENDI build1
      IF maybe
       SKIP
       STOR countit + 1 TO countit
       @ 16,40 SAY countit
      ENDI maybe
     ENDD WHILE $(data,7,2) = nu2
     STOR STR(tempamt,12,2) TO tempam
     STOR 1 TO blank
     DO WHIL SUBSTR(tempam,blank,1)=' '
      STOR blank+1 TO blank
     ENDD
     STOR SUBSTR(tempam,blank) TO tempam
     STOR (tempcr +',' + tempam +',') TO mtemp
     STOR (mcode&nu2 + mtemp) TO mcode&nu2
     STOR SUBSTR(data,7,4) TO tempcr
     STOR 0 TO tempamt
    ENDI $(tempcr,1,2) = nu1
    STOR planct + 3 TO planct
    IF nu2 = 'A' .OR. EOF()
     STOR .f. TO looping
    ENDI nu2
   ENDD while looping
   IF stub
    GO rec_no
    STOR 0 TO tempamt
    STOR tempcr1 TO tempcr
    STOR 1 TO planct
    STOR '306a407a508a569a570a60Aa' TO plan
    STOR .t. TO LOOPING
    DO WHIL looping
     STOR SUBSTR(plan,planct,4) TO nu
     STOR SUBSTR(nu,1,2) TO nu1
     STOR SUBSTR(nu,3,2) TO nu2
     IF SUBSTR(tempcr,1,2) = '&nu1'
      DO WHIL SUBSTR(data,7,2) = '&nu1' .AND. (.NOT. EOF())
       IF (build1 = '99' .OR. build1 = build) .AND. date <= stdat
        STOR SUBSTR(data,7,4) TO cr
        IF tempcr = cr
         STOR .t. TO maybe
         STOR tempamt + amount TO tempamt
        ELSE
         STOR STR(tempamt,12,2) TO tempam
         STOR 0 TO tempamt
         STOR 1 TO blank
         DO WHIL SUBSTR(tempam,blank,1)=' '
          STOR blank+1 TO blank
         ENDD
         STOR SUBSTR(tempam,blank) TO tempam
         STOR (tempcr +',' + tempam +',') TO mtemp
         STOR (mcode&nu2 + mtemp) TO mcode&nu2
         STOR cr TO tempcr
         STOR .f. TO maybe
        ENDI tempcr = cr
       ELSE
        SKIP
       ENDI build1
       IF maybe
        SKIP
        STOR countit + 1 TO countit
        @ 16,40 SAY countit
       ENDI maybe
      ENDD WHILE $(data,7,2) = nu2
      STOR STR(tempamt,12,2) TO tempam
      STOR 1 TO blank
      DO WHIL SUBSTR(tempam,blank,1)=' '
       STOR blank+1 TO blank
      ENDD
      STOR SUBSTR(tempam,blank) TO tempam
      STOR (tempcr +',' + tempam +',') TO mtemp
      STOR (mcode&nu2 + mtemp) TO mcode&nu2
      STOR SUBSTR(data,7,4) TO tempcr
      STOR 0 TO tempamt
     ENDI $(tempcr,1,2) = nu1
     STOR planct + 4 TO planct
     IF SUBSTR(nu2,1,1) = 'A' .OR. EOF()
      STOR .f. TO looping
     ENDI nu2
    ENDD while looping
   ENDI stub
   STOR .f. TO more
  ENDD while more
  SELE E
  USE &dr.:statemnt
  IF stub
   APPE BLANK
   REPL date WITH stdate, fyr WITH mfyr, bld WITH build1
   REPL code6 WITH mcode6a, code7 WITH mcode7a, code8 WITH mcode8a
   REPL code9 WITH mcode9a, code0 WITH mcode0a, codea WITH mcodeaa
   REPL stubs WITH .t.
  ENDI stub
  APPE BLANK
  REPL date WITH stdate, fyr WITH mfyr, bld WITH build1
  REPL code1 WITH mcode1, code2 WITH mcode2, code3 WITH mcode3
  REPL code4 WITH mcode4, code5 WITH mcode5, code6 WITH mcode6
  REPL code7 WITH mcode7, code8 WITH mcode8, code9 WITH mcode9
  REPL code0 WITH mcode0, codea WITH mcodea
  IF stub
   REPL stubs WITH .t.
  ENDI stub
  IF nowprint = 'Y'
   STOR stdate TO daya
   * RELE stdate, mfyr, mcode1, mcode2, mcode3, mcode4, mcode5
   * RELE mcode6, mcode7, mcode8, mcode9, mcode0,mcodea, bl, maybe, cr
   * RELE mcode6a, mcode7a, mcode8a, mcode9a, mcode0a, mcodeaa
   * RELE countit, tempcr, blank, tempam, mtemp, more, account
   * RELE command, build1, tempamt, stub1
   IF comm = 'A'
    STOR 'C' TO com1
   ELSE
    STOR 'D' TO com1
   ENDI comm
   DO statemp
  ELSE
   CLEA
   SELE C
   USE &dr.:account
   SET INDEX TO &dr.:account
   STOR .t. TO more2
  ENDI nowprint
 CASE comm = 'C' .OR. comm = 'D'
  IF comm = 'C'
   STOR 'C' TO com1
  ELSE
   STOR 'D' TO com1
  ENDI comm
  DO statemp
 CASE comm = '?'
  CLEA
  TEXT

          S T A T E M E N T   P R I N T I N G   H E L P   M E N U

    This module calculates a trial balance and an income statement and
    a balance sheet.  It will also prepare a one month 'stub' income
    statement.

    You can print the statement at the time of the calculation, or at
    any later time. It will always print the last statement prepared
    under a particular date.  If you initially asked for the stub
    statement, it will always print the stub statement in addition to
    the full statement.

    If you elect to print the statement, you can send it to both the
    screen and the printer or just the screen.  You can also send the
    output to a disk file where you can edit it further before printing.

    It will take a few minutes for the calculations, so please be patient
    while it runs.


                    Please hit any key to return to the menu
  ENDT
  SET CONSOLE OFF
  WAIT
  SET CONSOLE ON
  CLEA
  STOR .t. TO more2
 CASE comm = 'E' .OR. comm = 'Q'
  STOR .f. TO more2
 ENDC
ENDD WHILE more2
RETU