home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Between Heaven & Hell 2
/
BetweenHeavenHell.cdr
/
300
/
270
/
statemp.prg
< prev
next >
Wrap
Text File
|
1987-08-16
|
17KB
|
618 lines
** Last revision: April 6, 1986 at 15:54
* statement printing program
SELE E
USE &dr.:statemnt
STOR 0 TO totalit
STOR 0 TO totalit1
STOR 0 TO netin
GO top
IF nowprint = 'Y'
GO bottom
STOR date to daya
ELSE
STOR ' ' to daya
@ 15,01 SAY SPACE(75)
@ 16,01 SAY SPACE(75)
@ 15,01 SAY ' What is the date of the statement you want to print'
@ 15,65 GET daya picture '99/99/99'
READ
GO TOP
LOCA for daya = date
DO WHIL .NOT. EOF()
IF .NOT. EOF()
STOR RECNO() TO rec_no
ENDI .NOT. EOF
CONT
ENDD WHILE .NOT. EOF
IF rec_no = 0
DO WHIL rec_no = 0
GO TOP
@ 15,65 GET daya picture '99/99/99'
READ
LOCA for daya = date
DO WHIL .NOT. EOF()
IF .NOT. EOF()
STOR RECNO() TO rec_no
ENDI .NOT. EOF
CONT
ENDD WHILE .NOT. EOF
ENDD WHILE rec:no = 0
ENDI rec:no = 0
IF rec_no <> 0
GO rec_no
ENDI rec:no
ENDI nowprint = 'Y'
* RELE nowprint
IF stubs
STOR .t. TO stub
ELSE
STOR .f. TO stub
ENDI stubs
@ 15,01 SAY SPACE(75)
@ 16,01 SAY SPACE(75)
@ 15,01 SAY " Send Statements to the Printer (Y/N)"
@ 15,60 GET printer PICTURE '!'
READ
@ 16,01 SAY " Send Statements to a Disk File (Y/N)"
@ 16,60 GET disk PICTURE '!'
READ
STOR LEN(dconame)/2 TO L
STOR 40-L TO L
STOR ' ' TO bl
STOR SUBSTR(bl,1,L) + dconame TO coname1
IF disk ='Y'
@ 18,01 SAY " Enter Disk File Name "
@ 18,44 GET filename PICTURE '!!!!!!!!'
@ 18,54 SAY "(.TXT will be added )"
READ
STOR 'A' to dr1
@ 19,01 SAY ' Select drive to put Files on'
@ 19,54 GET dr1 PICTURE '!'
READ
DO WHIL AT(dr1,'ABCD') = 0
@ 19,54 GET dr1 PICTURE '!'
READ
ENDD while @
ENDI disk = Y
@ 15,01 SAY SPACE(75)
@ 16,01 SAY SPACE(75)
@ 17,01 SAY SPACE(75)
@ 18,01 SAY SPACE(75)
@ 19,01 SAY SPACE(75)
IF printer = 'Y'
@ 16,01 SAY " MAKE PRINTER READY AND HIT ANY KEY"
SET CONSOLE OFF
WAIT
SET CONSOLE ON
CLEA
@ 10,20 SAY 'Calculating........................................'
@ 12,00 SAY ' '
SET print ON
ELSE
CLEA
@ 10,20 SAY 'Calculating........................................'
@ 12,00 SAY ' '
ENDI printer = Y
IF disk = 'Y' .AND. filename <> ' '
* make a proper REPORT file name that is of type TXT
STOR AT('.',filename) TO length
IF length = 0 .OR. length > 8
STOR 9 TO length
ENDI length
STOR SUBSTR(filename,1,length-1) TO filename
STOR '&dr1.:'+filename+'.TXT' TO filename
* RELE dr1
SET ALTERNATE TO &filename
SET ALTERNATE ON
ELSE
* RELE filename
ENDI disk = Y and filename <> ''
IF SUBSTR(daya,4,1) = '0'
STOR SUBSTR(daya,5,1) TO date2
ELSE
STOR SUBSTR(daya,4,2) TO date2
ENDI
STOR fyr TO mfyr
IF mfyr < SUBSTR(daya,1,2)
STOR VAL(fyr)+12 TO mfyr1
ELSE
STOR VAL(mfyr) TO mfyr1
ENDI mfyr
STOR mfyr1 - VAL(SUBSTR(daya,1,2)) TO mfyr1
STOR mfyr1 + 100 TO mfyr1
STOR STR(mfyr1,3) TO mfyr2
STOR SUBSTR(mfyr2,2,2) TO mfyr
DO CASE
CASE mfyr = '01'
STOR 'One month ending ' TO date3
CASE mfyr = '02'
STOR 'Two months ending ' TO date3
CASE mfyr = '03'
STOR 'Three months ending ' TO date3
CASE mfyr = '04'
STOR 'Four months ending ' TO date3
CASE mfyr = '05'
STOR 'Five months ending ' TO date3
CASE mfyr = '06'
STOR 'Six months ending ' TO date3
CASE mfyr = '07'
STOR 'Seven months ending ' TO date3
CASE mfyr = '08'
STOR 'Eight months ending ' TO date3
CASE mfyr = '09'
STOR 'Nine months ending ' TO date3
CASE mfyr = '10'
STOR 'Ten months ending ' TO date3
CASE mfyr = '11'
STOR 'Eleven months ending ' TO date3
CASE mfyr = '12'
STOR 'Twelve months ending ' TO date3
ENDC
DO CASE
CASE SUBSTR(daya,1,2) = '01'
STOR 'January ' + date2 + ', 19' + SUBSTR(daya,7,2) TO date1
CASE SUBSTR(daya,1,2) = '02'
STOR 'February ' + date2 + ', 19' + SUBSTR(daya,7,2) TO date1
CASE SUBSTR(daya,1,2) = '03'
STOR 'March ' + date2 + ', 19' + SUBSTR(daya,7,2) TO date1
CASE SUBSTR(daya,1,2) = '04'
STOR 'April ' + date2 + ', 19' + SUBSTR(daya,7,2) TO date1
CASE SUBSTR(daya,1,2) = '05'
STOR 'May ' + date2 + ', 19' + SUBSTR(daya,7,2) TO date1
CASE SUBSTR(daya,1,2) = '06'
STOR 'June ' + date2 + ', 19' + SUBSTR(daya,7,2) TO date1
CASE SUBSTR(daya,1,2) = '07'
STOR 'July ' + date2 + ', 19' + SUBSTR(daya,7,2) TO date1
CASE SUBSTR(daya,1,2) = '08'
STOR 'August ' + date2 + ', 19' + SUBSTR(daya,7,2) TO date1
CASE SUBSTR(daya,1,2) = '09'
STOR 'September ' + date2 + ', 19' + SUBSTR(daya,7,2) TO date1
CASE SUBSTR(daya,1,2) = '10'
STOR 'October ' + date2 + ', 19' + SUBSTR(daya,7,2) TO date1
CASE SUBSTR(daya,1,2) = '11'
STOR 'November ' + date2 + ', 19' + SUBSTR(daya,7,2) TO date1
CASE SUBSTR(daya,1,2) = '12'
STOR 'December ' + date2 + ', 19' + SUBSTR(daya,7,2) TO date1
ENDC
STOR TRIM(date1) TO date1
STOR TRIM(date3+date1) TO date3
STOR LEN(date3)/2 TO L
STOR 40-L TO L
STOR ' ' TO bl
STOR SUBSTR(bl,1,L) + date3 TO date3
STOR LEN(date1)/2 TO L
STOR 40-L TO L
STOR ' ' TO bl
STOR SUBSTR(bl,1,L) + date1 TO date1
* RELE L, bl, daya, date2, printer, disk,mfyr, mcyr, mfyr1, mfyr2
STOR .t. TO wholelist
STOR 1 to count
IF com1 = 'C'
STOR 'BCDEFGHIJKL' TO plan
STOR .t. TO trial
ELSE
STOR '6789A012345' TO plan
STOR .f. TO trial
ENDI com1
STOR 0 TO plus
STOR 0 TO minus
DO WHIL WHOLELIST
SELE E
USE &dr.:statemnt
GO rec_no
STOR SUBSTR(plan,(count),1) TO char
DO CASE
CASE char = '1'.OR. char = 'B'
STOR code1 TO mcode
STOR count + 1 TO count
CASE char = '2' .OR. char = 'C'
STOR code2 TO mcode
STOR count + 1 TO count
CASE char = '3'.OR. char = 'D'
STOR code3 TO mcode
STOR count + 1 TO count
CASE char = '4' .OR. char = 'E'
STOR code4 TO mcode
STOR count + 1 TO count
CASE char = '5'
STOR code5 TO mcode
IF .NOT. stub
STOR .f. TO wholelist
ELSE
STOR 'M789A0X' TO plan
STOR 1 TO count
ENDI
CASE char = 'X'
STOR .f. TO wholelist
CASE char = 'F'
STOR code5 TO mcode
STOR count+1 TO count
CASE char = '6' .OR. char = 'G' .OR. char = 'M'
STOR code6 TO mcode
STOR count + 1 TO count
CASE char = '7' .OR. char = 'H'
STOR code7 TO mcode
STOR count + 1 TO count
CASE char = '8' .OR. char = 'I'
STOR code8 TO mcode
STOR count + 1 TO count
CASE char = '9' .OR. char = 'J'
STOR code9 TO mcode
STOR count + 1 TO count
CASE char = '0' .OR. char = 'K'
STOR code0 TO mcode
STOR count + 1 TO count
CASE char = 'A'
STOR codea TO mcode
STOR count + 1 TO count
CASE char = 'L'
STOR codea TO mcode
STOR .f. TO wholelist
ENDC
STOR ',' TO C
STOR 1 TO X
STOR 1 TO Y
STOR AT(C,SUBSTR(mcode,x)) TO y
STOR .t. TO more
STOR 0 TO countup
STOR '0' TO nu
DO WHIL more
IF Y > 0
IF VAL(nu) <9
STOR STR(VAL(SUBSTR(nu,1,1))+1,1) TO nu
ELSE
STOR STR(VAL(SUBSTR(nu,1,2))+1,2) TO nu
ENDI VAL(nu)
STOR X + Y TO X
STOR AT(C,SUBSTR(mcode,x)) TO y
STOR SUBSTR(mcode,x,y-1) TO N&nu
STOR X + Y TO X
STOR AT(C,SUBSTR(mcode,x)) TO y
STOR (VAL(SUBSTR(mcode,x,y-1))*1.00) TO NM&nu
STOR countup + 1 TO countup
ELSE
STOR .f. TO more
ENDI Y > 0
ENDD WHILE more
STOR VAL(nu) TO last
STOR 0 TO sumup
STOR countup-1 to countup
STOR countup to countup1
SELE D
USE &dr.:chart
STOR '0' TO nu
DO WHIL val(nu) < last-1
** here comes trouble
IF countup > 0
IF VAL(nu) <9
STOR STR(VAL(SUBSTR(nu,1,1))+1,1) TO nu
ELSE
STOR STR(VAL(SUBSTR(nu,1,2))+1,2) TO nu
ENDI VAL(nu)
LOCA FOR N&nu= acctno
IF comm = 'A' .OR. comm = 'C'
STOR N&nu + ' ' + desc TO mdesc&nu
ELSE
STOR desc TO mdesc&nu
ENDI comm
* RELE N&nu
STOR sumup + NM&nu TO sumup
STOR countup -1 TO countup
else
stor last-1 to last
ENDI countup
ENDD WHILE &nu
DO CASE
CLEA
CASE char = 'B'
? ' '
? coname1
? ' TRIAL BALANCE'
? date1
? ' '
? '----------------------------------------------------------------------------'
? 'Acct # Description Debit Credit'
? '----------------------------------------------------------------------------'
CASE char = '1'
IF printer = 'Y'
EJEC
SET PRINT OFF
ELSE
? CHR(12)
ENDI printer
? ' '
? coname1
? ' BALANCE SHEET'
? date1
? ' '
? ' '
? 'ASSETS '
? ' '
CASE char = '3'
? ' '
? 'LIABILITIES AND CAPITAL'
? ' '
CASE char = '5'
? ' '
? 'CAPITAL'
? ' '
CASE char = '6' .OR. char = 'M'
? ' '
? coname1
? ' PROFIT AND LOSS STATEMENT'
IF char = '6'
? date3
* RELE date3
ELSE
? ' ONE MONTH ENDING '
? date1
ENDI char = '6'
? ' '
? 'INCOME'
? ' '
ENDC
STOR '0' TO nu
IF trial
IF char='B'.OR.char='C'.OR.char='D'.OR.char='E'.OR.char='F';
.OR.char='G'.OR.char='H'.OR.char='I'.OR.char='J'.OR.;
char='K'.OR.char='L'
DO WHIL VAL(nu) < last-1
IF countup1 > 0
IF VAL(nu) <9
STOR STR(VAL(SUBSTR(nu,1,1))+1,1) TO nu
ELSE
STOR STR(VAL(SUBSTR(nu,1,2))+1,2) TO nu
ENDI VAL(nu)
IF NM&nu< 0
STOR ' ' TO sp
STOR minus + NM&nu TO minus
ELSE
STOR ' ' TO sp
STOR plus + NM&nu TO plus
ENDI NM
? ' ' + mdesc&nu + sp+ STR(NM&nu,12,2)
* RELE N&nu, mdesc&nu, NM&nu, sp
STOR countup1 -1 TO countup1
ENDI countup1
ENDD WHILE &nu
ENDI char
ELSE
STOR .t. TO full
DO WHIL VAL(nu) < last-1
IF countup1 > 0
IF VAL(nu) <9
STOR STR(VAL(SUBSTR(nu,1,1))+1,1) TO nu
ELSE
STOR STR(VAL(SUBSTR(nu,1,2))+1,2) TO nu
ENDI VAL(nu)
IF NM&nu < 0 .AND. char <> '1'
STOR (NM&nu*-1) TO NM&nu
ENDI NM
IF full .AND. NM&nu <> 0
DO CASE
CASE char = '1'
? 'CURRENT ASSETS '
? ' '
CASE char = '2'
? ' '
? 'FIXED ASSETS'
? ' '
CASE char = '3'
? ' '
? 'CURRENT LIABILITIES'
? ' '
CASE char = '4'
? ' '
? 'LONG TERM LIABILITIES'
? ' '
CASE char = '7'
? ' '
? 'OPERATING EXPENSES'
? ' '
CASE char = '8'
? ' '
? 'GENERAL & ADMINISTRATIVE EXPENSES'
? ' '
CASE char = '9'
? ' '
? 'FINANCIAL EXPENSES'
? ' '
CASE char = '0'
? ' '
? 'TAX EXPENSES'
? ' '
ENDC
ENDI NM&nu
? ' ' + mdesc&nu + STR(NM&nu,12,2)
STOR .f. TO full
* RELE mdesc&nu, MN&nu, N&nu
STOR countup1 -1 TO countup1
ENDI countup1
ENDD while &nu
ENDI trial
DO CASE
CASE char = '1'
STOR 0 TO totalit
STOR sumup + totalit TO totalit
STOR 0 TO sumup
CASE char = '2'
? ' ---------- '
STOR sumup + totalit TO totalit
IF totalit < 0
STOR totalit*-1 TO totalit
? ' TOTAL ASSETS (' + STR(totalit,12,2)+')'
ELSE
? ' TOTAL ASSETS ' + STR(totalit,12,2)
ENDI totalit
? ' ============'
? ' '
STOR 0 TO sumup
CASE char = '3'
STOR 0 TO totalit
STOR sumup + totalit TO totalit
CASE char = '4'
STOR sumup + totalit TO totalit
? ' ---------- '
IF TOTALIT < 0
STOR totalit*-1 TO total1
ELSE
STOR totalit TO total1
ENDI
? ' TOTAL LIABIlITIES ' + STR(total1,12,2)
? ' '
STOR 0 TO sumup
* RELE total1
CASE char = '5'
STOR sumup + totalit + netin TO totalit
IF netin >= 0
STOR netin*-1 TO net
? ' Earnings this period ' + STR(NET,12,2)
ELSE
? ' Earnings this period (' + STR(NETIN,12,2)+')'
ENDI netin
? ' ---------- '
IF totalit > 0
? ' TOTAL LIABILITIES & CAPITAL (' + STR(totalit,12,2)+')'
ELSE
? ' TOTAL LIABILITIES & CAPITAL ' + STR(totalit,12,2)
ENDI totalit
? ' ============'
IF printer = 'Y'
EJEC
SET PRINT OFF
ELSE
? CHR(12)
ENDI printer
? ' '
CASE char = 'B'.OR.char='C'.OR.char='D'.OR.char='E'.OR.char='F'
STOR 0 TO sumup
CASE char = 'G'
STOR 0 TO netin
STOR sumup + netin TO netin
STOR 0 TO sumup
CASE char = 'H'.OR.char='I'.OR.char='J'
STOR sumup + netin TO netin
STOR 0 TO sumup
CASE char = 'K'
STOR 0 TO sumup
CASE char = 'L'
STOR sumup + netin TO netin
IF netin < 0
STOR ' ' TO sp
ELSE
STOR ' ' TO sp
ENDI netin
STOR minus*-1 TO minus
? '----------------------------------------------------------------------------'
? ' VALIDATION Debits = '+ STR(plus,12,2)+ ' Credits = '+STR(minus,12,2)
? '----------------------------------------------------------------------------'
IF netin <=0
? ' NET INCOME FOR PERIOD ' +sp+ STR(netin,12,2)
ELSE
? ' NET LOSS FOR PERIOD ' +sp+ STR(netin,12,2)
ENDI netin
? '----------------------------------------------------------------------------'
? ' '
IF printer = 'Y'
EJEC
SET PRINT OFF
ELSE
? CHR(12)
ENDI printer
? ' '
CASE char = '6' .OR. char = 'M'
STOR 0 TO netin
STOR sumup + netin TO netin
STOR (sumup*-1) TO sumup
IF sumup <> 0
? ' ---------- ' + STR(SUMUP,12,2)
ENDI sumup
? ' '
STOR 0 TO sumup
CASE char = '7'
STOR sumup + netin TO netin
STOR 0 TO exp
STOR sumup + exp to exp
IF sumup <> 0
? ' ---------- ' + STR(SUMUP,12,2)
ENDI sumup
? ' '
STOR 0 TO sumup
CASE char = '8'
STOR sumup + netin TO netin
STOR sumup + exp TO exp
IF sumup <> 0
? ' ---------- ' + STR(SUMUP,12,2)
ENDI sumup
? ' '
STOR 0 TO sumup
CASE char = '9'
STOR sumup + netin TO netin
STOR sumup + exp TO exp
STOR sumup TO adjust
IF sumup <> 0
? ' ---------- ' + STR(SUMUP,12,2)
ENDI sumup
? ' '
STOR 0 TO sumup
CASE char = '0'
STOR sumup + netin TO netin
STOR sumup + exp TO exp
IF sumup <> 0
? ' ---------- ' + STR(SUMUP,12,2)
ENDI sumup
? ' --------------'
? ' TOTAL ALL EXPENSES ' + STR(exp,12,2)
? ' ------------'
IF netin < 0
STOR netin*-1 TO net
? ' NET INCOME FOR PERIOD ' + STR(net,12,2)
? ' ============'
ELSE
? " NET INCOME FOR PERIOD $(" + STR(netin,12,2) + ")"
? ' ============'
ENDI netin
STOR (sumup+netin-adjust) TO adjust
IF adjust <> netin
IF adjust < 0
STOR adjust*-1 TO adjust
? ' '
? ' CASH GENERATED FROM OPERATIONS $' + STR(adjust,12,2)
? ' '
? ' '
ELSE
? ' '
? ' CASH GENERATED FROM OPERATIONS $(' + STR(adjust,12,2)+ ')'
? ' '
? ' '
STOR 0 TO sumup
ENDI
ENDI adjust
IF stub
SKIP -1
ENDI stub
CASE char = 'X'
IF printer = 'Y'
EJEC
SET PRINT OFF
ELSE
? CHR(12)
ENDI printer
? ' '
STOR .f. TO wholelist
ENDC
* RELE N1, N2, N3, N4, N5, N6, N7, N8, N9, N10, N11, N12,N13,N14,N15,N16,N17,N18
* RELE NM1, NM2, NM3, NM4, NM5, NM6, NM7, NM8, NM9, NM10, NM11, NM12,NM13,NM14
* RELE NM15,NM16,NM17,NM18,mdesc1, mdesc2, mdesc3, mdesc4, mdesc5, mdesc6, mdesc7, mdesc8
* RELE mdesc9, mdesc10, mdesc11, mdesc12,mdesc13,mdesc14,mdesc15,mdesc16,mdesc17,mdesc18, countup, countup1, full
STOR 0 TO countup
ENDD while wholelist
SET PRINT OFF
SET ALTERNATE OFF
CLEA
SELE C
USE &dr.:account
SET INDEX TO account
RETU