home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.barnyard.co.uk
/
2015.02.ftp.barnyard.co.uk.tar
/
ftp.barnyard.co.uk
/
cpm
/
walnut-creek-CDROM
/
MBUG
/
MBUG061.ARC
/
DCLEDGER.ASC
< prev
next >
Wrap
Text File
|
1979-12-31
|
13KB
|
367 lines
00001POKE140,1
00002GOSUB357
00003IN#0:OUT#0
00004N=8:IFB0$(0)=""THENLETN=2ELSEIFC=1THENLETN=4
00005K0$=KEY$:K4$="":I=0:Q=0:IFC<3ANDN=8THENLETN=5
00006GOSUB322:INVERSE:CURS28,4:PRINT" MENU ":NORMAL
00007PRINT\SPC(14)"Create ..... 1";
00008PRINTSPC(4)"Load ....... 2":IFN=2THEN16
00009PRINTSPC(14)"Enter ...... 3";
00010PRINTSPC(4)"Save ....... 4":IFN=4THEN16
00011PRINTSPC(14)"Delete ..... 5";:IFN=5THEN16
00012PRINTSPC(4)"Sort ....... 6"
00013PRINTSPC(14)"Print ...... 7";
00014PRINTSPC(4)"New Base ... 8"
00015IFC=V+1THENPRINT\SPC(21)"*** LEDGER FULL ***"
00016K2$="Select Menu Option":GOSUB246
00017X=INT(VAL(K0$)):IFX=0ORX>NTHEN16
00018PLAY22,1:ONXGOTO68,33,86,123,142,22,154,222
00019 REM
00020 REM sort routine
00021 REM
00022GOSUB252:IFK1$="N"ORS=1THEN3
00023X=0:GOSUB341
00024FORX=1TOC-1:GOSUB316:A1(X)=F4:NEXTX
00025FORX=1TOC-2:GOSUB341:FORM=X+1TOC-1
00026IFA1(M)=>A1(X)THEN29
00027K0$=A0$(M):A0$(M)=A0$(X):A0$(X)=K0$
00028F1=A1(M):A1(M)=A1(X):A1(X)=F1
00029NEXTM:NEXTX:S=1:GOTO82
00030 REM
00031 REM load
00032 REM
00033N=3:IFC>1ANDC<V+1THENLETN=4
00034 K5$="LOAD":GOSUB231:IFK2$=""THEN82
00035ONERRORGOTO239:OPEN"I",6,K5$+".LGR":CLOSE6
00036ONERRORGOTO0:GOSUB348:IFO=0THENDISKRESET"A":GOTO3
00037OPEN"I",6,K5$+".LGR":IN#6ON:OUT#0OFF
00038INPUTK1$,D,H,X,Y,Z,E
00039IN#0:OUT#0
00040IFO=3ANDH<3THENLETO=0
00041IFO=1ANDH=2THENLETO=0
00042IFO>1ANDH=1THENLETO=0
00043K0$="":J=1:L=D-1:IFO<4THEN46
00044J=C:L=L+C:C=L:S=0:K0$=" - Merge"
00045IFC>V+1THENLETC=V+1:K0$=K0$+" (Part only)"
00046IFO=2ORO=3THENLETC=D:S=Z
00047IFO=1ORO=3THENLETB0$(0)=K1$:P=X:R=Y:T=E
00048IFO=1ANDC=0THENLETC=1
00049K1$=K1$+K0$:CURS0,12:PRINT[A64 32]
00050CURS(62-LEN(K1$))/2,12:PRINTK1$:CURS26,13
00051IFH=1ORO=1ORC=1THENPRINT" (Base)":GOTO54
00052IF(H=2ORO=2)ANDC>1THENPRINT" (File)":GOTO54
00053IFS=0ANDC>1ANDO>1THENPRINT"(Unsorted)"
00054IFO=0THEN82ELSELETN=X:IFY>XTHENLETN=Y
00055CURS0:PLAY0,10:IN#6ON:OUT#0:OUT#0OFF
00056FORX=1TON
00057IF(O=2ORO=4)ANDH=3THENINPUTK0$,K0$,F1,F1
00058IFO=1ORO=3THENINPUTB0$(X),B1$(X),B2(X),B3(X)
00059NEXTX:IFO=1THEN61ELSEFORX=JTOCSTEP3
00060INPUTA0$(X),A0$(X+1),A0$(X+2):NEXTX
00061IFC<V+1ANDO>1THENGOSUB360
00062Y=P+1:IFP<20THENGOSUB361
00063Y=R+1:IFR<20THENGOSUB362
00064IN#0:OUT#0:CLOSE6:DISKRESET"A":GOTO82
00065REM
00066 REM create
00067 REM
00068GOSUB355:IFK1$="N"THEN3
00069G=24:K2$="File Title":GOSUB322:GOSUB274:B0$(0)=K1$:I=1
00070GOSUB328:P=P+1:GOSUB269:B0$(P)=K1$:K3$=K1$
00071IFK3$=""ANDP=1THENLETB0$(1)="Payment":GOTO73
00072IFK3$=""THENLETP=P-1:GOTO74
00073GOSUB257:B2(P)=F3:IFP<20ANDK3$<>""THEN70
00074PLAY22,1
00075GOSUB331:R=R+1:GOSUB269:B1$(R)=K1$:K3$=K1$
00076IFK3$=""ANDR=1THENLETB1$(1)="Receipt":GOTO78
00077IFK3$=""THENLETR=R-1:GOTO79
00078GOSUB257:B3(R)=F3:IFR<20ANDK3$<>""THEN75
00079PLAY22,1:T=0:FORX=1TO20:IFB2(X)>0THENLETT=T+1
00080IFB3(X)>0THENLETT=T+1
00081NEXTX:C=1:K3$="":GOTO3
00082CURS0:PLAY22,1;0,5:GOTO3
00083REM
00084 REM enter
00085 REM
00086IFC>VTHEN3
00087S=0:A0$(C)="":M=C:GOSUB292:I=C-1:G=2
00088IFC>1THENLETX=C-1:GOSUB316
00089K2$="Day":GOSUB274:IFK1$=""ANDF1>0THEN95
00090F1=VAL(K1$):IFF1=0ORF1>31THEN89
00091K2$="Month":GOSUB274:IFK1$=""ANDF2>0THEN95
00092F2=VAL(K1$):IFF2=0ORF2>12THEN91
00093K2$="Year":GOSUB274:IFK1$=""ANDF3>0THEN95
00094F3=VAL(K1$):IFF3=0THEN93
00095RESTORE:FORX=1TOINT(F2):READZ:NEXTX
00096DATA 31,28,31,30,31,30,31,31,30,31,30,31
00097IFFRACT(F3/4)=0ANDF2=2THENLETZ=29
00098IFINT(F1)<=ZTHEN100
00099CURS1,16:PRINT"*** DATE ERROR ***";:PLAY10,12:GOTO89
00100K0$=STR$(INT(F1)):K1$=K0$(;2)+"/"
00101K0$=STR$(INT(F2)):K1$=K1$+K0$(;2)+"/"
00102K0$=STR$(INT(F3)):IFF3<10THENLETK1$=K1$+"0"
00103K1$=K1$+K0$(;2):GOSUB291:K2$="From/To":G=16:I=1
00104GOSUB274:IFK1$=""THENLETK1$="Paid"
00105GOSUB291:K2$="Cheque/Receipt No.":G=7:GOSUB274
00106IFX=2THENLETK1$="B/card"ELSEIFX=1THENLETK1$="Cash"
00107GOSUB291:K2$="Receipt (R) or Payment (P)"
00108GOSUB246:IFK1$<>"R"ANDK1$<>"P"THEN108
00109GOSUB309:GOSUB322
00110IFK1$<>"P"THEN112
00111M=P:IFM=1THENLETK1$="A":GOTO114ELSEGOSUB328:GOTO113
00112M=R:IFM=1THENLETK1$="A":GOTO114ELSEGOSUB331
00113K2$="Category":GOSUB246:X=X-64:IFX<1ORX>MTHEN113
00114GOSUB291
00115G=9:I=0:K2$="Amount":GOSUB274:GOSUB262:IFX=1THEN115
00116GOSUB291:K2$="Next=<CR> Menu=M Re-do=R ":I=1
00117GOSUB246:IFK1$="R"THEN87
00118IFK1$<>"M"ANDX<>128THEN117
00119C=C+1:IFX=128THEN86ELSE3
00120 REM
00121 REM save
00122 REM
00123N=3:IFC=1THENLETN=1
00124K5$=SAVE":GOSUB231:IFK2$=""THEN82
00125Q=0:ONERRORGOTO126:OPEN"I",6,K5$+".LGR":Q=1
00126ONERRORGOTO0:IN#0:OUT#0:CLOSE6:IFQ=0THEN129
00127K2$="OVERWRITE "+K5$+" (Y/N)":GOSUB246
00128IFK1$="N"THEN124ELSEIFK1$<>"Y"THEN127
00129GOSUB348:IFH=0THENDISKRESET"A":GOTO3
00130 K0$=B0$(0):N=P:IFR>PTHENLETN=R
00131CURS0,12:PRINT[A24 32];"SAVING ";K5$;[A33 32]:CURS0
00132 OPEN"O",6,K5$+".LGR":OUT#6
00133PRINT"''";K0$;"'',";C;",";H;",";P;",";R;",";S;",";T
00134IFH=2THEN136ELSEFORX=1TON
00135PRINTB0$(X);",";B1$(X);",";B2(X);",";B3(X):NEXTX
00136IFC<2ORH=1THEN64
00137FORX=1TOCSTEP3
00138PRINTA0$(X);",";A0$(X+1);",";A0$(X+2):NEXTX:GOTO64
00139 REM
00140 REM DELETE
00141 REM
00142G=3:K3$=" file to be deleted":K2$="First"+K3$
00143GOSUB274:O=INT(VAL(K1$)):IFO<1ORO=>CTHEN142
00144M=O:GOSUB292:GOSUB252:IFK1$="N"THEN3
00145G=3:K2$="Last"+K3$+" - or <CR>":I=1:GOSUB274
00146L=INT(VAL(K1$)):IFK1$=""THENLETL=O
00147I=0:IFL<OORL=>CTHEN145ELSEIFL=OTHEN149
00148M=L:GOSUB292:GOSUB252:IFK1$="N"THEN145
00149K3$="":Z=L-O+1:X=0:GOSUB341:FORX=L+1TOC
00150A0$(O)=A0$(X):O=O+1:NEXTX:C=C-Z:GOSUB360:GOTO82
00151 REM
00152 REM PRINT
00153 REM
00154G=20:I=1:H=1:K2$="String search":GOSUB274:K4$=K1$
00155IFASC(K4$)=35THENLETH=INT(VAL(K4$(;2))):K4$="#"
00156IFH=0ORH>C-2THEN154
00157K2$="Screen (S) or Printer (P)":GOSUB246
00158L=12:IFK1$="S"THEN167ELSEIFK1$<>"P"THEN3
00159GOSUB322:K2$="PRINTER Type:":PRINT\\SPC(15);K2$
00160PRINT\SPC(20)"Parallel - Key 1"
00161PRINTSPC(20)"Serial 300bd - Key 2"
00162PRINTSPC(20)"Serial 1200bd - Key 3"
00163PRINTSPC(20)"Abort - any other Key"
00164GOSUB246:X=X-48:IFX<0ORX>4THEN3
00165L=57:Q=X:IFX>1THENLETQ=X+2
00166GOSUB245:OUT#0:OUT#0OFF:OUT#QON:PRINT
00167FORX=1TO20:B4(X)=B2(X):B5(X)=B3(X):NEXTX
00168D=0:F3=0:F4=1:O=T:U=0:W=0:E=C+P+R+T+4
00169IFK4$<>""THENLETE=C:O=1
00170G=1:K0$=KEY$:IFK0$=""THEN173ELSEPLAY22,2
00171IFK0$="A"ORK0$="a"THEN216
00172K1$=KEY$:IFK1$=""THEN172
00173IFD>0THEN184ELSEIFQ>0THEN177
00174 REM
00175FORX=3TO14:CURS1,X:PRINT[A64 32]:NEXTX:CURS1,3:GOTO184
00176REM
00177D=2:PRINT"LEDGER: ";B0$(0);SPC(26-LEN(B0$(0)));
00178K2$=" to ":IFS=0THEN181
00179K0$=A0$(1):GOSUB310:K2$=K1$+K2$
00180K0$=A0$(C-1):GOSUB310:K2$=K2$+K1$:PRINTK2$;
00181PRINTSPC(34-LEN(K2$));"Page ";F4:F4=F4+1
00182PRINT"No. DATE TRANSACTION";SPC(17);
00183PRINT"CLASS";SPC(16);"AMOUNT ($)":PRINT[A7 45]
00184IFO=0ORK4$<>""THEN194
00185U=U+1:IFU>PTHEN188
00186F1=B2(U):IFF1=0THEN185
00187K0$=B0$(U):X=LEN(K0$):Z=0:GOTO190
00188W=W+1:F1=B3(W):IFF1=0THEN188
00189K0$=B1$(W):X=LEN(K0$):Z=11
00190IFO=TTHENPRINT" CARRIED FORWARD: ";ELSEPRINTSPC(20);
00191IFQ>0THENPRINTSPC(22);K0$;SPC(27-X-Z);
00192IFQ=0THENPRINTK0$;SPC(33-X-Z);
00193O=O-1:PRINT[F10.2 F1]:GOTO211
00194IFK4$=""ORK4$="#"ORO<>1THEN196
00195PRINT\SPC(10);"SEARCH; ";K4$\:O=0:G=3:GOTO211
00196M=H:IFK4$=""THENLETM=H-T
00197IFM<1ORM>=CTHEN200ELSEGOSUB293
00198IFM=0THENLETB5(N)=B5(N)+F1ELSELETB4(N)=B4(N)+F1
00199GOTO211
00200IFK4$<>""THEN211
00201M=M-C:IFM=0THENPRINT:GOTO211
00202IFM>PTHEN205ELSEIFB4(M)=0THEN215
00203PRINTSPC(20);B0$(M);SPC(22-LEN(B0$(M)));[F10.2 B4(M)]
00204F3=F3-B4(M):GOTO211
00205M=M-P:IFM>RTHEN208ELSEIFB5(M)=0THEN215
00206PRINTSPC(20);B1$(M);SPC(22-LEN(B1$(M)));[F10.2 B5(M)]
00207F3=F3+B5(M):GOTO211
00208X=67:IFQ=0THENLETX=51
00209IFH=EORH=E-2THENPRINTSPC(X+2);[A10 45]:G=1
00210IFH=E-1THENPRINTSPC(X);[F11.2 F3]:G=1
00211D=D+G:IFD<LTHEN215
00212 REM
00213IFQ>0THENPRINT\\\\\\\
00214D=0:IFQ>0THEN215ELSEGOSUB245:IFK0$="A"THEN218
00215H=H+1:IFH<=ETHEN170
00216IFQ>0THENOUT#QOFF:GOTO218
00217IFK0$<>"A"ANDK0$<>"a"THENGOSUB245
00218Q=0:GOTO3
00219 REM
00220 REM NEW BASE
00221 REM
00222GOSUB252:IFK1$="N"THEN3
00223I=1:G=24:K2$="New Title":GOSUB274:IFK1$<>""THENLETB0$(0)=K1$
00224FORY=1TOC-1:K0$=A0$(Y):X=SEARCH(K0$,"|",3):GOSUB311
00225O=ASC(K0$):GOSUB310:Z=ASC(K0$)-64:GOSUB310:F1=VAL(K0$)
00226IFO=80THENLETB2(Z)=B2(Z)+F1ELSELETB3(Z)=B3(Z)+F1
00227X=Y:GOSUB341:NEXTY:C=1:GOSUB360:GOTO79
00228 REM
00229 REM DRIVE/FILENAME SELECTION
00230 REM
00231POKE257,1:K2$="Select Drive? (A/B/C)":GOSUB246
00232 IFX<65ORX>67THENLETK2$="":GOTO235
00233DISKRESETK1$:K2$=K5$+": Filename":G=8:GOSUB274
00234 K5$=K1$
00235POKE257,0:RETURN
00236 REM
00237 REM INVALID FILE
00238 REM
00239ONERRORGOTO0:IN#0:OUT#0:CLOSE6:CURS1,16
00240 PRINT[A63 32];CURS22,16:PRINT"<<< NO SUCH FILE >>>"
00241 CURS0:PLAY0,20:DISKRESET"A":K5$="":GOTO82
00242 REM
00243 REM KEY TO CONTINUE
00244 REM
00245K2$="KEY to Continue"
00246G=1:GOSUB274:X=ASC(K1$)
00247IFX>96ANDX<123THENLETX=X-32:K1$=CHR$(X)
00248RETURN
00249 REM
00250 REM SURE Y/N
00251 REM
00252K2$="Sure (Y/N)":GOSUB246:IFK1$<>"N"ANDK1$<>"Y"THEN252
00253RETURN
00254 REM
00255 REM PREVIOUS BALANCE
00256 REM
00257G=9:K2$="Balance Forward":GOSUB274:GOSUB262
00258IFX=1THEN257ELSERETURN
00259 REM
00260 REM MONEY INPUT
00261 REM
00262X=1:F1=VAL(K1$):IFF1<=0ANDI=0ORF1=>1000000THEN265
00263X=0:F2=FRACT(F1):F3=F1-F2+FLT(INT(F2*100))/100
00264K1$=STR$(F3):K1$=K1$(;2)
00265RETURN
00266 REM
00267 REM CATEGORY
00268 REM
00269G=12:K2$="Category"
00270 REM
00271 REM MAIN INPUT
00272 REM G=No of chars, I=Null allowed, K2$=Prompt
00273 REM
00274GOSUB323:Y=LEN(K2$):CURS1,15:PRINT[A64 45][A63 32];
00275X=V+1-C:IFX>VTHENLETX=V
00276CURS1,16:PRINTK2$;:CURS52,16:PRINTINT(FRE($));" :";X;
00277CURSY+3,16:Z=0:K1$="":FORX=1TOG:PRINT"*";:NEXTX
00278CURSY+1,16:PRINT"? ";
00279K0$=KEY$:X=ASC(K0$):IFX=124ORX=128THEN279
00280IFX=8ORX=127THEN285ELSEIFX>13THEN283
00281IFZ>0THENCURS0:RETURN
00282IFI>0THENLETK1$="":RETURNELSE279
00283Z=Z+1:CURSY+Z+2,16:PRINTK0$;
00284K1$=K1$+K0$:IFZ=GTHENRETURNELSE279
00285K0$=K1$(;1,LEN(K1$)-1):K1$=K0$
00286IFZ>0THENCURSY+Z+2,16:PRINT"*";:CURSY+2,16:Z=Z-1
00287GOTO279
00288 REM
00289 REM File Entry
00290 REM
00291M=C:GOSUB309
00292GOSUB322:PRINT"FILE:"
00293IFK4$=""ORK4$="#"THEN295
00294K0$=A0$(M):IFSEARCH(K0$,K4$)=0THENLETG=0:RETURN
00295K0$=STR$(M)+".":K0$=K0$(;2):X=LEN(K0$)
00296PRINTK0$;SPC(4-X);:K0$=A0$(M):GOSUB310
00297PRINTSPC(9-LEN(K1$));K1$;" ";:IFQ>0THENPRINT" ";
00298GOSUB310:PRINTK1$;SPC(18-X);
00299GOSUB310:PRINTK1$;SPC(9-X);
00300GOSUB310:M=0:IFK1$="P"THENLETM=11
00301IFQ=0THENPRINTK1$;" ";
00302GOSUB310:N=ASC(K1$)-64:K2$=B0$(N):IFM=0THENLETK2$=B1$(N)
00303IFQ>0THENLETX=LEN(K2$):PRINTK2$;SPC(16-X);ELSEPRINTK1$;
00304GOSUB310:F1=VAL(K1$):IFF1>0THENPRINTSPC(M);[F10.2 F1]
00305RETURN
00306 REM
00307 REM Extract File
00308 REM
00309A0$(C)=A0$(C)+K1$+"|":RETURN
00310K1$="":X=SEARCH(K0$,"|"):IFX=0THENRETURN
00311K1$=K0$(;1,X-1):K0$=K0$(;X+1):IFQ>0THENLETX=X-1
00312RETURN
00313 REM
00314 REM Extract Data Variables
00315 REM
00316K1$=A0$(X):F1=VAL(K1$):Y=SEARCH(K1$,"/")+1:K1$=K1$(;Y)
00317F2=VAL(K1$):Y=SEARCH(K1$,"/")+1:K1$=K1$(;Y)
00318F3=VAL(K1$):F4=100*F3+F2+F1/100:RETURN
00319 REM
00320 REM Print Screen Heading
00321 REM
00322CLS:PRINTK5$;:CURS53,1:PRINT"by L.R. Ford";
00323CURS17,1:INVERSE:PRINT" * Dreamcards LedgerMaster * "
00324NORMAL:PRINT[A64 45];:RETURN
00325 REM
00326 REM print BASE sub
00327 REM
00328GOSUB322:PRINT"PAYMENT CATEGORIES: (";B0$(0);")":K2$="Category"
00329IFP=0THENRETURN
00330FORX=1TOP:K0$=B0$(X):F1=B2(X):GOSUB334:NEXTX:RETURN
00331GOSUB322:PRINT"RECEIPTS CATEGORIES: (";B0$(0);")"
00332IFR=0THENRETURN
00333FORX=1TOR:K0$=B1$(X):F1=B3(X):GOSUB334:NEXTX:RETURN
00334J=X+3:K=3:IFX>10THENLETJ=J-10:K=35
00335CURSK,J:PRINTCHR$(X+64);". ";K0$;SPC(13-LEN(K0$));
00336IFF1>0THENPRINT[F10.2 F1]
00337RETURN
00338 REM
00339 REM counter
00340 REM
00341IFX>1THEN343
00342CURS1,12:PRINT[A26 32]"* WAIT *"[A92 32]
00343IFX>0THENCURS28,13:PRINT[I4 X];
00344CURS0:RETURN
00345 REM
00346 REM save/load type sub
00347 REM
00348K2$="Base (1)":IFN>2THENLETK2$=K2$+", Files (2), All (3)"
00349IFN>3THENLETK2$=K2$+", Merge (4)"
00350GOSUB246:H=INT(VAL(K1$)):IFH>NTHENLETH=0
00351O=H:RETURN
00352 REM
00353 REM Initialise Arrays
00354 REM
00355IFC=0THEN357
00356GOSUB252:IFK1$="N"THENRETURN
00357CLEAR:K5$="":V=230:STRS(V*51+1400)
00358DIMA0(V+2),A1(V+2),B0(20),B1(20),B2(20)
00359DIMB3(20),B4(20),B5(20):GOSUB361:GOSUB362
00360FORX=CTOV+2:A0$(X)="":NEXTX:K1$="":RETURN
00361FORX=YTO20:B0$(X)="":B2(X)=0:NEXTX:RETURN
00362FORX=YTO20:B1$(X)="":B3(X)=0:NEXTX:RETURN
(X)="":NEXTX:K1$="":RETURN
00361FORX=YTO20:B0$(X)="":B2(X)=0:NEXTX:RETURN
00362FORX=YTO2