IMD 1.16: 8/06/2007 14:35:59 public domain software for the epson qx-10 disk #1                    BARGRAPHBASFED-TAX BAS! INTERESTBASCOMMSN BAS3DBGRAPHBAS0IRSENTRYBAS]FINANCE BAS+REALEVALBAS' DECISIONASC !CALC BAS"#CPM/PERTBASS$%&'()EZCHECK CBLY*+,-./PAYABLE2BASt01234567PAYROLL BAS89LABELS BAS:;COMMSN DOC <LABELS4 BAS =>SLSHIST BAS?@LOAN BAS ARECOVERYBASBUGRAPH DBFCUGRAPH DOCDDEPREC BASEMAILLISTBASQFGHIJKNAMEADDRBAShLMNOPQRPHONDAT2BAS8STUVPWRBDGETBAS WVALMERGECOMXYZ[\]^_VALMERGEDOC3`abcDBFORMATBASdDATABASEASC^efghijSCREEN MEMkl100 ' 3-D BAR GRAPH 110 ' BY BILL BURKETT 120 ' HOUSTON, TX 130 ' Received from MILWOG-- Milwaukee, WI 140 E$=CHR$(27):' ESCAPE 150 DC$=E$+"=":' DIRECT CURSOR ADDRESSING 160 UY$=E$+"l":' START UNDERLINING ("l" IS A LETTER) 170 UN$=E$+"m":' STOP UNDERLINING 180 DIM X$(20),I(20),U(20),N(20),T(20),AV(20) 190 F$=CHR$(150):G$=CHR$(127):E$=CHR$(153):B$=CHR$(128) 200 T=0:A=0 210 PRINT CHR$(26):' CLEAR SCREEN 220 PRINT STRING$(10,B$)+" Variable Bar Graph "+STRING$(10,B$):PRINT:PRINT 230 PRINT "Number oPRINTEXTABSmnREAD ME opBLKFRI2 ASCOqrstuHELP1 CMDvHELP1 ZIP wHELP2 ZIP xHELP3 ZIPyHELP4 ZIPzHELP DBF|{|}~HELP NDXHELP CMD HELP2 CMDHELP3 CMDHELP4 CMDHELP5 CMDSTOCGRPHBASf observations covered,(Max-20)"; 240 INPUT N 250 C$=STRING$(3,G$) 260 PRINT:PRINT"What is the scale factor,(ie..5,10,100 etc.)"; 270 INPUT S 280 PRINT:PRINT"One (1) line of ";C$;" = ";S 290 FOR I=1 TO N 300 PRINT:PRINT"Name of observation No.";UY$;I;UN$; 310 INPUT X$(I) 320 X$=LEFT$(X$(I),3) 330 PRINT"Number of units for ";UY$;X$(I);UN$;" = ";:INPUT U(I) 340 PRINT 350 T=T+U(I) 360 U(I)=U(I)/S 370 NEXT I:PRINT 380 PRINT CHR$(26) 390 PRINT:PRINT"Press any key to continue..." 395 Q$=INKEY$:IFSTOCGRPHDOCVALINDEXCOMoCRUNCHERBAS'MORTGAGEBAS'CAL BAS6HBARGRAFBASIINVEST BASDRAWDATAGRFCREATE BASMBASEDITBASPRINT MEMPRINTEXTDOCD    Q$="" THEN 395 ELSE 400 400 M=28 410 PRINT CHR$(26) 420 FOR I=1 TO N 430 K=U(I) 440 P$=LEFT$(X$(I),3)+SPACE$(1) 450 IF K>20 THEN 460 ELSE 480 460 IF K<40 THEN K=K/2:GOTO 490 470 IF K>40 THEN K=K/4:GOTO 500 480 P0$=STRING$(3,G$)+E$:GOTO 510 490 P0$=CHR$(110)+CHR$(47)+CHR$(50)+E$:GOTO 510 500 P0$=CHR$(110)+CHR$(47)+CHR$(52)+E$:GOTO 510 510 P1$=STRING$(3,G$)+F$ 520 P2$=CHR$(138)+STRING$(3,F$) 530 L=54:M=M+5 540 J=1 550 PRINT DC$;CHR$(L);CHR$(M);P$ 560 L=L-1 570 PRINT DC$;CHR$(L);CHR$(M);P0$  NOT APPLY, OR YOU DO NOT" 200 PRINT"HAVE INCOME OR EXEMPTIONS FOR THIS ITEM, ENTER A (0) UNLESS" 210 PRINT"THE QUESTION REQUIRES A (YES) OR (NO) ANSWER." 220 PRINT 230 PRINT 240 PRINT"THE 1040 FORM WILL BE DONE FIRST." 250 PRINT 260 PRINT 270 PRINT 280 M=0 290 J=0 300 PRINT 310 INPUT"ARE YOU MARRIED (Y/N) ";Y$ 320 PRINT 330 IF LEFT$(Y$,1)="Y" THEN 360 340 IF LEFT$(Y$,1)="N" THEN 430 350 GOTO 310 360 M=1 370 PRINT 380 INPUT"ARE YOU FILLING A JOINT RETURN (Y/N) ";Y$ 390 PRINT 400 IF LEFT 580 GOTO 600 590 PRINT DC$;CHR$(L);CHR$(M);P1$:J=J+1 600 IF J=K THEN L=L-1:GOTO 620 620 PRINT DC$;CHR$(L);CHR$(M);P2$ 630 NEXT I 640 PRINT DC$;"7 ";"Press any key to continue..."; 650 Q$=INKEY$:IF Q$="" THEN 650 ELSE 660 660 PRINT:PRINT 670 AV=T/N:PRINT"Total of units for overall period = ";UY$;T;UN$ 680 PRINT"Average units for ";UY$;N;UN$;" observations = ";UY$;AV;UN$ 690 PRINT:PRINT"Press 'V' for another Variable Bar Graph"; 700 Q$=INKEY$:IF Q$="" THEN 700 ELSE$(Y$,1)="Y" OR LEFT$(Y$,1)="N" THEN 410 ELSE 380 410 IF LEFT$(Y$,1)="N" THEN J=0 420 IF LEFT$(Y$,1)="Y" THEN J=1 430 INPUT"HOW MANY OTHER DEPENDENTS DO YOU CLAIM ";D1 440 PRINT 450 IF J=0 THEN 480 460 D0=D1+2 470 GOTO 490 480 D0=D1+2 490 PRINT"ARE YOU OR YOUR SPOUSE (IF FILING JOINT RETURN) OVER 65 ?" 500 INPUT" ENTER A (0), (1), OR (2) --- ";E1 510 PRINT 520 PRINT"ARE YOU OR YOUR SPOUSE (IF FILING JOINT RETURN) BLIND ?" 530 INPUT" ENTER A (0), (1), OR (2) --- ";B5 540 PRINT 550 E1=E1 710 710 IF Q$="V" OR Q$="v" THEN 190 720 SYSTEM  'V' for another Variable Bar Graph"; 700 Q$=INKEY$:IF Q$="" THEN 700 ELSENT DC$;CHR$(L);CHR$(M);P2$ 630 NEXT I 640 PRINT DC$;"7 ";"Press any key to continue..."; 650 Q$=INKEY$:IF Q$="" THEN 650 ELSE 660 660 PRINT:PRINT 670 AV=T/N:PRINT"Total of units for overall period = ";UY$;T;UN$ 680 PRINT"Average units for ";UY$;N;UN$;" observations = ";UY$;AV;UN$ 690 PRINT:PRINT"Press 'V' for another Variable Bar Graph"; 700 Q$=INKEY$:IF Q$="" THEN 700 ELSE+B5 560 D2=D0+E1 570 PRINT"LINE 7" 580 INPUT"WHAT ARE THE GROSS WAGES ON YOUR W-2's --- ";A1# 590 PRINT 600 PRINT"LINE 8" 610 INPUT"ENTER ALL INTERESTS RECEIVED (FROM SCHEDULE B) --- ";A2# 620 PRINT 630 PRINT"LINE 9a" 640 INPUT"ENTER ALL DIVIDENDS RECEIVED (FROM SCHEDULE B) --- ";A3# 650 PRINT 660 PRINT"LINE 9b" 670 INPUT"ENTER YOUR EXCLUSION (FROM SCHEDULE B) --- ";A4# 680 A5#=A3#-A4# 690 PRINT 700 A6#=0 710 PRINT"DID YOU ITEMIZE YOUR DEDUCTIONS ON YOUR FEDERAL" 720 INPUT"RETURN LAST YEAR 10 REM *** 1040 TAX PROGRAM *** 20 REM *** 1982 TAX FORM *** 30 REM *** WRITTEN BY FRANK SAUCIUNAS *** 40 REM *** GREENWELL SPRINGS, LA. 70739 *** 50 CLEAR 1000 60 WIDTH 79 70 P$="$$#,###.##" 80 B$="#######" 90 PRINT CHR$(12) 100 PRINT TAB(32);"* 1040 TAX *" 110 FOR I=1 TO 7 120 PRINT 130 NEXT I 140 PRINT"1040 FEDERAL TAX PROGRAM INCLUDING SCHEDULE (A) AND" 150 PRINT"SUPPLEMENTAL SCHEDULES (B), (C), (D), (F) AND (W)." 160 PRINT 170 PRINT 180 PRINT 190 PRINT"ANSWER ALL QUESTIONS. IF IT DOES   (Y/N) ";Y$ 730 PRINT 740 IF LEFT$(Y$,1)="N" THEN 820 750 IF LEFT$(Y$,1)="Y" THEN 770 760 GOTO 710 770 PRINT 780 PRINT"LINE 10" 790 PRINT"HOW MUCH STATE AND LOCAL TAX REFUNDS DID YOU RECEIVE" 800 INPUT"FROM LAST YEARS TAXES ";A6# 810 PRINT 820 PRINT"LINE 11" 830 INPUT"HOW HUCH ALIMONY DID YOU RECEIVE ";A7# 840 PRINT 850 PRINT"LINE 12" 860 PRINT"HOW MUCH BUSINESS INCOME (OR LOSS) DID YOU RECEIVE ?" 870 INPUT"IF A LOSS, ENTER A NEGATIVE AMOUNT. --- ";A3# 880 PRINT 890 PRINT"LINE 12" 900 PRINTREDIT FOR POLITICAL CONTRIBUTIONS --- ";E3# 1870 PRINT 1880 PRINT"LINE 45" 1890 PRINT"ENTER THE AMOUNT OF CREDIT FOR CHILD CARE." 1900 INPUT" (ATTACH FORM 2441) --- ";E4# 1910 PRINT 1920 PRINT"LINE 47" 1930 INPUT"ENTER THE AMOUNT OF ENERGY CREDIT --- ";E5# 1940 PRINT 1950 PRINT 1960 E0#=E1#+E2#+E3#+E4#+E5# 1970 PRINT"LINE 60" 1980 INPUT"WHAT ARE THE FEDERAL WITHOLDINGS ON YOUR W-2's --- ";F1# 1990 PRINT 2000 PRINT"LINE 61" 2010 INPUT"ENTER ANY ESTIMATED TAX PAYMENTS MADE LAST YEAR --- ";F INCOME YOU RECEIVED --- ";C7# 1360 C0#=C1#+C2#+C3#+C4#+C5#+C6#+C7# 1370 D0#=B0#-C0# 1380 PRINT CHR$(12) 1390 PRINT 1400 PRINT 1410 PRINT 1420 PRINT"THIS COMPLETES SIDE (1) OF THE 1040 FORM. NOW WE WILL" 1430 PRINT"DO THE REVERSE SIDE." 1440 PRINT 1450 PRINT 1460 PRINT 1470 F3#=0 1480 IF D0#>10000 THEN 1770 1490 IF M=1 AND J=1 THEN 1520 1500 IF M=1 THEN 1770 1510 PRINT 1520 PRINT"DID YOU RECEIVE ANY WAGES, SALARIES, TIPS, OR OTHER" 1530 INPUT"EARNED INCOME NOT REPORTED ON LINE 7 (Y/N) ";Y$"HOW MUCH DID YOU GAIN (OR LOOSE) FROM THE SALE OR EXCHANGE OF" 910 INPUT"CAPITAL ASSETS? IF A LOSS, ENTER A NEGATIVE AMOUNT. --- ";S6# 920 PRINT 930 PRINT"LINE 18" 940 INPUT"ENTER RENTS, ROYALTIES, PARTNERSHIPS, TRUSTS, ETC. --- ";B1# 950 PRINT 960 PRINT"LINE 19" 970 PRINT"DID YOU HAVE ANY FARM INCOME (OR LOSS)? IF A LOSS," 980 INPUT"ENTER A NEGATIVE AMOUNT. --- ";B2# 990 PRINT 1000 B4#=0 1010 PRINT"LINE 20a" 1020 INPUT"HOW MUCH UNEMPLOYMENT COMPENSATION DID YOU RECEIVE ";B3# 1030 PRINT 10402# 2020 PRINT 2030 F0#=F1#+F2#+F3# 2040 PRINT CHR$(12) 2050 FOR I=1 TO 5 2060 PRINT 2070 NEXT I 2080 PRINT"THIS COMPLETES THE 1040 QUESTION AND ANSWER SECTION." 2090 PRINT"SCHEDULE (A) WILL BE NEXT." 2100 FOR I=1 TO 6 2110 PRINT 2120 NEXT I 2130 INPUT"DO YOU WANT TO ITEMIZE YOUR TAXES (Y/N) ";Y$ 2140 PRINT 2150 D2#=0 2160 IF LEFT$(Y$,1)="Y" OR LEFT$(Y$,1)="N" THEN 2170 ELSE 2130 2170 IF LEFT$(Y$,1)="Y" THEN T=1 2180 IF LEFT$(Y$,1)="N" THEN T=0 2190 IF T=1 THEN 2270 2200 PRINT 2210 INPUT" 1540 PRINT 1550 IF LEFT$(Y$,1)="N" THEN 1770 1560 IF LEFT$(Y$,1)="Y" THEN 1580 1570 GOTO 1520 1580 INPUT"DO YOU HAVE ANY DEPENDENT CHILDREN (Y/N) ";Y$ 1590 PRINT 1600 IF LEFT$(Y$,1)="Y" THEN 1630 1610 IF LEFT$(Y$,1)="N" THEN 1770 1620 GOTO 1580 1630 PRINT"IF YOU ARE SELF-EMPLOYED, ENTER THE AMOUNT FROM" 1640 PRINT"FROM LINE 9 OF SCHEDULE SE. IF THE INCOME IS A" 1650 INPUT"LOSS, ENTER A NEGATIVE AMOUNT. --- ";G1# 1660 PRINT 1670 G2#=A1#+G1# 1680 IF G2#<0 THEN G2#=0 1690 IF G2#=0 THEN 1770 1 IF B3#=0 THEN 1070 1050 PRINT"LINE 20b" 1060 INPUT"ENTER TAXABLE PART OF UNEMPLOYMENT COMPENSATION ";B4# 1070 PRINT 1080 PRINT"LINE 21" 1090 INPUT"ENTER ANY OTHER INCOME ";B5# 1100 PRINT 1110 B0#=A1#+A2#+A5#+A6#+A7#+A8#+A9#+B1#+B2#+B4#+B5# 1120 PRINT"LINE 23" 1130 INPUT"ENTER ANY MOVING EXPENSES. (ATTACH FORM 3903) ";C1# 1140 PRINT 1150 PRINT"LINE 24" 1160 PRINT"ENTER ANY EMPLOYEE BUSINESS EXPENSES." 1170 INPUT" (ATTACH FORM 2106) --- ";C2# 1180 PRINT 1190 PRINT"LINE 25" 1200 PRINT"ENTEENTER ALL CHARITABLE CONTRIBUTIONS --- ";H1# 2220 D1#=H1#*.25 2230 IF J=1 AND D1#>25 THEN D1#=25 2240 IF J=0 AND D1#>12.5 THEN D1#=12.5 2250 D2#=D0#-D1# 2260 GOTO 3590 2270 PRINT CHR$(12) 2280 PRINT 2290 PRINT"MEDICAL EXPENSES WILL BE DONE FIRST." 2300 PRINT 2310 PRINT 2320 PRINT"LINE 1" 2330 INPUT"HOW MUCH DID YOU PAY FOR PRESCRIPTIONS ";I1# 2340 I2#=D0#*.01 2350 I3#=I1#-I2# 2360 IF I2#>I1# THEN I3#=0 2370 PRINT 2380 PRINT"LINE 4" 2390 PRINT"ENTER INSURANCE PREMIUMS YOU PAID FOR MEDICAL 700 PRINT"YOUR EARNED INCOME IS"; 1710 PRINT USING P$;G2# 1720 INPUT"ENTER YOUR CREDIT FROM THE EARNED INCOME TABLE --- ";G3# 1730 IF D0#<=6000 THEN F3#=G2# 1740 IF D0#<=6000 THEN 1770 1750 IF G2#I6# THEN I8#=0 2490 I9#=I4#/2 2500 IF I9#>150 THEN I9#=150 2510 IF I8#>I9# THEN I0#=I8# ELSE I0#=I9# 2520 PRINT 2530 PRINT 2540 PRINT CHR$(12) 2550 IF I0#>550 THEN GOSUB 6130 2560 PRINT 2570 PRINT"TAX EXPENSES WILL BE DONE NEXT." 2580 PRINT 2590 PRINT 2600 PRINT"LINE 11" 2610 INPUT"ENTER STAAND" 3700 INPUT"ENTER YOUR TAX HERE. --- ";D5# 3710 PRINT CHR$(12) 3720 PRINT 3730 D6#=0 3740 H0#=D5#+D6# 3750 X1#=H0#-E0# 3760 IF X1#<0 THEN X1#=0 3770 X2#=F0#-X1# 3780 X3#=X1#-F0# 3790 IF X2#<0 THEN X2#=0 3800 IF X3#<0 THEN X3#=0 3810 IF X2#=0 THEN 3920 3820 FOR I=1 TO 4 3830 PRINT 3840 NEXT I 3850 PRINT CHR$(14);CHR$(20) 3860 PRINT" * * * R E F U N D * * * "; 3870 PRINT CHR$(15);CHR$(21); 3880 PRINT" REFUND OF";USING P$;X2# 3890 FOR I=1 TO 5 3900 PRINT 3910 NEXT I 3920 PRINT 3UCTIONS WILL BE DONE NEXT." 3160 PRINT 3170 PRINT 3180 PRINT"LINE 24" 3190 PRINT"ENTER ALL CASUALTY OR THEFT LOSS(ES)." 3200 INPUT" (ATTACH FORM 4684) --- ";M1 3210 PRINT 3220 PRINT"LINE 25a" 3230 INPUT"ENTER ALL UNION AND PROFESSIONAL DUES --- ";M2# 3240 PRINT 3250 PRINT"LINE 25b" 3260 INPUT"ENTER TAX RETURN PREPARATION FEE --- ";M3# 3270 PRINT 3280 PRINT"LINE 26" 3290 INPUT"ENTER ALL MISC. DEDUCTIONS --- ";M4# 3300 PRINT 3310 M0#=M1#+M2#+M3#+M4# 3320 IF M0#>300 THEN GOSUB 6250 3330 TE AND LOCAL TAXES WITHELD FROM W-2s --- ";J1# 2620 PRINT 2630 PRINT"LINE 12" 2640 INPUT"ENTER THE REAL ESTATE TAXES PAID --- ";J2# 2650 PRINT 2660 PRINT"LINE 13a" 2670 PRINT"LOOK UP THE SALES TAX CREDIT FROM THE TAX TABLE AND ENTER" 2680 INPUT"THAT AMOUNT PLUS THE SALES TAX OF MAJOR PURCHASES --- ";J3# 2690 PRINT 2700 PRINT"LINE 13b" 2710 INPUT"ENTER GENERAL SALES TAX PAID ON MOTOR VEHICHELS --- ";J4 2720 PRINT 2730 PRINT"LINE 14" 2740 INPUT"ENTER ANY MISC. TAXES PAID --- ";J5# 2750 PRINT 27930 PRINT 3940 PRINT"THIS FINISHES THE QUESTIONING SECTION OF THE 1040 TAX PROGRAM." 3950 PRINT"NOW THE PROGRAM WILL PRINT OUT THE TOTALS TO BE USED IN" 3960 PRINT"FILLING OUT YOUR FORMS. THE 1040 FORM WILL BE FIRST." 3970 FOR I=1 TO 5 3980 PRINT 3990 NEXT I 4000 PRINT"PRESS (CR) WHEN PRINTER IS READY. "; 4010 LINE INPUT Z$ 4020 LPRINT 4030 LPRINT"THE FOLLOWING ARE THE LINE NUMBERS AND AMOUNTS" 4040 LPRINT"TO BE ENTERED ON YOUR 1040 FORM." 4050 LPRINT 4060 LPRINT 4070 LPRINT" LINE NUMBER N0#=I0#+J0#+K0#+L0#+M0# 3340 IF M=0 THEN 3390 3350 IF J=1 THEN N1#=3400 3360 IF N1#=3400 THEN 3460 3370 N1#=1700 3380 GOTO 3460 3390 N1#=2300 3400 PRINT"ARE YOU A QUALIFING WIDOW OR WIDOWER WITH A" 3410 INPUT"DEPENDENT CHILD OR CHILDREN (Y/N) ";Z$ 3420 IF LEFT$(Z$,1)="Y" THEN 3450 3430 IF LEFT$(Z$,1)="N" THEN 3160 3440 GOTO 3400 3450 N1#=3400 3460 G0#=N0#-N1# 3470 IF G0#<0 THEN G0#=0 3480 IF G0#>0 THEN 3580 3490 PRINT 3500 PRINT" <<<<< WARNING >>>>>" 3510 PRINT 3520 PRINT"THE ITEMIZED60 J0#=J1#+J2#+J3#+J4#+J5# 2770 PRINT CHR$(12) 2780 IF J0#>(D0#*.15) THEN GOSUB 6050 2790 PRINT 2800 PRINT 2810 PRINT"INTEREST EXPENSES WILL BE NEXT." 2820 PRINT 2830 PRINT 2840 PRINT"LINE 16a" 2850 INPUT"ENTER THE INTEREST PAID ON YOUR HOUSE MORTGAGE --- ";K1# 2860 K2#=0 2870 PRINT 2880 PRINT"LINE 17" 2890 INPUT"ENTER THE INTEREST PAID ON ALL CREDIT CARDS --- ";K3# 2900 PRINT 2910 PRINT"LINE 18" 2920 INPUT"ENTER THE INTEREST PAID ON LOANS AND ETC. --- ";K4# 2930 PRINT 2940 K0#=K1#+K2#+K3# (1040 SIDE 1) AMOUNT" 4080 LPRINT 4090 LPRINT" 6e NUMBER OF EXEMPTIONS ------------- "; 4100 LPRINT USING B$;D2 4110 LPRINT" 7 WAGES, SALARIES, TIPS, ETC. ------ "; 4120 LPRINT USING P$;A1# 4130 LPRINT" 8 INTEREST INCOME ------------------ "; 4140 LPRINT USING P$;A2# 4150 LPRINT" 9a DIVIDENDS ------------------------ "; 4160 LPRINT USING P$;A3# 4170 LPRINT" 9b EXCLUSION ------------------------ "; 4180 LPRINT USING P$;A4# 4190 LPRINT" 9c TOTAL ------------------ DEDUCTIONS ARE LESS THAN YOUR "; 3530 PRINT USING P$;N1# 3540 PRINT"STATUS DEDUCTION. DEDUCT YOUR CHARITABLE CONTRIBUTIONS." 3550 PRINT 3560 T=0 3570 GOTO 2200 3580 D2#=D0#-G0# 3590 D3#=D2 * 1000 3600 D4#=D2#-D3# 3610 PRINT 3620 Q$=" (X), (Y), OR (Z) " 3630 IF N1#<>3400 THEN 3650 3640 Q$=" " 3650 PRINT"THE TOTAL NUMBER OF EXEMPTIONS YOU CLAIMED IS";D2;"." 3660 PRINT"YOUR TAXABLE INCOME IS "; 3670 PRINT USING P$;D4#; 3680 PRINT". LOOK UP THIS AMOUNT" 3690 PRINT"IN THE TAX RATE TABLES";Q$;"+K4# 2950 PRINT CHR$(12) 2960 IF K0#>(D0#*.15) THEN GOSUB 6170 2970 PRINT 2980 PRINT 2990 PRINT"CONTRIBUTIONS WILL BE DONE NEXT." 3000 PRINT 3010 PRINT 3020 PRINT"LINE 20a" 3030 INPUT"ENTER ANY CASH CONTRIBUTIONS YOU MADE --- ";L1# 3040 L2#=0 3050 PRINT 3060 PRINT"LINE 21" 3070 INPUT"ENTER CASH VALUE OF OTHER CONTRIBUTIONS --- ";L3# 3080 L4#=0 3090 PRINT 3100 L0#=L1#+L2#+L3#+L4# 3110 PRINT CHR$(12) 3120 IF L0#>(D0*.1) THEN GOSUB 6210 3130 PRINT 3140 PRINT 3150 PRINT"LOSSES AND MISC. DED   ---------- "; 4200 LPRINT USING P$;A5# 4210 LPRINT" 10 STATE & LOCAL INCOME TAX REFUND -- "; 4220 LPRINT USING P$;A6# 4230 LPRINT" 11 ALIMONY RECEIVED ----------------- "; 4240 LPRINT USING P$;A7# 4250 LPRINT" 12 BUSINESS INCOME ------------------ "; 4260 LPRINT USING P$;A8# 4270 LPRINT" 13 CAPITAL GAINS -------------------- "; 4280 LPRINT USING P$;A9# 4290 LPRINT" 18 RENTS, ROYALTIES, ETC. ----------- "; 4300 LPRINT USING P$;B1# 4310 LPRINT" 19 FARM INCOME ---------------SING P$;F0# 5070 LPRINT" 68 OVER PAID ------------------------ "; 5080 LPRINT USING P$;X2# 5090 LPRINT" 69 REFUND TO YOU -------------------- "; 5100 LPRINT USING P$;X2# 5110 LPRINT" 71 BALANCE DUE ---------------------- "; 5120 LPRINT USING P$;X3# 5130 LPRINT 5140 LPRINT 5150 LPRINT 5160 LPRINT"THIS ENDS THE PRINT OUT OF THE 1040 TAX TOTALS." 5170 IF T=0 THEN 5950 5180 LPRINT 5190 LPRINT 5200 LPRINT 5210 LPRINT"THE FOLLOWING LINE NUMBER AMOUNTS ARE TO BE USED" 5220 LPRINT"IN FIL00 LPRINT USING P$;G0# 4710 LPRINT" 34b CHARITABLE CONTRIBUTIONS --------- "; 4720 LPRINT USING P$;D1# 4730 LPRINT" 35 TOTAL (33 - 34a OR 34b) ---------- "; 4740 LPRINT USING P$;D2# 4750 LPRINT" 36 LINE 6e TIMES $1,000 ------------- "; 4760 LPRINT USING P$;D3# 4770 LPRINT" 37 TAXABLE INCOME (36 - 35) --------- "; 4780 LPRINT USING P$;D4# 4790 LPRINT" 38 TAX RATE FROM TAX TABLE ---------- "; 4800 LPRINT USING P$;D5# 4810 LPRINT" 40 TOTAL (38 + 39) ------------------ "; 4820 LP------- "; 4320 LPRINT USING P$;B2# 4330 LPRINT" 20a UNEMPLOYMENT COMPENSATION -------- "; 4340 LPRINT USING P$;B3# 4350 LPRINT" 20b TAXABLE UNEMPLOYMENT ------------- "; 4360 LPRINT USING P$;B4# 4370 LPRINT" 21 OTHER INCOME --------------------- "; 4380 LPRINT USING P$;B5# 4390 LPRINT" 22 TOTAL INCOME --------------------- "; 4400 LPRINT USING P$;B0# 4410 LPRINT" 23 MOVING EXPENSES ------------------ "; 4420 LPRINT USING P$;C1# 4430 LPRINT" 24 EMPLOYEE BUSINESS EXPENSE ---LING OUT SCHEDULE (A)." 5230 LPRINT 5240 LPRINT 5250 LPRINT" LINE NUMBER (SCHEDULE A) AMOUNT" 5260 LPRINT 5270 LPRINT" 1 MEDICINE & DRUGS ----------------- "; 5280 LPRINT USING P$;I1# 5290 LPRINT" 2 1% OF ADJUSTED GROSS ------------- "; 5300 LPRINT USING P$;I2# 5310 LPRINT" 3 TOTAL (1 - 2) -------------------- "; 5320 LPRINT USING P$;I3# 5330 LPRINT" 4 INSURANCE PREMIUMS PAID ---------- "; 5340 LPRINT USING P$;I4# 5350 LPRINT" 5c OTHER MEDICAL EXPENSES ---RINT USING P$;H0# 4830 LPRINT" 41 CREDIT FOR THE ELDERLY ----------- "; 4840 LPRINT USING P$;E1# 4850 LPRINT" 43 CREDIT FOR INVESTMENTS ----------- "; 4860 LPRINT USING P$;E2# 4870 LPRINT" 44 CREDIT FOR POLITICAL CONTRIBUTIONS "; 4880 LPRINT USING P$;E3# 4890 LPRINT" 45 CREDIT FOR CHILD CARE ------------ "; 4900 LPRINT USING P$;E4# 4910 LPRINT" 47 CREDIT FOR ENERGY ---------------- "; 4920 LPRINT USING P$;E5# 4930 LPRINT" 49 TOTAL CREDITS -------------------- "; 4940 LPRINT----- "; 4440 LPRINT USING P$;C2# 4450 LPRINT" 25 PAYMENTS TO AN I.R.A. ------------ "; 4460 LPRINT USING P$;C3# 4470 LPRINT" 27 INTEREST PENALTY ON SAVINGS ------ "; 4480 LPRINT USING P$;C4# 4490 LPRINT" 28 ALIMONY PAID --------------------- "; 4500 LPRINT USING P$;C5# 4510 LPRINT" 29 WORKING MARRIED COUPLE DEDUCTION - "; 4520 LPRINT USING P$;C6# 4530 LPRINT" 30 DISABILITY INCOME EXCLUSION ------ "; 4540 LPRINT USING P$;C7# 4550 LPRINT" 31 TOTAL ADJUSTMENTS ---------------------- "; 5360 LPRINT USING P$;I5# 5370 LPRINT" 6 TOTAL ---------------------------- "; 5380 LPRINT USING P$;I6# 5390 LPRINT" 7 3% OF ADJUSTED GROSS ------------- "; 5400 LPRINT USING P$;I7# 5410 LPRINT" 8 TOTAL ---------------------------- "; 5420 LPRINT USING P$;I8# 5430 LPRINT" 9 1/2 THE AMOUNT OF LINE 4 --------- "; 5440 LPRINT USING P$;I9# 5450 LPRINT" 10 TOTAL MEDICAL -------------------- "; 5460 LPRINT USING P$;I0# 5470 LPRINT" 11 STATE & LOCAL TAXES --------- USING P$;E0# 4950 LPRINT" 50 BALANCE (40 - 49) ---------------- "; 4960 LPRINT USING P$;X1# 4970 LPRINT" 59 TOTAL TAX ------------------------ "; 4980 LPRINT USING P$;X1# 4990 LPRINT" 60 FEDERAL INCOME TAX WITHELD ------- "; 5000 LPRINT USING P$;F1# 5010 LPRINT" 61 ESTIMATED TAX PAYMENTS ----------- "; 5020 LPRINT USING P$;F2# 5030 LPRINT" 62 EARNED INCOME -------------------- "; 5040 LPRINT USING P$;F3# 5050 LPRINT" 67 TOTAL ---------------------------- "; 5060 LPRINT U-- "; 4560 LPRINT USING P$;C0# 4570 LPRINT" 32 ADJUSTED GROSS INCOME (22 - 31) -- "; 4580 LPRINT USING P$;D0# 4590 LPRINT 4600 LPRINT 4610 LPRINT"THIS IS THE END OF SIDE (1) OF THE 1040 FORM." 4620 LPRINT"NOW SIDE (2) OF THE 1040 WILL BE FILLED IN." 4630 LPRINT 4640 LPRINT 4650 LPRINT" LINE NUMBER (1040 SIDE 2) AMOUNT" 4660 LPRINT 4670 LPRINT" 33 ADJUSTED GROSS INCOME ------------ "; 4680 LPRINT USING P$;D0# 4690 LPRINT" 34a ITEMIZED DEDUCTIONS -------------- "; 47   ----- "; 5480 LPRINT USING P$;J1# 5490 LPRINT" 12 REAL ESTATE TAX ------------------ "; 5500 LPRINT USING P$;J2# 5510 LPRINT" 13a GENERAL SALES TAX ---------------- "; 5520 LPRINT USING P$;J3# 5530 LPRINT" 13b SALES TAX ON MOTOR VEHICLES ------ "; 5540 LPRINT USING P$;J4# 5550 LPRINT" 14 OTHER TAXES ---------------------- "; 5560 LPRINT USING P$;J5# 5570 LPRINT" 15 TOTAL TAXES ---------------------- "; 5580 LPRINT USING P$;J0# 5590 LPRINT" 16a HOME MORTGAGE INTEREST --------CT PLACES. BE SURE" 5990 LPRINT"TO INCLUDE ANY AND ALL SUPPORTING FORMS, AND A" 6000 LPRINT"CHECK IF YOU OWE THE GOVERNMENT ANY TAXES." 6010 LPRINT 6020 LPRINT 6030 LPRINT CHR$(12) 6040 GOTO 6310 6050 PRINT 6060 PRINT 6070 PRINT"YOUR TAXES "; 6080 PRINT"ARE GREATER THAN WOULD BE EXPECTED FOR" 6090 PRINT"YOUR INCOME. THIS MAY CAUSE YOUR RETURN TO BE AUDITED." 6100 PRINT 6110 PRINT 6120 RETURN 6130 PRINT 6140 PRINT 6150 PRINT"YOUR MEDICAL EXPENSES "; 6160 GOTO 6080 6170 PRINT 6180 PRINT --- "; 5600 LPRINT USING P$;K1# 5610 LPRINT" 17 CREDIT CARD INTEREST ------------- "; 5620 LPRINT USING P$;K3# 5630 LPRINT" 18 OTHER INTEREST PAID -------------- "; 5640 LPRINT USING P$;K4# 5650 LPRINT" 19 TOTAL INTEREST PAID -------------- "; 5660 LPRINT USING P$;K0# 5670 LPRINT" 20a CASH CONTRIBUTIONS --------------- "; 5680 LPRINT USING P$;L1# 5690 LPRINT" 21 CASH VALUE CONTRIBUTIONS --------- "; 5700 LPRINT USING P$;L3# 5710 LPRINT" 22 CARRYOVER FROM PRIOR YEARS ------ 6190 PRINT"YOUR INTEREST "; 6200 GOTO 6080 6210 PRINT 6220 PRINT 6230 PRINT"YOUR CONTRIBUTIONS "; 6240 GOTO 6080 6250 PRINT 6260 PRINT 6270 PRINT"YOUR LOSSES MAY CAUSE YOUR RETURN TO BE AUDITED." 6280 PRINT 6290 PRINT 6300 RETURN 6310 PRINT 6320 PRINT"DO YOU WANT TO DO YOUR LA. INCOME TAX (Y/N)"; 6330 INPUT X$ 6340 IF LEFT$(X$,1)="Y" THEN 6370 6350 IF LEFT$(X$,1)="N" THEN 6420 6360 GOTO 6310 6370 Z0$="TAX.DAT" 6380 OPEN "O",1,Z0$ 6390 PRINT #1,D2#,H0#,D2 6400 CLOSE 1 6410 RUN "LATAX" - "; 5720 LPRINT USING P$;L4# 5730 LPRINT" 23 TOTAL CONTRIBUTIONS -------------- "; 5740 LPRINT USING P$;L0# 5750 LPRINT" 24 CASUALTY OR THEFT LOSS ----------- "; 5760 LPRINT USING P$;MI# 5770 LPRINT" 25a UNION AND PROFESSIONAL DUES ------ "; 5780 LPRINT USING P$;M2# 5790 LPRINT" 25b TAX RETURN PREPARATION FEE ------- "; 5800 LPRINT USING P$;M3# 5810 LPRINT" 26 OTHER MISCELLANEOUS DEDUCTIONS --- "; 5820 LPRINT USING P$;M4# 5830 LPRINT" 27 TOTAL MISCELLANEOUS DEDUCTIONS --- ";  6420 PRINT 6430 PRINT"THE END" 6440 SYSTEM 6450 END N "O",1,Z0$ 6390 PRINT #1,D2#,H0#,D2 6400 CLOSE 1 6410 RUN "LATAX" NT 6260 PRINT 6270 PRINT"YOUR LOSSES MAY CAUSE YOUR RETURN TO BE AUDITED." 6280 PRINT 6290 PRINT 6300 RETURN 6310 PRINT 6320 PRINT"DO YOU WANT TO DO YOUR LA. INCOME TAX (Y/N)"; 6330 INPUT X$ 6340 IF LEFT$(X$,1)="Y" THEN 6370 6350 IF LEFT$(X$,1)="N" THEN 6420 6360 GOTO 6310 6370 Z0$="TAX.DAT" 6380 OPEN "O",1,Z0$ 6390 PRINT #1,D2#,H0#,D2 6400 CLOSE 1 6410 RUN "LATAX"  5840 LPRINT USING P$;M0# 5850 LPRINT" 28 TOTAL DEDUCTIONS ----------------- "; 5860 LPRINT USING P$;N0# 5870 LPRINT" 29 STATUS DEDUCTION ----------------- "; 5880 LPRINT USING P$;N1# 5890 LPRINT" 30 TOTAL ---------------------------- "; 5900 LPRINT USING P$;G0# 5910 LPRINT 5920 LPRINT 5930 LPRINT 5940 LPRINT 5950 LPRINT 5960 LPRINT"THIS FINISHES THE 1040 TAX PROGRAM. NOW YOU MUST" 5970 LPRINT"FILL IN THE BLANKS ON THE APPROPRIATE FORMS AND" 5980 LPRINT"THEN SIGN THEM IN THE CORRE   2 PRINT TAB(30);"INTEREST" 4 PRINT 8 PRINT 9 PA=0 10 REM -PROGRAM TO COMPUTE INTEREST PAYMENTS 20 PRINT "INTEREST IN PERCENT"; 25 INPUT J 26 J=J/100 30 PRINT "AMOUNT OF LOAN"; 35 INPUT A 40 PRINT "NUMBER OF YEARS"; 45 INPUT N 50 PRINT "NUMBER OF PAYMENTS PER YEAR"; 55 INPUT M 60 N=N*M 65 I=J/M 70 B=1+I 75 R=A*I/(1-1/B^N) 78 PRINT 80 PRINT "AMOUNT PER PAYMENT=";INT(R*100)/100 85 PRINT "TOTAL INTEREST =";INT((R*N-A)*100)/100 90 B=A 95 PRINT "PAYMENT NO.";TAB(15);"INTEREST";TAB(30);"PRINCD - C ELSE T=D + C 360 NETP=T/N 370 PRINT "NET AMOUNT = $";:PRINT USING "######.##";CDBL(T) 380 PRINT "NET PRICE PER SHARE = $";NETP 390 PRINT "COMMISSION PER SHARE = $";:PRINT USING "######.###";C/N 395 ML=C 400 REM SCHWAB COMMISSION 440 IF D <3001 THEN C=18+(D*.012): GOTO 470 450 IF D < 7001 THEN C=36+(D*.006): GOTO 470 460 IF D>= 7001 THEN C= 57 + (D*.003) 470 IF N<=600 THEN M=N*.08 ELSE M=48 + (N-600)*.04 480 IF N>=100 THEN X=N*.45 ELSE X=C 485 PRINT "****** SCHWAB ******": 490 IF C=101 THEN GOTO 200 140 IF D <801 THEN C=8.43+(D*.02696): GOTO 180 145 IF D < 2501 THEN C=16.85+(N*.0315)+(D*.01685):GOTO 180 150 IF D< 5IPAL";TAB(45);"BALANCE" 100 L=B*I 110 P=R-L 120 B=B-P 122 L=INT(L*100)/100 124 P=INT(P*100)/100 126 B=INT(B*100)/100 128 PA=PA+1 130 PRINT PA;TAB(15);"$";L;TAB(30);"$";P;TAB(45);"$";B 140 IF B>=R THEN 100 150 PRINT TAB(30);"$";INT((B*1)*100)/100;TAB(45);"$";INT((R-B*I)*100)/100 155 PRINT 160 PRINT PA+1;"LAST PAYMENT =";TAB(30);"$";INT((B*I+B)*100)/100 170 PRINT 180 PRINT 190 PRINT 200 END 0)/100 155 PRINT 160 PRINT PA+1;"LAST PAYMENT =";TAB(30);"$";INT((B*I+B)*100)/100 170 PRINT 180 PRC=M 495 IF C>X THEN C=X 500 PRINT "COMMISSION = $";: PRINT USING "######.##";CDBL(C) 505 PRINT "AMOUNT = $";:PRINT USING "######.##";CDBL(D) 510 IF D>56000! THEN PRINT "AMOUNT OVER $56,000. CALL SCHWAB FOR QUOTE.":GOTO 5 520 IF Q$="S" THEN T=D-C ELSE T=D+C 525 NETP=T/N 530 PRINT "NET AMOUNT = $";:PRINT USING "######.##";CDBL(T) 535 PRINT "NET PRICE PER SHARE = $";NETP 538 PRINT "COMMISSION PER SHARE = $";:PRINT USING "######.###";C/N 539 IF ML>C THEN DIF=ML-C ELSE DIF=C-ML 540 PRINT "***********001 THEN C=29.21 +(N*.0315)+ (D*.01236):GOTO 170 155 IF D < 20001 THEN C=31.46 +(N*.0315) + (D*.01236): GOTO 175 160 IF D>=20001 THEN C=92 161 GOTO 180 170 IF C>87 THEN X=87 ELSE X=C 171 GOTO 300 175 IF C>92 THEN X=92 ELSE X=C 176 GOTO 300 180 X=C:GOTO 300 200 IF D <801 THEN C=8.43+(N*.0785)+(D*.02696): IF C>D*.1 THEN C=D*.1:GOTO 270 205 IF D < 2501 THEN C=18.95+(N*.0893)+(D*.01685): GOTO 270 210 IF D< 5001 THEN C=31.31 +(N*.0893)+ (D*.01236):GOTO 270 215 IF D < 20001 THEN C=33.56 +(N*.0945) + (": PRINT "DIFFERENCE = $";DIF;,"PER SHARE = $";DIF/N 545 PRINT "***********" 547 IF ML>C THEN PRINT "SCHWAB WINS" ELSE PRINT "MERRILL LYNCH WINS" 548 IF ML>C THEN W=100*DIF/C:PRINT "MERRILL LYNCH COMMISSION IS GREATER BY";W;"PER CENT" ELSE W=100*DIF/ML: PRINT "SCHWAB COMMISSION IS GREATER BY";W;"PER CENT" 549 PRINT "***********" 550 GOTO 5 600 END  CENT" ELSE W=100*DIF/ML PRINT "COMMISSION PER SHARE = $";:PRINT USING "######.###";C/N 539 IF ML>C THEN DIF=ML-C ELSE DIF=C-ML 540 PRINT "***********D*.01236):GOTO 270 220 IF D< 30001 THEN C=114.45 +(N*.0945) + (D*.00843): GOTO 270 225 IF D < 300001! THEN C= 199.84 +(N*.0945) +(D*.00562): GOTO 270 230 IF D>= 300001! THEN C= 1209.86 + (N*.0945) +(D*.00225) 270 IF D<=5000 THEN X=N*.87 ELSE X=N*.92 300 IF D>300 THEN M=30 ELSE M=0 310 PRINT "****** MERRILL LYNCH ******" 320 IF CX THEN C=X 335 PRINT "COMMISSION = $";:PRINT USING "######.##";CDBL(C) 340 PRINT "AMOUNT = $";:PRINT USING "######.##";CDBL(D) 350 IF Q$="S" THEN T =    -3)) 690 IF INT(MAX/MAG)*MAG<>MAX THEN MAX=FNR(MAX,MAG) 700 IF MAX-TOP < .1*TOP THEN MAX=MAX+1:GOTO 690 710 PRINT "How thick do you want the bars "; 720 PRINT INT((74-FACTORS)/FACTORS);" is max. "; 730 INPUT A1:IF A1*FACTORS+FACTORS<75 THEN 740 ELSE 710 740 PRINT CS$ 750 Q$=STRING$(A1,BARCH$):HL$=STRING$(A1,HORLN$) 760 FOR I=0 TO 20:PRINT " -":NEXT I 770 PRINT FNC$(1,0);MAX;FNC$(6,0);3*MAX/4;FNC$(11,0);MAX/2 780 PRINT FNC$(16,0);MAX/4;FNC$(21,0);" 0 " 790 PRINT FNC$(22,40-LEN(TITLE$)/2)TITLE$ VRTLN$="|" 'Vertical Line char for printer 250 PDGLN$="/" 'Diagonal Line char for printer 260 '***** NOTE ***** 270 'if HORLN$, VRTLN$, and DGLN$ are special graphics chars that must be 280 'have graphics mode switched in (ie on and OSBORNE) put the switch 290 'in & out sequence in the definitions of VRTLN$ and DGLN$, and for 300 'HORLN$ put the switch in and out chars before & after the STRING$ 310 'in line 750 below: 320 ' 330 'End of Customization Section 340 ' 350 DEF FNR(NUM,FAC)=INT(NUM/FA800 TT=5 810 FOR I=1 TO FACTORS 820 IF LEN(A$(I))>A1 THEN OP$=LEFT$(A$(I),A1) ELSE OP$=A$(I) 830 PRINT FNC$(21,TT);OP$ 840 TT=TT+LEN(Q$)+1 850 NEXT I 860 X=21:H=5 870 FOR I=1 TO FACTORS 880 FOR II=1 TO B(I) STEP MAX/20 890 X=X-1:PRINT FNC$(X,H);IVON$;Q$;IVOFF$:NEXT II 900 PRINT FNC$(X-1,H);DGLN$;SPC(A1-1);DGLN$;:PRINT FNC$(X-2,H+1)+HL$ 910 H=H+A1+1:X=21 920 BB=B(I) 930 X=20 940 FOR II=1 TO BB STEP MAX/20 950 X=X-1:PRINT FNC$(X,H);VRTLN$:NEXT II 960 PRINT FNC$(20,H-1)DGLN$ 970 X=21 980 NEXC+1)*FAC 360 DIM A$(35),B(35),PB(35) 370 PRINT CS$ 380 PRINT "ead in graph from disk, or ype in graph. ";:SS$=INPUT$(1) 390 IF SS$<>"R" THEN 460 400 INPUT "File to read in";F$ 410 IF INSTR(F$,".")=0 THEN F$=F$+".GRF" 420 OPEN "I",#1,F$ 430 INPUT#1,TITLE$,FACTORS,A1,MAX 440 FOR I=1 TO FACTORS:INPUT#1,A$(I):NEXT I:FOR I=1 TO FACTORS:INPUT#1,B(I) 450 NEXT:CLOSE#1:GOTO 740 460 PRINT 470 INPUT "What is the title of this graph ";TITLE$ 480 IF TITLE$="" THEN 460 490 TITLE$="** "+TITLE$+" **" 510 ' A three-dimensional Bar-graph written by Jonathan Winton, June 1983. (C) 20 'Modified 1983-07-07 -Bob Bowerman 30 'Added Automatic scaling, a routine to print the bargraph on the 40 'Printer, put any terminal/printer dependant strings up 50 'fron so that they are easily modified and allowed the user 60 'to chose the name of the output file name. 70 WIDTH 255 80 ' 90 'Modify this section for customiztion ... 100 ' 110 CS$=CHR$(24) 'Clear Screen 120 CE$=CHR$(23) 'Clear to End of Screen 130 IVT I 990 PRINT FNC$(23,0)CE$;"ave, o again, ew graph, hange , or

rint."; 1000 I$=INPUT$(1) 1010 IF I$="P" THEN 1200 1020 IF I$<>"S" AND I$<>"N" AND I$<>"D" AND I$<>"C" THEN 1000 1030 IF I$="N" THEN GOTO 370 1040 IF I$="C" THEN 1090 1050 IF I$="S" THEN 1130 1060 IF I$="D" THEN PRINT CS$:PRINT "New size, ";INT(((76-FACTORS)/FACTORS)-.4);" is max. "; 1070 INPUT A1:IF A1*FACTORS+FACTORS<75 AND A1>0 THEN 1080 ELSE 1060 1080 GOTO 740 1090 PRINT FNC$(22,0);CE$;"Enter the bar number to chan00 INPUT "How many bars (35 is max.) ";FACTORS 510 IF FACTORS>35 OR FACTORS<1 THEN 500 520 PRINT 530 FOR I=1 TO FACTORS 540 PRINT "Title for bar #";I;" "; 550 INPUT A$(I) 560 NEXT I 570 FOR I=1 TO FACTORS 580 PRINT "Value of "A$(I); 590 INPUT B(I) 600 IF B(I)<1 THEN 580 610 NEXT I 620 TOP=0 630 FOR I=1 TO FACTORS 640 IF B(I)>TOP THEN TOP=B(I) 650 NEXT I 660 IF INT(TOP)<>TOP THEN TOP=INT(TOP+1) 670 MAX=TOP 680 IF MAX<100 THEN MAG=CINT(10^(LEN(STR$(MAX))-2)) ELSE MAG=CINT(10^(LEN(STR$(MAX))ON$=CHR$(14) 'Inverse/Highlight/Graphics on 140 IVOFF$=CHR$(15) 'Inverse/Highlight/Graphics off 150 DEF FNC$(Y,X)=CHR$(16)+CHR$(Y+32)+CHR$(X+32) 'Cursor Address 160 PRINIT$=CHR$(18) 'Initialize printer - 170 PRESET$=CHR$(24) 'Reset Printer 180 BARCH$="X" 'Character to use in bar 190 HORLN$="_" 'Horizontal Line char 200 VRTLN$="|" 'Vertical Line char 210 DGLN$="/" 'Diagonal Line char 220 PBARCH$="X" 'Character to use in bar for the printer 230 PHORLN$="_" 'Horizontal Line char for printer 240 P   ge ";:INPUT LE 1100 PRINT CS$ 1110 PRINT "The value for ";A$(LE);" is ";B(LE);", what do you want to change it to";:INPUT B(LE) 1120 GOTO 620 1130 PRINT FNC$(23,0);CE$;:INPUT; "File name to save graph under";F$ 1140 IF INSTR(F$,".")=0 THEN F$=F$+".GRF" 1150 OPEN "O",#1,F$ 1160 PRINT#1,TITLE$;",";STR$(FACTORS);",";STR$(A1);",";STR$(MAX);","; 1170 FOR I=1 TO FACTORS:PRINT#1,A$(I);",";:NEXT I 1180 FOR I=1 TO FACTORS:PRINT#1,STR$(B(I));",";:NEXT I 1190 CLOSE#1:GOTO 990 1200 'Print out routine 1210 PSR LINE 240 HOME$ = CHR$(27) + CHR$(61)+CHR$(1)+CHR$(32) 'CURSOR TO 0,1 (X,Y) 260 R$ = CHR$(13) + CHR$(10) 'CARRIAGE RETURN AND LINE FEED 270 CLRLIN$ = CHR$(13) + CHR$(27)+CHR$(84) 'RETURN CURSOR AND CLEAR LINE 280 HLFCLR$ = CHR$(27) + "T" 'CLEARS LINE TO LEFT OF CURSOR 290 DEF FNCRSRMV$(XX,YY) = CHR$(27)+"="+CHR$(YY+32)+CHR$(XX+32) 291 DEF FNSCRNMV$(XX,YY) = CHR$(27)+"S"+CHR$(YY+32)+CHR$(XX+32) 300 '-- PRINTER INITIALIZATION AND ROUTINES 310 WIDTH LPRINT 255 315 E1 '---- INFORMATION AND REMARKS 100 '-- DEFINE VARIABLES AND COMMON VARIABLES 110 DEFINT A-Z 120 DIM IN$(20) 121 DIM RECORD$(30) 122 DIM CCC$(128) 150 FALSE = 0 160 TRUE = -1 200 '-- CONSOLE INITIALIZATION AND ROUTINES 201 WIDTH 255 204 XXXX = 0 205 YYYY = 0 206 ALT$ = CHR$(27) + "S"+CHR$(0)+CHR$(85) 'SCREEN TO COLUMN 53, ROW 0 207 REG$ = CHR$(27) + "S"+CHR$(0)+CHR$(25) 'SCREEN TO COLUMN 7, ROW 0 208 CLS$ = CHR$(26) + CHR$(27)+"S"+CHR$(0)+CHR$(32) 'CLEAR SCREEN ANDRINT FNC$(23,0);CE$; 1220 INPUT;"How long should the graph be? (20,40,80) ";GLEN 1230 IF GLEN<>20 AND GLEN<>40 AND GLEN<>80 THEN 1210 1240 LN1=MAX/GLEN:LN2=2*LN1:STP=-LN1:MIN=LN1-.1 1250 TQ=(3*GLEN)/4+1:HLF=GLEN/2+1:OQ=GLEN/4+1 1260 LPRINT PRINIT$ 1270 I=1 1280 FOR II=MAX TO 1 STEP STP 1290 IF I=1 THEN LPRINT MAX;:GOTO 1340 1300 IF I=OQ THEN LPRINT (3*MAX)/4;:GOTO 1340 1310 IF I=HLF THEN LPRINT MAX/2;: GOTO 1340 1320 IF I=TQ THEN LPRINT MAX/4;:GOTO 1340 1330 LPRINT " -"; 1340 TT=7 1350 FOR $ = CHR$(27) 'ESCAPE 320 RS$ = CHR$(27)+CHR$(13)+"P" 'EXTERNAL RESET 325 SP$ = CHR$(32) 'SPACE 330 LF$ = CHR$(10) 'LINE FEED 335 NF$ = CHR$(27) + CHR$(10) 'NEGATIVE LINE FEED 340 G$ = CHR$(51) '3 345 TX$ = CHR$(52) '4 350 PP$ = "." 'PERIOD (PRINT CHARACTER) 355 BS$ = CHR$(8) 'BACKSPACE 360 BW$ = CHR$(27) + "6" ' SET TO COLUMN 0, ROW 0 209 CL1$ = CHR$(26) + CHR$(27)+"S"+CHR$(0)+CHR$(25) 'CLEAR SCREEN AND SET TO COLUMN 7, ROW 0 210 G1$ = CHR$(27) + "g" 'TURN GRAPHICS ON 211 G0$ = CHR$(27) + "G" 'TURN GRAPHICS OFF 212 U1$ = CHR$(27) + "l" 'TURN UNDERLINING ON 213 U0$ = CHR$(27) + "m" 'TURN UNDERLINING OFF 214 H1$ = CHR$(27) + ")" 'TURN HALF INTENSITY DISPLAY ON 215 H0$ = CHR$(27) + "(" 'TURN HALF INTENSITY DISPLAY OFF 216 CRSRMOVE$ = CI1=1 TO FACTORS 1360 IF B(I1) < MIN THEN PB(I1)=INT(MIN) ELSE PB(I1)=B(I1) 1370 NEXT 1380 FOR I1=1 TO FACTORS 1390 IF II <= PB(I1) THEN LPRINT TAB(TT);STRING$(A1,PBARCH$);:GOTO 1420 1400 IF II<= PB(I1)+LN1 THEN LPRINT TAB(TT);PDGLN$;SPC(A1-1);PDGLN$;:GOTO 1420 1410 IF II<= PB(I1)+LN2 THEN LPRINT TAB(TT+1);STRING$(A1,PHORLN$); 1420 TT=TT+A1+1 1430 IF I=GLEN THEN LPRINT TAB(TT-1);PDGLN$; 1440 IF I1=FACTORS AND II<=PB(I1)+LN1 AND I<>GLEN THEN LPRINT TAB(TT);PVRTLN$;: GOTO 1470 1450 IF I1=FACTORS THEBACKWARD PRINT MODE ON 365 RV$ = CHR$(27) + "<" 'REVERSE PRINTING MODE 370 CR$ = CHR$(13)+E$+G$ 'CARRIAGE RETURN WITH GRAPHICS RESET 400 '-- 400-799 RESERVED FOR LIBRARY EXPANSION 800 '-- ERROR RECOVERY ROUTINES 801 ON ERROR GOTO 803 802 GOTO 1000 803 '-- BEGINNING OF ERROR TRAP 804 IF ERR = 53 AND ERL = 1490 THEN NFFL = TRUE: RESUME NEXT 806 IF ERR = 62 AND ERL = 1560 THEN PRINT R$;U1$;H1$;"INPUT PAST END";U0$;H0$: HR$(27) + "="+CHR$(YYYY)+CHR$(XXXX+32) 'MOVES CRSR TO POSITION XXXX,YYYY 217 CRSRLEFT$ = CHR$(8) 'CRSR LEFT w/o ERASE 218 CRSRRIGHT$ = CHR$(12) 'CRSR RIGHT w/o ERASE 219 DEL1$ = CHR$(27) + "W" 'DELETE CHARACTER AT CRSR POSITION 220 CRSRUP$ = CHR$(11) 'CRSR UP 221 CRSRDOWN$ = CHR$(10) 'CRSR DOWN 222 RTN$ = CHR$(13) 'CARRIAGE RETURN 223 INSERT$ = CHR$(27) + "Q" 'INSERTS CHARACTER AT CRSR POSSTION 224 INSERTLINE$ = CHR$(27) + "E" 'INSERT LINE AT CRN GOTO 1470 1460 IF II<=PB(I1)+LN1 AND II > PB(I1+1)+LN1 THEN LPRINT TAB(TT);PVRTLN$; 1470 NEXT I1 1480 I=I+1 1490 LPRINT 1500 NEXT II 1510 LPRINT "0 - "; 1520 FOR I=1 TO FACTORS-1:LPRINT STRING$(A1,"-");"+";:NEXT:LPRINT STRING$(A1,"-") 1530 TT=7 1540 FOR I=1 TO FACTORS 1550 IF LEN(A$(I))>A1 THEN OP$=LEFT$(A$(I),A1) ELSE OP$=A$(I) 1560 LPRINT TAB(TT);OP$; 1570 TT=TT+A1+1 1580 NEXT I 1590 LPRINT 1600 LPRINT TAB(40-LEN(TITLE$)/2);TITLE$ 1610 LPRINT PRESET$:LPRINT:LPRINT 1620 GOTO 990 TT+A    RESUME 1625 808 IF ERR = 58 AND ERL = 2280 THEN GOSUB 910 : RESUME NEXT 810 IF ERR = 58 AND ERL = 1594 THEN PRINT R$;U1$;H1;"KILLING ";FLNM1$;".BAK";U0$;H0$: KILL FLNM1$+".BAK": RESUME 814 IF ERR = 53 AND ERL = 1570 THEN PRINT R$;U1$;H1$;"FILE NOT FOUND";H0$;U0$: RESUME 1625 'FILE NOT FOUND 899 ON ERROR GOTO 0 900 '-- ADDITIONAL ERROR RECOVERY SUBROUTINES 910 PRINT R$;U1$;"FILE ";FLNM1$;".IRS ALREADY EXISTS";U0$ 912 QU$ = H1$ + "OVERWRITE FILE? #2, CCC$(J) 1592 NEXT J 1594 IF FFFL THEN CLOSE#1: PRINT R$;U1$;"CLOSING ";FLNM$;" AS ";FLNM1$;".BAK";U0$: NAME FLNM$ AS FLNM1$+".BAK": GOTO 1625 1600 GOTO 1552 1610 '______________________________________________ 1620 'READ DATA ROUTINE 1625 PRINT R$;H1$;"PRESS ANY KEY TO CONTINUE";H0$; 1626 AAAA$ = INKEY$ : IF AAAA$ = "" THEN 1626 1630 NN = 19 ' number of data entries per record 1640 FOR RECNO = 1 TO NN 1650 READ IN$(RECNO) 1660 RECORD$(RECNO) = LEFT$(IN$(RECNO),LENSK$ = CC$ + ":" 1320 IF CC$ = "X" THEN PRINT CLS$; : GOTO 2285 1330 PRINT R$; 1340 PRINT H1$;" FILE NAME:";H0$; 1350 LN = 8 1355 RECNO = 21 1360 GOSUB 2320 : FLNM1$ = CC$ 1365 PRINT R$; 1370 PRINT H1$;" FILE EXTENSION:";H0$; 1380 LN = 3 1385 RECNO = 22 1390 GOSUB 2320 : FLNM2$ = CC$ 1400 UCFL = 0 1410 FLFL = 0 1415 IF FLNM2$="$$$" OR FLNM2$="BAK" THEN PRINT CLS$;U1$;"EXTENSION .";FLNM2$;" NOT ACCEPTABLE. TRY AGAIN";U0$;R$;: GOTO 1160 1420 IF FLNM2$ = "" THEN" + H0$ 914 GOSUB 2690 915 IF FL THEN PRINT R$;U1$;"OVERWRITING ";FLNM1$;".IRS";U0$: KILL FLNM1$+".IRS" : RESUME ELSE NAME FLNM1$+".$$$" AS FLNM1$+".XXX" : PRINT R$;U1$;"SAVING FILE AS ";FLNM1$;".XXX";U0$: RESUME NEXT 1000 '- BEGINNING OF MAIN BODY OF PROGRAM 1010 '- PROGRAM ENTERIRS.BAS 11/28/81 1020 PRINT CLS$; 1030 PRINT "Use this program to write IRS format files to disk" 1040 PRINT "or to add to an existing IRS file. If the IRS file" 1050 PRINT "has a(IN$(RECNO))-5) 1670 NEXT RECNO 1680 '______________________________________________ 1690 'DATA ENTRY ROUTINE 1700 PRINT CLS$; 1705 PRINT H1$; 1710 PRINT " UP-Arrow : Previous Entry LEFT-arrow : Delete" 1715 PRINT U1$; 1720 PRINT "DOWN-Arrow : Delete Entry RIGHT-arrow : Immed " 1725 PRINT U0$; 1740 FOR RECNO = 1 TO NN 1750 PRINT IN$(RECNO) 1760 NEXT RECNO 1770 PRINT H0$; 1776 XYZ = 1 1780 ATFL = FALSE 1785 UCFL = FALSE 1790 LN = 90 1795 OFFSET = 18 1800 FOR RECNO = XYZ TO NN  FLNM$ = FLNM1$ ELSE FLNM$ =FLNM1$ + "." + FLNM2$ 1430 IF FLNM$ = "" THEN 1350 ELSE FLNM$ = DSK$ + FLNM$ : FLNM1$ = DSK$ + FLNM1$ 1440 QU$ = H1$ + FLNM$ + " is OK? (Y or N) " + H0$ 1450 PRINT R$ 1460 GOSUB 2680 1470 IF NOT FL THEN PRINT CLS$;: GOTO 1150 1480 PRINT CLS$; 1490 OPEN "I",#1,FLNM$ 1492 IF NFFL THEN PRINT R$;U1$;"NEW FILE ";FLNM$;" WILL BE ";FLNM1$;".IRS";U0$: OPEN "O",#2,FLNM1$+".$$$": PRINT U1$;"OPENING ";FLNM1$;".$$$ ";U0$: GOTO 1625 ELSE PRINT R$;U1$;"OPENING ";lready been indexed by IRS as a .D00 type file" 1060 PRINT "then it will be renamed with the extension .IRS." 1070 PRINT "The old file will be saved with the extension .BAK." 1080 PRINT "It will overwrite a previous .IRS type file with the" 1090 PRINT "same name." 1100 PRINT 1110 PRINT "Two disks must be inserted for this program to run," 1120 PRINT "since it searches both disks." 1130 PRINT 1140 PRINT "Press any key to continue" 1142 AAAA$ = INKEY$ : IF AAAA$ = "" THEN 1142 1150 PRINT CLS$1820 PRINT FNCRSRMV$(OFFSET,RECNO+1); 1840 GOSUB 2330 : IF ATFL = TRUE THEN 1870 ELSE RECORD$(RECNO) = CC$ 1860 NEXT RECNO 1865 ATFL = TRUE 1866 UCFL = FALSE 1870 PRINT FNSCRNMV$(0,2); 1871 PRINT FNCRSRMV$(0,23); 1900 QU$ = H1$ + "ENTER NUMBER TO CHANGE--00 TO CONTINUE--99 TO EXIT" + H0$ 1901 RECNO = 22 1902 OFFSET = 50 1950 GOSUB 2780: RECNO = NM 1952 IF ((RECNO > NN) AND (RECNO <> 99)) OR (RECNO < 0) THEN 1870 1960 IF RECNO = 0 THEN GOSUB 2070 : GOTO 1700 1965 IF RECNO = 99 THEN RECNO = 0 :FLNM$;" AS INPUT FILE";U0$ 1495 PRINT R$;U1$;"OPENING ";FLNM1$;".$$$ AS TEMPORARY FILE";U0$ 1500 OPEN "O",#2,FLNM1$ + ".$$$" 1510 QU$ = R$ + H1$ + "DISPLAY OLD FILE "+FLNM$+"? " + H0$ 1520 GOSUB 2690 1530 PRNFL = FL 1540 PRINT R$;R$;R$; 1550 PRINT U1$;"READING ";FLNM$;" INTO NEW ";FLNM1$;".$$$";U0$ 1552 FOR I = 1 TO 128 1560 LINE INPUT #1,CCC$(I) 1570 IF EOF(1) THEN FFFL = -1 : GOTO 1578 1571 NEXT I 1572 IF I >= 128 THEN I = 128 1578 FOR J = 1 TO I 1580 IF PRNFL THEN PRINT CCC$(J) 1590 PRINT ; 1160 PRINT R$; 1180 WIDTH 52 1190 PRINT U1$;"DRIVE A:";U0$;H1$;R$ 1200 FILES "A:*.*" 1210 PRINT H0$; 1220 PRINT R$;R$;U1$;"DRIVE B:";U0$;H1$;R$ 1230 FILES "B:*.*" 1240 PRINT H0$; 1250 WIDTH 255 1260 PRINT R$ 1270 UCFL = TRUE 1280 FLFL = TRUE 1285 NFFL = FALSE 1286 PRINT FNCRSRMV$(0,21); 1290 PRINT H1$;"DRIVE A or B? (X to EXIT):";H0$; 1300 LN = 1 1305 OFFSET = 28 1306 RECNO = 20 1310 GOSUB 2320 : IF CC$ <> "A" AND CC$ <> "B" AND CC$ <> "X" THEN PRINT CRSRLEFT$; : GOTO 1310 ELSE D    GOSUB 2070 :GOTO 2240 1969 PRINT FNSCRNMV$(0,0); 2020 OFFSET = 18 2030 GOSUB 2330: RECORD$(RECNO) = CC$ 2035 IF ATFL = FALSE THEN XYZ = RECNO : GOTO 1800 2040 GOTO 1870 2050 '_____________________________________________ 2060 'PRINT TO FILE SUBROUTINE 2070 PRINT#2,R$;"..";RECORD$(9);"*C";R$; 2080 FOR FLDNO = 1 TO NN-7 2090 PRINT#2,RECORD$(FLDNO);","; 2100 IF FLDNO = 4 THEN PRINT#2,R$; 2110 IF FLDNO = 10 THEN PRINT#2,R$; 2120 NEXT FLDNO 2130 PRINT#2,"*";R$;RECORD$(NN-6);R$;"*K "; 2140 FOR FA" KEYWORD(S)- 17:" 3120 DATA" KEYWORD(S)- 18:" 3130 DATA" KEYWORD(S)- 19:" " 3100 DATA" KEYWORD(S)- 16:" 3110 DAT:" 2990 DATA" ADDRESS 1- 05:" 3000 DATA" ADDRESS 2- 06:" 3010 DATA" CITY- 07:" 3020 DATA" STATE- 08:" 3030 DATA" ZIP- 09:" 3040 DATA" SALUTATION- 10:" 3050 DATA" PHONE 1- 11:" 3060 DATA" PHONE 2- 12:" 3070 DATA" NOTES- 13:" 3080 DATA" KEYWORD(S)- 14:" 3090 DATA" KEYWORD(S)- 15:" 3100 DATA" KEYWORD(S)- 16:" 3110 DATCC$)-1):GOTO 2540 2570 IF C$ = CHR$(8) AND CC$ = "" THEN GOTO 2540 2580 IF C$ = CHR$(10) THEN PRINT FNCRSRMV$(OFFSET,RECNO+1);: GOTO 2410 2610 IF C$ = "," THEN C$ = "" 2615 IF C$ = CHR$(12) THEN ATFL = NOT ATFL : CC$ = "" : C$ = "" : GOTO 2660 2620 IF C$ = "." AND FLFL = TRUE THEN 2660 2640 PRINT C$;:CC$=CC$ + C$ 2650 NEXT I 2660 PRINT HLFCLR$;FNCRSRMV$(OFFSET,RECNO+1); 2670 RETURN 2680 '________________________________________________ 2690 ' Subroutine Yes or NO 2700 PRINT CLRLIN$; 2710 PRINTLDNO = NN - 5 TO NN 2150 IF RECORD$(FLDNO) <> "" THEN PRINT#2,RECORD$(FLDNO);"/"; 2160 NEXT FLDNO 2170 PRINT#2,"*E";R$;R$; 2175 RETURN 2180 '______________________________________________ 2240 QU$ = "Exit `IRSENTRY' (Y or N)?" 2250 GOSUB 2680 2260 IF NOT FL THEN 1870 2265 PRINT CLS$;U1$;"CLOSING ALL FILES";U0$ 2270 CLOSE 2275 PRINT R$;U1$;"NAMING ";FLNM1$;".$$$ AS ";FLNM1$;".IRS";U0$ 2280 NAME FLNM1$+".$$$" AS FLNM1$+".IRS" 2285 QU$ = R$ + H1$ + "EXIT TO MBASIC? " + H0$ 2290 GOSUB 2680 2292 I10 L1=9 20 DEF FNR(X)=INT(X*100+.5)/100 30 CL$=CHR$(26):REM SCREEN CLEAR CHAR. 40 REM ******************************************************** 50 REM 60 PRINT CL$;"THIS PROGRAM IS A COLLECTION OF BUSINESS" 70 PRINT "APPLICATIONS. HERE IS A LIST OF THE VALUES THAT" 80 PRINT "CAN BE COMPUTED GIVEN SUPPORTING DATA:" 90 PRINT 100 PRINT "1) FUTURE VALUE OF AN INVESTMENT" 110 PRINT "2) FUTURE VALUE OF REGULAR DEPOSITS (ANNUITY)" 120 PRINT "3) REGULAR DEPOSITS" 130 PRINT "4) REGULAR DEPOSITS FROM AN IN QU$; 2720 YN$ = INKEY$: IF YN$ = "" THEN 2720 2730 IF YN$ = "y" OR YN$ = "Y" THEN PRINT "Y";:FL = -1:RETURN 2740 IF YN$ = "n" OR YN$ = "N" THEN PRINT "N";:FL = 0:RETURN 2750 GOTO 2720 2760 RETURN 2770 '________________________________________________ 2780 ' Subroutine returns 2-digit numeric input 2790 PRINT CLRLIN$; 2800 PRINT QU$; 2810 LN = 2 2820 XXX=1 2830 GOSUB 2320 : NM = VAL(CC$) 2840 XXX=0 2850 LN = 90 2870 RETURN 2880 '_______________________________________________ 2940 'DATA SF FL THEN END 2294 QU$ = H1$ + "EXIT TO CP/M? " + H0$ 2295 GOSUB 2680 2296 IF FL THEN SYSTEM 2300 GOTO 1000 2320 '______________________________________________ 2330 ' subroutine for stringdata entry 2390 ' the entered string is returned as CC$ 2400 PRINT FNCRSRMV$(OFFSET,RECNO+1); 2410 PRINT G1$;' graphics on 2412 PRINT H1$; 2420 PRINT STRING$(LN,127); 2450 PRINT G0$;' graphics off 2452 PRINT H0$; 2480 ' enter data and display it as entered 2485 PRINT FNCRSRMV$(OFFSET,RECNO+1); 2490 CC$="" VESTMENT" 140 PRINT "5) INITIAL INVESTMENT" 150 PRINT "6) MINIMUM INVESTMENT FOR WITHDRAWALS" 160 PRINT "7) NOMINAL INTEREST RATE ON INVESTMENTS" 170 PRINT "8) EFFECTIVE INTEREST RATE ON INVESTMENTS" 180 PRINT "9) EARNED INTEREST TABLE" 190 PRINT 200 PRINT "WHICH OF THE ABOVE VALUES WOULD YOU LIKE" 210 PRINT "TO COMPUTE ( 1 TO";L1;", OR 0 TO END RUN )"; 220 INPUT X 230 PRINT CL$ 240 IF X=0 THEN 1860 250 ON X GOSUB 270,360,470,590,690,800,910,1010,1150 260 GOTO 90 270 PRINT "FUTURE VALUE OF AECTION 2950 DATA" LAST NAME- 01:" 2960 DATA" FIRST NAME- 02:" 2970 DATA" POSITION- 03:" 2980 DATA" ORGANIZATION- 04:" 2990 DATA" ADDRESS 1- 05:" 3000 DATA" ADDRESS 2- 06:" 3010 DATA" CITY- 07:" 3020 DATA" STATE- 08:" 3030 DATA" ZIP- 09:" 3040 DATA" SALUTATION- 10:" 3050 DATA" PHONE 1- 11:" 3060 DATA" PHONE 2- 12:" 3070 DATA" NOTES- 13:" 3080 DATA" KEYWORD(S)- 14:" 3090 DATA" KEYWORD(S)- 15:" 3100 DATA" KEYWORD(S)- 16:" 3110 DAT 2500 J=0 2510 FOR I = 1 TO LN 2520 J = J + 1 2530 IF NOT FLFL AND RECNO => NN - 5 AND RECNO <= NN THEN UCFL = TRUE 2540 C$ = INKEY$: IF C$ = "" THEN 2540 2542 IF C$ = RTN$ THEN 2660 2543 IF C$ = CHR$(11) AND RECORD$(RECNO) <> "" AND XXX=0 THEN C$=RECORD$(RECNO) ELSE IF C$ = CHR$(11) THEN C$ = "" 2545 IF C$ <> "" THEN IF (UCFL = TRUE) THEN IF ((ASC(C$) >= 97) AND (ASC(C$) <= 122)) THEN C$ = CHR$(ASC(C$)-32) 2560 IF C$ = CHR$(8) AND NOT CC$="" THEN PRINT CHR$(8);CHR$(27);"W";:CC$=LEFT$(CC$,LEN(   N INVESTMENT" 280 PRINT:INPUT "INITIAL INVESTMENT (0 TO STOP) ";P:IF P=0 THEN RETURN 290 GOSUB 1130 300 GOSUB 1140 310 GOSUB 1110 320 I=I/N/100 330 T=P*(I+1)^(N*Y) 340 GOSUB 1100 350 GOTO 280 360 PRINT "FUTURE VALUE OF REGULAR DEPOSITS (ANNUITY)" 370 PRINT 380 INPUT "AMOUNT OF REGULAR DEPOSITS (0 TO STOP)";R 390 IF R=0 THEN RETURN 400 GOSUB 1130 410 INPUT "NUMBER OF DEPOSITS PER YEAR";N 420 GOSUB 1110 430 I=I/N/100 440 T=R*((I+1)^(N*Y)-1)/I 450 GOSUB 1100 460 GOTO 370 470 PRINT "REGULARFECTIVE INTEREST RATE";FNR(100*((1+I/N)^N-1));"% PER YEAR" 1470 PRINT 1480 PRINT "YEAR","BALANCE","INTEREST","ACCUM. INTEREST" 1490 PRINT 1500 PRINT J0, 1510 L1=1 1520 N2=1 1530 P2=1 1540 FOR J1=1 TO N 1550 IF N2>N1 THEN 1590 1560 IF N2/N1>J1/N THEN 1590 1570 B0=B0+R 1580 N2=N2+1 1590 B2=B0*(1+I/N) 1600 I1=B2-B0 1610 I3=I3+I1 1620 I2=I2+I1 1630 IF P2/P1>J1/N THEN 1670 1640 I2=FNR(I2) 1650 B2=FNR(B2) 1660 P2=P2+1 1670 IF J0=Y THEN 1820 1770 NEXT J1 1780 IF J0=59 THEN PRINT CHR$(26) : GOTO 139 134 CX=CX+1 135 GOTO 129 136 GOSUB 142 137 PRINT "YES" 138 GOTO 147 139 GOSUB 142 140 PRINT "NO" 141 GOTO 147 142 PRINT : PRINT 143 PRINT "YOUR QUESTION :" 144 PRINT Q$ : PRINT 145 PRINT "MY ANSWER (AFTER"; CX; "AGONIZING STEPS) :" 146 RETURN 147 PRINT : PRINT 148 PRINT "DO YOU NEED HELP IN MAKING ANOTHER DECISION (Y OR N)" 149 INPUT Q$ 150 IF e 360 CBK$=ESC$+"D" ' cursor back 370 X1$="#########.##" ' print using field 380 ' define function C$ for X,Y cursor positioning 390 DEF FN C$(R,C)=Y$+CHR$(R+31)+CHR$(C+31) 400 PRINT ESC$+"x1" ' enable 25th line 410 GOTO 450 ' start main program 420 ' erase 25th line and home cursor 430 PRINT FN C$(25,1);L$;CUH$ 440 RETURN 450 ' Calculate 460 GOSUB 420: PRINT CLR$ 470 PRINT: PRINT EOP$;EGR$ 480 PRINT ESC$+"x5" ' turn cursor off 490 PRINT FN C$(21,31);"faaaaaaaaaaaaac" 500 PRINT FN C$(2LEFT$(Q$,1)="Y" THEN RUN 151 PRINT CHR$(26) : END O YOU NEED HELP IN MAKING ANOTHER DECISION (Y OR N)" 149 INPUT Q$ 150 IF CHR$(26) : GOTO 139 134 CX=CX+1 135 GOTO 129 136 GOSUB 142 137 PRINT "YES" 138 GOTO 147 139 GOSUB 142 140 PRINT "NO" 141 GOTO 147 142 PRINT : PRINT 143 PRINT "YOUR QUESTION :" 144 PRINT Q$ : PRINT 145 PRINT "MY ANSWER (AFTER"; CX; "AGONIZING STEPS) :" 146 RETURN 147 PRINT : PRINT 148 PRINT "DO YOU NEED HELP IN MAKING ANOTHER DECISION (Y OR N)" 149 INPUT Q$ 150 IF  100 REM EXECUTIVE DECISION MAKER 101 REM WRITTEN BY W.A.BURTON 102 REM INTENDED FOR CRT'S AT HIGH BAUD RATES 103 CLEAR : WIDTH 80 : PRINT CHR$(26) 104 DIM Q$(80) : XX=36 105 PRINT TAB(15); "*** EXECUTIVE DECISION MAKER ***" 106 PRINT : PRINT : PRINT 107 PRINT "WHAT IS THE DECISION THAT YOU WOULD LIKE ME TO MAKE FOR YOU" 108 PRINT "TYPE IN YOUR QUESTION WHICH CAN BE ANSWERED 'YES OR NO'; AND" 109 PRINT "KEEP IT SHORTER THAN ONE LINE (INCLUDING SPACES)." 110 PRINT : PRINT : PRINT : PRINT 111 INPU2,31);"` `" 510 PRINT FN C$(23,31);"eaaaaaaaaaaaaad" 520 PRINT XGR$; 530 PRINT FN C$(19,18);"The keypad may now be used as a calculator." 540 PRINT FN C$(25,10); 550 PRINT "EOp3 o mulitply, '/' to divide." 560 PRINT FN C$(22,32);" 0": N$="" 570 N$=N$+INPUT$(1) 580 IF ASC(RIGHT$(N$,1))=13 THEN N$="": N#=0: GOTO 560' check for clear/enter 590 IF ASC(RIGHT$(N$,1))=27 THEN 610 ' check for escape 600 GOTO 620 610 N$=INPUT$(1): IF N$="Q" THEN PRINT ESC100 ' Calculator for HDOS or CP/M MBASIC. H-19 or H-89 only. 110 ' By Keith Boone, October 10/81 120 ' 130 ' Simulates a simple four function calculator 140 ' on-screen. Originally designed as part of 150 ' a checkbook program which is still unfinished, 160 ' the calculator could be merged into any similar 170 ' program without difficulty. 180 ' 190 ' This is a 12 digit calculator with 4 digits 200 ' precision to the right of the decimal place. 210 ' Change the multiplication factor in T Q$ 112 PRINT : PRINT 113 REM THIS IS A 'PSEUDO-RANDOMIZE' ROUTINE 114 FOR X=1 TO LEN(Q$) 115 Z$=MID$(Q$,X,1) 116 Z=ASC(Z$) 117 Y=Y+Z 118 NEXT X 119 Y=Y MOD 97 120 FOR X=1 TO Y 121 Z=RND(1) : Z1=RND(Y) 122 NEXT X 123 A$="<*>" : AL$="YES :" : AR$=": NO" 124 PRINT "THE '<*>' IS THE BOUNCING BALL OF FATE..." 125 PRINT "HIT SPACE BAR TO ANSWER YOUR QUESTION" 126 PRINT : PRINT : PRINT 127 PRINT TAB(10); AL$; TAB(XX); A$; TAB(61); AR$ 128 WAIT 0,1,1 129 PRINT TAB(10); AL$; TAB(XX); A$; TAB(61);   $+"y5": N#=0: N$="": GOSUB 420: PRINT CLR$: END ELSE PRINT BELL$: GOTO 560 620 IF RIGHT$(N$,1)="+" OR RIGHT$(N$,1)="-" OR RIGHT$(N$,1)="*" OR RIGHT$(N$,1)="/" OR RIGHT$(N$,1)="=" THEN 670 630 IF RIGHT$(N$,1)="." THEN 780 640 IF RIGHT$(N$,1)<"0" OR RIGHT$(N$,1)>"9" THEN N$=LEFT$(N$,LEN(N$)-1): PRINT BELL$: GOTO 780 650 IF LEN(N$)>12 THEN PRINT BELL$: N$=LEFT$(N$,12): GOTO 800 660 GOTO 780 670 PRINT FN C$(22,45-LEN(LEFT$((N$),LEN(N$)-1)));LEFT$((N$),LEN(N$)-1) 680 IF N#=0 THEN SIGN$="" 690 IF SIGN$=(I); TAB(25); F(I); TAB(35); D(I) 260 NEXT I 270 GOTO 340 280 PRINT "ACTIVITY # FROM TO ML MO MP" 290 FOR I = 1 TO N 300 PRINT TAB(5); I; TAB(15); S(I); TAB(25); F(I); 310 PRINT TAB(35); ML(I); TAB(45); MO(I); TAB(55); MP(I) 320 NEXT I 330 PRINT 340 POKE 37,201:PRINT: INPUT "Would you like to edit an activity (Y/N)"; Q1$ 350 IF LEFT$(Q1$,1) = "N" THEN 430 360 REM * EDIT MODE 370 PRINT: INPUT "What activity needs alteration (0 to end)"; I 380 IF I=0 THEN 150 390 R5 REM CPM/PERT.BAS ENDLESS LOOP IN 2580-2630 6/15/81 TEM 6 REM APPEARS TO HAVE BEEN AN HDOS PROGRAM REQUIRING "SETUP" LOADED FOR PRINTER! 10 REM CPM-PERT PROGRAM FROM INTERFACE AGE, FEB. 1981 12 REM WRITTEN BY RICHARD PARRY 14 REM ADAPTED TO MICROSOFT BASIC BY CHARLES H STROM 16 REM 17 REM NOTE: PRINTER OPERATION REQUIRES LOADING SETUP.ASM BEFORE MBASIC 18 REM *INITIALIZE NORMAL DISTRIBUTION CONSTANTS 20 RN=15: RS=SQR(3/RN) 25 CL$=CHR$(27)+CHR$(28): REM CHARACTER STRING TO HOME CURSOR & CLEAR SCR"" THEN N#=VAL(LEFT$((N$),LEN(N$)-1)) 700 IF SIGN$="+" THEN N#=N#+VAL(LEFT$((N$),LEN(N$)-1)) 710 IF SIGN$="-" THEN N#=N#-VAL(LEFT$((N$),LEN(N$)-1)) 720 IF SIGN$="*" THEN N#=N#*VAL(LEFT$((N$),LEN(N$)-1)) 730 IF SIGN$="/" AND VAL(LEFT$(N$,LEN(N$)-1))=0 THEN PRINT FN C$(22,36)"ERROR ";BELL$: N$="": GOTO 570 740 IF SIGN$="/" THEN N#=N#/VAL(LEFT$((N$),LEN(N$)-1)) 750 SIGN$=RIGHT$(N$,1):N$="" 760 IF SIGN$="=" THEN 830 770 GOTO 570 780 IF SIGN$="=" THEN SIGN$="": N#=0 790 IF VAL(RIGHT$(N$,1))>=0 ANDEM * GO TO INPUT DATA ROUTINE 400 GOSUB 1920 410 GOTO 370 420 REM * GO TO SORT ROUTINE 430 GOSUB 2080 440 IF LEFT$(Q$,1) <>"C" THEN 760 450 REM *********************************************************** 460 REM * CRITICAL PATH ANALYSIS REQUESTED. PERFORM CRITICAL PATH * 470 REM * ANALYSIS ONCE AND DISPLAY RESULTS. * 480 REM *********************************************************** 490 GOSUB 2340 500 C2=0 505 IF HC$="Y" THEN POKE 37,195 510 PRINT CL$: PRINT "CP ANALYSIS IEEN 30 REM ************** 40 REM * INPUT DATA * 50 REM ************** 55 PRINT CL$ 60 INPUT "CPM or PERT Simulation (C/P) "; Q$ 65 INPUT "Do you want a HARD-COPY record (Y/N)"; HC$: HC$=LEFT$(HC$,1) 66 IF HC$="Y"THEN PRINT "NOTE - SETUP.ASM MUST BE LOADED BEFORE MBASIC OR PRINTER WILL NOT FUNCTION!" 68 PRINT 70 INPUT "Number of Activities"; N 80 DIM ML(N), MO(N), MP(N), CP(N), ME(N), SD(N), IC(20) 90 DIM S(N), F(N), D(N), E(N), L(N), F1(N) 100 FOR I=1 TO N 110 PRINT CL$: PRINT "ACTIVITY"; I: PR VAL(RIGHT$(N$,1))<=9 THEN PRINT FN C$(22,32)" " ELSE IF RIGHT$(N$,1)="." THEN PRINT FN C$(22,32)" " 800 IF N$="" THEN N$="0" 810 PRINT FN C$(22,45-LEN(N$));N$: IF N$="0" THEN N$="" 820 GOTO 570 830 ' calculation finished 840 N$=STR$((INT(N#*10000))/10000) 850 IF LEN(N$)>13 THEN N$=ERV$+"E"+XRV$+LEFT$(N$,11): PRINT BELL$ 860 IF LEFT$(N$,1)=ESC$ THEN PRINT FN C$(22,32);N$: GOTO 890 870 PRINT FN C$(22,32)" " 880 PRINT FN C$(22,45-LEN(N$));N$:N$="" 890 GOTO 570  PS:" 520 PRINT: PRINT: PRINT "FROM","TO","EST","LFT","FLOAT": PRINT 530 FOR I = 1 TO N 540 PRINT S(I),F(I),E(S(I)),L(F(I)),F1(I) 550 NEXT I 560 PRINT "THE CRITICAL PATH LENGTH IS ";PL 570 PRINT: PRINT "THE CRITICAL PATH IS:": PRINT"FROM","TO": PRINT 580 FOR I = 1 TO N 590 IF F1(I) = 0 THEN 610 600 NEXT I 610 PRINT S(I),F(I): C2=C2+1: IF I>N THEN 650 620 FOR M= 1 TO N 630 IF S(M)=F(I) AND F1(M) = 0 THEN I=M: GOTO 610 640 NEXT M 650 IF C1<>C2 THEN PRINT: PRINT "THERE IS MORE THAN ONE CRITICAL INT 120 REM * GO TO INPUT DATA ROUTINE 130 GOSUB 1920 140 NEXT I 150 PRINT CL$: INPUT "Would you like to examine or edit the input data (Y/N)";Q1$ 160 IF LEFT$(Q1$,1) = "N" THEN 430 170 REM *SORT INPUT DATA 180 GOSUB 2080 190 REM ********************** 200 REM * DISPLAY INPUT DATA * 210 REM ********************** 215 IF HC$="Y" THEN POKE 37,195 220 PRINT CL$: IF LEFT$(Q$,1)<>"C" THEN 280 230 PRINT "ACTIVITY # FROM TO DURATION" 240 FOR I = 1 TO N 250 PRINT TAB(5); I; TAB(15); S    PATH" 660 PRINT: POKE 37,201 670 INPUT "Would you like to edit an activity or stop program (E/S)"; Q1$ 680 IF LEFT$(Q1$,1) = "E" THEN PRINT: GOTO 220: 690 END 700 REM ***************************************************************** 710 REM * PERT SIMULATION REQUESTED. PERFORM CRITICAL PATH ANALYSIS THE * 720 REM * NUMBER OF TIMES SPECIFIED. STORE PATH LENGTHS AND INCREMENT * 730 REM * ACTIVITIES WHICH APPEAR ON CRITICAL PATH. CONSTRUCT HISTOGRAM * 740 REM * AND DISPLAY RESULTS. 1610 FOR M=1 TO 20 1620 HM=IC(M)*SC 1630 FOR K=1 TO 3 1640 J=J+1: PRINT MID$(X$,J,1);TAB(2); 1650 IF K=2 THEN PRINT ">=";LL-IN;"<";LL;: LL=LL+IN 1660 PRINT TAB(LO); 1670 IF IC(M)=0 THEN PRINT: GOTO 1720 1680 FOR I=1 TO HM 1690 PRINT "*"; 1700 NEXT I 1710 PRINT 1720 NEXT K 1730 NEXT M 1740 REM *************************** 1750 REM * PRINT ACTIVITY ANALYSIS * 1760 REM *************************** 1770 PRINT: PRINT 1780 PRINT TAB(10); "+++ CP ACTIVITY ANALYSIS TABLE +++": PRI S=0: E(J)=0: L(J)=0 1200 IF ML(J)=0 THEN D(J)=0: GOTO 1250 1210 FOR I=1 TO RN 1220 S=S+2*RND-1 1230 NEXT I 1240 D(J)=ME(J)+SD(J)*S*RS 1250 NEXT J 1260 GOSUB 2340 1270 REM * FIND INTERVAL FOR THIS PATH LENGTH 1280 I3=(PL-LL)/IN+2 1290 IF I3<1 THEN LS=LS+1: GOTO 1330 1300 IF I3>20 THEN HS=HS+1: GOTO 1330 1310 I3=INT(I3) 1320 IC(I3)=IC(I3)+1 1330 NEXT K 1340 REM ************************************** 1350 REM * PRINT FREQUENCY DISTRIBUTION TABLE * 1360 REM ***************** * 750 REM ***************************************************************** 760 FOR I = 1 TO N 770 REM * COMPUTE MEAN OF EACH ACTIVITY 780 ME(I) = (MO(I)+4*ML(I)+MP(I))/6 790 REM * COMPUTE STANDARD DEVIATION OF EACH ACTIVITY 800 SD(I) = (MP(I)-MO(I))/6 810 NEXT I 820 REM * COMPUTE MOST OPTIMISTIC PATH LENGTH 830 DU=0: FOR I=1 TO N: CP(I)=0: E(I)=0: L(I)=0: NEXT I 840 FOR I = 1 TO N 850 D(I)=MO(I) 860 NEXT I 870 GOSUB 2340 880 BC=PL 890 REM * COMPUTE MOST PESSIMISTNT 1790 PRINT "ACTIVITY # FROM TO CP FREQ. PCT." 1800 FOR I=1 TO N 1810 PRINT TAB(5);I;TAB(15);S(I);TAB(25);F(I); 1820 PRINT TAB(35);CP(I);TAB(45);INT(.5+100*CP(I)/NS) 1830 NEXT I 1840 PRINT: PRINT "DUPLICATE critical paths occurred";DU;"times." 1850 PRINT: POKE 37,201 1860 INPUT "Would you like to edit an activity or stop program (E/S)"; Q1$ 1870 IF LEFT$(Q1$,1)="E" THEN PRINT: GOTO 220 1880 END 1890 REM ********************** 1900 REM * INPUT DATA ROUTINE * 1910 REM ****************************** 1365 IF HC$="Y" THEN POKE 37,195 1370 PRINT CL$: PRINT "++FREQUENCY DISTRIBUTION TABLE++": PRINT 1380 PRINT "Most OPTIMISTIC path length"; BC 1390 PRINT "Most PESSIMISTIC path length"; WC 1400 PRINT "Number of transactions LOWER than histogram range ";LS 1410 PRINT "Number of transactions HIGHER than histogram range ";HS: PRINT 1420 PRINT " INTERVAL FREQ. PCT." 1430 I1=LL-IN: I2=LL 1440 FOR M=1 TO 20 1450 PRINT"=>";I1;"<";I2;TAB(20);IC(M);TAB(30);INT(.5+100*IIC PATH LENGTH 900 DU=0: FOR I=1 TO N: CP(I)=0: E(I)=0: L(I)=0: NEXT I 910 FOR I = 1 TO N 920 D(I)=MP(I) 930 NEXT I 940 GOSUB 2340 950 WC=PL 960 REM * INITIALIZ KEY VARIABLES 970 DU=0: FOR I = 1 TO N: CP(I)=0: E(I)=0: L(I)=0: NEXT I 980 LS=0: HS=0: FOR I=1 TO 20: IC(I)=0: NEXT I 990 REM * INITIALIZE RANDOM NUMBER GENERATOR 1000 RANDOMIZE 1010 REM * PROPOSE # OF TRANSACTIONS AS 20 TIMES # OF ACTIVITIES 1020 PRINT "Number of transactions should be >= "; 20*N 1030 INPUT "Number of transactions";************* 1920 INPUT "FROM";S(I) 1930 INPUT "TO";F(I) 1940 IF F(I)>N THEN PRINT "++END NODE # NOT <= # OF ACTIVITIES++":GOTO 1930 1950 IF S(I)>F(I) THEN PRINT "++START NODE MUST BE < END NODE++":GOTO 1920 1960 IF LEFT$(Q$,1)="C" THEN INPUT "DURATION";D(I): GOTO 2040 1970 INPUT "MOST LIKELY";ML(I) 1980 REM * CHECK FOR DUMMY ACTIVITY 1990 IF ML(I)=0 THEN MO(I)=0: MP(I)=0: GOTO 2040 2000 INPUT "MOST OPTIMISTIC"; MO(I) 2010 IF MO(I)>ML(I) THEN PRINT "++MO MUST BE <= ML++": GOTO 2000 2020 INPUT "MC(M)/NS) 1460 I1=I1+IN: I2=I2+IN 1470 NEXT M 1480 REM ******************* 1490 REM * PRINT HISTOGRAM * 1500 REM ******************* 1510 REM * COMPUTE HISTOGRAM SCALE FACTOR 1520 SC=0: LO=18: J=0: LL=INT(BC) 1530 FOR M=1 TO 20 1540 IF IC(M)>SC THEN SC=IC(M) 1550 NEXT M 1560 SC=50/SC 1570 X$="PATH LENGTH" 1580 PRINT: PRINT: PRINT TAB(24); "++ HISTOGRAM ++": PRINT 1590 PRINT TAB(18);"RELATIVE FREQUENCY OF PATH LENGTHS" 1600 PRINT TAB(LO); "+------------------------------------------------+"  NS 1040 PRINT: PRINT "++SIMULATION IN PROGRESS++" 1050 REM *********************** 1060 REM * CONSTRUCT HISTOGRAM * 1070 REM *********************** 1080 REM * SET APPROPRIATE INTERVAL (I.E. INTEGER >=1) 1090 LL=INT(BC) 1100 IF WC-BC<=20 THEN IN=1 1110 IN=INT((WC-BC)/20)+1 1120 REM ********************** 1130 REM * PERFORM SIMULATION * 1140 REM ********************** 1150 TC=100 1160 FOR K=1 TO NS 1170 IF K=TC THEN PRINT "++SIMULATION IN PROGRESS++", TC: TC=TC+100 1180 FOR J=1 TO N 1190    OST PESSIMISTIC"; MP(I) 2030 IF MP(I)= ML++": GOTO 2020 2040 RETURN 2050 REM ************************************* 2060 REM * SORT DATA USING START NODE AS KEY * 2070 REM ************************************* 2080 PRINT: PRINT "SORTING IN PROGRESS": PRINT 2090 SW=0 2100 FOR I=1 TO N-1 2110 J=I+1 2120 IF S(I)<=S(J) THEN 2200 2130 EX=S(I): S(I)=S(J): S(J)=EX 2140 EX=F(I): F(I)=F(J): F(J)=EX 2150 EX=D(I): D(I)=D(J): D(J)=EX 2160 EX=ML(I): ML(I)=ML(J): ML(J)=E570 NEXT I 2579 REM ------- 2580 - 2630 IS ENDLESS SORTING LOOP. TEM 6/15/81 ------ 2580 C2=C2+1: CP(I)=CP(I)+1 2590 IF I>N THEN 2630 2600 FOR M=1 TO N 2610 IF S(M)=F(I) AND F1(M)=0 THEN I=M: GOTO 2580 2620 NEXT M 2630 IF C1<>C2 THEN DU=DU+1 2640 RETURN  2600 FOR M=1 TO N 2610 IF S(M)=F(I) AND F1(M)=0 THEN I=M: GOTO 2580 2620 NEXT M 2630 IF C1<>C2 THEN DU=DU+1 2640 IF L(F(I))>PL THEN PL=L(F(I)) 2530 NEXT I 2540 REM * COMPUTE CRITICAL PATH 2550 FOR I=1 TO N 2560 IF F1(I)=0 THEN 2580 2X 2170 EX=MO(I): MO(I)=MO(J): MO(J)=EX 2180 EX=MP(I): MP(I)=MP(J): MP(J)=EX 2190 SW=1 2200 NEXT I 2210 IF SW=1 THEN 2090 2220 RETURN 2230 REM ************************************************************* 2240 REM * THE FOLLOWING SUBROUTINE IS USED BY BOTH THE CPM ANALYSIS * 2250 REM * AS WELL AS THE PERT SIMULATION ANALYSIS. WHILE THE CPM * 2260 REM * ANALYSIS CALLS THE ROUTINE ONLY ONCE, THE SIMULATION * 2270 REM * CALLS THE ROUTINE THE NUMBER OF TIMES REQUESTED BY THE * 2280 REM 0001 IDENTIFICATION DIVISION. 0002 PROGRAM-ID. 0003 EZCHECK. 0004* this program reads a sequential file containing checking 0005* account data and outputs to the printer a listing with 0006* updated balances, # transactions, total $ dep, 0007* and total $ value of checks processed. 0008 AUTHOR. 0009 STEVE SANDERS. 0010 DATE-WRITTEN. 0011 MAY 17, 1983. 0012 DATE-COMPILED. 0013 JUNE 10, 1983. 0014 SECURITY. 0015 NONE. 0016 ENVIRONMENT DIVISION. 0017 CONFIGURATION SECTION. * USER. THE EARLIEST, LATEST, AND FLOAT TIMES ARE COMPUTED * 2290 REM * AND FROM THIS DATA THE CRITICAL PATH LENGTH AND CRITICAL * 2300 REM * PATH ARE CALCULATED. DUPLICATE CRITICAL PATHS ARE ONLY * 2310 REM * COUNTED ONCE. * 2320 REM ************************************************************* 2330 REM * COMPUTE EARLIEST STARTING TIME 2340 C1=0: C2=0: PL=0 2350 FOR I=1 TO N 2360 M1=E(S(I))+D(I) 2370 IF E(F(I))<=M1 THEN E(F(I))=M1 2380 NEXT I 230018 SOURCE-COMPUTER. 0019 KAYPRO-II-Z80A. 0020 OBJECT-COMPUTER. 0021 ANY-Z80A-8080-CPU. 0022 INPUT-OUTPUT SECTION. 0023 FILE-CONTROL. 0024 SELECT CKFILE1 ASSIGN TO INPUT DISK 0025 ORGANIZATION IS SEQUENTIAL 0026 ACCESS IS SEQUENTIAL 0027 RECORD DELIMITER IS STANDARD. 0028 SELECT PRINT-OUT ASSIGN TO OUTPUT PRINTER. 0029 DATA DIVISION. 0030 FILE SECTION. 0031 FD CKFILE1 0032 LABEL RECORDS ARE STANDARD 0033 VALUE OF FILE-ID IS FILE-IN 0034 BLOCK C90 REM * COMPUTE LATEST FINISHING TIME 2400 L(F(N))=E(F(N)) 2410 FOR I=N TO 1 STEP -1 2420 L1=S(I): M2=L(F(I))-D(I) 2430 IF L(L1)>=M2 OR L(L1)=0 THEN L(L1)=M2 2440 NEXT I 2450 REM * COMPUTE FLOAT TIME 2460 FOR I=1 TO N 2470 F1(I)=L(F(I))-E(S(I))-D(I) 2480 IF F1(I)<.0001 THEN F1(I)=0: C1=C1+1 2490 NEXT I 2500 REM * COMPUTE CRITICAL PATH LENGTH 2510 FOR I=1 TO N 2520 IF L(F(I))>PL THEN PL=L(F(I)) 2530 NEXT I 2540 REM * COMPUTE CRITICAL PATH 2550 FOR I=1 TO N 2560 IF F1(I)=0 THEN 2580 2    ONTAINS 1 RECORD 0035 DATA RECORD IS CHECK-IN. 0036 01 CHECK-IN. 0037 02 DATE-IN PIC X(8). 0038 02 FILLER PIC X(2). 0039 02 CHECK-NO-IN PIC X(3). 0040 02 FILLER PIC X(2). 0041 02 DESCRIPTION-IN PIC X(20). 0042 02 FILLER PIC X(2). 0043 02 AMOUNT-IN PIC 9999V99. 0044 02 FILLER PIC X(37). 0045 FD PRINT-OUT 0046 ES. 0103 02 ITEM-10 PIC X(17) VALUE 0104 "END OF LISTING...". 0105 02 FILLER PIC X(85) VALUE SPACES. 0106 01 SUMMARY. 0107 02 FILLER PIC X(20) VALUE SPACES. 0108 02 ITEM-11 PIC X(27) VALUE 0109 "SUMMARY OF CHECKING ACCOUNT". 0110 02 ITEM-12 PIC X(13) VALUE 0111 " TRANSACTIONS".IC X(3) VALUE ZEROES. 0075 02 FILLER PIC X(12) VALUE SPACES. 0076 02 DESCRIPTION-OUT PIC X(20). 0077 02 FILLER PIC X(2) VALUE SPACE. 0078 02 AMOUNT-OUT PIC ZZZZ.99 VALUE 0079 ZEROES. 0080 02 FILLER PIC X(7) VALUE SPACES. 0081 02 BALANCE-OUT PIC ZZZZ.99 VALUE 0082 ZEROES. 0083 02 FILLER LABEL RECORDS ARE STANDARD 0047 VALUE OF FILE-ID IS "PRINTER" 0048 DATA RECORD IS PRINT-REC. 0049 01 PRINT-REC PIC X(133). 0050 WORKING-STORAGE SECTION. 0051 01 FILE-IN PIC X(14) VALUE 0052 "A:CKFILE1.MAS". 0053 01 HEAD-1. 0054 02 FILLER PIC X(30) VALUE SPACES. 0055 02 ITEM-1 PIC X(20) VALUE 0056 "ELECTRONIC CHECKBOOK" 0112 02 FILLER PIC X(73) VALUE SPACES. 0113 01 START-BALANCE. 0114 02 ITEM-13 PIC X(17) VALUE 0115 "STARTING BALANCE ". 0116 02 BALANCE2-OUT PIC $ZZZZ.99 VALUE 0117 ZEROES. 0118 01 CREDIT. 0119 02 ITEM-14 PIC X(17) VALUE 0120 "TOTAL CREDIT ". 0121 02 CREDIT-OUT PIC $ZZZZ.99 V PIC X(60) VALUE SPACES. 0084 01 DATA-LINE. 0085 02 ITEM-7 PIC X(16) VALUE 0086 "TRANS PROCESSED ". 0087 02 NO-TRANS-OUT PIC 999 VALUE ZEROES. 0088 02 FILLER PIC X(114) VALUE SPACES. 0089 01 DEPOSITS. 0090 02 ITEM-8 PIC X(17) VALUE 0091 "TOTAL DEPOSITS ". 0092 02 DEP-TOTAL-OUT PIC $ZZZZ.99 VALUE. 0057 02 FILLER PIC X(83) VALUE SPACES. 0058 01 HEAD-2. 0059 02 ITEM-2 PIC X(4) VALUE "DATE". 0060 02 FILLER PIC X(10) VALUE SPACES. 0061 02 ITEM-3 PIC X(9) VALUE 0062 "CHECK NO.". 0063 02 FILLER PIC X(8) VALUE SPACES. 0064 02 ITEM-4 PIC X(11) VALUE 0065 "DESCRIPTION". 0066 ALUE 0122 ZEROES. 0123 02 FILLER PIC X(109) VALUE SPACES. 0124 01 END-BALANCE. 0125 02 ITEM-15 PIC X(17) VALUE 0126 "ENDING BALANCE ". 0127 02 BALANCE1-OUT PIC $ZZZZ.99 VALUE 0128 ZEROES. 0129 02 FILLER PIC X(109) VALUE SPACES. 0130 01 NO-PAGE. 0131 02 FILLER PIC X(37)  0093 ZEROES. 0094 02 FILLER PIC X(109) VALUE SPACES. 0095 01 CHECKS. 0096 02 ITEM-9 PIC X(17) VALUE 0097 "TOTAL CHECKS ". 0098 02 CHECK-TOTAL-OUT PIC $ZZZZ.99 VALUE 0099 ZEROES. 0100 02 FILLER PIC X(109) VALUE SPACES. 0101 01 FOOTER. 0102 02 FILLER PIC X(31) VALUE SPAC 02 FILLER PIC X(12) VALUE SPACES. 0067 02 ITEM-5 PIC X(6) VALUE "AMOUNT". 0068 02 FILLER PIC X(7) VALUE SPACES. 0069 02 ITEM-6 PIC X(7) VALUE "BALANCE". 0070 02 FILLER PIC X(59) VALUE SPACES. 0071 01 CHECK-LINE. 0072 02 DATE-OUT PIC X(8) VALUE ZEROES. 0073 02 FILLER PIC X(8) VALUE SPACES. 0074 02 CHECK-NO-OUT P   VALUE SPACES. 0132 02 ITEM-16 PIC X(5) VALUE 0133 "PAGE ". 0134 02 PAGE-NO-OUT PIC 99 VALUE ZEROES. 0135 02 FILLER PIC X(89) VALUE SPACES. 0136 77 BALANCE-IN PIC 9999V99 VALUE 0137 ZEROES. 0138 77 BALANCE PIC 9999V99 VALUE 0139 ZEROES. 0140 77 TRANS-COUNTER PC BEFORE ADVANCING PAGE 0218 ADD 1 TO PAGE-COUNT 0219 ELSE 0220 WRITE PRINT-REC BEFORE ADVANCING 2 LINES. 0221 MOVE SPACE TO PRINT-REC. 0222 IF PAGE-COUNT > 1 AND X1 > 0 0223 MOVE HEAD-1 TO PRINT-REC 0224 WRITE PRINT-REC BEFORE ADVANCING 2 LINES 0225 ELSE 0226 MOVE HEAD-1 TO PRINT-REC 0227 WRITE PRINT-REC BEFORE ADVANCING 2 LINES 0228 MOVE PAGE-COUNT TO PAGE-NO-OUT 0229 MOVE NO-PAGE TO PRINT-REC 0230 WRITE PRINT-REC BEFORE ADAMOUNT-IN TO BALANCE 0176 GIVING BALANCE-IN 0177 ELSE 0178 SUBTRACT AMOUNT-IN FROM BALANCE 0179 GIVING BALANCE-IN. 0180 IF CHECK-NO-IN IS NUMERIC 0181 ADD AMOUNT-IN TO CHECK-TOTAL-IN 0182 ELSE 0183 ADD AMOUNT-IN TO DEP-TOTAL-IN. 0184 MOVE AMOUNT-IN TO AMOUNT-OUT. 0185 MOVE BALANCE-IN TO BALANCE-OUT. 0186 MOVE BALANCE-IN TO BALANCE. 0187 MOVE CHECK-LINE TO PRINT-REC. 0188 WRITE PRINT-REC BEFORE ADVANCING 1 LINE. 0189 MOIC XXX VALUE ZEROES. 0141 77 CHECK-TOTAL-IN PIC 9999V99 VALUE ZEROES. 0142 77 DEP-TOTAL-IN PIC 9999V99 VALUE ZEROES. 0143 77 BALANCE2 PIC 9999V99 VALUE ZEROES. 0144 77 LINE-COUNT PIC 999 VALUE ZEROES. 0145 77 BAL1-IN PIC 9999V99 VALUE ZEROES. 0146 77 CREDIT-IN PIC 9999V99 VALUE ZEROES. 0147 77 PAGE-COUNT PIC 99 VALUE 01. 0148 77 X1 VANCING 2 LINES. 0231 MOVE SUMMARY TO PRINT-REC. 0232 WRITE PRINT-REC BEFORE ADVANCING 3 LINES. 0233 MOVE TRANS-COUNTER TO NO-TRANS-OUT. 0234 MOVE DATA-LINE TO PRINT-REC. 0235 WRITE PRINT-REC BEFORE ADVANCING 2 LINES. 0236 MOVE BALANCE2 TO BALANCE2-OUT. 0237 MOVE START-BALANCE TO PRINT-REC. 0238 WRITE PRINT-REC BEFORE ADVANCING 1 LINE. 0239 MOVE DEP-TOTAL-IN TO DEP-TOTAL-OUT. 0240 MOVE DEPOSITS TO PRINT-REC. 0241 WRITE PRINT-REC BEFORE ADVANCING 1 LINE.VE ZEROES TO BALANCE-IN. 0190 ADD 1 TO TRANS-COUNTER. 0191 ADD 1 TO LINE-COUNT. 0192 IF LINE-COUNT > 52 0193 ADD 1 TO X1 0194 MOVE SPACE TO PRINT-REC 0195 WRITE PRINT-REC BEFORE ADVANCING PAGE 0196 MOVE HEAD-1 TO PRINT-REC 0197 WRITE PRINT-REC BEFORE ADVANCING 2 LINES 0198 ADD 1 TO PAGE-COUNT 0199 MOVE PAGE-COUNT TO PAGE-NO-OUT 0200 MOVE NO-PAGE TO PRINT-REC 0201 WRITE PRINT-REC BEFORE ADVANCING 2 LINES 0202 MOVE HEAD-2 TO  PIC 9 VALUE ZERO. 0149 PROCEDURE DIVISION. 0150 START-PAR. 0151 DISPLAY "ENTER INPUT FILE ". 0152 DISPLAY FILE-IN WITH NO ADVANCING. 0153 ACCEPT FILE-IN. 0154 DISPLAY "ENTER STARTING BALANCE (807.48 = 080748) ". 0155 ACCEPT BALANCE. 0156 MOVE BALANCE TO BALANCE2. 0157 OPEN OUTPUT PRINT-OUT. 0158 OPEN INPUT CKFILE1. 0159 HEAD-PAR. 0160 MOVE SPACES TO PRINT-REC. 0161 MOVE HEAD-1 TO PRINT-REC. 0162 WRITE PRINT-REC BEFORE ADVANCING 2 LINES. 0163  0242 MOVE CREDIT-IN TO CREDIT-OUT. 0243 MOVE CREDIT TO PRINT-REC. 0244 WRITE PRINT-REC BEFORE ADVANCING 1 LINE. 0245 MOVE CHECK-TOTAL-IN TO CHECK-TOTAL-OUT. 0246 MOVE CHECKS TO PRINT-REC. 0247 WRITE PRINT-REC BEFORE ADVANCING 2 LINES. 0248 MOVE BAL1-IN TO BALANCE1-OUT. 0249 MOVE END-BALANCE TO PRINT-REC. 0250 WRITE PRINT-REC BEFORE ADVANCING PAGE. 0251 END-PAR. 0252 CLOSE CKFILE1. 0253 CLOSE PRINT-OUT. 0254 STOP RUN. 0255 END PROGRAM EZCHECK. PRINT-REC 0203 WRITE PRINT-REC BEFORE ADVANCING 2 LINES 0204 MOVE ZEROES TO LINE-COUNT 0205 GO TO CHECK-PAR 0206 ELSE 0207 GO TO CHECK-PAR. 0208 DATA-PAR. 0209 ADD BALANCE2 TO DEP-TOTAL-IN 0210 GIVING CREDIT-IN. 0211 SUBTRACT CHECK-TOTAL-IN FROM CREDIT-IN 0212 GIVING BAL1-IN. 0213 MOVE SPACE TO PRINT-REC. 0214 WRITE PRINT-REC BEFORE ADVANCING 2 LINES. 0215 MOVE FOOTER TO PRINT-REC. 0216 IF LINE-COUNT > 40 0217 WRITE PRINT-RE MOVE PAGE-COUNT TO PAGE-NO-OUT. 0164 MOVE NO-PAGE TO PRINT-REC. 0165 WRITE PRINT-REC BEFORE ADVANCING 2 LINES. 0166 MOVE HEAD-2 TO PRINT-REC. 0167 WRITE PRINT-REC BEFORE ADVANCING 2 LINES. 0168 CHECK-PAR. 0169 READ CKFILE1 AT END GO TO DATA-PAR. 0170 IF DATE-IN = "XXXXXXXX" GO TO DATA-PAR. 0171 MOVE DATE-IN TO DATE-OUT. 0172 MOVE CHECK-NO-IN TO CHECK-NO-OUT. 0173 MOVE DESCRIPTION-IN TO DESCRIPTION-OUT. 0174 IF CHECK-NO-IN IS NOT NUMERIC 0175 ADD      CING 2 LINES. 0231 MOVE SUMMARY TO PRINT-REC. 0232 WRITE PRINT-REC BEFORE ADVANCING 3 LINES. 0233 MOVE TRANS-C 0245 MOVE CHECK-TOTAL-IN TO CHECK-TOTAL-OUT. 0246 MOVE CHECKS TO PRINT-REC. 0247 WRITE PRINT-REC BEFORE ADVANCING 2 LINES. 0248 MOVE BAL1-IN TO BALANCE1-OUT. 0249 MOVE END-BALANCE TO PRINT-REC. 0250 WRITE PRINT-REC BEFORE ADVANCING PAGE. 0251 END-PAR. 0252 CLOSE CKFILE1. 0253 CLOSE PRINT-OUT. 0254 STOP RUN. 0255 END PROGRAM EZCHECK. B 10500 : 'PUT & INCREMENT 1090 PRINT : PRINT "ACCOUNT NUMBER"; ACCOUNT.NO; "ASSIGNED" 1100 CLOSE : RETURN 2000 ' ENTER NEW BILL TO BE PAID 2010 OPEN "R",1,F1$,64 : GOSUB 9000 : AF=2 : GOTO 12000: 'FIELD + INPUT ACCOUNT NO. 2020 INPUT "AMOUNT OF BILL ? ", TOTAL.DUE 2030 AF=2 : GOSUB 2600 : 'INPUT DATE 2040 DUE.DATEX$=Z$: BALANCE = VAL(BALANCE$) + TOTAL.DUE 2050 PRINT "NEW BALANCE IS";: PRINT USING F8$;BALANCE 2060 GOSUB 10000 : CLOSE : RETURN 2400 ' YES/NO 2410 RESPONSE$=INPUT$(1): 00 'necessary 270 PRINT: AF=1 : GOSUB 2600: DATE$=Z$: 'INPUT DATE 280 PRINT CHR$(12);STRING$(2,10) 290 PRINT "ACCOUNTS PAYABLE SYSTEM";TAB(50);DATE$ 300 PRINT:PRINT 310 PRINT "ALLOWABLE OPTIONS ARE:" 320 PRINT 330 PRINT "A=ENTER A NEW ACCOUNT";TAB(36);"B=ENTER A NEW BILL" 340 PRINT "C=PAY A BILL";TAB(36);"D=PAYMENT (NOT WITH BILL)" 350 PRINT "E=PRINT BILLS DUE THIS MONTH";TAB(36);"F=LIST CURRENT ACCOUNTS" 360 PRINT "G=LIST ACCOUNT HISTORY";TAB(36);"H=LIST SPECIFIC ACCOUNT" 370 PRINT "I=EDIT AN ACPRINT RESPONSE$ 2420 ANSWER = 2 2440 IF LEFT$(RESPONSE$,1) ="Y" THEN ANSWER=YES 2450 IF LEFT$(RESPONSE$,1)="N" THEN ANSWER=NO 2460 IF LEFT$(RESPONSE$,1)="E" THEN ANSWER=ESCAPE: GOTO 440 2470 IF ANSWER<>2 THEN RETURN 2480 PRINT : PRINT "Please respond 'YES' or 'NO'"; 2490 GOTO 2410 2500 ' ACCOUNT NOT FOUND 2510 PRINT : PRINT "ACCOUNT NOT FOUND" 2520 GOSUB 3700: RETURN: 'PRINT ACCOUNT NUMBERS TO CRT 2600 ' CHECK DATE 2605 IF AF=1 THEN INPUT "TODAYS DATE ? ",Z$ 2610 IF AF=2 THEN INPUCOUNT";TAB(36);"J=RUN SYSTEM MENU" 375 PRINT "K=END PROGRAM" 380 PRINT:PRINT:PRINT:PRINT 390 PRINT "OPTION (?=LIST OPTIONS) ? "; : OP$=INPUT$(1): PRINT OP$ 400 IF OP$="?" THEN 280 410 OP=ASC(OP$)-64 420 IF OP < 1 OR OP > 11 OR OP<>INT(OP) THEN 390 430 ON OP GOSUB 1000,2000,3000,4000,5000,6000,7000,8000,8500,20000,25000 440 PRINT: PRINT: TT=0: AF=0: FL=0: Z=0: Z$="": CLOSE 445 BALANCE=0: BALANCE$="": TOTAL.DUE=0: TOTAL.DUE$="" 450 GOTO 390 1000 ' ENTER A NEW ACCOUNT 1010 PRINT: LINE INPUT 1 REM ******************************************* 2 ' 3 ' ACCOUNTS PAYABLE 4 ' Version 2.0 5 ' 6 ' WRITTEN BY BRUCE LEVISON 7 ' SEPTEMBER 1979 8 ' 9 REM ******************************************* 10 ' 12 ' 01/10/81 Fixed the bug in the initialization routine 13 ' by adding the automatic initilization 14 ' of data files when they are empty. The program 15 ' now takes care of the initialization automatically. (BL) 16 ' 100 WIDTH 64 120 YES=-1 : NO=0 : ESCAT "DUE DATE ? ",Z$ 2620 IF AF=3 THEN INPUT "DATE OF PAYMENT ? ",Z$ 2630 IF AF=4 THEN INPUT "DATE OF CHECK ? ",Z$ 2640 IF AF=5 THEN INPUT "DATE PAYED ? ",Z$ 2650 IF AF=6 THEN INPUT "DATE WRITTEN ? ",Z$ 2660 IF LEN(Z$)=0 AND AF<>1 THEN Z$=DATE$ : GOTO 2680 2670 IF LEN(Z$)<>8 OR MID$(Z$,6,1)<>"/" THEN PRINT : PRINT "FORMAT IS mm/dd/yy" : GOTO 2600 2680 AF=0 : RETURN 2700 ' PRINT CRT HEADER 2705 PRINT CHR$(12): PRINT: PRINT 2710 PRINT TAB(5);Z$;TAB(46);"DATE: ";DATE$ :PRINT : PRINT 2715 IF FL="ACCOUNT NAME ? "; ACCOUNT.NAMEX$ : IF ACCOUNT.NAMEX$="ESCAPE" THEN RETURN 1020 INPUT "CLASSIFICATION TYPE NUMBER ? ", Z$ : IF Z$="?" THEN GOSUB 3810 : GOTO 1020 1030 IF VAL(Z$)<0 OR (VAL(Z$)>25 AND VAL (Z$)<>99) OR VAL (Z$)<>INT(VAL(Z$)) THEN PRINT: PRINT "No such classification number": PRINT: GOSUB 3810: GOTO 1020 1040 TYPE=VAL(Z$) 1050 OPEN "R",1,F1$,64 : GOSUB 9000 : 'FIELD 1060 GET #1,1 : WREC = VAL(WREC$) 1070 TOTAL.DUE=0 : BALANCE=0 : DUE.DATEX$="" : ACCOUNT.NO=WREC -1 1080 GOSUB 10000 : GOSUPE=1 170 HD$="AC.# ACCOUNT TOTAL BALANCE DATE DUE" 180 HC$="AC.# ACCOUNT PAYMENT CHK NUM CHK DATE" 190 SP$="---- -------------------- --------- --------- --------" 200 TR$=STRING$(64,45) 205 M1$="MENU.FIN" 210 F1$="CURRENT.PAY" : F2$="HISTORY.PAY" 220 F6$="########" 230 F5$="####" 240 F9$="\ \" 250 F8$="$$#####.##" 260 F7$="\ \" 262 Z$=F1$: GOSUB 50000 'Initialize files to empty if 266 Z$=F2$: GOSUB 500   1 THEN PRINT HC$: PRINT SP$: RETURN 2720 PRINT HD$ : PRINT SP$: RETURN 2750 ' PRINT LINE PRINTER HEADERS 2760 LPRINT CHR$(14); : LPRINT TAB(1);Z$; : LPRINT CHR$(15); : LPRINT TAB(34);"DATE: ";DATE$ : LPRINT : LPRINT 2765 IF FL=1 THEN LPRINT HC$: LPRINT SP$: RETURN 2770 LPRINT HD$ : LPRINT SP$: RETURN 2780 ' PRINT TRAILER 2790 PRINT TR$: RETURN 2795 ' PRINT LPRINTER TRAILER 2800 LPRINT STRING$(64,"-"): RETURN 3000 ' PAY A BILL 3010 OPEN "R",1,F1$,64 : GOSUB 9000 : AF=3 r 'C','M' or 'A'": GOTO 4010 4035 ' Micellaneous 4040 INPUT "CLASSIFICATION TYPE NUMBER ? ",Z$ : IF Z$="?" THEN GOSUB 3820: GOTO 4040 4050 IF VAL(Z$)<0 OR (VAL(Z$)>25 AND VAL(Z$)<>99) OR VAL (Z$)<>INT(VAL(Z$)) THEN PRINT : PRINT "No such classification number" : PRINT: GOSUB 3810: GOTO 4040 4060 TYPE=VAL(Z$) : ACCOUNT.NO=-1 4070 INPUT "FOR WHAT (Payee) ? ",ACCOUNT.NAMEX$ 4075 ' Cash 4080 PRINT "PAYMENT BY CHECK ? "; : GOSUB 2400 4085 IF LEFT$(OP$,1)="M" THEN 4100 4090 ACCOUNT.NO=0 : ACCOUNT.Nunt numbers are: ": PRINT: GET #3,1: WREC=VAL(AA$): RECORDS=1 3725 PRINT USING F5$;YES;: PRINT " = ";: PRINT USING F9$;"MICELLANEOUS", 3727 PRINT USING F5$;NO;: PRINT " = ";: PRINT USING F9$;"CASH", 3730 WHILE (WREC-1)-RECORDS<>0 3740 RECORDS=RECORDS+1: GET #3,RECORDS 3750 PRINT USING F5$;VAL(BB$); : PRINT " = "; : PRINT USING F9$;CC$, 3760 WEND 3770 CLOSE #3: PRINT: PRINT 3780 RETURN 3810 ' PRINT TYPE CLASSIFICATION NUMBERS TO CRT 3820 ' 3830 PRINT: PRINT "CLASSIFICATIONS ARE." : PRINT 384: GOTO 12000 3020 BALANCE=VAL(BALANCE$) 3030 PRINT "BALANCE DUE IS";: PRINT USING F8$;BALANCE 3040 INPUT "AMOUNT OF PAYMENT ? ",Z 3050 PRINT "PAYMENT BY CHECK "; : GOSUB 2400 : IF ANSWER=YES THEN GOTO 3100 3060 CHECK.NO=0 3070 AF=3 : GOSUB 2600 : 'INPUT DATE 3090 GOTO 3130 3100 INPUT "CHECK NUMBER ? ", CHECK.NO 3110 AF=4 : GOSUB 2600: ' INPUT DATE 3130 DUE.DATEX$=Z$ : BALANCE=BALANCE-Z : TOTAL.DUE=VAL(TOTAL.DUE$) 3140 GOSUB 10000 : CLOSE : 'PUT 3150 OPEN "R",1,F2$,64 : GOSUB 9000 : GET#1,1 : WREAMEX$="CASH" : TYPE=0 4100 IF ANSWER=YES THEN GOTO 4130 4110 INPUT "AMOUNT OF PAYMENT ? ", TOTAL.DUE : BALANCE=0 4120 AF=5 : GOSUB 2600 : GOTO 4160 4130 INPUT "AMOUNT OF CHECK ? ", TOTAL.DUE 4140 INPUT "CHECK NUMBER ? ", BALANCE 4150 AF=6 : GOSUB 2600 : 'INPUT DATE 4160 DUE.DATEX$=Z$ 4170 OPEN "R",1,F2$,64 : GOSUB 9000 4180 GET #1,1 : WREC=VAL(WREC$) 4190 GOSUB 10000 : GOSUB 10500 : 'PUT & INCREMENT 4200 CLOSE: PRINT: PRINT "ANOTHER WITHOUT A BILL ? ";: GOSUB 2400: IF ANSWER=YES THEN 4000 ELSE RE0 PRINT "0-CASH";TAB(30);"1-GROCERY & DRUGIST" 3850 PRINT "2-CLOTHS";TAB(30);"3-DRY CLEANERS" 3860 PRINT "4-CREDIT CARDS";TAB(30);"5-MORGATGE & UTILITIES" 3870 PRINT "6-TELEPHONE";TAB(30);"7-DOGS" 3880 PRINT "8-DOCTORS";TAB(30);"9-DENTIST" 3890 PRINT "10-BEAUTY (HAIRDRESSER)";TAB(30);"11-SUBSCRIPTIONS" 3900 PRINT "12-CHARITY";TAB(30);"13-TAXES/FED" 3910 PRINT "14-TAXES/STATE";TAB(30);"15-LARGE PURCHASE" 3915 PRINT "16-HOUSEKEEPER";TAB(30);"17-WORK RELATED" 3920 PRINT "18-INSURANCE";TAB(30);"19-JEWLC=VAL(WREC$) 3160 TOTAL.DUE=Z : BALANCE=CHECK.NO 3170 GOSUB 10000 : GOSUB 10500 : 'PUT/INCREMENT 3180 CLOSE : RETURN 3420 ' RECORD WRITE TO CRT SUBROUTINE 3440 PRINT USING F5$;VAL(ACCOUNT.NO$); : PRINT " "; 3450 PRINT USING F9$;ACCOUNT.NAME$; 3460 PRINT USING F8$;VAL(TOTAL.DUE$); : PRINT SPC(2); 3470 IF FL=1 THEN PRINT " ";: PRINT USING F6$;VAL(BALANCE$); : PRINT SPC(4); : GOTO 3490 3480 PRINT USING F8$;VAL(BALANCE$);: PRINT SPC(3); 3490 PRINT USING F7$;DUE.DATE$ 3500 RETURN 3520 ' TURN 4205 ' Account 4210 OPEN "R",1,F1$,64 : GOSUB 9000 : 'FIELD 4220 AF=4 : GOTO 12000 : 'INPUT ACCOUNT# 4260 CLOSE 4270 PRINT : PRINT "PAYMENT BY CHECK ? "; : GOSUB 2400 : GOTO 4100 5000 ' BILLS DUE THIS MONTH 5005 PRINT "TTY ? ";: GOSUB 2400: IF ANSWER=YES THEN AF=1 5010 OPEN "R",1,F1$,64 : GOSUB 9000 : 'OPEN AND FIELD 5030 Z$="BILLS DUE THIS MONTH" 5040 IF AF=1 THEN GOSUB 2750 : 'PRINT LPRINTER HEADER 5050 GOSUB 2700 : 'PRINT CRT HEADER 5060 TT=0 : GET #1,1 5070 FOR WREC=2 TO VAL(ERY" 3924 PRINT "20-GIFTS ";TAB(30);"21-AUTOMOBILE" 3925 PRINT TAB(13);"99-MISCELLANEOUS" 3928 REM IF YOU ADD MORE THAN 25 CLASSIFICATION TYPES LINES 1030 AND 4050 MUST BE CORRECTED 3929 PRINT 3930 RETURN 4000 ' PAYMENT (NOT WITH BILL) 4010 PRINT : PRINT "FOR 'CASH','MISCELLANEOUS' OR 'ACCOUNT' ? "; : OP$=INPUT$(1): PRINT OP$: IF LEFT$(OP$,1)="E" THEN RETURN 4020 IF LEFT$(OP$,1)="A" THEN GOTO 4210 4030 IF LEFT$(OP$,1)="C" THEN GOTO 4080 4032 IF LEFT$(OP$,1)<>"M" THEN PRINT "You must entePRINT ON LINE PRINTER SUBROUTINE 3530 LPRINT USING F5$;VAL(ACCOUNT.NO$); : LPRINT SPC(2); 3540 LPRINT USING F9$;ACCOUNT.NAME$; 3550 LPRINT USING F8$;VAL(TOTAL.DUE$); : LPRINT SPC(2); 3560 IF FL=1 THEN LPRINT " ";: LPRINT USING F6$;VAL(BALANCE$); : LPRINT SPC(4); : GOTO 3580 3570 LPRINT USING F8$;VAL(BALANCE$); : LPRINT SPC(3); 3580 LPRINT USING F7$;DUE.DATE$ 3590 RETURN 3700 ' PRINT ACCOUNT NUMBERS TO CRT 3710 OPEN "R",3,F1$,64: FIELD #3,4 AS AA$,4 AS BB$,30 AS CC$: PRINT 3720 PRINT "Acco    WREC$)-1 5080 GET #1,WREC 5090 IF VAL(BALANCE$)=0 THEN 5110 5100 IF LEFT$(DUE.DATE$,2)<=LEFT$(DATE$,2) THEN GOSUB 3420 : TT=TT+VAL(BALANCE$) : IF AF=1 THEN GOSUB 3520 5110 NEXT WREC : GOSUB 2790: IF AF=1 THEN GOSUB 2800: 'PRINT TRAILER 5120 IF AF=1 THEN LPRINT TAB(44);: LPRINT USING F8$; TT: LPRINT CHR$(12) 5130 PRINT TAB(44);: PRINT USING F8$; TT: PRINT 5140 CLOSE: RETURN 6000 ' LIST CURRENT ACCOUNTS 6010 PRINT "PRINT ON TTY ? ";: GOSUB 2400: IF ANSWER=YES THEN AF=1 6020 OPEN "R",1,F1$,64:64 AS ZZ$ 9030 RETURN 10000 ' PUT DATA RECORD 10010 LSET ZZ$=STRING$(64,CHR$(32)) 10020 LSET WREC$=STR$(WREC) 10030 LSET ACCOUNT.NO$=STR$(ACCOUNT.NO) 10040 LSET ACCOUNT.NAME$=ACCOUNT.NAMEX$ 10050 LSET TOTAL.DUE$=STR$(TOTAL.DUE) 10060 LSET BALANCE$=STR$(BALANCE) 10070 LSET DUE.DATE$=DUE.DATEX$ 10080 IF LEFT$(STR$(TYPE),1)=" " THEN LSET TYPE$=MID$(STR$(TYPE),2) ELSE LSET TYPE$=STR$(TYPE) 10090 PUT #1,WREC : RETURN 10400 ' INCREMENT AND PUT NEXT AVAILABLE RECORD COUNTER 10500 LSET ZZ$HEN GOTO 8570 8520 OPEN "R",1,F1$,64: GOSUB 9000 8530 AF=6: GOTO 12000: 'GET ACCOUNT NUMBER 8540 PRINT: GOSUB 3420: PRINT TYPE$: 'PRINT TO CRT 8550 PRINT: PRINT "THIS TO BE EDITED ? ";: GOSUB 2400: IF ANSWER=NO THEN 2500: GOTO 8500 8560 GOTO 8650 8570 FL=1: OPEN "R",1,F2$,64: GOSUB 9000 8580 AF=7: GOTO 12000: 'GET ACCOUNT NUMBER 8590 GET #1,1: Z=VAL(WREC$) 8600 FOR WREC=2 TO Z 8610 GET #1,WREC: IF ACCOUNT.NO=VAL(ACCOUNT.NO$) THEN PRINT: GOSUB 3420: PRINT TYPE$: GOTO 8640 8620 NEXT WREC 8630 PRI GOSUB 9000: Z$="CURRENT ACCOUNTS" 6030 IF AF=1 THEN GOSUB 2750: 'LPRINT HEADER 6040 GOSUB 2700: 'PRINT HEADER 6050 TT=0: GET #1,1 6060 FOR WREC=2 TO VAL(WREC$)-1 6070 GET #1,WREC: TT=TT+VAL(BALANCE$) 6075 IF AF=1 THEN GOSUB 3520 6080 GOSUB 3420 6090 NEXT WREC 6100 GOSUB 2790: 'PRINT TRAILER 6110 IF AF=1 THEN GOSUB 2800: LPRINT TAB(44);: LPRINT USING F8$;TT: LPRINT CHR$(12) 6120 PRINT TAB(44);: PRINT USING F8$;TT 6125 PRINT STRING$(3,23) 6130 CLOSE: RETURN 7000 ' LIST ACCOUNT HISTORY 7=STRING$(64,CHR$(32)) 10510 LSET WREC$=STR$(WREC+1) 10520 PUT #1,1 : RETURN 12000 ' INPUT ACCOUNT NUMBER AND GET RECORD 12010 PRINT: INPUT "ACCOUNT NUMBER ? ",Z$ : IF LEFT$(Z$,1)="E" THEN CLOSE : RETURN 12020 IF LEFT$(Z$,1)="?" THEN GOSUB 3700: GOTO 12010 12030 IF VAL(Z$)=0 AND (AF=2 OR AF=3 OR AF=4) THEN PRINT: PRINT "You've entered a value that evaluates to zero": PRINT "Enter a NUMBER that is greater than zero.": PRINT SPC(21);"or": PRINT "If the account is CASH then use OPTION D.": GOTO 120NT: PRINT "ACCOUNT NOT FOUND": CLOSE: GOTO 8500 8640 PRINT: PRINT "THIS TO BE EDITED ? ";: GOSUB 2400: IF ANSWER=NO THEN 8620 8650 PRINT "CHANGE WHAT FIELD ? ";: Z$=INPUT$(1): PRINT Z$: IF VAL(Z$)<1 OR VAL(Z$)>6 THEN PRINT: PRINT "The fields are numbered 1 thru 6": GOTO 8650 8660 Z=VAL(Z$) 8670 IF Z=1 THEN PRINT "ARE YOU SURE YOU WANT TO CHANGE THE ACCOUNT NUMBER ? ";: GOSUB 2400: IF ANSWER=N0 THEN 8650 8675 PRINT "RETYPE FIELD";Z; 8680 IF Z=1 THEN INPUT ACCOUNT.NO: LSET ACCOUNT.NO$=STR$(ACCOUNT.NO) 010 PRINT "PRINT ON TTY ? ";: GOSUB 2400: IF ANSWER=YES THEN Z=1 7015 OPEN "R",1,F2$,64: GOSUB 9000 7020 AF=5: GOTO 12000: 'INPUT ACCOUNT NUMBER 7030 Z$="ACCOUNT HISTORY": TT=0: FL=1 7050 IF Z=1 THEN GOSUB 2750: 'LPRINT HEADER 7060 GOSUB 2700: 'PRINT HEADER 7070 GET #1,1 7080 FOR WREC=2 TO VAL(WREC$)-1 7090 GET #1,WREC 7100 IF VAL(ACCOUNT.NO$)=ACCOUNT.NO THEN GOSUB 3420: TT=TT+VAL(TOTAL.DUE$): IF Z=1 THEN GOSUB 3520 7110 NEXT WREC 7120 GOSUB 2780: IF Z=1 THEN GOSUB 2800: LPRINT TAB(32);: LPRINT U10 12035 IF AF=7 THEN ACCOUNT.NO=VAL(Z$): AF=0: GOTO 8590 12050 ACCOUNT.NO=VAL(Z$) : WREC=ACCOUNT.NO+1 12055 IF AF=5 THEN 12075 12060 GET #1,WREC 12070 IF LEFT$(ACCOUNT.NAME$,1)=CHR$(0) THEN GOSUB 2500 : GOTO 12010 12075 IF AF=5 THEN ACCOUNT.NO=VAL(Z$): AF=0: GOTO 7030 12076 IF AF=6 THEN AF=0: GOTO 8540 12077 IF AF=8 THEN AF=0: GOTO 8025 12080 PRINT : PRINT "ACCOUNT NUMBER";ACCOUNT.NO;"IS ";ACCOUNT.NAME$ 12090 PRINT "CORRECT ? "; : GOSUB 2400 : IF ANSWER=NO THEN GOTO 12010 12100 ACCOUNT.NAMEX$=AC8690 IF Z=2 THEN INPUT ACCOUNT.NAMEX$: LSET ACCOUNT.NAME$=ACCOUNT.NAMEX$ 8700 IF Z=3 THEN INPUT TOTAL.DUE: LSET TOTAL.DUE$=STR$(TOTAL.DUE) 8710 IF Z=4 THEN INPUT BALANCE: LSET BALANCE$=STR$(BALANCE) 8720 IF Z=5 THEN INPUT DUE.DATEX$: LSET DUE.DATE$=DUE.DATEX$ 8730 IF Z=6 THEN INPUT TYPE: LSET TYPE$=MID$(STR$(TYPE),2) 8740 PUT #1,WREC: CLOSE: RETURN 9000 ' FIELD 9010 FIELD #1, 4 AS WREC$,4 AS ACCOUNT.NO$,30 AS ACCOUNT.NAME$,8 AS TOTAL.DUE$,8 AS BALANCE$,8 AS DUE.DATE$,2 AS TYPE$ 9020 FIELD #1,SING F8$;TT: LPRINT CHR$(12) 7130 PRINT TAB(32);: PRINT USING F8$;TT: PRINT 7140 CLOSE 1: RETURN 8000 ' LIST SPECIFIC ACCOUNT 8010 PRINT "TTY ? ";: GOSUB 2400: IF ANSWER=YES THEN FL=1 8020 OPEN "R",1,F1$,64: GOSUB 9000: AF=8: GOTO 12000 8025 Z$="SPECIFIC ACCOUNT" 8030 GOSUB 2700: GOSUB 3420: IF FL=1 THEN GOSUB 2750: GOSUB 3520: GOSUB 2800 8040 GOSUB 2780 8050 CLOSE: RETURN 8500 ' EDIT AN ACCOUNT 8510 PRINT: PRINT "IS IT A CURRENT ACCOUNT TO BE EDITED ? ";: GOSUB 2400: IF ANSWER=NO T   COUNT.NAME$ : TYPE=VAL(TYPE$) 12110 IF AF=2 THEN AF=0 : GOTO 2020 12120 IF AF=3 THEN AF=0 : GOTO 3020 12130 IF AF=4 THEN AF=0 : GOTO 4260 20000 ' RUN SYSTEM MENU 20010 CLOSE 20020 RUN M1$ 25000 RESET: END 50000 ' INITIALIZE FILES TO EMPTY 50005 OPEN "R",1,Z$,64 50010 IF LOF(1)>0 THEN CLOSE: RETURN 50013 PRINT 50014 PRINT "Initializing ";Z$ 50020 FIELD #1,4 AS WREC$,60 AS ZZ$ 50030 LSET WREC$="2": PUT #1,1 50040 CLOSE: RETURN INT 50014 PRINT "Initializing ";Z$ 50020 FIELD #1,xָ&6-OĆx̩o$Ϙ /wU~2<32JLnͼ},IJ#^/No8z XKKu#saFajqFM"F־=DI+Li=Y\Jg.U݉h{Xȧۉ0%sߣzX Ye/ҋHCn꺘݌MZɒkf36'sةG' dX3O&`P淲 `sWȝql+}i p4[hҀ\DWer.n (N2]l[P?,X?xF杞 =D6vd's^1' q^nYRq&%|v' )+9ćSy֥HV ߶%-54O&h;8ʙ5S | %Tw?|ou0/lk=J·PeFئ֮ UEɀ&\2ȿl5 "$CD) UAَנ#%-w$ARNζ^剫8wp>֦,[S"Yδ 9@} Ww pMyV탔B5,ĝA#֟Gg{Cn꺘݌MZɒkf36'sةG' dX3O&`P淲 `sWȝql+}i p'r7#"^;+q\Ycּi n;wpxM/*]IA) Y|H '&R a[ܐ߆$rtd$ (s_Ɉ73[ ;á\c7K^}e.m= a+%,4!x _<5>FqG)F׀ae!HJ/] <`whww.e({p# Б(Fx#_igBAsdc=#M! KL7h/^3kY\ ʺB։]름kKkZ UM'=J9;n1%O/R<"`,}#^_XmqK&[ 0Hkl]FKfOO'D'IŮ7:vat%iG\$Q؍i kpO' VG/VGq:\VHJ% F 5Pk}9"r5iwp(KsN0_qY܇e&mxUe' [9-^ jwdgZlݭ®ihi}!dz$Xr;ϯK1DO/'eOm',C\J; 1 THEN GOTO 800 770 INPUT " IS FORM ALIGNMENT OK ? (Y-N) ";G$ 780 IF G$ <> "Y" THEN GOTO 750 800 NEXT I 820 GOTO 100 840 END TO 800 770 INPUT " IS FORM ALIGNMENT OK ? (Y-N) ";G$ 780 IF G$ <> "Y" THEN GOTO 750 800 NEXINPUT "LOOK OK ? Y=YES N=NO E=EXIT PROGRAM ";OKAY$ 720 IF OKAY$ = "E" THEN GOTO 100 740 IF OKAY$ <> "Y" THEN GOTO 170 745 FOR I = 1 TO L 750 LPRINT:LPRINT 752 LPRINT N$:LPRINT O$:LPRINT S$ 754 LPRINT LEFT$ (C$+SPACES$,25):LPRINT Z$ 756 LPRINTATE (NO COMMA)";C$ 220 INPUT " ZIPCODE";Z$ 230 PRINT 233 IF U = 1 THEN GOTO 600 240 PRINT "******************************"; " "; 250 PRINT "******************************" 260 PRINT N$;TAB(36);N$ 270 PRINT O$;TAB(36); O$ 280 PRINT S$;TAB(36); S$ 290 PRINT LEFT$ (C$+SPACES$,25); TAB(36); 300 PRINT LEFT$ (C$+SPACES$,25) 305 PRINT Z$; TAB(36);Z$ 310 PRINT "******************************"; " "; 320 PRINT "******************************":PRINT 330 INPUT " LOOK OK ? Y=YES N=NO E=EXIT PROGRAM ";OKAY$ 335 IF OKAY$ = "E" THEN GOTO 100 340 IF OKAY$ <> "Y" THEN GOTO 170 370 FOR I = 1 TO L/2 380 LPRINT:LPRINT 390 LPRINT N$;TAB(36);N$ 400 LPRINT O$;TAB(36); O$ 410 LPRINT S$;TAB(36); S$ 420 LPRINT LEFT$ (C$+SPACES$,25); 430 LPRINT TAB(36);LEFT$ (C$+SPACES$,25) 435 LPRINT Z$; TAB(36);Z$ 450 LPRINT:LPRINT 452 IF I > 1 THEN GOTO 460 453 INPUT "...FORM ALIGNMENT PAUSE: OK ? (Y-N)";G$ 456 IF G$ <> "Y" THEN GOTO 380 460 NEXT I 480 GOTO 100 6 GOTO 50 7 SAVE "LABELS.BAS",A:STOP 10 'LABELS.BAS MBASIC 5.2 BASCOM 5.30 CP/M 2.2 08/81 20 ' PRINTS MAILING LABELS OR RETURN ADDRESS 30 ' LABELS OF A SPECIFIED QUANTITY OF A SINGLE NAME/ADDR 40 SPACES$ = " " 50 N$ = " " 55 O$ = " " 60 S$ = " " 65 C$ = " " 70 Z$ = " " 100 PRINT CHR$(27);CHR$(69); 'REM CLEAR ZENITH 490 '-------------------------------------------------- 600 ' 1-UP ROUTINE 610 PRINT "******************************" 620 PRINT N$:PRINT O$:PRINT S$: 630 PRINT LEFT$ (C$+SPACES$,25) 640 PRINT Z$ 650 PRINT "******************************":PRINT 700 INPUT "LOOK OK ? Y=YES N=NO E=EXIT PROGRAM ";OKAY$ 720 IF OKAY$ = "E" THEN GOTO 100 740 IF OKAY$ <> "Y" THEN GOTO 170 745 FOR I = 1 TO L 750 LPRINT:LPRINT 752 LPRINT N$:LPRINT O$:LPRINT S$ 754 LPRINT LEFT$ (C$+SPACES$,25):LPRINT Z$ 756 LPRINT SCREEN 110 PRINT TAB(30);"L A B E L S" 120 PRINT:INPUT " PRINT 1-UP OR 2-UP (1 OR 2)";U 123 U = INT (U): IF U < 1 OR U > 2 THEN GOTO 120 130 PRINT:INPUT " HOW MANY LABELS (1-200 0 to exit)";L 140 L = INT (L) 145 IF L=0 THEN SYSTEM 150 IF L < 1 OR L > 200 THEN 130 160 IF L/2 <> INT (L/2) THEN L = L + 1 170 PRINT 180 INPUT " NAME (NO COMMA)";N$ 190 INPUT " ORGANIZATION";O$ 200 INPUT " STREET";S$ 210 INPUT "CITY & ST    "COMMSN.BAS" Robert S. Blacher Washington, D.C. August, 1983 Th purpos o thi progra i t calculat an compar th commission charge b Merril Lync an Charle Schwa fo transactions involving common stocks. The program is written in Microsoft Basic-80, Version 5. Th progra i self-prompting Th progra wil as yo t ente o fo whethe yoE 2100 PRINT "*************************";" "; 2200 PRINT "*************************" 2300 PRINT N$;TAB(27);N$ 2400 PRINT O$;TAB(27); O$ 2500 PRINT S$;TAB(27); S$ 2600 PRINT LEFT$ (C$+SPACES$,25); TAB(27); 2700 PRINT LEFT$ (C$+SPACES$,25) 2800 PRINT Z$; TAB(27);Z$ 2900 PRINT "*************************"; " "; 3000 PRINT "*************************":PRINT 3100 PRINT " LOOK OK ? Y=YES N=NO E=EXIT PROGRAM "; 3200 OKAY$=INPUT$(1) 3300 IF OKAY$ = "E" OR OKAY$ = "e" THEN GOTO 100 34001 'LABELS3.BAS MBASIC 5.2 CP/M 05/82 TEM 2 'PRINT LABELS ONE, TWO, OR THREE UP. 6 GOTO 50 7 SAVE "LABELS3.BAS",A:STOP 40 SPACES$ = " " 50 N$ = " " 55 O$ = " " 60 S$ = " " 65 C$ = " " 70 Z$ = " " 90 DEFINT A-Z: WIDTH 80 100 PRINT:PRINT 110 PRINT TAB(20);"L A B E L S" 130 PRINT 150 PRINT ar buyin o selling th numbe o shares an th pric pe share Th progra wil the d th rest. Th fee calculate fo Merril Lync ar fo transaction involvin 1,00 share o les i an dolla amount Fo Schwab th progra i accurat u t $56,00 regardles o th numbe o shares. Th autho o thi progra i no associate i an wa wit eithe Merril Lync o Schwa an take n positio o whethe o no yo shoul trad wit discoun broker IF OKAY$ = "N" OR OKAY$ = "n" THEN GOTO 1200 3500 FOR I = 1 TO L/U 'HOW MANY LINES TO PRINT? 3600 LPRINT:LPRINT 3700 IF U = 3 THEN GOTO 4600 'GO DO 3-UP PRINTING, NOT 2-UP 3800 LPRINT N$;TAB(27);N$ 3900 LPRINT O$;TAB(27); O$ 4000 LPRINT S$;TAB(27); S$ 4100 LPRINT LEFT$ (C$+SPACES$,25); 4200 LPRINT TAB(27);LEFT$ (C$+SPACES$,25) 4300 LPRINT Z$; TAB(27);Z$ 4400 GOTO 5300 'DONE 2-UP 4500 ' THREE-UP PRINT ROUTINE 4600 LPRINT N$;TAB(27); N$;TAB(53);N$ 4700 LPRINT O$;TAB(27); O$;TAB( " Prints labels of up to five lines each." 160 PRINT "Each field may contain a total of 25 characters max." 170 PRINT "The lines are: Name, Organization, Street address," 175 PRINT "City and State, and Zip code. 180 PRINT "You may omit any line(s). Do NOT use commas." 200 PRINT "Prints one, two, or three across in 80 columns." 300 PRINT:PRINT " PRINT 1, 2, OR 3-UP (1-3 or 0 to exit)"; 400 INPUT U 500 IF U = 0 THEN SYSTEM 600 IF U < 1 OR U > 3 THEN GOTO 300 700 PRINT:PRINT " Commissio fee ar onl on facto t conside i makin you choic o brokerag houses.  calculate fo Merril Lync ar fo transaction involvin 1,00 share o les i an dolla amount Fo Schwab th progra i accurat u t $56,00 regardles o th numbe o shares. Th autho o thi progra i no associate i an wa wit eithe Merril Lync o Schwa an take n positio o whethe o no yo shoul trad wit discoun broker53);O$ 4800 LPRINT S$;TAB(27); S$;TAB(53);S$ 4900 LPRINT LEFT$ (C$+SPACES$,25); 5000 LPRINT TAB(27);LEFT$ (C$+SPACES$,25); 5100 LPRINT TAB(53);LEFT$ (C$+SPACES$,25) 5200 LPRINT Z$; TAB(27);Z$;TAB(53);Z$ 5300 LPRINT:LPRINT 5400 IF I > 1 THEN GOTO 5700 5500 PRINT "...FORM ALIGNMENT PAUSE: OK ? (Y-N)";:G$=INPUT$(1) 5600 IF G$ = "N" OR G$ = "n" THEN GOTO 3600 5700 NEXT I 5800 GOTO 100 5900 '-------------------------------------------------- 6000 ' 1-UP ROUTINE 6100 PRINT "*********** HOW MANY LABELS (1-300 0 to exit)"; 800 INPUT L 900 IF L=0 THEN SYSTEM 1000 IF L < 1 OR L > 300 THEN 700 1100 IF L/3 <> INT (L/3) THEN L = L + 1: GOTO 1100 1150 GOSUB 25900 'IS PRINTER READY? 1200 PRINT 1300 INPUT " NAME (NO COMMA)";N$ 1400 INPUT " ORGANIZATION";O$ 1500 INPUT " STREET";S$ 1600 INPUT "CITY & STATE (NO COMMA)";C$ 1700 INPUT " ZIPCODE";Z$ 1800 PRINT 1900 IF U = 1 THEN GOTO 6000 2000 ' TWO-UP OR THREE-UP ROUTIN   *******************" 6200 PRINT N$:PRINT O$:PRINT S$: 6300 PRINT LEFT$ (C$+SPACES$,25) 6400 PRINT Z$ 6500 PRINT "******************************":PRINT 6600 PRINT "LOOK OK ? Y=YES N=NO E=EXIT PROGRAM ";:OKAY$=INPUT$(1) 6700 IF OKAY$ = "N" OR OKAY$ = "n" THEN GOTO 100 6800 IF OKAY$ = "E" OR OKAY$ = "e" THEN SYSTEM 6900 PRINT 7000 FOR I = 1 TO L 7100 LPRINT:LPRINT 7200 LPRINT N$:LPRINT O$:LPRINT S$ 7300 LPRINT LEFT$ (C$+SPACES$,25):LPRINT Z$ 7400 LPRINT:LPRINT 7500 IF I > 1 THEN GOTO 7800INTERIOR, V.PERSPECTIVE, H.PERSPECTIVE POSITION 23,5 PRINT " 71 72 73 74 75 76 77 78 79 80 81 82 83" LINEON 86,5,86,135 LINEON 88,8,10,8 RESTORE FOR X = 22 TO 4 STEP -2 READ Y DATA 0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15 POSITION X,1 PRINT Y NEXT X INPUT3 S PRINT CHR(27);"B4" FOR X = 1 TO 90 FOR Y = 160 TO 40 STEP 8 LINEON X,Y,(X+10),(Y-X) INPUT3 S GOTO 0 RSPECTIVE = -1 H.PERSPECTIVE = 1 INTERIOR = 1 BAR V4, H4, H, W, DEPTH, INTERIOR, V.PTIVE REM 1975 V4 = 84 H4 = 50 H = 33 W = 5 DEPTH = 3 V.PERSPECTIVE = -1 H.PERSPECTIVE = 1 INTERIOR = 1 BAR V4, H4, H, W, DEPTH, INTERIOR, V.PERSPECTIVE, H.PERSPECTIVE REM 1976 V4 = 84 H4 = 60 H = 46 W = 5 DEPTH = 3 V.PERSPECTIVE = -1 H.PERSPECTIVE = 1 INTERIOR = 1 BAR V4, H4, H, W, DEPTH, INTERIOR, V.PERSPECTIVE, H.PERSPECTIVE REM 1977 V4 = 84 H4 = 70 H = 55 W = 5 DEPTH = 3 V.PERSPECTIVE = -1 H.PERSPECTIVE = 1 INTERIOR = 1 BAR V4, H4, H, W, DEPTH, INTERIOR, V.PERSPECTIVE, 7600 PRINT " IS FORM ALIGNMENT OK ? (Y-N) ";G$=INPUT$(1) 7700 IF G$ = "N" OR G$ = "n" THEN GOTO 7100 7800 NEXT I 7900 GOTO 100 8000 END 25900 'TEST FOR PRINTER READY RTN 25910 IF (INP(230) AND (48))<>0 THEN GOTO 25990 25920 PRINT:PRINT CHR$(7) 'ONE RINGY DINGY 25930 PRINT " Printer is NOT turned-on, or NOT ready." 25940 INPUT " Press the RETURN key when printer is ready.";Z$ 25950 GOTO 25910 25990 RETURN ned-on, or NOT ready." 25940 INPUT " Press the RETURN key w H.PERSPECTIVE REM 1978 V4 = 84 H4 = 80 H = 50 W = 5 DEPTH = 3 V.PERSPECTIVE = -1 H.PERSPECTIVE = 1 INTERIOR = 1 BAR V4, H4, H, W, DEPTH, INTERIOR, V.PERSPECTIVE, H.PERSPECTIVE REM 1979 V4 = 84 H4 = 90 H = 22 W = 5 DEPTH = 3 V.PERSPECTIVE = -1 H.PERSPECTIVE = 1 INTERIOR = 1 BAR V4, H4, H, W, DEPTH, INTERIOR, V.PERSPECTIVE, H.PERSPECTIVE REM 1980 V4 = 84 H4 = 100 H = 34 W = 5 DEPTH = 3 V.PERSPECTIVE = -1 H.PERSPECTIVE = 1 INTERIOR = 1 BAR V4, H4, H, W, DEPTH, INTERIOR, V.P$INCLUDE GRAPHICS.BAS VAR V1, H1, RADIUS = INTEGER VAR V2, H2, HEIGHT, WIDTH = INTEGER VAR V3, H3, LENGTH = INTEGER VAR V4, H4, H, W, V.PERSPECTIVE, H.PERSPECTIVE, INTERIOR, DEPTH = INTEGER VAR X,O,C = INTEGER VAR S,Y = CHAR 0 CLEAR.SCREEN PRINT " SALES HISTORY SINCE 1971" PRINT CHR(27);"C4"; REM 1971 V4 = 84 H4 = 10 H = 20 W = 5 DEPTH = 3 V.PERSPECTIVE = -1 H.PERSPECTIVE = 1 INTERIOR = 1 BAR V4, H4, H, W, DEPTH, INTERIOR, V.PERSPECTIVE, H.PERSPECTIVE REERSPECTIVE, H.PERSPECTIVE REM 1981 V4 = 84 H4 = 110 H = 50 W = 5 DEPTH = 3 V.PERSPECTIVE = -1 H.PERSPECTIVE = 1 INTERIOR = 1 BAR V4, H4, H, W, DEPTH, INTERIOR, V.PERSPECTIVE, H.PERSPECTIVE REM 1982 V4 = 84 H4 = 120 H = 30 W = 5 DEPTH = 3 V.PERSPECTIVE = -1 H.PERSPECTIVE = 1 INTERIOR = 1 BAR V4, H4, H, W, DEPTH, INTERIOR, V.PERSPECTIVE, H.PERSPECTIVE REM 1983 V4 = 84 H4 = 130 H = 65 W = 5 DEPTH = 3 V.PERSPECTIVE = -1 H.PERSPECTIVE = 1 INTERIOR = 1 BAR V4, H4, H, W, DEPTH, M 1972 V4 = 84 H4 = 20 H = 40 W = 5 DEPTH = 3 V.PERSPECTIVE = -1 H.PERSPECTIVE = 1 INTERIOR = 1 BAR V4, H4, H, W, DEPTH, INTERIOR, V.PERSPECTIVE, H.PERSPECTIVE REM 1973 V4 = 84 H4 = 30 H = 50 W = 5 DEPTH = 3 V.PERSPECTIVE = -1 H.PERSPECTIVE = 1 INTERIOR = 1 BAR V4, H4, H, W, DEPTH, INTERIOR, V.PERSPECTIVE, H.PERSPECTIVE REM 1974 V4 = 84 H4 = 40 H = 60 W = 5 DEPTH = 3 V.PERSPECTIVE = -1 H.PERSPECTIVE = 1 INTERIOR = 1 BAR V4, H4, H, W, DEPTH, INTERIOR, V.PERSPECTIVE, H.PERSPEC   100 REM: ******************** LOAN ********************** 110 REM: 120 REM: PROGRAM TO COMPUTE INTEREST PAYMENTS 130 REM: 140 REM: BY BOB SCALF, 22 APRIL 1978 150 REM: 160 INPUT "INTEREST IN PERCENT";J 170 J=J/100 180 INPUT"AMOUNT OF LOAN";A 190 INPUT"NUMBER OF YEARS";N 200 INPUT"NO. OF PAYMENTS PER YEAR";M 210 N=N*M: I=J/M: B=1+I: R=A*I/(1-1/B^N) 220 A$=" ### $###.## $###.## $#####.##" 230 PRINT:PRINT "AMOUNT PER PAYMENT = "; 240 PRINT USING "$###.##";R 250 PRINT "TO 100 'THIS TRIVIAL ROUTINE CALCULATE THE PRESENT VALUE 110 'OF A NON-CASH SECURITY WHICH AMORTIZES AND/OR PAYS INTEREST 120 'OR DIVIDENDS. 130 'USEFUL IN EVALUATING THE TREATMENT OF A CLAIM BY CHAPTER X 140 'PLAN OF RE-ORG. OR XI ARRANGEMENT (OR SECT 77 RAILROAD REORG.) 1000 REM PV OF CASH FLOW STREAM OF RE-PAYMENTS 2000 DIM B(50),C(50),P(50) 3000 INPUT"STARTING PRINCIPAL";A1 4000 INPUT"DISCOUNT RATE, IN %";A2 5000 FOR N=1 TO 999 6000 INPUT"PAYMENTS AND TIME FROM START IN YEARS";B(N),C(N) 7000 NTAL INTEREST = "; 260 PRINT USING "$#####.##";R*N-A 270 PRINT: B=A 280 X$=" MONTH INTEREST PRINCIPAL PRIN. BALANCE" 290 Y=1 300 PRINT "YEAR -";Y:PRINT 310 PRINT X$ 320 X=1:II=0 330 L=B*I: P=R-L: B=B-P 340 II=II+L 350 PRINT USING A$;X,L,P,B 360 X=X+1 370 IF X<13 THEN 420 380 PRINT:PRINT"INTEREST FOR YEAR - "; 390 PRINT USING "$####.##";II:PRINT 400 X=1:Y=Y+1:PRINT:PRINT "YEAR -";Y:PRINT:PRINT X$:PRINT 410 II=0 420 IF B>=R THEN 330 430 PRINT B*I,R-B*I 440 PRINT "LAST PA XNlYNlLABELC l 1=N1+1 8000 A1=A1-B(N) 9000 GOSUB 13000 10000 PRINT A1,P(N),P2 11000 IF A1<1E-08 THEN 16000 12000 NEXT N 13000 P(N)=B(N)/(1+A2/100)^C(N) 14000 P2=P2+P 15000 RETURN 16000 PRINT:PRINT 17000 PRINT"PAYMENT #","AMOUNT","AFTER YRS.","PRES. VAL." 18000 FOR N=1 TO N1 19000 PRINT N,B(N),C(N),P(N) 20000 B1=B1+B(N):C1=C1+C(N):P1=P1+P(N) 21000 NEXT N 22000 PRINT"---------","----------","-------","----------" 23000 PRINT"TOTAL",B1,"N/A",P1 =C1+C(N):P1=P1+P(N) 21000 NEXT N 22000 PRINT"---------","----YMENT WAS "B*I+B 450 PRINT:PRINT "INTEREST FOR YEAR - "; 460 PRINT USING "$###.##";II:PRINT 470 END B*I 440 PRINT "LAST PAN. BALANCE" 290 Y=1 300 PRINT "YEAR -";Y:PRINT 310 PRINT X$ 320 X=1:II=0 330 L=B*I: P=R-L: B=B-P 340 II=II+L 350 PRINT USING A$;X,L,P,B 360 X=X+1 370 IF X<13 THEN 420 380 PRINT:PRINT"INTEREST FOR YEAR - "; 390 PRINT USING "$####.##";II:PRINT 400 X=1:Y=Y+1:PRINT:PRINT "YEAR -";Y:PRINT:PRINT X$:PRINT 410 II=0 420 IF B>=R THEN 330 430 PRINT B*I,R-B*I 440 PRINT "LAST PA 1 3.30ONE 2 5.50TWO 3 6.60THREE 4 4.50FOUR 5 3.80FIVE 6 2.80SIX 7 7.70SEVEN 8 5.50EIGHT 9 4.90NINE  0 14444-2-3243FF 076.3123.6942.8257.151.332.650.29 0 14444-2-3245FF 076.0223.9943.0256.981.322.660.25 50 52 8 200-2-0496FF 076.7323.2742.5457.461.352.320.49 OK 0 5 130-2-0580FF 076.2423.7742.7457.261.340.000.47     ********* SET UP SUM OF YEARS DIGITS ********* 200 T=0 205 FOR I=1 TO Y : T=T+I : NEXT I 208 REM *** SET UP DOUBLE DECLINING BALANCE PRECENTAGE *** 210 P=(1/Y)*2 212 P=(P+5E-03)*100 : P=INT(P)/100 218 REM ********* SET UP STRAIGHT LINE AMOUNT ********* 220 D1=(C-S)/Y 222 D1=(D1+5E-03)*100 : D1=INT(D1)/100 240 REM ********* PRINT SPECIFIERS ********* 250 L$="## #####.## ######.## #####.## ######.## #####.## ######.##" 262 PRINT " COST : ";C;" USEFUL LIFE : ";Y; 265 PRINT " enly divisable by 5. The program is fairly fast for short data bases but could take awhile for longer files. If your files are real long, I would suggest that you conditionally copy the data you want graphed into a temporary file. Legal Entries: FIELD (X/Y) : Any valid field name or the record number symbol (#) CONDITIONS: Any valid conditional statement including .AND.,.OR., and .NOT. The record number symbol (#) may also be used SALVAGE : ";S 266 PRINT : PRINT TAB(20);STRING$(30,45) : PRINT 267 PRINT " S. LINE S. YRS. DIGITS DBL. DEC BAL." 268 PRINT "YR DEP BAL DEP BAL DEP BAL" 269 PRINT STRING$(69,61) 299 REM ******** WORKING LOOP ******** 300 FOR I=1 TO Y 302 B1=B1-D1 304 IF B1-S < .05 THEN B1=S 312 A=(Y-(I-1))/T : A=(A+5E-03)*100 320 A=INT(A)/100 : D2=A*(C-S) 322 IF B2-D2 < S THEN D2=B2-S 324 B2=B2-D2 328 IF F=1 THEN 360 330 IF B3 <= S THEN D3=0 :. LABELS: Any valid field name. The substring functrion ($) may also be used. This version of the program will run on any terminal with cursor addressing capabilities. I also have versions which will run on the Televidio 950 and H89/Z19 terminals. Leave a message here if you would like to have these uploaded. itional statement including .AND.,.OR., and .NOT. The record number symbol (#) may also be usedUGRAPH.DOC ---> Documentation for UGRAPH.CMD and DEMGRAPH.CMD Written by John Hathaway (3/1/83) The UGRAPH command file is a screen graphics program which will generate bar or scatter graphs on the CRT screen using data from a specified data base file. It requires the input of two numeric fields ( FIELD X and FIELD Y ), a CONDITION ( ie. FIELD X<>0) and a LABEL field if the Bar option is chosen. The data base is first read to determine the minimum and maximum values in each variable f B3=S : GOTO 370 340 D3=B3*P 342 S9=(B3-S)/(Y-(I-1)) 344 IF D3 < S9 THEN D3=S9 : F=1 : GOTO 360 350 IF B3-D3 < S THEN D3=B3-S 360 B3=B3-D3 370 PRINT USING L$; I,D1,B1,D2,B2,D3,B3 380 IF I/10 <> INT(I/10) THEN 400 385 PRINT : PRINT : PRINT : PRINT 390 PRINT "PRESS TO CONTINUE "; : INPUT A$ 400 NEXT I 405 PRINT : PRINT : PRINT 410 PRINT " DO YOU WANT ANOTHER ANALYSIS "; : INPUT Q$ 420 IF LEFT$(Q$,1)="Y" THEN 20 430 REM 9999 END NT : PRINT : PRINT 410 PRINT " DO YOU WANT ANOTHER ANALYSIS20 PRINT : PRINT "** DEPRECIATION ANALYSIS **" : PRINT 21 REM CLEAR EVERYTHING IN CASE WE LOOP 22 A=0 : D1=0 : D2=0 : D3=0 : F=0 : S9=0 : T=0 30 PRINT "ENTER THE FOLLOWING INFORMATION:" : PRINT 40 PRINT TAB(15)"COST OF ASSET :";TAB(40); : INPUT C 50 PRINT TAB(15)"USEFUL LIFE IN YEARS" 60 PRINT TAB(15)"( WHOLE YEARS ONLY ) :";TAB(40); : INPUT Y 70 PRINT TAB(15)"SALVAGE VALUE :";TAB(40); : INPUT S 80 PRINT 90 PRINT 179 REM ********* SET ALL BALANCES TO COST ********* 180 B1=C : B2=C : B3=C 199 REMield using the conditions specified. Then these values are displayed and you are prompted to enter the actual axis endpoints. Since the alphanumeric graphics capabilities of DBASE are fairly limited, the number of intervals on each axis is preset. The Y axis has 4 intervals which means that the difference between the upper endpoint and the lower endpoint must be evenly divisable by 4 (so the labels don't come out like '4.6666666' ). The X axis has 5 intervals so its difference must be ev   100 DEFINT A-Z 110 FILL$="A"+CHR$(7)+"???ERROR" 120 ON ERROR GOTO 0 140 DIM TIT$(9),A3$(52) 160 INPUT "DATA FILE NAME? ",F0$ 180 OPEN "I",1,F0$+".TTL" 200 IF EOF(1) THEN PRINT "ERROR - NO *.TTL TITLES FILE" : STOP 220 FOR I=1 TO 9 240 IF EOF(1) THEN PRINT "ERROR - MUST HAVE 9 ENTRIES IN TITLES FILE.":GOTO 6060 260 INPUT #1,TIT$(I) 280 NEXT I 300 CLOSE 1 320 ON ERROR GOTO 620 340 OPEN "R",1,F0$+".LAB",128 350 FIELD #1,1 AS A0$,127 AS A1$ 360 OPEN "R",2,F0$+".$$$",128 380 FIELD #2,128 AS A2$ 60 GOTO 2040 2280 NLAB=0 2300 A$=INKEY$ 2320 IF LEN(A$)=0 THEN GOTO 2420 2340 IF ASC(A$)=3 THEN GOTO 3040 2360 IF ASC(A$)<>19 THEN GOTO 2420 2380 A$=INKEY$ 2400 IF LEN(A$)=0 THEN GOTO 2380 2420 IF ACT$="I" THEN GOTO 3020 2440 NLAB=NLAB+1 2460 A$ = ACCT$+" "+DATE$+" "+MISC$ 2480 IF A$=STRING$(29," ") THEN A$="" 2500 IF CON THEN PRINT A$ 2520 IF LST THEN LPRINT A$ 2540 I=INSTR(NAM$,";") 2560 A$=RIGHT$(NAM$,25-I) 2580 J=INSTR(A$," ") 2600 IF J=0 THEN GOTO 2720 2620 J=J-1 : K=J 2640 IF K=LE REM 1480 PRINT 1500 PRINT "SHOULD LABELS BE PRINTED TO CONSOLE (C)," 1520 PRINT "LIST DEVICE (L), OR BOTH (B) ? "; 1540 A$=INPUT$(1) : PRINT A$ 1560 IF A$="C" OR A$="C" THEN CON=-1:LST= 0:GOTO 1640 1580 IF A$="L" OR A$="L" THEN CON= 0:LST=-1:GOTO 1640 1600 IF A$="B" OR A$="B" THEN CON=-1:LST=-1:GOTO 1640 1620 GOTO 1480 1640 PRINT 1660 PRINT "FROM THIS POINT ON, SHOULD LABELS BE PRINTED FOR ONLY" 1680 PRINT "SELECTED RECORDS (S) OR FOR ALL (A) ? "; 1700 A$=INPUT$(1) : PRINT A$ 1720 IF A$="S"  400 RNI=1 : RNO=1 420 K=0 440 FOR I=1 TO 52 460 A3$(I)=FILL$ 520 GET #1,RNI : RNI=RNI+1 540 IF EOF(1) THEN GOTO 820 560 IF A0$="I" THEN GOTO 800 580 IF A0$="A" THEN GOTO 760 600 PRINT "PROGRAM ERROR - BAD ACTIVE CODE" : GOTO 6060 620 PRINT "***CAUTION***";CHR$(7);CHR$(7) 640 PRINT "ERROR OCCURRED DURING FILE INPUT/REORGANIZATION - RESTART PROGRAM." 660 PRINT:PRINT "IF ERROR PERSISTS, GO TO BACKUP FILE BY RENAMING FILENAME.BAK" 680 PRINT "TO FILENAME.LAB, RUN PROGRAM, AND RE-ENTER ALL ACTIVITY FN(A$) THEN A$=LEFT$(A$,J):GOTO 2720 2660 K=K+1 2680 IF MID$(A$,K,1)=" " THEN GOTO 2640 2700 J=K : GOTO 2640 2720 IF I>1 THEN A$=A$+" "+LEFT$(NAM$,I-1) 2740 IF CON THEN PRINT A$ 2760 IF LST THEN LPRINT A$ 2780 IF ADDR1$=STRING$(25," ") THEN GOTO 2840 2800 IF CON THEN PRINT ADDR1$ 2820 IF LST THEN LPRINT ADDR1$ 2840 IF CON THEN PRINT ADDR2$ 2860 IF LST THEN LPRINT ADDR2$ 2880 IF CON THEN PRINT CITY$;" ";STATE$;" ";ZIP$ 2900 IF LST THEN LPRINT CITY$;" ";STATE$;" ";ZIP$ 2920 IF CON THEN PRINT 2OR A$="s" THEN GOTO 1780 1740 IF A$="A" OR A$="a" THEN TYP=0 : GOTO 1780 1760 PRINT "PLEASE REPLY 'S' OR 'A'." : GOTO 1640 1780 PRINT 1800 PRINT "DURING LABEL PRINTING:" 1820 PRINT " CONTROL-S WILL SUSPEND PRINTING UNTIL ANY OTHER CHARACTER INPUT" 1840 PRINT " CONTROL-C WILL CANCEL LABEL PRINTING" 1860 PRINT 1880 PRINT "AFTER THIS MESSAGE, THE PROGRAM WILL PAUSE FOR YOUR INPUT." 1900 PRINT "ENTER 'Y' TO IMMEDIATELY BEGIN PRINTING LABELS." 1920 PRINT "ENTER ANYTHING ELSE TO PRODUCE A TEST PATROM" 700 PRINT "LAST RUN." : PRINT 720 ON ERROR GOTO 0 740 GOTO 6060 760 K=K+1 780 A3$(K)=A0$+A1$ 800 NEXT I 820 IF K=0 AND EOF(1) THEN GOTO 940 840 FOR I=1 TO K 860 LSET A2$=A3$(I) 880 PUT #2,RNO : RNO=RNO+1 900 NEXT I 920 IF NOT EOF(1) THEN GOTO 420 940 CLOSE 1 : CLOSE 2 960 NR = RNO-1 980 ON ERROR GOTO 6080 1000 OPEN "I",1,F0$+".BAK" 1020 CLOSE 1 : KILL F0$+".BAK" : GOTO 1060 1040 CLOSE 1 1060 ON ERROR GOTO 0 1080 NAME F0$+".LAB" AS F0$+".BAK" 1100 NAME F0$+".$$$" AS F0$+".LAB" 1120940 IF LST THEN LPRINT 2960 IF ADDR1$<>STRING$(25," ") THEN GOTO 3020 2980 IF CON THEN PRINT 3000 IF LST THEN LPRINT 3020 GOSUB 5780 : IF NOT ENDSW THEN GOTO 2300 3040 IF CON THEN PRINT STRING$(25,"*") 3060 IF LST THEN LPRINT STRING$(25,"*") 3080 IF CON THEN PRINT "* FILENAME: ";F0$;TAB(25);"*" 3100 IF LST THEN LPRINT "* FILENAME: ";F0$;TAB(25);"*" 3120 IF CON THEN PRINT USING "* LABELS PRINTED: ##### *";NLAB 3140 IF LST THEN LPRINT USING "* LABELS PRINTED: ##### *";NLAB 3160 IF CON THEN PRINT TERN TO AID IN" 1940 PRINT "LINING UP YOUR PRINTER. AFTER THE PATTERN HAS BEEN" 1960 PRINT "PRINTED, 'Y' WILL BEGIN PRINTING, ANYTHING ELSE WILL" 1980 PRINT "REPEAT THE PATTERN." 2000 PRINT 2020 PRINT " ***LINE UP YOUR PRINTER AND THEN RESPOND***" 2040 A$=INPUT$(1) 2060 IF A$="Y" OR A$="y" THEN GOTO 2280 2080 A$=STRING$(32,"X") 2100 FOR J=1 TO 2 2120 FOR I=1 TO 5 2140 IF CON THEN PRINT A$ 2160 IF LST THEN LPRINT A$ 2180 NEXT I 2200 IF CON THEN PRINT 2220 IF LST THEN LPRINT 2240 NEXT J 22 PRINT : PRINT "THERE ARE ";NR;" ACTIVE RECORDS." 1140 PRINT 1160 PRINT "DO YOU WISH TO:" 1180 PRINT " (1) ADD NAMES" 1200 PRINT " (2) ALTER OR PRINT EXISTING NAMES" 1220 PRINT " (3) QUIT" 1240 PRINT 1260 PRINT "ENTER NUMBER FROM ABOVE LIST "; 1280 A$=INPUT$(1) : PRINT A$ 1300 I=VAL(A$) 1320 IF I<1 OR I>3 THEN GOTO 1260 1340 ON I GOTO 1360,3340,6060 1360 GOSUB 5560 1380 RN=NR+1 : GOSUB 3660 : NR=NR+1 1400 IF A$="Q" OR A$="q" THEN CLOSE 1 : GOTO 1140 ELSE GOTO 1380 1420 REM 1440 REM 1460   "*";STRING$(23," ");"*" : PRINT STRING$(25,"*") 3180 IF LST THEN LPRINT "*";STRING$(23," ");"*" : LPRINT STRING$(25,"*") 3200 IF CON THEN PRINT 3220 IF LST THEN LPRINT 3240 GOTO 1140 3260 REM 3280 ' 3300 ' 3320 ' 3340 RN=0 3360 GOSUB 5560 3380 PRINT 3400 PRINT "THE FIELDS ARE DEFINED AS FOLLOWS:" 3420 FOR I=1 TO 9 3440 IF LEN(TIT$(I))<1 THEN GOTO 3480 3460 PRINT USING " #) &";I,TIT$(I) 3480 NEXT I 3500 GOSUB 6200 3520 GOSUB 5780 3540 IF ENDSW THEN PRINT "**END OF FILE**" : PRINT : GOTO 1 5540 ' 5560 OPEN "R",1,F0$+".LAB",128 5580 FIELD #1,1 AS ACT$,25 AS NAM$,25 AS ADDR1$,25 AS ADDR2$,15 AS CITY$, 2 AS STATE$,9 AS ZIP$,6 AS ACCT$,6 AS DATE$,14 AS MISC$ 5600 ENDSW=0 5620 RETURN 5640 ' 5660 ' 5680 ' 5700 REM 5720 REM 5740 REM ---ROUTINE TO GET NEXT RECORD--- 5760 REM 5780 RN=RN+1 : IF RN>NR THEN CLOSE 1 : ENDSW=-1 : RETURN 5800 GET #1,RN 5820 IF TYP=0 THEN RETURN 5840 ON TYP GOTO 5880,5900,5920,5940,5960,5980,6000,6020,6040 5860 PRINT "PROGRAM ERROR - INVALID SELECT TYP 4760,4780,4800,4820,4840,4860,4880,4900,4920 4740 PRINT "PROGRAM ERROR - BAD FIELD NUMBER" : GOTO 6060 4760 LSET NAM$= A$ : RETURN 4780 LSET ADDR1$=A$ : RETURN 4800 LSET ADDR2$=A$ : RETURN 4820 LSET CITY$= A$ : RETURN 4840 LSET STATE$=A$ : RETURN 4860 LSET ZIP$= A$ : RETURN 4880 LSET ACCT$= A$ : RETURN 4900 LSET DATE$= A$ : RETURN 4920 LSET MISC$= A$ : RETURN 4940 ' 4960 ' 4980 ' 5000 PRINT 5020 GOSUB 4300 5040 GOTO 5240 5060 PRINT 5080 PRINT "ENTER FIELD NUMBER TO CHANGE OR:" 5100 PRIN140 3560 IF ACT$="I" THEN GOTO 3520 3580 GOSUB 5000 : GOTO 3520 3600 ' 3620 ' 3640 ' 3660 PRINT 3680 FOR FLD=1 TO 9 3700 GOSUB 4680 3720 NEXT FLD 3740 PRINT 3760 LSET ACT$="A" 3780 PRINT 3800 PRINT "(L,Q,?,0-9): "; : A$=INPUT$(1) : PRINT A$ 3820 IF A$="?" THEN GOSUB 4100 : GOTO 3780 3840 IF A$="L" OR A$="l" THEN GOSUB 4300 : GOTO 3780 3860 IF A$="Q" OR A$="q" THEN GOTO 3980 3880 IF A$<"0" OR A$>"9" THEN GOSUB 4100 : GOTO 3780 3900 FLD=VAL(A$) 3920 IF FLD=0 THEN GOTO 3980 3940 GOSUB 4680 E":GOTO 6060 5880 IF INSTR(NAM$,AA$)<>0 THEN RETURN ELSE GOTO 5780 5900 IF INSTR(ADDR1$,AA$)<>0 THEN RETURN ELSE GOTO 5780 5920 IF INSTR(ADDR2$,AA$)<>0 THEN RETURN ELSE GOTO 5780 5940 IF INSTR(CITY$,AA$)<>0 THEN RETURN ELSE GOTO 5780 5960 IF INSTR(STATE$,AA$)<>0 THEN RETURN ELSE GOTO 5780 5980 IF INSTR(ZIP$,AA$)<>0 THEN RETURN ELSE GOTO 5780 6000 IF INSTR(ACCT$,AA$)<>0 THEN RETURN ELSE GOTO 5780 6020 IF INSTR(DATE$,AA$)<>0 THEN RETURN ELSE GOTO 5780 6040 IF INSTR(MISC$,AA$)<>0 THEN RETURN ELSE GOTOT " C TO CHANGE RECORD SELECTION CRITERIA" 5120 PRINT " D TO DELETE THIS RECORD" 5140 PRINT " L TO LIST THE CURRENT RECORD (INCLUDING ANY CHANGES)" 5160 PRINT " N TO GET NEXT RECORD WITHOUT CHANGING THIS ONE" 5180 PRINT " P TO PRINT LABELS STARTING WITH THE CURRENT RECORD" 5200 PRINT " Q TO QUIT THIS FUNCTION AND RETURN TO MAIN MENU" 5220 PRINT " S TO GET NEXT RECORD AFTER SAVING CHANGES ALREADY MADE" 5240 PRINT:PRINT "ACTION(C,D,L,N,P,Q,S,?,1-9): ";:A$=INPUT$(1):PRINT A$ 5260 I 3960 GOTO 3780 3980 PUT #1,RN 4000 PRINT 4020 RETURN 4040 ' 4060 ' 4080 ' 4100 PRINT "THE FOLLOWING ENTRIES ARE ALLOWED:" 4120 PRINT " L -TO LIST THE CURRENT RECORD" 4140 PRINT " Q -IF DONE ENTERING NEW NAMES" 4160 PRINT " 0 -IF DONE WITH THIS RECORD" 4180 PRINT " A NUMBER FROM 1 TO 9 TO CHANGE THE" 4200 PRINT " CORRESPONDING FIELD OF THE CURRENT RECORD" 4220 RETURN 4240 ' 4260 ' 4280 ' 4300 FOR I=1 TO 9 4320 ON I GOTO 4360,4380,4400,4420,4440,4460,4480,4500,4520 4340 PRIN 5780 6060 CLOSE : PRINT "PROGRAM TERMINATED." : STOP 6080 IF ERR=53 THEN RESUME 1040 6100 ON ERROR GOTO 0 6120 PRINT "SOME UNKNOWN ERROR" 6140 GOTO 6060 6160 ' 6180 ' 6200 PRINT : PRINT "ENTER THE FIELD NUMBER YOU WISH TO SELECT ON" 6220 PRINT "OR ZERO TO SELECT ALL RECORDS: "; 6240 A$=INPUT$(1) : PRINT A$ : PRINT 6260 IF A$<"0" OR A$>"9" THEN PRINT "ENTRY MUST BE 0-9":GOTO 6200 6280 TYP=VAL(A$) 6300 IF TYP<0 OR TYP>9 THEN PRINT "ENTRY MUST BE 0-9":GOTO 6200 6320 AA$="" 6340 IF TYP>0 THEN LF A$="C" OR A$="c" THEN GOSUB 6200:GOTO 5240 5280 IF A$="N" OR A$="n" THEN RETURN 5300 IF A$="P" OR A$="p" THEN GOTO 1480 5320 IF A$="S" OR A$="s" THEN PUT #1,RN : RETURN 5340 IF A$="Q" OR A$="q" THEN PUT #1,RN : CLOSE 1 : GOTO 1140 5360 IF A$="L" OR A$="l" THEN GOTO 5000 5380 IF A$="D" OR A$="d" THEN LSET ACT$="I":PUT #1,RN : RETURN 5400 IF A$="?" THEN GOTO 5060 5420 FLD=VAL(A$) 5440 IF FLD<1 OR FLD>9 THEN PRINT "INVALID ENTRY";CHR$(7) : GOTO 5060 5460 GOSUB 4680 5480 GOTO 5240 5500 ' 5520 ' T "WOW! THIS CAN'T HAPPEN! (RECORD PRINT ROUTINE)":GOTO 6060 4360 A$=NAM$:GOTO 4540 4380 A$=ADDR1$:GOTO 4540 4400 A$=ADDR2$:GOTO 4540 4420 A$=CITY$:GOTO 4540 4440 A$=STATE$:GOTO 4540 4460 A$=ZIP$:GOTO 4540 4480 A$=ACCT$:GOTO 4540 4500 A$=DATE$:GOTO 4540 4520 A$=MISC$ 4540 IF LEN(TIT$(I)+A$)<1 THEN GOTO 4580 4560 PRINT USING "#) & &";I,TIT$(I),A$ 4580 NEXT I 4600 RETURN 4620 ' 4640 ' 4660 ' 4680 IF LEN(TIT$(FLD))<1 THEN A$="":GOTO 4720 4700 PRINT TIT$(FLD); : LINE INPUT A$ 4720 ON FLD GOTO   INE INPUT "ENTER STRING YOU ARE SEARCHING FOR:";AA$ 6360 RETURN 6380 ' 6400 ' 6420 END  6320 AA$="" 6340 IF TYP>0 THEN LUNKNOWN ERROR" 6140 GOTO 6060 6160 ' 6180 ' 6200 PRINT : PRINT "ENTER THE FIELD NUMBER YOU WISH TO SELECT ON" 6220 PRINT "OR ZERO TO SELECT ALL RECORDS: "; 6240 A$=INPUT$(1) : PRINT A$ : PRINT 6260 IF A$<"0" OR A$>"9" THEN PRINT "ENTRY MUST BE 0-9":GOTO 6200 6280 TYP=VAL(A$) 6300 IF TYP<0 OR TYP>9 THEN PRINT "ENTRY MUST BE 0-9":GOTO 6200 6320 AA$="" 6340 IF TYP>0 THEN LT "WRONG NUMBER - TRY AGAIN!!":PRINT :GOTO 280 360 GOTO 170 1000 PRINT E$;"E" 1010 PRINT "TO STOP INPUT TYPE 'NONE' FOR LAST NAME " 1020 PRINT 1030 PRINT 1040 R=R+1 1050 '---------------------------------------------------------------- 1060 PRINT TAB(5);R;" ";:LINE INPUT "LAST NAME ? ";A$(R) 1070 IF A$(R)="NONE" OR A$(R)="none" THEN R=R-1:PRINT E$;"E":RETURN 1075 PRINT TAB(5);R;" ";:LINE INPUT "FIRST NAME, MIDDLE INITIAL? ";A2$(R) 1080 PRINT TAB(5);R;" ";:LINE INPUT "STREET ADDRESS? ";A1$(R6 GOTO 10 7 SAVE "NAMEADDR.BAS",A:STOP 9 ' Based on: 10 ' SUPMAIL.BAS Mailing label program for 'Business Mailing Labels' 20 ' MBASIC 5.2 CP/M ver 08/29/81 from Missasauga RCPM 30 ' H19/H89/Z89 device depen clear scr & rev video 40 ' Written by: Alden C. Olander III 80 ' Modified by: Paul J. Mayer, Jr. 90 ' Thomas E. McCormick converted from HDOS to CP/M. 120 CLEAR 10000 130 DIM A$(250),A1$(250),A2$(250),A3$(250),A4$(250),A5$(250),A6$(250),A7$(250) 135 ON ER) 1090 PRINT TAB(5);R;" ";:LINE INPUT "CITY? ";A3$(R) 1100 PRINT TAB(5);R;" ";:LINE INPUT "STATE? ";A4$(R) 1110 PRINT TAB(5);R;" ";:LINE INPUT "ZIP CODE? ";A5$(R) 1111 PRINT TAB(5);R;" ";:LINE INPUT "HOME PHONE? ";A6$(R) 1112 PRINT TAB(5);R;" ";:LINE INPUT "BUSINESS PHONE? ";A7$(R) 1120 PRINT:LINE INPUT" IS THIS INFO CORRECT? (Y OR N) ";B$ 1130 IF B$="N" THEN GOSUB 7190:GOTO 1050 1140 FOR I=1 TO 4:PRINT :NEXT I 1150 GOTO1010 2000 PRINT E$;"E" 2010 PRINT " This part of the program wilROR GOTO 140 140 E$=CHR$(27):PRINT E$;"E":PRINT:PRINT:PRINT 150 PRINT TAB(10);E$;"p";" NAMEADDR mailing list program. ";E$;"q":PRINT 160 PRINT " The following options are available:" 170 PRINT 180 PRINT "0 - READ OR WRITE NAMES ON DISK" 190 PRINT "1 - ADD NEW NAMES TO THE LIST" 200 PRINT "2 - DELETE NAMES FROM THE LIST" 210 PRINT "3 - PRINT LABELS" 220 PRINT "4 - SEARCH BY LAST NAME, CITY, OR STATE AND PRINT" 230 PRINT "5 - FINISH: EXIT THIS PROGRAM." 240 PRINT "6 - EXCHANGE DATA DISK IN DRl delete a name. You may" 2020 PRINT " locate the desired line by agency name or city. 2030 PRINT " BE CAREFUL: DELETED INFORMATION CANNOT BE RECOVERED." 2050 PRINT:PRINT:PRINT:PRINT 2060 PRINT " 0 - RETURN TO MAIN PROGRAM" 2070 PRINT " 1 - LOCATE INFORMATION FOR DELETE BY LAST NAME" 2080 PRINT " 2 - LOCATE INFORMATION FOR DELETE BY CITY" 2090 PRINT:PRINT:PRINT:PRINT 2100 LINE INPUT "WHICH OPTION DO YOU WANT? (0,1, OR 2) <0> ";N1$ 2110 IF N1$="" OR N1$="0" THEN PRINT E$;"E":RIVE 'B:'" 250 PRINT "7 - ALPHABETIZE YOUR DATA LIST ON DISK" 260 PRINT "8 - CHANGE/CORRECT INFORMATION IN DATA FILE" 265 PRINT "9 - PRINT ROSTER OF NAMES AND OTHER INFORMATION" 270 PRINT:PRINT:PRINT:PRINT 280 INPUT "WHICH OPTION DO YOU WANT? (0,1,2,3,4,5,6,7,8 OR 9) - ";N1 290 ON N1 GOSUB 1000,2000,3000,4000 300 IF N1=0 THEN GOSUB 5170 310 IF N1=5 THEN GOTO 5000 320 IF N1=6 THEN GOSUB 6000 330 IF N1=7 THEN GOSUB 7000 340 IF N1=8 THEN GOSUB 8000 345 IF N1=9 THEN GOSUB 9000 350 IF N1>=9 THEN PRIN   ETURN 2120 IF N1$="1" OR N1$="2" THEN GOSUB 4170 2130 IF N1$="1" OR N1$="2" THEN GOTO 2150 2140 GOTO 2050 2150 PRINT :LINE INPUT "DO YOU WANT TO DELETE THIS INFORMATION? ";N$ 2160 IF LEFT$(N$,1)="Y" THEN GOSUB 2180 2170 GOTO 2050 2180 FOR I=1 TO 4:PRINT :NEXT I 2190 PRINT "WHEN YOU ENTER THE NUMBER THINK BEFORE HITTING RETURN!!" 2200 PRINT "IF YOU HAVE CHANGED YOUR MIND THEN ENTER A '0' " 2210 INPUT "WHAT IS THE NUMBER OF THE RECORD TO BE DELETED? ";X 2220 IF X=0 THEN A$="":RETURN 2230 PRINT E290 NEXT I 4300 IF X=I THEN PRINT " NOT ON THIS LIST ":GOTO 4170 4310 RETURN 4320 PRINT 4330 PRINT I;" ";A2$(I);" ";A$(I) 4340 PRINT A1$(I) 4350 PRINT A3$(I);", ";A4$(I);" ";A5$(I) 4351 PRINT A6$(I);" ";A7$(I) 4355 FOR P=1 TO 300:NEXT P 4360 PRINT 4370 GOTO 4290 5000 PRINT E$;"E" 5010 PRINT 5020 FOR I=1 TO 4:PRINT :NEXT I 5030 PRINT " REMEMBER, if you exit the program without saving" 5040 PRINT " your new data, the disk file is the same as it was" 5050 PRINT " when you start";A1$(I) 3290 IF B$=A5$(I) THEN PRINT #2," ";A3$(I);", ";A4$(I);" ";A5$(I) 3300 IF B$=A5$(I) THEN FOR J=1 TO L:PRINT #2,:NEXT J 3310 NEXT I 3320 CLOSE #2 3330 GOTO 3010 3340 PRINT E$;"E":PRINT :PRINT :PRINT :PRINT :PRINT 3350 LINE INPUT " Output to SCREEN or PRINTER ? (S or P) ";S$ 3360 IF LEFT$(S$,1)="P" THEN OPEN "O",#2,"LP:":RETURN 3370 IF LEFT$(S$,1)="p" THEN OPEN "O",#2,"LP:":RETURN 3380 OPEN "O",#2,"TT:":RETURN 4000 FOR I=1 TO 24:PRINT :NEXT I 4010 PRINT " This is the search an$;"E";E$;"p"; 2240 PRINT " HOLD TIGHT! I'M WORKING ON YOUR DATA - BE PATIENT ";E$;"q" 2250 A$(X)="":A1$(X)="":A2$(X)="":A3$(X)="":A4$(X)="":A5$(X)="": 2255 A6$(X)="":A7$(X)="" 2260 FOR D= X TO R 2270 A$(D)=A$(D+1):A1$(D)=A1$(D+1):A2$(D)=A2$(D+1):A3$(D)=A3$(D+1) 2280 A4$(D)=A4$(D+1):A5$(D)=A5$(D+1):A6$(D)=A6$(D+1):A7$(D)=A7$(D+1) 2290 NEXT D 2300 R=R-1:RETURN 3000 PRINT E$;"E":PRINT :PRINT :PRINT :PRINT :PRINT 3010 PRINT " 0 - RETURN TO MAIN PROGRAM" 3020 PRINT " 1 - TYPE ALL LABELS INed! If you made CHANGES you must" 5060 PRINT " SAVE THE NEW DATA!!!!":PRINT 5070 PRINT E$;"p";" HAVE YOU SAVED YOUR NEW DATA TO YOUR DISK FILE? ";E$;"q" 5075 PRINT 5080 LINE INPUT " ? ";N$ 5090 IF LEFT$(N$,1)="N" THEN GOSUB 5170:GOTO 5110 5100 IF LEFT$(N$,1)<>"Y" THEN GOTO 5000 5110 CLOSE #1 5120 CLOSE #2 5130 PRINT :PRINT :PRINT " IF YOU GOOFED AND DID NOT SAVE YOUR DATA YOU MAY RESTART THE PROGRAM" 5140 PRINT " BY TYPING 'RUN 140' ... AND THE PROGRAM" 5150 PRINT " WILd find option." 4020 PRINT " You may locate a specific LAST NAME, CITY," 4030 PRINT " or all those listed under a STATE." 4040 PRINT 4050 PRINT 4060 PRINT " 0 - RETURN TO MAIN PROGRAM" 4070 PRINT " 1 - LOCATE BY LAST NAME" 4080 PRINT " 2 - LOCATE BY CITY" 4090 PRINT " 3 - LOCATE ALL IN STATE" 4100 FOR I=1 TO 4:PRINT :NEXT I 4110 LINE INPUT "WHICH OPTION DO YOU WANT? (0,1,2 OR 3) <0> ";N1$ 4120 IF N1$="" OR N1$="0" THEN PRINT E$;"E":PRINT :PRINT :PRINT :PRINT :PRINT :RET FILE" 3030 PRINT " 2 - TYPE LABELS FOR xxxxx ZIP CODE" 3040 FOR I=1 TO 4:PRINT :NEXT I 3050 LINE INPUT " WHICH OPTION DO YOU WANT? (0,1, OR 2) <0> ";P$ 3060 IF P$="" OR P$="0" THEN PRINT E$;"E":PRINT :PRINT :PRINT :PRINT :PRINT :RETURN 3070 IF P$="1" THEN 3110 3080 IF P$="2" THEN 3220 3090 PRINT " THAT'S NOT A VALID CHOICE ! TRY AGAIN.." 3100 FOR I=1 TO 4:PRINT :NEXT I:GOTO 3010 3110 FOR I=1 TO 4:PRINT :NEXT I 3120 INPUT " WHAT IS THE NUMBER OF LINES YOU WANT BETWEEN LABELS? ";L 3130 L RESTART WITH YOUR DATA INTACT!!!" 5160 END 5170 PRINT E$;"E" 5180 C$=CHR$(34) 5190 PRINT " 0 - RETURN TO MAIN PROGRAM" 5200 PRINT " 1 - GET LIST FROM DISK FILE" 5210 PRINT " 2 - PUT LIST ON DISK":PRINT 5220 PRINT " NOTE: If you PUT your files to the disk and have" 5230 PRINT " not previously gotten all info from the disk you" 5240 PRINT " will save only the info in the computer and will" 5250 PRINT " ERASE your disk file.......THINK FIRST.":PRINT 5260 LINE INPUT "URN 4130 IF N1$="1" THEN GOSUB 4170 4140 IF N1$="2" THEN GOSUB 4170 4150 IF N1$="3" THEN GOSUB 4170 4160 GOTO 4040 4170 FOR I=1 TO 24:PRINT :NEXT I 4180 IF N1$="1" THEN PRINT "WHAT IS THE LAST NAME YOU ARE LOOKING FOR? "; 4190 IF N1$="2" THEN PRINT "WHAT IS THE CITY? "; 4200 IF N1$="3" THEN PRINT "WHAT IS THE STATE? "; 4210 LINE INPUT B$ 4220 FOR I=1 TO 4:PRINT :NEXT I 4230 X=1 4240 FOR I=1 TO R 4250 IF B$=A$(I) THEN 4320 4260 IF B$=A3$(I) THEN 4320 4270 IF B$=A4$(I) THEN 4320 4280 X=X+1 4GOSUB 3340 3140 FOR I=1 TO R 3150 PRINT #2," ";A2$(I);" ";A$(I) 3160 PRINT #2," ";A1$(I) 3170 PRINT #2," ";A3$(I);", ";A4$(I);" ";A5$(I) 3180 FOR J=1 TO L:PRINT #2,:NEXT J 3190 NEXT I 3200 CLOSE #2 3210 GOTO 3010 3220 FOR I=1 TO 4:PRINT :NEXT I 3230 INPUT " WHAT IS THE NUMBER OF LINES YOU WANT BETWEEN LABELS? ";L 3240 LINE INPUT "WHAT IS THE ZIP FOR YOUR LABELS? ";B$ 3250 GOSUB 3340 3260 FOR I=1 TO R 3270 IF B$=A5$(I) THEN PRINT #2," ";A2$(I);" ";A$(I) 3280 IF B$=A5$(I) THEN PRINT #2,"     WHICH OPTION DO YOU WANT? (0,1, OR 2) <0> ";N$ 5270 IF N$="" OR N$="0" THEN GOTO 140 5280 IF N$="1" THEN GOSUB 5530 5290 IF N$="2" THEN GOSUB 5530 5300 IF N$="1" THEN 5330 5310 IF N$="2" THEN 5430 5320 PRINT :PRINT :PRINT :GOTO 5190 5330 PRINT E$;"E" 5340 PRINT E$;"p";TAB(10);" Please wait while I read your data ! "; 5350 PRINT E$;"q" 5360 OPEN "I",#1,D$ 5370 INPUT #1,R 5380 FOR I=1 TO R 5390 INPUT #1,A$(I),A1$(I),A2$(I),A3$(I),A4$(I),A5$(I),A6$(I),A7$(I) 5400 NEXT I 5410 CLOSE #1 5415 (J) 8440 LINE INPUT "NEW ZIP CODE - ";H5$(J) 8450 IF H5$(J)="" THEN H5$(J)=A5$(J) 8451 PRINT "OLD HOME PHONE - ";A6$(J) 8452 LINE INPUT "NEW HOME PHONE - ";H6$(J) 8453 IF H6$(J)="" THEN H6$(J)=A6$(J) 8454 PRINT "OLD BUSINESS PHONE - ";A7$(J) 8455 LINE INPUT "NEW BUSINESS PHONE -";H7$(J) 8456 IF H7$(J)="" THEN H7$(J)=A7$(J) 8460 PRINT E$;"E":FOR X=1 TO 6:PRINT:NEXT X 8470 PRINT TAB(10)H$(J):PRINT TAB(10)H2$(J) 8480 PRINT TAB(10)H1$(J):PRINT TAB(10)H3$(J) 8490 PRINT TAB(10)H4$(J):PRINT TAB(10)H5$(O I%:PRINT #2,A$(X%):NEXT X%:CLOSE:GOTO 120 7190 PRINT CHR$(27);CHR$(69):FOR I=1 TO 6:PRINT:NEXT I:RETURN 8000 ' 8010 ' ** CORRECTION ROUTINE ** 8110 ' 8120 PRINT E$;"E":FOR X=1 TO 6:PRINT:NEXT X 8130 PRINT "YOU CAN SEARCH BY LAST NAME OR CITY" 8140 PRINT "TO FIND ENTRY TO BE CORRECTED.":PRINT :PRINT 8150 PRINT "0 - RETURN TO MAIN MENU" 8160 PRINT "1 - SEARCH BY LAST NAME" 8170 PRINT "2 - SEARCH BY CITY " 8180 PRINT :INPUT "WHICH OPTION DO YOU WANT? <0,1, OR 2> <0> ";N1$ 8190 IF N1$="" OR N1PRINT E$;"E":FOR X=1 TO 6:PRINT:NEXT X 5420 RETURN 5430 PRINT E$;"E" 5440 PRINT E$;"p";TAB(10);" Please wait while I put your data away. "; 5450 PRINT E$;"q" 5460 OPEN "O",#1,D$ 5470 PRINT #1,R 5480 FOR I=1 TO R 5490 PRINT #1,C$;A$(I);C$;",";C$;A1$(I);C$;",";C$;A2$(I);C$;",";C$; 5495 PRINT A3$(I);C$;",";C$;",";C$;A4$(I);C$;",";C$;A5$(I);C$;","; 5497 PRINT C$;A6$(I);C$;",";C$;A7$(I);C$ 5500 NEXT I 5510 CLOSE #1 5520 RETURN 5530 LINE INPUT " What is the NAME of your data file? ";X2$ 8510 PRINT E$;"E":FOR X=1 TO 6:PRINT:NEXT X 8520 IF X2$="n" OR X2$="N" THEN 8280 8530 GOSUB 8610 8540 ' STORE NEW DATA 8550 OPEN "O",1,D$ 8560 PRINT #1,R 8570 FOR I=1 TO R 8580 PRINT #1,C$;A$(I);C$;",";C$;A1$(I);C$;",";C$;A2$(I);C$;",";C$;A3$(I);C$;",";C$;A4$(I);C$;","C$;A5$(I);C$;",";C$;A6$(I);C$;","C$;A7$(I);C$ 8590 NEXT I 8600 CLOSE #1:GOTO 140 8610 A$(J)=H$(J):A1$(J)=H1$(J):A2$="0" THEN GOTO 140 8210 IF N1$="1" THEN GOSUB 4170 8220 IF N1$="2" THEN GOSUB 4170 8230 INPUT "WHAT IS THE NUMBER OF THE RECORD TO BE CHANGED? ";X 8240 J=X 8250 GOTO 8280 8260 IF N1$=0 THEN 140 8270 GOTO 8110 8280 ' MAKE ENTRY CORRECTION 8290 PRINT E$;"E":FOR X=1 TO 6:PRINT:NEXT X 8300 PRINT "Make Corrections on your data. If no change hit CR." 8310 PRINT "OLD LAST NAME IS - ";A$(J) 8320 LINE INPUT "NEW LAST NAME - ";H$(J) 8330 IF H$(J)="" THEN H$(J)=A$(J) 8331 PRINT "OLD FIRST NAME AND MIDDLR.DAT> ";D$ 5540 IF D$="" THEN LET D$="B:NAMEADDR.DAT" 5550 RETURN 6000 RESET "B:" 6010 GOTO 140 7000 CLEAR (15000):DIM A$(200):I%=1 7010 FOR I=1 TO 24:PRINT :NEXT I 7020 PRINT " This section of the program will alphabetize your" 7030 PRINT "data file. You will be asked for the file to be" 7040 PRINT "sorted 'eg. B:NAMEADDR.DAT' and the output file name" 7050 PRINT "which you must give a different name to such as" 7060 PRINT "eg. 'B:NAMEALPH.DAT'." 7070 PRINT 7080 PRINT 7090 INPUT "Incoming$(J)=H2$(J):A3$(J)=H3$(J):A4$(J)=H4$(J):A5$(J)=H5$(J):A6$(J)=H6$(J):A7$(J)=H7$(J):GOTO 8110 9000 PRINT E$;"E":PRINT :PRINT :PRINT :PRINT :PRINT 9010 OPEN "O",#2,"AT:" 9020 FOR I=1 TO R 9030 PRINT #2," ";A$(I);", ";A2$(I);TAB(35);" ";A1$(I);TAB(57);" ";A3$(I); 9033 PRINT TAB(75);" ";A4$(I);TAB(88);" ";A5$(I);TAB(96);" "; 9036 PRINT A6$(I);TAB(107);" ";A7$(I) 9040 NEXT I 9050 CLOSE 9060 GOTO 140 75);" ";A4$(I);TAB(88);" ";A5$(I);TAB(96);" "; 9036 PRINT A6$(I);TAB(107);" ";A7$(I) 9040 NEXT I 9050E INITIAL IS - ";A2$(J) 8332 LINE INPUT "NEW FIRST NAME AND MIDDLE INITIAL - ";H2$(J) 8333 IF H2$(J)=""THEN H2$(J)=A2$(J) 8340 PRINT "OLD STREET ADDRESS IS - ";A1$(J) 8350 LINE INPUT "NEW STREET ADDRESS IS - ";H1$(J) 8360 IF H1$(J)="" THEN H1$(J)=A1$(J) 8370 PRINT "OLD CITY - ";A3$(J) 8380 LINE INPUT "NEW CITY - ";H3$(J) 8390 IF H3$(J)="" THEN H3$(J)=A3$(J) 8400 PRINT "OLD STATE - ";A4$(J) 8410 LINE INPUT "NEW STATE - ";H4$(J) 8420 IF H4$(J)="" THEN H4$(J)=A4$(J) 8430 PRINT "OLD ZIP CODE - ";A5$ FILE NAME to be sorted.. ";P$:INPUT "Output FILE NAME for sorted file ";T$ 7095 IF T$="" THEN LET T$="B:NAMEALPH.SRT" 7100 OPEN "I",1,P$:OPEN "O",2,T$ 7110 IF EOF(1) THEN 7120 ELSE LINE INPUT#1,A$(I%):I%=I%+1:GOTO 7110 7120 I%=I%-1:C%=I%:B%=I% 7130 C%=INT(C%/2):PRINT C%:IF C%=0 THEN 7180 ELSE D%=1:E%=B%-C% 7140 F%=D% 7150 G%=F%+C%:IF A$(F%)<=A$(G%) THEN 7170 7160 SWAP A$(F%),A$(G%):F%=F%-C%:IF F%<1 THEN 7170 ELSE 7150 7170 D%=D%+1:IF D%>E% THEN 7130 ELSE 7140 7180 FOR X%=1 T    520 WREC=VAL(WREC$) 'change to number 521 ' 522 'Get desired user funtion 523 PRINT: PRINT "(A)dd (E)dit (S)ort e(X)it ? ";: Z$=INPUT$(1): PRINT Z$ 524 IF (Z$="A" OR Z$="a") THEN 530 525 IF (Z$="E" OR Z$="e") THEN EDFLAG=1: GOTO 1000 'set edit flag 526 IF (Z$="S" OR Z$="s") THEN 1500 527 IF (Z$="X" OR Z$="x") THEN 770 528 PRINT "Enter either A or E or S or X to the question.": GOTO 523 529 ' 530 'Take input from console and set into random file buffer. 540 PRINT 550 LINE INPUT "Phone N 'character highlight on/or a null 280 HOFF$=CHR$(14)+CHR$(15) 'character highlight off/or 2 nulls 289 ' 290 ' The following string HDR$ must be exactly 55 characters in 300 ' length. Use spaces to fill out if necessary. Also it starts 310 ' printing in the 6th character position of the line upon output. 320 ' XXXX1XXXXXXXXX2XXXXXXXXX3XXXXXXXXX4XXXXXXXXX5XXXXXXXXX6 Column # 330 HDR$="Phone No. Name of Party Baud Passwd Comment" '(OUTPUT) 334 ' 338 'No more user modifications are number: ";Z$: LSET NUM$=Z$: IF EDFLAG THEN 1115 560 LINE INPUT "Operator : ";Z$: LSET NAM$=Z$: IF EDFLAG THEN 1115 570 LINE INPUT "Max.Baud : ";Z$ 580 WHILE LEN(Z$)<4 : Z$=" "+Z$ : WEND 590 LSET MAXBAUD$=Z$: IF EDFLAG THEN 1115 600 LINE INPUT "Password : ";Z$: LSET PSWRD$=Z$: IF EDFLAG THEN 1115 610 LINE INPUT "Comment : ";Z$: LSET COM$=Z$: IF EDFLAG THEN 1115 620 LSET ACRLF$=CRLF$ 'cr/lf at end of every record 630 ' Write next available record. 640 PUT #1,WREC 650 ' Increment next avecessary. 339 ' 340 ' Open and field file for 80 characters per record. The last 350 ' 2 characters are taken up by carriage return,line feed. 360 OPEN "R",1,"PHONDAT",80 'PHONDAT is name of datafile 370 FIELD #1,16 AS NUM$,20 AS NAM$,5 AS MAXBAUD$,11 AS PSWRD$,26 AS COM$, 2 AS ACRLF$ 380 FIELD #1,5 AS WREC$,75 AS DUM$ 390 ' If PHONDAT does'nt exist then create and initialize it. 400 IF LOF(1)>0 THEN GOTO 500 410 LSET WREC$=STR$(3) 'first available data record 420 LSET DUM$100 ' 110 ' PHONDAT.BAS 120 ' Last revision 1/10/81 130 ' 140 ' Originally written by Bruce Levison-Aug.15,1980 150 ' 154 ' Must use the /X option if compiling with BASCOM 156 ' 157 ' Warning...this program will not work properly with 158 ' the old data file PHONDAT. This program uses an 80 159 ' character record size. 160 ' 169 '09/25/80 Revised to format the data file so that 170 ' a simple TYPE command from CP/M will produce a header 180 ' and nicely formated table. Alsailable record counter. 660 WREC=WREC+1 670 ' More entries ??? 680 PRINT: PRINT "Another ? ";: Z$=INPUT$(1): PRINT Z$ 690 IF (ASC(Z$) AND 95)=ASC("Y") THEN 540 'make response upper case 700 ' The following two lines "pear" off any leading spaces from 710 ' the next available record counter before putting it back to disk. 720 ZZ$=STR$(WREC) 730 IF LEFT$(ZZ$,1)=" " THEN ZZ$=MID$(ZZ$,2,6): GOTO 730 740 LSET WREC$=ZZ$ 750 LSET DUM$=STRING$(71,32)+CRLF$+CRLF$ 760 PUT #1,1 'put next available record =STRING$(71,32)+CRLF$+CRLF$ 'clear rest of file buffer + cr/lf 430 PUT #1,1 'store next available record counter 440 ' Create header for table in record 2. 450 LSET WREC$=HON$ 'turn highlight on 460 ' The following writes the header,turns highlight off,appends spaces,cr/lf 470 LSET DUM$=LEFT$(HDR$,55)+HOFF$+STRING$(16,32)+CRLF$ 480 PUT #1,2 'store header in record 2 490 ' 500 ' Start by getting next available record counter. 510 GET #1,1 'get next available record counter o re-wrote the code to 190 ' make it more readable. (BL) 200 ' 210 '11/04/80 Changed the record length from 64 to 80 characters to allow 220 ' for a larger comment field. (BL) 221 ' 222 '12/20/80 Added an editing funtion. (BL) 223 ' 224 '01/10/81 Added the sort funtion. (BL) 225 ' 230 ' Define a few things. 240 DEFINT A-Z 'make all numbers integer type 250 WIDTH 255 'unlimited 255 EDFLAG=0 'edit flag 260 CRLF$=CHR$(13)+CHR$(10) 'carriage return,line feed 270 HON$=CHR$(14)   counter back 765 GOTO 523 770 ' Now end 780 CLOSE 790 PRINT 800 PRINT "++Done++" 810 END 999 ' 1000 'Edit routine 1002 ' 1005 PRINT 1010 LINE INPUT "Which operator to edit ? ";Z$ 1020 FOR I=3 TO WREC-1 1030 GET #1,I 1040 IF INSTR(NAM$,Z$)<>0 THEN 1080 1050 NEXT I 1060 PRINT "++Operator not found in any of the records++" 1065 EDFLAG=0 'reset edit flag 1070 GOTO 523 1080 PRINT: PRINT WREC$;DUM$ 1090 PRINT "This one to edit ? "; 1100 ZZ$=INPUT$(1):PRINT ZZ$ 1110 IF (ASC(ZZ$) AND 95) <> 00 PRINT TAB(10);LEFT$(A1$(L),15),A(L) 1910 I1=I1-M 1920 IF I1<2 THEN 1940 1930 GOTO 1860 1940 J=J+1 1950 IF J>K THEN 1820 1960 GOTO 1850 1970 ' INPUT KEY AND RECORD.NO 1980 GET #2,1 1990 WREC=VAL(WREC$)-1 2000 FOR I=3 TO WREC 2010 GET #2,I 2020 A1$(I)=LEFT$(LA$(1),LS) : A(I)=I 2030 NEXT I 2040 RETURN 2050 ' 2055 PRINT "Writing sorted file back to disk..."; 2060 KILL F3$ 2070 OPEN "R",1,F3$,Z: FIELD 1,5 AS WREC1$: FIELD 1,Z AS ZZ$ 2080 FIELD 1,(ST-1) AS LO$(2),LE AS LO$(1) 2090 FOR I=3 TASC("Y") THEN 1050 'keep searching 1115 PRINT 1120 PRINT "(1) Phone number: ";NUM$ 1130 PRINT "(2) Operator : ";NAM$ 1140 PRINT "(3) Max.Baud : ";MAXBAUD$ 1150 PRINT "(4) Password : ";PSWRD$ 1160 PRINT "(5) Comment : ";COM$ 1165 PRINT 1170 PRINT "(6) Done edit" 1180 PRINT 1190 PRINT "Which # to edit ? ";: Z$=INPUT$(1): Z=VAL(Z$): PRINT Z$ 1200 PRINT 1205 IF (Z<1 OR Z>6) THEN 1190 1210 ON Z GOTO 550,560,570,600,610,1250 1250 PUT #1,I 1255 EDFLAG=0 'reset edit flag 1260 GOTO 52310 PRINT CHR$(26):REM Screen clear 20 REM THIS PROGRAM CALCULATES A POWER BUDGET FOR UHF-VHF 30 PRINT"THIS PROGRAM WILL GIVE THE POWER BUDGET FOR UHF-VHF" 40 PRINT" COMMUNICATIONS OVER A KNOWN PATH. ENTER THE FOLLOWING" 50 PRINT" DATA. SOME POSSIBLE VALUES ARE SUGGESTED." 60 PRINT 70 INPUT" FREQUENCY OF OPERATION (MHZ)";F 80 INPUT" TRANS ANT GAIN REL ISOTROPIC (DIPOLE=2DB)";GT 90 INPUT" TRANS TSMSN LINE LOSSES (DB)";LT 100 INPUT" RCVR ANT GAIN REL ISOTROPIC ANT.";GR 110 INPUT" RCVR TO WREC 2100 GET #2,A(I) 2110 LSET LO$(1)=LA$(1) : LSET LO$(2)=LA$(2) 2120 PUT #1,I 2130 NEXT I 2140 FOR I=1 TO 2 2150 GET #2,I 2160 LSET LO$(1)=LA$(1) : LSET LO$(2)=LA$(2) 2170 PUT #1,I 2180 NEXT I 2190 CLOSE 1,2,3 2200 KILL F2$: NAME F1$ AS F2$ 2210 NAME F3$ AS F1$ 2215 PRINT 2220 GOTO 360 2500 ' 2505 ' ERROR TRAP 2510 IF ERR=53 THEN RESUME NEXT 2600 ON ERROR GOTO 0 2610 END S F1$ 2215 PRINT 2220 GOTO 360 2500 ' 2505 ' ERROR TRAP 2510 IF ERR=53 THEN RESUME NEXT 2600 ON ERROR GO 1500 ' 1510 ' SORT 1520 ' 1530 ' MODIFIED FOR USE WITH PHONDAT.BAS 1540 ' 1545 ON ERROR GOTO 2500 1550 CLOSE 'make sure 1560 DIM A1$(100),A(100),LO$(2),LA$(2) '100 names to sort max. 1570 ' 1580 ' F1$= filename to be sorted 1590 ' F2$= back-up file after sort 1600 ' F3$= new sorted file 1610 ' Z= number of characters per record 1620 ' LS= length of sort field 1630 ' ST= first character of sort field 1640 ' 1650 F1$="PHONDAT" 1660 F2$="PHONDAT.BAC" 1670 F3$="PHONDAT.$$$" 1680 ZSMSN LINE LOSSES (DB)";LR 120 INPUT" DISTANCE BETWEEN ANT. (ST. MILES)";D 130 A=36.6+20*LOG(F)+20*(D)+M+LT+LR-GT-GR 140 PRINT 150 PRINT"WORST CASE PATH LOSS BETWEEN XMTR & RCVR IS ";A;" DB" 160 PRINT 170 PRINT"RECEIVER LOSSES ARE AFFECTED BY THE FOLLOWING: ENTER:" 180 INPUT" 1) RCVR IF BANDWIDTH (HZ). (TRY 32 KHZ)";B 190 INPUT" 2) RCVR NOISE FIGURE. (15DB?)";NF 200 INPUT" 3) CARRIER TO NOISE RATIO (DB). (15DB?)";CN 210 R=-204+10*LOG(B)+NF+CN 220 PRINT 230 PRINT"SIGNAL POWER REQUIRED=80 1690 LS=20 1700 ST=17 1710 ' 1720 LE=Z-(ST-1) 1730 OPEN "R",2,F1$,Z 1740 FIELD 2,(ST-1) AS LA$(2),LE AS LA$(1): FIELD 2,5 AS WREC$ 1750 GOSUB 1970 : REM LOAD ARRAY WITH KEY & RECORD NO. 1760 ' I=NUMBER OF ELEMENTS TO BE SORTED 1770 ' OTHER VARIABLES USED 1780 ' M,J,K,I1,L,A$,B$ 1790 ' 1800 I=WREC 1810 M=I 1820 M=INT(M/2) 1830 IF M=0 THEN 2050 : REM FINISHED 1840 J=2 : K=I-M 1850 I1=J 1860 L=I1+M 1870 IF A1$(I1)  6#s#r#=f >2 >2 >2 2 ! " !$\" >&2 L æ6#}š |š  STOͨ ø 2 * .. . ........͖* |¿ : - * |- 3 <  s#r<  {͋ w#6" * * >2 ͌ ò !9N#F< ~#~e ~+k ~#~e +^#V###C ###C |w ~#fo!  Internal Error - No Line Number < ~#  at line3 2 > <  < 0̀5  }_|W! 8!*͸ ͑!!!8͑!!!!8!*!͘/!/!X*|/g}/o|ʋF Ü!b !9 Fͦ +ͮu!b !FF !9" 9* ͺ +ͮF !9!|!9!+!9"  g"  g!0^p * " g!0** ͺ  +ͮ ͑!!!~! [+6~#fo> at address|}2 > ̀5> À5~#*K +6~#fo(@!9" !S * Y " !z * 2 ! ~<ʦ =ʦ #~# Ò #Syntax Error in DATRETURN without GOSU Type MismatcOut of DatIllegal Function CalOverfloOut of Memor Subscript Out of Rang Division By ZerOut of String SpacString Formula Too CompleRESUME without Erro2Field Overflo3Internal Erro4Bad File Numbe5File Not Foun6Bad File Mod7File Already Ope9Disk I/O Erro:File Already +F :ͧ!98 +ͮ!z͈!v͈|g}o||!P͍ !FÈͧ! [8U!*͑! 8͑!I8͸ !9 !!E͈"  !! [͈"  T|8)?go* |g}o* |g}o|A!9 "  DM!0* ͺæ͸ H LDone#SHit return when ready for next pageys}S Printing Page with Mergeing  lines File Read File is too long 60 lines is maxI"Single Sheet (S) or +"6# x+:`i* ">"/##~>;+> 6*s#r w+͊1>2 u+#w+>36*s#rw+6*xDM"+ڍ+s#r#À+! æ+>2:*ã+6*x+Á*~#ʽ+#~+ҽ+~+x 6*s#rw+ɯ2,x_O:*+2,x_O6*9w#w+x,+r+s=,w>#w+Á*~7^#VE,E,!~ѧ7x1P*x1~7!~#fo~ʁ,7,#~+~w}D#wx#1]*KÄ,!9*?>":u,2g>2u:u Exist=Disk Ful>Input Past En?Bad Record Numbe@Bad File NamCToo Many FileUnprintable Erro| O }%0t3~q3`i" !" !"  ,'|!ͧ*@7*>7*<7*:7̓! *>7̓!͐*@7*>7 “,Z'~#xd` !> 'Ud͊ʹ,  7'"LG{,xLPXʹ,ښ!Oz"yʅ ʺ …O{,yʹ,ښ …{ ʔ,> ʔʔʚʚʹ,Q"ʥ ʹ, ʥ, ʹ, * ( 4: {,6!UO +~ #6!ɷw#Continuous (C) \\/ What is the name of your merge data (list) file,H What is the name of your merge (letter) file"w How many Fields in your merge file8 Val-Merge Merge Utility for Valdocs Ver 1.34 JAD 8307.15 pt[[[[ BASLIB #000000 5.30 - OWNED BY MICROSOFT, 1980 3 ~Z=DM*"*M ##" >2* 2- *^#V"+ ##^#V".  20 !~ !!""1 ! " 6#6P>2 >2 >2 * - ú _23ͤ423~4]=i=ʼ4ͤ4ð44x¬4:3=, PJ-,O:u,-!l{Ps",͖Q!-gQH-*fx-͸QP'-͌Q!l>P͍PH-@]T}_|H-)>-x1P*I&>4ͺ-K3y=d-e#x2#~+Œ-x-xGe#>.xʛ-e#>.xG ʩ->.x#~+>.>X6*s#r+}*W!-K^#V#~.  !'&   ͑![! 8!t ͍ !F!E ͍ !F! ͍ !F! ͇!͍ !F!͘/!/!X*|/g}/ö́ |g}o|!b bg9ͰP+æͮ ͑!   NU;N#"!9""y2* |,* !" A~#*6: L~^|!a̓!"ʇʓͧ*@7*>7*<7*:7à *>7à͐*@7*>7*6~#",4 : 4~!" ~,"#"~# "#"x"  +~ ydà?Redo from Start *͖!C͍*:O3*+~+qcc +w e|++~#fo͊"!5*<~2#~#^#V++͌͝3ک :O * |!Ud͊* Lʬ̀5#G~## ++&0:1À5> I> I:=ʣE:=<ʈGI*9?|>I#"9͹(*>7}/o|/g#">7|ʹ=Ã!@7~wɯ2A7͹(g;ʹ*>7ʹ=͹(G;>>Y!~ͯ #ùï R!D7>!D7:72# !D79!D7; X7>> >|}+!t!8͆ o>+6!@7> ;297!p!|7*@7͉ ">7`i"@7!>7^#V#N#F#!p!=ͧ?x{Ҝ?!B76|>wg>@? :[Gw#  !D7 >7͹(:7͹( *>7||<͹(*>7!|7g:>7+> |/g}/o)!>G|:1o& Gȯ|g}oAW>d~+~?~o+#|+ |O >~##++ >06+V+^+ʷ+r+sVO ͊~uO  ͌͌~#~#fo06O | BK8PYO | BK ) o_ O z z@ F_Lo}`iu͌DMO | !9>d>Ê>Ê>Ê>Ê>Ê>͓!+GNʿyʿ#~#fo~#fo#ʾ ® yy<.))͌͌x ű y<2F~"*##s#rq#p !#'()+,-.06#~6+E5#w+~=w!%=K~go A= *K!^[oR=$~##~O++###^#VBâ,r+sx##^#V@ZMERGE REL?RO A%O L%O W%O %O AGO LGO WGO ͬGO AO LO WO ͬ>7b:7b">7kH~# cx2[: ›Q#U<S~ʔ4#ÈBQ#~ʗ 4#Þ>2[: F#~#foxS~#4Ì>"4G: xʔ5* + !9( ͗!K :@72@7:A7Җ)͘ :A75!:!@!|/g}/oT!!):A7]!͘ ">7>2[Q ajS! L}͋ͱ)>24`hT!~&(-ʫ!+ʫ!+͟(ڒ".8"eʽ!E!͟(l!L!q!Q!:[">"~%E"#V"!W"d"D"`"͟((͟(#"_{_o"""b͹(!` ]!͹( "`"ë!͟(!` ! "`"͟("̐ħ͹( - =͹(' 7  "T])))O |"">7ë!y͞7"t$Q "͒ "ÿ"ͮ- b ͮÿ"k b @@#~#foy+6O #~#foxD4##D!4 2͌͌*&~͌o&O ~< ~#~#fo066+͟(|!ͧ͌Ì ͛2ͪͭͰ=:2GE_!45*"~#N#F# +6yx +++6@#yw#xw+++6###!~6)>͈*#~#~` !*"~#^#V#څd+6K|pK++~_w#~Ww#K>*DM~#^#V#Ñ+zĿ+{Ŀ##{z~#q#p_ʑyxDMÑ~#ÑYP+++"6@###{_zW+r+sɷ1~<=###~* Ô5!* * ~=,/<SB=8> 4>,4W* #^ }w+=w: =w͔5z{ڏ{_Á! " !" 2 ͽ! " !" 2 ͽ! ~6#w~! N` i&  g͉̓g͉̓g͉͕̓g͉͕̓g͉̓g͉̓g͉͕̓g͉͕̓ͤ^#V#"*ͤmͤ^#qÞͤ^#V#s"~2"O **:õ5:5:DG$":7`i"<7#~+x$-O$0OxGx$#~6$`xEm$y !$>26}$|!$e$!$":7`i"<7{ #W͌&:6$õ$$ҹ$+'60̐ R'+~0$.Đ $͹(>"w#6+$6-/</ $:#p#w#6!8*|` ^#V+"w#s#r+++r+s##!8=*{z*?S}|~# YyGx06Gx#N#F& m> V**>6ʻ͏ʵ V###Ü during G.C.   Internal Error - String Space Corrup#N#F*yxQ*yxQ++`i+V+^>6##6+6+~6  >@++*"s#r+͈*#~_#~W` r+s##6"###!~#foʣ>6“<*"*}o|g6@#s#r#6"**"}w>#w##>6++6+6ɛ~̀5#=~^#V#5^#V#55^#V#5 Ϳ5͵5^#qͿ5^#q5]&)))< >!>!>!>!>!>^#V#^#V#>ÿ>ÿ>ÿ>ÿ>ÿ>^#V#^#V# GM GM ~#fo##j =^#V#'T>2 O O HO 5Ϳ5| O vO \: ! 9g;ã: ! <:@72@7:A7:A7|/g}/og;:A7!A7M!` :A7goW*?7   #zҁ%&#'z&'{ =&͊#0%p#6!7#:\~ 5%*5%+I%͟(-+_: {0y%#͟(y%++wo%6%y%6%%&ʝ%A(%Q#+6%Q %͵ Č&%_x&'R''>'%_y}"%"%{_x%&' &&yB'O&GOR'&*\=&P&%͞ѯ+&͵ 7Č&y}"OzWO"K&Y&/<'|& ~.Đ "\ڃ&$&%կ͹(&:A7Ұ&!(!D7; 3 Õ&&͹(&COQ &)(&p"ó&"&͹(&t#Q &1(&i" !3" <3ʹ,` !> O | ,63-: t3* ! " {f$%Z3!S3* E3|}!" >6>4>?>=>:>7>5>2>3>@>C>` o& j !" !"ï3:3?3p43:4>\243ʿ3ͻ4+3~ͻ44+ͻ44ͻ4͸4!2444O3:44>\ͻ424yʅ4̾47 ʬ4 ʅ4 ?43Å4̾43]43ͻ4> ͻ4>3g4>#3€46͸4!44 4x<>ʐ4yq#ͻ4 4> ͻ44ʝ4 44:̸4w2 À5>^ͻ4@ͻ4͸4~ 4> ͻ4ͻ4#4ͦ ##* 5#~+<5=,* #A-~.---7-#-28*͌z ʌ3ڌ3> --!-> F-!-O ,),*<ʃ3!*,*> 06,:,*!*’3,*<}3**M*~q3#N#F++͌ O-I-Rq3*O*|-!"O*}_%0-0{%0€3z, 0" #,*> 0666ͣ,~9.<ʏ3N.'60#= '{ >'/>{'>p#=r'!:7x î'K >͘ { (?>'͆ /{_#zW#yO++'9 #{ p#ڴ'>'(>>'N#F#*>7/}o|g(">7p#='>'w1_cƤ~@zZrN vH Tʚ;@B''d #~: ʟ( ʟ( ʟ(0?<=:[(7-++͟(\)O(H(+((T!H#&))` 5 k5n5 54+~# 4~=r5* ! " 4" > 4> 4: =ʯ5> Ͷ > Ͷ *4^#V#Ϳ5ɷ!>75!:75>75:75w#w#w#w#*m6>:76>>75 ~#= 6!5#~ 6 6Ʌo$ɧGw#46{z!mKs#r`4a:+`fx7g~@`#~!m~#~#R`\` yF`7xͤfxG*m*mLxggxʭ`####~``͢fxͤf͢f>e>ixg#>ͤf~!if>e>ixʃ3O!)  ~#ͻ4y0/~ -/>.ͻ4 /: W: I/> ͻ4ͻ4ܸ4,* /~*6?# a/O!!4/#4/#4y"–/ʏ3><"M*>2 !2" : <2 * "Q*!/" O "O*͡-* |/##n*/.**Q*O /O 2S*!1"T*!1O 0O 2S*"1"T*"1t3w2a!rͽTxT:k2a͒TcT4 XTcT>͔T!jO }%0t3q3!' ~ʓ* ʓ*#~ˆ*`io,i*>O #~goPY!' ůwͣ,:2 i/ʏ3=ʉ3=*ѯz3<ʏ3!% ^#Vr+sO }/!"O*}%0+ PY+! +fxgn}a*m#~!q`!~ax!mK6#6###5&o)))!bax6#L7|;K7ʇ7?Oʌ7!?!@7y#„7+w7???p8͐?G;å7p8>;S8!D7|;8:A7?:K7/::@7<=:!:7ͯ:!s6ͭ:x7!A757S9!@7N#Fo>+6H8!@7>N ;$:297::7q:?x/F+N+=8!D7ä8!:7>q#p#=§8!:78"r6͛8͊8v8*r6|;w?:A7w?!J7N#F`=:q9G8:6;x 8*O*|1! s#r#w120}%0q3! ^#V:S*D1*T*{w3+s#r! w#w! ~#fo!_3t1ò1BK>!)҇1)#È1))Җ1 ҕ1#=}1}_}la)ڒ3ҭ1#x’3"0! "0!) "0!}o|g_31bk:0"2_31?2DM*0*0v2"0PY>2}o|g*0#"0¿1?2DM*0*0v2"0PY22^3*0! ~#fo_3s#re2:^3r2!r2!& Ö+~# xw2DM2ʆ32! w!( V6 ʬ2zw2ʆ32! ~!2! ^#V! s#rDM22_3}%0t32q3``i>k+!' ~Ğ*ͣ,0O }%0t3!&:+! ~+ngO }%0t3! n&* ~n3ʃ2DM'~̛*4N#V pʏ+zw w+s#r#6#6DM:0 ʺ+!" s#r#6+! {zV+)w<+<ʏ3!! {w:^3 ,o,!! ~)!) -,͛*-,e3~#0,* ~ʱ2( ~Z,+~#5O ~+~f,l,<,7>* T]% N#F+q#p###6 „,ͣ,:1 i/>œ,>w+w!(:,7?* ' 6#67~ʌ3#^#fk_,N#~:,++@ʌ3y@ڌ3Ҍ3   8q:!@7;8j0 TeB׳]h!I.k p8͐?G;M9p8>;!D78!A7q#~++w+qh9?DNn"~`35zr1{r1h!I|;?yO2J79|;?:A7S89/G2C7!J7 ;:C7297x!D7:7X:A::46;:97$:!B7~++w?!:74#):4S9+6!D7:7# A:ɯ# N:N:q:/!97Oyw#i:G:@7š:!97Vwz# :xr:w?!97ͭ::x:!A7ww?:~w# ¯:p8͐?G;:p8>;!D79p8͐?G;:p8>;S8!D7ñ9y2J7!@7y6igits (e.g. \\01, \\42, etc. - note that a leading zero should be used for numbers less that 10). You may use up to 99 markers. 2) Similarly, prepare the data file with VALDOCS. Enter each field of variable data on a separate line, and separate each group with a blank line. Example: if your base file uses \\01 for company name, \\02 for address and \\03 for city/state, the corresponding data file would be set up thus: COMPANY NAME #1 ADDRESS #1 CITY/STATE #1 COMP TO: Epson QX-10 Dealers FROM: Technical Support Department COMPUTRONICS DISTRIBUTING, INC. DATE: July 18, 1983 SUBJECT: VALMERGE Utility for Valdocs Computronics' software staff has developed a program called VALMERGE which will give VALDOCS the ability to generate multiple form letters. The VALDOCS editor is used to create a data file (containing names, addresses, etc.) and a base file (containing the text of the letter), and VALMERGE will link the files t~q+;q!;NsY+; ; W~w++;$;!@7(;=G;͐?!:7w#M;?^;}͓;g;Ù;͓;o>!=7F#^#V#NW?͙;}D7~#;G++Ny?:7;!>7͐?>;Ү;͹?;ͧ?;!B76|>g>@|=>!>¨;ak͐?;̀=;?!A7~+>w?= <ͱ??:A7ʙ??o>g@!>7O<~_#~W#~OW?#4F?.@W?G~_#~W#~O7>Ù>=l<ͱ??>O <=<ͱ?+>?ȯG`="'7y2)7FoB>K>!D*>7:@7OҼ<A74F?<7:@7enu of Applications and run VALINDEX.COM to get the "true" filenames on your data and base o produce a series of "customized form letters". In addition to VALDOCS and VALMERGE, the DEVAL program (which is used to "clean" the data and base files of special Valdocs control characters) and the VALINDEX program (which lists the index references and the true filenames on a VALDOCS data disk) will be needed. All these files may be obtained through Computronics Technical Support. The files VALMERGE.COM, DEVAL.COM and VALINDEX.COM should be placed on the VALDOCS data disk W?= =ͱ?ʜ??`=y+F+F+Fw`h|X=gy<=:>7O|g}oxG-|0=}+=Ù>ElaO*=!A7~Gxx=ƀv?wo>w+ɷF?w?ͧ?x{Ҝ?!B76|>wg=z= >@|i?{>2A7͙>/Ù>̈́>=K>z+>zB/>|G||/>?/>O_yW!B7~/woG}_}W}Ö́>͜?||DM!>))j> =b>!@7~7w?##wy7O*>7*@7"@7">7ajSX>w?JS\E!A7w?/x8>G@G>?ø>>+?>x| ?>>?ejSX ? files. VALINDEX can list either to the screen or to a printer. 4) Also in enu of Applications, run DEVAL.COM on both files to produce two new, "clean" files. When asked for the "VALDOCS" filename, enter the "true" filename (see step 3), and enter any descriptive name for the "OUTPUT" filename (e.g. MATRIX, DATA, etc.). NOTE: DEVAL will remove all special control characters from the file; therefore, your files will not be printed with special print characters (bold,  as non-indexed files, and will be later run as "applications" programs in VALDOCS. The procedure is as follows: 1) Prepare the base file with VALDOCS. Generally, this would be a one- page letter - a multi-page base file can be used, but you will have to merge each page separately. Also, each page must not exceed 60 text lines. For every area where variable data is to be inserted, place a four- character marker consisting of two backslash characters and two d ?ch|"?{_zW}o|g?"7"7x!7~w#2?+?>?_?J!A7qx!A7i?F#~怩OÙ? 4J?go">7"@7ͧ?s#r#q#pù?ͱ?͜?͹?">7`i"@7*>7*@7DM^#V#N#F#xy?:A7:@77|/G}/O!>? ?7>{_zW}o|g=?|g}o@CZQ@ o-yOzW{_xG@>7*@7DM^#V#N#F#xy?:A7:@77|/G}/O!>? ?7>{_zW}o|g=?|gO*>7*@7"@7">7ajSX>w?JS\E!A7w?/x8>G@G>?ø>>+?>x| ?>>?ejSX ?    italic, underline or correspondence quality). 5) Now, you are ready to run VALMERGE.COM (again, from enu of Applications). You will be asked to enter the number of fields in each set of entries (do NOT enter the number of sets), the names of the data and base files, and whether or not you are printing on continuous fanfold paper or single sheets. When these parameters are entered, VALMERGE will begin the printing run. One word of caution: long names or addresses asked to provide a filename for this output file and you must specify NO to the COMPRESS BLANK LINES? question. Using the ML program may be the best way for you to select the data for printing your form letters. The ML program allows you to select specific names and addresses from your data base using up to three fields for selection. If you compose your merge data file under VALDOCS, you must merge the entire file. ML allows you to be selective. When you Define your Lainserted into the body of the letter may disturb the text formatting, since VALMERGE will not automa- tically realign margins or right-justify after merging. To prevent this, leave the line short enough (by hitting a ) so that the filled-out line will not overrun the right margin. Example: the following line Looking forward to seeing you in \\13 and hope that all is well with will certainly extend past the right margin when marker \\13 is replaced with the data "Los Abel (DL) format, you must use the same format as shown on the previous page. If your letter is to use a persons last name within the text i.e.: Dear Mr. //LASTNAME Your ML data file definition must show the LAST NAME as a separate field when you design your mailing list data file. This is an important consideration when designing your file. You may find that if you have already designed your file with the FIRST and LAST name on the same line (FIELD), you ngeles". Breaking the line up, like so, Looking forward to seeing you in \\13 and hope that ... will help prevent this. You will have to examine the data file to see what the largest fields will be, and format the base file accordingly. It would also be desirable not to right-justify the base file so that variations in line lengths after merging will not be noticed. Obviously, data fields on their own line (e.g. the name/address at the beginning of a letter) wil will not e able to print only the LASTNAME as shown above. If you experiment with both the ML program and the VALMERGE.COM program, you may save yourself a lot of time. Happy merging..... ou may save yourself a lot of time. Happy merging..... You may find that if you have already designed your file with the FIRST and LAST name on the same line (FIELD), you l give you no trouble at all in this regard. VALMERGE - VALDOCS MERGE UTILITY Peachtree's MAILING LIST MANAGER program may also be utilized to create the data file for merging with your VALDOCS base letter. This is done in much the same fashion as you would use to generate mailing labels with the ML program. The only difference is that you when you're Producing a Mailing (PM) you must send output to the DISK rather than the PRINTER. You will be     10 FOR I=1 TO 15 20 PRINT 30 NEXT 40 INPUT "DATA BASE NAME";F$ 50 IF LEN(F$)>7 THEN F$=LEFT$(F$,7) 60 INPUT "NUMBER OF FIELDS";N 70 DIM A$(N),L(N),C(N),T$(N) 80 FOR I=1 TO N 90 INPUT "FIELD NAME, LENGTH, KEY(Y/N), TYPE(C/N)";A$(I),L(I),X$,T$(I) 100 IF L(I)<1 OR L(I)<>INT(L(I)) THEN 120 110 GOTO 130 120 INPUT "INVALID LENGTH - RE-ENTER";L(I):GOTO 100 130 IF LEFT$(X$,1)="N" THEN C(I)=0:GOTO 160 140 IF LEFT$(X$,1)="Y" THEN C(I)=1:GOTO 160 150 INPUT "INVALID KEY - RE-ENTER";X$:GOTO 130 160 T$(IN GOSUB 7000:GOTO 500 720 IF Q$="END" THEN 780 730 PRINT "INVALID OPTION SELECTED '";Q$;"'" 740 PRINT 750 PRINT 760 PRINT 770 GOTO 530 780 CLEAR 100 790 END 1000 PRINT 1010 PRINT 1020 INPUT "KEY OF RECORD";A$ 1030 A$=LEFT$(A$+SPACE$(L(K9)),L(K9)) 1040 GOSUB 3500 1050 IF P>0 THEN 1090 1060 PRINT A$;" KEY NOT FOUND"; 1070 INPUT Q$ 1080 GOTO 1110 1090 GOSUB 4000 1100 INPUT Q$ 1110 RETURN 1500 FOR I=1 TO 15 1510 PRINT 1520 NEXT I 1530 INPUT "RECORD KEY";A$ 1540 A$=LEFT$(A$+SPACE$(L(K9))10 FOR I=1 TO 15 20 PRINT 30 NEXT I 40 CLEAR 4000 50 INPUT "DATA BASE NAME";F$ 60 IF LEN(F$)>7 THEN F$=LEFT$(F$,7) 70 PRINT 80 INPUT "IS THE DATA BASE DISK MOUNTED";Q$ 90 IF LEFT$(Q$,1)="Y" THEN 130 100 INPUT "HIT ENTER WHEN DISK IS MOUNTED";Q$ 120 RESET 130 OPEN "I",1,"X"+F$ 140 INPUT #1,Q,N 150 DIM L(N),T$(N),N$(N) 160 DIM K$(Q),K(Q),NX(Q) 170 FOR I=1 TO N 180 INPUT #1,L(I),N$(I),X,T$(I) 190 L=L+L(I) 200 IF X=1 AND K9=0 THEN K9=I 210 NEXT I 220 CLOSE 1 230 C=INT(128/L) 240 DIM Z$(N*C)=LEFT$(T$(I),1) 170 IF T$(I)="C" THEN 210 180 IF T$(I)="N" THEN 200 190 INPUT "INVALID TYPE - RE-ENTER";T$(I):GOTO 160 200 IF L(I)<>2 AND L(I)<>4 THEN 120 210 NEXT I 220 PRINT 230 INPUT "NUMBER OF RECORDS";Q 240 IF Q<1 OR Q<>INT(Q) THEN 230 250 IF Q>500 THEN PRINT "THAT IS TOO MANY FOR THE DISK":GOTO 230 260 PRINT 270 L=0 280 PRINT 290 PRINT "DATA BASE NAME = ";F$ 300 PRINT 310 PRINT Q;"TOTAL RECORDS IN DATA BASE" 320 PRINT 330 PRINT "FIELD NAME","LENGTH","KEY","TYPE" 340 PRINT 350 FOR ,L(K9)) 1550 GOSUB 3500 1560 IF P>0 THEN GOTO 1580 1570 GOTO 2500 1580 GOSUB 4000 1590 INPUT Q$ 1600 PRINT 1610 INPUT "FIELD TO BE CAHNGED";B$ 1620 PRINT 1630 IF B$="?" THEN GOSUB 1850:GOTO 1600 1640 FOR I=1 TO N 1650 IF N$(I)=LEFT$(B$+SPACE$(LEN(N$(I))),LEN(N$(I))) THEN 1690 1660 NEXT I 1670 PRINT "INVALID FIELD NAME - TRY AGAIN" 1680 GOTO 1600 1690 IF I<>K9 THEN 1740 1700 PRINT 1710 PRINT "KEY CANNOT BE CHANGED" 1720 INPUT Q$ 1730 GOTO 1840 1740 PRINT "NEW VALUE"; 1750 IF T$(I)="C" TH) 250 OPEN "R",1,F$ 260 X=0 270 FOR J=1 TO C 280 FOR I=1 TO N 290 FIELD #1,X*(I+1-I) AS D$,L(I) AS Z$(I+((J-1)*N)) 300 X=X+L(I) 310 NEXT I 320 NEXT J 330 FOR I=1 TO Q 340 NX(I)=-1 350 NEXT I 360 J=1 370 I=1 380 R=Q 390 FOR P=1 TO Q 400 GOSUB 4500 410 IF Z$(K9+K0)=SPACE$(L(K9)) THEN NX(J)=P:J=J+1:GOTO 450 420 K$(I)=Z$(K9+K0) 430 K(I)=P 440 I=I+1 450 NEXT P 460 R=I 470 W=J 500 FOR I=1 TO 15 510 PRINT 520 NEXT I 530 FOR I=1 TO 3 540 PRINT 550 NEXT I 560 PRINT "COMMANDS:" 570 PRINI=1 TO N 360 PRINT A$(I), 370 PRINT L(I), 380 L=L+L(I) 390 IF C(I)=1 THEN PRINT "Y", ELSE PRINT "N", 400 PRINT T$(I) 410 NEXT I 420 PRINT 430 INPUT "EVERYTHING OK";Q$ 440 IF LEFT$(Q$,1)<>"Y" THEN 850 450 INPUT "IS DATA BASE DISK MOUNTED";Q$ 460 IF LEFT$(Q$,1)="Y" THEN 490 470 INPUT "ENTER WHEN NEW DISK IS READY";Q$ 480 RESET 490 OPEN "O",1,"X"+F$ 500 PRINT #1,Q,N 510 FOR I=1 TO N 520 PRINT #1,L(I);A$(I);",";C(I);T$(I) 530 NEXT I 540 CLOSE 1 550 C=INT(128/L) 560 DIM Z$(N*C) 570 OPEN "R"EN GOTO 1790 1760 INPUT Z 1770 IF L(I)=2 THEN LSET Z$(I+K0)=MKI$(Z) ELSE LSET Z$(I+K0)=MKS$(Z) 1780 GOTO 1810 1790 INPUT Z$ 1800 LSET Z$(I+K0)=Z$ 1810 INPUT "ANYMORE CHANGES";Q$ 1820 IF LEFT$(Q$,1)="Y" THEN 1600 1830 GOSUB 5000 1840 RETURN 1850 FOR I=1 TO N 1860 PRINT TAB(5);N$(I) 1870 NEXT I 1880 RETURN 2000 FOR Y=1 TO R-1 2010 P=K(Y) 2020 GOSUB 4500 2030 GOSUB 4000 2040 INPUT Q$ 2050 NEXT Y 2060 PRINT 2070 PRINT 2080 PRINT "TOTAL NUMBER OF RECORDS ON FILE =";R-1 2090 PRINT 2100 INPT TAB(5);"DELETE" 580 PRINT TAB(5);"DISPLAY" 590 PRINT TAB(5);"LIST" 600 PRINT TAB(5);"UPDATE" 610 PRINT TAB(5);"SECONDARY KEY DISPLAY" 620 PRINT TAB(5);"RELATIONAL DISPLAY" 630 PRINT TAB(5);"END" 640 PRINT 650 INPUT "OPTION";Q$ 660 IF LEFT$(Q$,2)="DE" THEN GOSUB 3000:GOTO 500 670 IF LEFT$(Q$,2)="DI" THEN GOSUB 1000:GOTO 500 680 IF LEFT$(Q$,1)="L" THEN GOSUB 2000:GOTO 500 690 IF LEFT$(Q$,1)="U" THEN GOSUB 1500:GOTO 500 700 IF LEFT$(Q$,2)="SE" THEN GOSUB 5500:GOTO 500 710 IF LEFT$(Q$,1)="R" THE,1,F$ 580 A=0 590 A=0 600 FOR J=1 TO C 610 FOR I=1 TO N 620 FIELD #1,A*(I+1-I) AS D$,L(I) AS Z$(I+((J-1)*N)) 630 A=A+L(I) 640 NEXT I 650 NEXT J 660 FOR J=1 TO C 670 FOR I=1 TO N 680 IF T$(I)="C" THEN LSET Z$(I+((J-1)*N))=" ":GOTO 710 690 IF L(I)=2 THEN LSET Z$(I+((J-1)*N))=MKI$(0):GOTO 710 700 LSET Z$(I+((J-1)*N))=MKS$(0) 710 NEXT I 720 NEXT J 730 C1=INT(Q/C) 740 IF Q*C<>C1 THEN C1=C1+1 750 FOR I=1 TO C1 760 PUT #1,I 770 NEXT I 780 CLOSE 1 790 PRINT 800 PRINT 810 PRINT "DONE"    UT Q$ 2110 RETURN 2500 FOR I=1 TO 15 2510 PRINT 2520 NEXT I 2522 P=NX(1) 2525 GOSUB 4500 2530 P=NX(1) 2540 GOSUB 4500 2550 FOR I=1 TO N 2560 IF T$(I)="C" THEN 2590 2570 IF L(I)=2 THEN LSET Z$(I+K0)=MKI$(0) ELSE LSET Z$(I+K0)=MKS$(0) 2580 GOTO 2600 2590 LSET Z$(I+K0)=" " 2600 NEXT I 2610 LSET Z$(K9+K0)=A$ 2620 FOR I=1 TO N 2630 IF I=K9 THEN 2710 2640 PRINT N$(I); 2650 IF T$(I)="C" THEN 2690 2660 INPUT X 2670 IF L(I)=2 THEN LSET Z$(K0+I)=MKI$(X) ELSE LSET Z$(I+K0)=MKS$(X) 2680 GOTO 2710 V$ THEN 5960 ELSE 5980 5900 IF SE$="NE" THEN IF Z$(B+K0)<>V$ THEN 5960 ELSE 5980 5910 IF SE$="GT" THEN IF Z$(B+K0)>V$ THEN 5960 ELSE 5980 5920 IF SE$="LT" THEN IF Z$(B+K0)V$ THEN 5960 ELSE 5980 5950 GOTO 5980 5960 GOSUB 4000 5970 INPUT Q$ 5980 NEXT I1 5990 RETURN 6000 FOR I=1 TO N 6010 PRINT TAB(5);N$(I) 6020 NEXT I 6030 RETURN 7000 FOR I=1 TO 15 7010 PRINT 7020 NEXT I 7030  4540 P1=P0 4550 K0=P-((P0-1)*C)-1 4560 K0=K0*N 4570 RETURN 5000 IF P<1 OR P>R THEN PRINT "INVALID PARAMETER (PUT)";P:GOTO 5030 5010 P0=INT((P+C-1)/C) 5020 PUT #1,P0 5030 RETURN 5500 FOR I=1 TO 15 5510 PRINT 5520 NEXT I 5530 INPUT "SECONDARY KEY NAME";S$ 5540 PRINT 5550 IF S$="?" THEN GOSUB 6000:PRINT:GOTO 5530 5560 FOR I=1 TO N 5570 IF N$(I)=LEFT$(S$+SPACE$(LEN(N$(I))),LEN(N$(I))) THEN 5610 5580 NEXT I 5590 PRINT "ERROR - FIELD NOT FOUND" 5600 PRINT:GOTO 5530 5610 PRINT 5620 PRINT" SE 2690 INPUT Z$ 2700 LSET Z$(I+K0)=Z$ 2710 NEXT I 2720 GOSUB 4000 2730 INPUT "DO YOU ACCEPT THIS ENTRY";Q$ 2740 IF LEFT$(Q$,1)<>"Y" THEN 2500 2750 P=NX(1) 2760 FOR I=1 TO W-2 2770 NX(I)=NX(I+1) 2780 IF NX(I)=-1 THEN 2800 2790 NEXT I 2800 K(R)=P 2810 K$(R)=A$ 2820 R=R+1 2830 GOSUB 5000 2840 RETURN 3000 FOR I=1 TO 15 3010 PRINT 3020 NEXT I 3030 INPUT "RECORD KEY";A$ 3040 A$=LEFT$(A$+SPACE$(L(K9)),L(K9)) 3050 GOSUB 3500 3060 IF P<0 THEN 3190 3070 GOSUB 4000 3080 PRINT 3090 INPUT "OK TO PRINT "RELATION TYPE:" 7040 PRINT " FIELD TO FIELD" 7050 PRINT " RECORD TO RECORD" 7060 PRINT 7070 INPUT Q$ 7080 IF Q$="END" THEN 8380 7090 IF LEFT$(Q$,1)="F" THEN 7130 7100 IF LEFT$(Q$,1)="R" THEN 7860 7110 PRINT " >>> ERROR - INVALID SELECTION <<<" 7120 PRINT:PRINT:GOTO 7030 7130 PRINT:PRINT 7140 PRINT "FIELD-TO-FIELD" 7150 PRINT 7160 INPUT "PRIMARY FIELD NAME";Q1$ 7170 IF Q1$="?" THEN GOSUB 8440:GOTO 7150 7180 FOR I=1 TO N 7190 IF Q1$=LEFT$(N$(I),LEN(Q1$)) THEN 7240 7200 NEXT I 72LECT COMPARE OPERATION:" 5630 PRINT " EQ = EQUAL NE = NOT EQUAL" 5640 PRINT " GT = GREATER THAN LT = LESS THAN" 5650 PRINT " GE = GREATER/EQUAL LE = LESS/EQUAL" 5660 PRINT 5670 INPUT SE$ 5680 IF SE$="EQ" OR SE$="NE" OR SE$="GT" OR SE$="LT" OR SE$="GE" OR SE$="LE" THEN 5700 5690 PRINT:PRINT "SELECTION ERROR::":GOTO 5610 5700 IF T$(I)="C" THEN 5730 5710 INPUT "ENTER KEY VALUE";V 5720 GOTO 5760 5730 INPUT "ENTER KEY VALUE";V$ 5740 B=I 5750 V$=LEFT$(V$+SPACE$(L(B)),L(B)) DELETE";Q$ 3100 IF LEFT$(Q$,1)<>"Y" THEN 3190 3110 FOR I=1 TO N 3120 IF T$(I)="C" THEN 3150 3130 IF L(I)=2 THEN LSET Z$(I+K0)=MKI$(0) ELSE LSET Z$(I+K0)=MKS$(0) 3140 GOTO 3160 3150 LSET Z$(I+K0)=" " 3160 NEXT I 3170 GOSUB 5000 3180 FOR I=1 TO R 3190 IF K$(I)=A$ THEN 3210 3200 NEXT I 3210 FOR J=I TO R 3220 K$(J)=K$(J+1) 3230 K(J)=K(J+1) 3240 NEXT J 3250 R=R-1 3260 K(R)=0 3270 K$(R)=" " 3280 NX(W)=P 3290 W=W+1 3300 RETURN 3500 FOR I=1 TO R-1 3510 IF A$=K$(I) THEN 3550 3520 NEXT I 353010 PRINT " >>> ERROR - NO SUCH FIELD <<<" 7220 PRINT 7230 GOTO 7160 7240 I9=I 7250 PRINT 7260 INPUT "SECONDARY FIELD NAME";Q1$ 7270 IF Q1$="?" THEN GOSUB 8440:GOTO 7250 7280 FOR I=1 TO N 7290 IF Q1$=LEFT$(N$(I),LEN(Q1$)) THEN 7340 7300 NEXT I 7310 PRINT " >>> ERROR - NO SUCH FIELD <<<" 7320 PRINT 7330 GOTO 7260 7340 I8=I 7350 IF T$(I9)=T$(I8) THEN 7400 7360 PRINT 7370 PRINT " >>> ERROR - FIELD TYPES NOT THE SAME <<<" 7380 PRINT 7390 GOTO 7030 7400 FOR I=1 TO 15 7410 PRINT 7420 NEX 5760 B=I 5770 FOR I1=1 TO R-1 5780 P=K(I1) 5790 GOSUB 4500 5800 IF T$(B)="C" THEN 5890 5810 IF L(B)=2 THEN C1=CVI(Z$(B+K0)) ELSE C1=CVS(Z$(B+K0)) 5820 IF SE$="EQ" THEN IF V=C1 THEN 5960 ELSE 5980 5830 IF SE$="NE" THEN IF V<>C1 THEN 5960 ELSE 5980 5840 IF SE$="GT" THEN IF VC1 THEN 5960 ELSE 5980 5860 IF SE$="LE" THEN IF V=>C1 THEN 5960 ELSE 5980 5870 IF SE$="GE" THEN IF V=R THEN PRINT "INVALID PARAMETER (GET)";P:GOTO 4570 4510 P0=INT((P+C-1)/C) 4520 IF P0=P1 THEN 4540 4530 GET #1,P0    T I 7430 PRINT "HOW IS ";N$(I9);" TO BE COMPARED TO ";N$(I8) 7440 PRINT 7450 PRINT TAB(15);"EQ = EQUAL NE = NOT EQUAL" 7460 PRINT TAB(15);"LT = LESS THAN LE = LESS/EQUAL" 7470 PRINT TAB(15);"GT = GREATER THAN GE = GREATER/EQUAL" 7480 PRINT 7490 INPUT Q1$ 7500 IF Q1$="EQ" THEN 7600 7510 IF Q1$="NE" THEN 7600 7520 IF Q1$="LT" THEN 7600 7530 IF Q1$="GT" THEN 7600 7540 IF Q1$="LE" THEN 7600 7550 IF Q1$="GE" THEN 7600 7560 PRINT 7570 PRINT " >>> ERROR - INVALID COMPARISON OPERATION " THEN IF Z$(I8+K0)Q9$ THEN 8280 ELSE 8260 8370 GOTO 8260 8380 PRINT 8390 PRINT 8400 PRINT TAB(20);"DONE" 8410 PRINT 8420 INPUT Q$ 8430 RETURN 8440 PRINT 8450 PRINT 10 IF Q1$="EQ" THEN IF Z$(I8+K0)=Q9$ THEN 8280 ELSE 8260 8320 IF Q1$="NE" THEN IF Z$(I8+K0)<>Q9$ THEN 8280 ELSE 8260 8330 IF Q1$="GE" THEN IF Z$(I8+K0)=>Q9$ THEN 8280 ELSE 8260 8340 IF Q1$="LE" THEN IF Z$(I8+K0)=>> ERROR - INVALID FIELD <<<" 8010 GOTO 7930 8020 PRINT:PRINT:PRINT 8030 PRINT "HOW IS THE BASE TO BE COMPARED:" 8040 PRINT TAB(10);"EQ = EQUAL NE = NOT EQUAL" 8050 PRINT TAB(10);"GT = GREATER THAN GE = GREATER/EQUAL" 8060 PRINT TAB(10);"LT = LESS THAN LE = LESS/EQUAL" 8070 PRINT 8080 INPUT Q1$ 8090 IF Q1$="EQ" OR Q1$="NE" OR Q1$="LE" OR Q1$="LT" OR Q1$="GT" OR Q1$="GE" THEN 8110 <<<" 7580 PRINT 7590 GOTO 7440 7600 FOR Y=1 TO R-1 7610 P=K(Y) 7620 GOSUB 4500 7630 IF T$(I8)="C" THEN 7770 7640 IF L(I9)=2 THEN V=CVI(Z$(I9+K0)) ELSE V=CVS(Z$(I9+K0)) 7650 IF L(I8)=2 THEN V1=CVI(Z$(I8+K0)) ELSE V1=CVS(Z$(I8+K0)) 7660 IF Q1$="EQ" THEN IF V=V1 THEN 7740 ELSE 7720 7670 IF Q1$="NE" THEN IF V<>V1 THEN 7740 ELSE 7720 7680 IF Q1$="GE" THEN IF V=>V1 THEN 7740 ELSE 7720 7690 IF Q1$="LE" THEN IF V=>> ERROR - INVALID COMPARISON OPERATION <<<":PRINT:GOTO 8030 8110 IF T$(I)="C" THEN Q9$=Z$(I+K0) ELSE IF L(I)=2 THEN V=CVI(Z$(I+K0)) ELSE V=CVS(Z$(I+K0)) 8120 I9=P 8130 I8=I 8140 FOR Y=1 TO R-1 8150 P=K(Y) 8160 IF P=I9 THEN 8260 8170 GOSUB 4500 8180 IF T$(I8)="C" THEN 8310 8190 IF L(I8)=2 THEN V1=CVI(Z$(I8+K0)) ELSE V1=CVS(Z$(I8+K0)) 8200 IF Q1$="EQ" THEN IF V=V1 THEN 8280 ELSE 8260 8210 IF Q1$="NE" THEN IF V<>V1 THEN 8280 ELSE 8260 8220 IF Q1$="GE" THEN IF V=>V1 THEN 8280 T" THEN IF V>V1 THEN 7740 ELSE 7720 7720 NEXT Y 7730 GOTO 8380 7740 GOSUB 4000 7750 PRINT:INPUT Q$:PRINT 7760 GOTO 7720 7770 V=L(I8) 7780 IF V>L(I9) THEN V=L(I9) 7790 IF Q1$="EQ" THEN IF LEFT$(Z$(I9+K0),V)=LEFT$(Z$(I8+K0),V) THEN 7740 ELSE 7720 7800 IF Q1$="NE" THEN IF LEFT$(Z$(I9+K0),V)<>LEFT$(Z$(I8+K0),V) THEN 7740 ELSE 7720 7810 IF Q1$="GE" THEN IF LEFT$(Z$(I9+K0),V)=>LEFT$(Z$(I8+K0),V) THEN 7740 ELSE 7720 7820 IF Q1$="LE" THEN IF LEFT$(Z$(I9+K0),V)=V1 THEN 8280 ELSE 8260 8260 NEXT Y 8270 GOTO 8380 8280 GOSUB 4000 8290 PRINT:INPUT Q$:PRINT 8300 GOTO 8260 8310 IF Q1$="EQ" THEN IF Z$(I8+K0)=Q9$ THEN 8280 ELSE 8260 8320 IF Q1$="NE" THEN IF Z$(I8+K0)<>Q9$ THEN 8280 ELSE 8260 8330 IF Q1$="GE" THEN IF Z$(I8+K0)=>Q9$ THEN 8280 ELSE 8260 8340 IF Q1$="LE" THEN IF Z$(I8+K0)=LEFT$(Z$(I8+K0),V) THEN 7740 ELSE 7720 7850 GOTO 7720 7860 PRINT 7870 PRINT "RECORD-TO-RECORD" 7880 PRINT 7890 INPUT "PRIMARY KEY OF BASE RECORD";Q1$ 7900 A$=LEFT$(Q1$+SPACE$(L(K9)),L(K9)) 7910 GOSUB 3500 7920 IF P<0 THEN PRINT " >>> ERROR - RECORD NOT FOUND <<<":GOTO 7030 7930 PRINT 7940 INPUT "WHICH FIELD IS TO BE COMPARED";Q1$ 7950 IF Q1$="?" THEN GOSUB 8440:GOTO 7930     CHR(27)+"l" CHR(27)+"m" CHR(27)+')' CHR(27)+'(' | *| | *|SYSTEM: Any system running dBASE II version 2.3B or equivalent | *| | *|PURPOSE: To provide a callable Procedure for printing or displaying | *| a dBASE II text string (field or memory variable) that | *| exceeds one line and have the line break at a space or -. | *|  | *|SUMMARIZE REVISION: | *| | *| | *|SUBMITTED BY: Melissa Gray, Mountain View, CA (415)965-3267 | *|ORIGINAL AUTHOR: Melissa Gray | *|OTHER CONTRIBUTORS: | *|  | *|REFERENCE: none | *| | *|DOCUMENTATION: Fairly extensive documentation both in the code and in | *| a separate .DOC file. However, with the number of | *| options available, the documentation is not all- | *| together clear. | *| *+======================================================================+ *| | *|TITLE: PRINTEXT.CMD - dBASE II PROCEDURE TO PRINT TEXT ON MULTIPLE | *| LINES. | *|DATE: 12/15/82 VERSION: 1.0 LANGUAGE: dBASE II (2.3B) | *|SQUEEZED NAME: PRINTEXT.CQD LIBRARY NAME: PRINTEXT.LBR | *|RELATED FILES: PRINTEXT.DQC->PRINTEXT.DOC BB    | *|PROGRAM USAGE: Since dBASE II does not seem to be able to print out | *| text that exceeds the capacity of a line and break | *| it at a reasonable place, this procedure should allow | *| more use of dBASE for long text fields. | *| | *|RATING: *** [slow when called from DO, beginning effort of programmer]| *|  - begin double-strike &ED - end double-strike &BE - begin emphasized print &EE - end emphasized print &BI - begin italic print &EI - end italic print &BL - begin underlining &EL - end underlining &BS - begin superscript &ES - end superscript &BW - begin double width &EW - end double width &RESET - clear all settings to power-on defaults and move paper to top of form. Not tha thes code won' wor i .FR file  dBase II Screen and Print Formatting Programming Tip by David A. Basskin, Toronto, Ontario INTRODUCTION I you'v go a OSBORN an a EPSO MX-80 yo ma fin thes tw file o som use Rathe tha goin t th troubl o typin ou contro code t forma th scree wit underline and/o half-intensit character ever tim yo se u scree o pag forma file yo ca us th macr substit | *+======================================================================+ dure should allow | *| more use of dBASE for long text fields. | *| | *|RATING: *** [slow when called from DO, beginning effort of programmer]| *|  generate b REPORT the mus appea i .FMԠ o .CMD files. MODIFICATIONS I you'r usin differen printer o dBas o differen computer th principl behin thi programmin ti ca b easil adapted I you termina support revers vide o blinkin curso (whic th Osborn doe not) thos code coul easil b adde t SCREEN Similarly proportiona spacing toggle could be added to PRINT. Send any questions or comments to: utio functio o dBas t tak ove thi tiresom job M suggestio i t kee the o th sam dis a DBASE.CO an RESTOR the t memor a your convenience. SCREEN.MEM Jus RESTOR thi fil o memor variable an us th followin command i you scree forma files: &BL - begins underlining &EL - ends underlining &BH - begins half-intensity &EH - ends half-intensity not tha th underlinin functio underline th whol fiel t David A. Basskin 5 Douville Ct., Toronto, Ont., M5A 4E7 Phone: 368-1085 ====================================================mina support revers vide o blinkin curso (whic th Osborn doe not) thos code coul easil b adde t SCREEN Similarly proportiona spacing toggle could be added to PRINT. Send any questions or comments to:  whic i applies whethe o no filled. To underline one field, you could type: . DISPLAY &BL,FIELD1,&EL,FIELD2 ... and so on. PRINT.MEM Thi fil i use i th sam wa a SCREEN Ther i n nee t releas al th variable fro th former SCREEΠ an PRIN shar n variable name an s bot ca b use together Th command will change the setup of an Epson MX-80 as follows: &BC - begin compressed print &EC - end compressed print &BD   10,-10,30,6,-19,22,-2 650 DATA 9,10,7,-5,-20,12,21,18,7 660 DATA 7,8,5,-6,-40,3,16,-14,4 670 DATA 8,6,4,-4,40,8,4,-12,3 680 DATA 6,4,3,3,-15,5,8,-8,5 690 DATA 5,7,-1,-3,45,6,-10,10,4 700 DATA -2,6,-3,-8,-20,7,10,14,6 710 DATA 11,11,-5,-7,30,10,-11,-18,-4 720 DATA -5,13,-8,6,25,4,18,-22,-4 730 DATA -8,-10,-10,-15,-20,-20,-23,-25,-7 740 DATA 5,1,0,4,7,0,0,2,6,3 750 REM 760 REM SECURITY NAMES 770 REM 780 A$="HIGHWAY IMPROVEMENT BONDS" 790 B$="X-PANDO CORPORATION" 800 C$="SEASIDE PROPERTIES IN,0,0,0,5,0,0,0,0,0 220 DATA 1,0,0,0,0,0,10,0,0,0,0,0 230 DATA 0,0,10,0,0,0,0,0,0,0,0,0 240 DATA 1,0,0,0,0,0,15,0,0,0,0,0 250 DATA 0,0,-5,0,0,0,0,0,0,0,0,0 260 DATA 1,8,5,5,0,0,0,7,0,0,0,0 270 DATA 0,0,0,0,0,0,0,0,-25,0,0,0 280 DATA 1,0,0,0,0,0,0,0,10,0,0,0 290 DATA 0,0,-10,0,0,0,0,0,0,0,0,0 300 DATA 1,0,5,0,0,0,0,0,0,0,0,0 310 DATA 0,10,0,0,0,0,0,0,0,0,1,0 320 DATA 1,0,0,0,0,17,0,0,0,0,0,0 330 DATA 0,0,0,0,0,-15,0,0,0,0,0,0 340 DATA 1,0,0,0,0,0,0,0,10,0,0,0 350 DATA 0,0,0,0,0,0,0,-15,0,0,0,0 C." 810 D$="OLD DOG MUTUAL FUND" 820 E$="RUBBLE DEVELOPMENT" 830 F$="SLIPPERY OIL COMPANY" 840 G$="BUMPY TRANSPORT CO." 850 H$="KRASH AUTO COMPANY" 860 I$="ZAP ELECTRONICS " 870 J$="BLINKEY POWER & LIGHT CO." 880 REM 970 REM 980 PRINT "WANT INSTRUCTIONS"; 990 INPUT R$ 1000 IF LEFT$(R$,1)="N" THEN 1280 1010 IF LEFT$(R$,1)<>"Y" THEN 990 1020 PRINT 1030 PRINT "THE MAIN OBJECT OF BLACK FRIDAY IS TO SHREWDLY INVEST $5000" 1040 PRINT"IN THE GAME'S 10 SECURITIES, BUYING AND SELLING EACH YEAR FOR"360 DATA 1,0,0,0,0,0,0,10,0,0,0,0 370 DATA 0,0,0,0,0,0,0,-15,0,0,0,0 380 DATA 1,0,0,-8,0,8,0,0,5,0,0,0 390 DATA 0,-10,0,0,0,0,0,0,0,0,0,0 400 DATA 1,8,0,0,0,0,0,0,0,0,0,0 410 DATA 0,0,0,0,0,0,0,-10,0,0,0,0 420 DATA 1,0,0,3,0,0,0,0,0,4,0,0 430 DATA 0,-8,0,0,0,0,0,0,0,0,0,0 440 DATA 1,0,0,0,5,0,0,0,0,0,0,0 450 DATA 0,0,0,0,0,-10,0,0,0,0,0,0 460 DATA 1,0,0,0,0,0,0,10,0,0,0,0 470 DATA 0,-8,-5,0,0,0,0,-7,0,0,0,0 480 DATA 1,10,0,0,0,0,0,0,0,0,0,0 490 DATA 0,0,0,0,0,0,0,0,0,-14,0,0 500 DATA 1,-10,0,0 10 REM AUTHOR: ROBERT W. BAKER 20 REM MODIFIED FOR BASIC-E BY R S MASON 9-25-77 30 REM RE-MODIFIED FOR MICROSOFT BY A.R.G. 33 REM THIS PROGRAM REQUIRES CP/M WITH 26K OF MEMORY 36 REM 40 REM THIS GAME IS WRITTEN TO PROVIDE A REALISTIC MODEL OF THE 50 REM ACTUAL STOCK MARKET RATHER THAN A COMPLETELY RANDOMIZED 60 REM HAPPENING OF EVENTS. 70 REM 80 REM 100 DIM A(36,12),U(11,9),E(11,9),K(10),T(10),F(9),M(4,12),X(4) 102 FOR I=1 TO 36: FOR J=1 TO 12: READ A(I,J): NEXT J: NEXT I 105 FOR 1050 PRINT"A MAXIMUM OF 10 YEARS (ROUNDS) IN AN ATTEMPT TO BECOME" 1060 PRINT"THE WEALTHIEST PLAYER." 1070 PRINT 1080 PRINT"EACH YEAR ALL PLAYERS WILL RECEIVE DIVIDENDS ON EVERY PAYING" 1090 PRINT"STOCK WHICH IS WORTH $50 OR MORE. THEN EACH PLAYER WILL" 1100 PRINT"GET A CHANCE TO SELL ANY STOCKS HE OWNS OR BUY ANY STOCKS" 1110 PRINT"HE WISHES. AT THE END OF THE SELECTED NUMBER OF YEARS" 1120 PRINT"EACH PLAYER'S NET WORTH WILL BE CALCULATED AND THE WEALTHIEST" 1130 PRINT"PLAYER WINS!" 1140 PRINT,0,0,0,0,0,0,0,0 510 DATA 0,0,0,0,0,0,-5,0,0,0,0,0 520 DATA -2,-10,7,-9,-2,-9,-7,-16,-4 530 DATA 26,16,25,8,-14,21,14,-4,17 540 DATA 18,23,11,12,46,18,-5,34,15 550 DATA 23,28,-2,11,56,19,30,29,14 560 DATA 20,15,15,7,-20,15,13,-10,12 570 DATA 17,21,13,-2,37,23,23,19,14 580 DATA 19,24,17,9,-5,26,13,-7,15 590 DATA 11,18,14,11,67,15,22,18,13 600 DATA 13,31,1,14,-11,18,18,-14,10 610 DATA 14,-8,19,1,-9,25,-10,13,19 620 DATA 24,24,23,20,51,27,38,33,18 630 DATA 12,14,13,10,10,20,21,25,8 640 DATA 7,-6, I=1 TO 11: FOR J=1 TO 9: READ U(I,J): NEXT J: NEXT I 107 FOR I=1 TO 11: FOR J=1 TO 9: READ E(I,J): NEXT J: NEXT I 111 FOR N=1 TO 10 112 READ K(N) 113 NEXT N 115 V$="HIBXP SP ODMRD SO BT KA ZE BPL" 120 Y$="$5 $1 NONE$4 $7 NONENONE$2 $6 $3 " 130 REM 140 REM DATA TO SIMULATE REAL LIFE STOCK MARKET 150 REM 160 DATA 1,0,0,0,0,0,0,0,0,5,0,0 170 DATA 0,0,0,0,0,0,-25,0,0,0,0,0 180 DATA 1,0,0,0,0,0,0,15,0,0,0,0 190 DATA 0,0,0,0,-5,0,0,0,0,0,0,0 200 DATA 1,0,0,0,0,0,0,0,0,5,0,0 210 DATA 0,0,0    1150 PRINT"IF THE VALUE OF ANY STOCK FALLS TO 0,THAT STOCK GOES BANKRUPT" 1160 PRINT"AND ALL SHARES ARE SURRENDERED.THE VALUE OF THE STOCK IS THEN" 1170 PRINT"ESTABLISHED AT $100. IF THE VALUE OF ANY STOCK REACHES $150," 1180 PRINT"THERE WILL BE A STOCK SPLIT.ANY PLAYERS OWNING SHARES OF THAT" 1190 PRINT"STOCK WILL RECEIVE THE EXTRA SHARES. THE VALUE OF THE STOCK" 1200 PRINT"IS HALVED (ROUNDED UP TO THE NEXT HIGHEST DOLLAR)." 1210 PRINT 1220 PRINT"A TABLE WILL BE PRINTED EACH YEAR GIVING THE CHANGEM(N,1); 2460 NEXT N 2470 PRINT 2471 PRINT 2472 PRINT "NEW NET WORTH "; 2473 GOSUB 4500 2474 FOR N=1 TO P 2475 PRINT TAB(18+8*N);X(N); 2476 NEXT N 2480 IF Y=S THEN 2990 2490 REM 2500 REM 2510 REM CHECK IF ANYONE WANTS TO SELL OR BUY ANYTHING 2520 REM 2530 FOR N=1 TO P 2540 PRINT 2550 PRINT "*** PLAYER ";N;" ***" 2560 PRINT 2570 PRINT "YOU NOW HAVE $";M(N,1) 2580 FOR J=1 TO 10 2590 IF M(N,J+1)<>0 THEN 2620 2600 NEXT J 2610 GOTO 2770 2620 PRINT "WANT TO SELL"; 2630 INPUT R$ 2640 IF 1780 1770 T(N)=T(N)/2 1780 FOR J=1 TO P 1790 M(J,N+1)=M(J,N+1)*2 1800 NEXT J 1810 REM 1820 REM CHECK FOR BANKRUPT STOCKS 1830 REM 1840 IF T(N)>0 THEN 1910 1850 T(N)=100 1860 FOR J=1 TO P 1870 M(J,N+1)=0 1880 NEXT J 1890 PRINT "*** "+S$+" WENT BANKRUPT ***" 1900 PRINT "THESE STOCKS MUST BE SURRENDERED" 1910 NEXT N 1920 Y=Y+1 1930 REM 1940 REM ADD EACH PLAYERS DIVIDENDS TO TOTAL CASH 1950 REM 1960 FOR N=1 TO P 1970 M(N,12)=0 1980 FOR J=1 TO 10 1990 IF T(J)<50 THEN 2010 2000 M(N,12) IN VALUE" 1230 PRINT"OF EACH STOCK, THE PRESENT PRICE, AND THE NUMBER OF SHARES" 1240 PRINT"EACH PLAYER OWNS OF EVERY STOCK. ALSO, ANY DIVIDENDS RECEIVED" 1250 PRINT"FOR THE YEAR WILL BE SHOWN ALONG WITH EACH PLAYERS TOTAL CASH" 1260 PRINT 1270 PRINT"******GOOD LUCK TO EVERYONE!******" 1280 PRINT 1290 PRINT"AVAILABLE SECURITIES, ABBREVIATION, DIVIDENDS PER SHARE" 1300 PRINT 1310 FOR N=1 TO 10 1320 GOSUB 4000 1325 PRINT S$,MID$(V$,3*N-2,3),MID$(Y$,4*N-3,4) 1330 NEXT N 1340 PRINT 1350 PRINT "NUR$="N" THEN 2760 2650 IF R$<>"Y" THEN 2630 2660 GOSUB 3160 2670 PRINT "NUMBER OF SHARES"; 2680 INPUT R 2690 IF R<=M(N,J+1) THEN 2720 2700 PRINT "*** YOU ONLY HAVE ";M(N,J+1);" SHARES ***" 2710 GOTO 2670 2720 PRINT 2730 M(N,J+1)=M(N,J+1)-R 2740 M(N,1)=M(N,1)+R*T(J) 2750 GOTO 2560 2760 PRINT 2770 FOR J=1 TO 10 2780 IF M(N,1)>T(J) THEN 2810 2790 NEXT J 2800 GOTO 2950 2810 PRINT "WANT TO BUY"; 2820 INPUT R$ 2830 IF R$="N" THEN 2950 2840 IF R$<>"Y" THEN 2820 2850 GOSUB 3160 2860 PRINT "NUMB=M(N,12)+K(J)*M(N,J+1) 2010 NEXT J 2020 IF A(C,11)=0 THEN 2050 2030 M(N,12)=M(N,12)+M(N,3)*2 2040 PRINT "*** X-PANDO CORP. PAYS $2 DIVIDENDS PER SHARE ***" 2050 M(N,1)=M(N,1)+M(N,12) 2060 NEXT N 2070 REM 2080 REM 2090 REM PRINT WHAT HAPPENED & CURRENT VALUES 2100 REM 2120 PRINT "*** YEAR ";Y;"*** "+W$+" MARKET ***" 2130 PRINT 2140 PRINT TAB(23);"PLAYER HOLDINGS YEAR ";Y 2150 PRINT 2160 PRINT TAB(6);" +/-$ PRICE"; 2170 FOR N=1 TO P 2180 PRINT TAB(18+8*N);N; 2190 NEXT N 2200 PRINT MBER OF PLAYERS (1 TO 4)="; 1360 INPUT P 1370 IF P>4 THEN 1360 1380 IF P<=0 THEN 1360 1390 FOR I=1 TO 4: FOR J=1 TO 12: M(I,J)=0: NEXT J: NEXT I 1400 PRINT 1410 PRINT "NUMBER OF YEARS (3 TO 10)="; 1420 INPUT S 1430 IF S<3 THEN 1420 1440 IF S>10 THEN 1420 1450 FOR I=1 TO 9: F(I)=0: NEXT I 1460 FOR N=1 TO P 1470 M(N,1)=5000 1480 NEXT N 1490 FOR I=1 TO 10: T(I)=100: NEXT I 1510 Y=0 1520 REM 1530 REM 1540 REM FIND MARKET CHANGES FOR NEXT ROUND,SEE IF BULL OR BEAR MARKET 1550 REM 1560 D=INTER OF SHARES"; 2870 INPUT R 2880 IF R*T(J)<=M(N,1) THEN 2910 2890 PRINT "ONLY MONEY ENOUGH FOR ";INT(M(N,1)/T(J));"SHARES" 2900 GOTO 2860 2910 M(N,J+1)=M(N,J+1)+R 2920 M(N,1)=M(N,1)-R*T(J) 2930 PRINT "YOU NOW HAVE $";M(N,1) 2940 GOTO 2760 2950 NEXT N 2960 GOTO 1560 2970 REM 2980 REM 2990 REM CLOSING OUT AT END OF GAME - PRINT FINAL TOTALS 3000 REM 3010 PRINT 3020 PRINT 3030 PRINT "*** FINAL TOTALS ARE:" 3040 PRINT 3050 PRINT "PLAYER TOTAL" 3060 FOR N=1 TO P 3070 FOR J=1 TO 102210 PRINT 2220 PRINT LEFT$(V$,3);TAB(7);"0";TAB(15);"100"; 2230 FOR N=1 TO P 2240 PRINT TAB(18+8*N);M(N,2); 2250 NEXT N 2260 PRINT 2270 FOR N=1 TO 9 2280 PRINT MID$(V$,3*N+1,3);TAB(7);F(N);TAB(15);T(N+1); 2310 FOR J=1 TO P 2320 PRINT TAB(18+8*J);M(J,N+2); 2330 NEXT J 2340 PRINT 2350 NEXT N 2360 PRINT 2370 PRINT "DIVIDENDS FOR YEAR"; 2380 FOR N=1 TO P 2390 PRINT TAB(18+8*N);M(N,12); 2400 NEXT N 2410 PRINT 2420 PRINT 2430 PRINT "NEW CASH TOTAL"; 2440 FOR N=1 TO P 2450 PRINT TAB(18+8*N);(RND(1)*11+1) 1570 C=INT(RND(1)*36+1) 1580 IF A(C,12)=1 THEN 1570 1590 A(C,12)=1 1600 FOR N=2 TO 10 1605 GOSUB 4000 1610 IF A(C,1)=1 THEN 1660 1620 W$="BEAR" 1630 F(N-1)=A(C,N)+E(D,N-1) 1640 T(N)=T(N)+F(N-1) 1650 GOTO 1720 1660 F(N-1)=A(C,N)+U(D,N-1) 1670 W$="BULL" 1680 T(N)=T(N)+F(N-1) 1690 REM 1700 REM CHECK FOR STOCK SPLITS 1710 REM 1720 IF T(N)<150 THEN 1840 1725 PRINT 1730 PRINT "*** "+S$+" STOCKS SPLIT ***" 1740 IF T(N)/2=INT(T(N)/2) THEN 1770 1750 T(N)=INT(T(N)/2)+1 1760 GOTO     3080 M(N,1)=M(N,1)+T(J)*M(N,J+1) 3090 NEXT J 3100 PRINT 3110 PRINT N,M(N,1) 3120 NEXT N 3130 STOP 3140 REM 3150 REM 3160 REM SUBROUTINE TO LOOK UP STOCK NAMES FOR BUY & SELL 3170 REM 3180 PRINT "NAME OF STOCK"; 3190 INPUT R$ 3200 FOR J=1 TO 10 3210 IF LEFT$(R$,2)=MID$(V$,3*J-2,2) THEN 3240 3220 NEXT J 3230 GOTO 3180 3240 RETURN 3250 REM 4000 ON N GOTO 4010,4020,4030,4040,4050,4060,4070,4080,4090,4100 4010 S$=A$ 4015 RETURN 4020 S$=B$ 4025 RETURN 4030 S$=C$ 4035 RETURN 4040 S$=D$ 1 - Describe a dBASE command 2 - List dBASE commands 3 - Summarize dBASE functions  4045 RETURN 4050 S$=E$ 4055 RETURN 4060 S$=F$ 4065 RETURN 4070 S$=G$ 4075 RETURN 4080 S$=H$ 4085 RETURN 4090 S$=I$ 4095 RETURN 4100 S$=J$ 4105 RETURN 4500 FOR N=1 TO P 4510 W=0 4520 FOR J=1 TO 10 4530 W=W+T(J)*M(N,J+1) 4540 NEXT J 4550 X(N)=W+M(N,1) 4560 NEXT N 4570 RETURN 9000 END 9100 REM ASDFGHJKL OR J=1 TO 10 4530 W=W+T(J)*M(N,J+1) 4540 NEXT J 4550 0,4030,4040,4050,4060,4070,4080,4090,4100 4010 S$=A$ 4015 RETURN 4020 S$=B$ 4025 RETURN 4030 S$=C$ 4035 RETURN 4040 S$=D$ 4 - Summarize cursor-control keys 0 - Exit Enter your choice (0-4) ->#choice  * HELP1.CMD ERASE @ 2,35 SAY "HELP Menu" @ 5,14 SAY "Do you want to:" @ 7,14 SAY "1 - Describe a dBASE command" @ 9,14 SAY "2 - List dBASE commands" @ 11,14 SAY "3 - Summarize dBASE functions" @ 13,14 SAY "4 - Summarize cursor-control keys" @ 15,14 SAY "0 - Exit" @ 17,14 SAY "Enter your choice (0-4) ->" @ 17,40 GET choice READ RETURNd) to xcommand do while xcommand # " " find &xcommand if #=0 @ 10,5 say "Command not found"  HELP Menu Do you want to:     Summary of dBASE Functions # - record number STR (num,len,dec) - Number -> string $ (char,start,len) - substring VAL (str) - string -> number EOF - end of file wn ^R - Scroll up ^W - Write and exit Press any key to continue#choice  ^N - Insert blank line ^T - Deletes line ^C - Scroll do dBASE II Cursor Control Keys ALL: ^E,A - previous field  @ (substr, str) - find substring ! (str) - uppercase CHR (num) - number -> ASCII DATE() - date FILE (dbname) - does file exist? TYPE (exp) - yields dat type TRIM (str) - trims trailing blanks  dBASE II Cursor Control Keys ALL: ^E,A - previous field  ^X,F - next field ^S - previous character ^D - next character ^Y - clear field to blanks ^V - Insert toggle ^G - delete character ^Q - abort EDIT:  Press any key to continue#choice r) - trims trailing blanks  ^X,F - next field ^S - previous character ^D - next character ^Y - clear field to blanks ^V - Insert toggle ^G - delete character ^Q - abort APPEND, CREATE, INSERT:  ^U - delete toggle ^R - previous record ^C - next record ^W - Write and exit MODIFY: ^N - Insert blank line ^T - Deletes line ^C - Scroll do    ^C,R - next record CR - (if no input) exit BROWSE: ^U - Delete toggle ^R - Previous record ^C - next record ^W - Write and exit ^Z - Pan left new data base 57 DELETE DELETE [] [FOR ] Deletes one or more records from data base 60%DEL %DEL DELETE FILE deletes a CP/M file or data base 60 DISPLAY DISLPAY [] [FOR ] [] [OFF] Displays one or more records from data base 62%DISPLAb %DISPLAbDISPLAY STRUCTURE ta to memory variable 38 APPEND APPEND FROM [FOR ] [SDF] [DELIMITED WITH ] Adds data from another data base or sequential file 39%APPEND1 %APPEND1APPEND BLANK Adds a blank record to the file 39%APPEND2 %APPEND2APPEND Allows interactive entry of one or more new records 39 BROWSE BROWSE one field ^B - Pan right one field Press any key to continue#choice vious record ^C - next record ^W - Write and exit ^Z - Pan left  Displays the structure of a data base 62%DISPLAc %DISPLAcDISPLAY MEMORY Displays memory variables 62%DISPLAd %DISPLAdDISPLAY FILES [ON [LIKE ] Displays data bases or CP/M files 62 DO DO Execute a command file  Allows interactive display/update of data base 46 CANCEL CANCEL Cancels command file execution 47 CHANGE CHANGE [] FIELD [FOR ] Changes data base record(s) individual field 48 CLEAR CLEAR [GETS] Clears dBASE II or outstanding @...GETs j SCOMMANDClSYNTAXC Begin a conditional block (ended with ENDDO) 64%ENDDO %ENDDO ENDDO Used to end a conditional block started with DO WHILE 64%DOc %DOc DO CASE Begins a set of cases 64%CASE %CASE CASE Begins 49 CONTINUECONTINUE Used with LOCATE 050 COPY (See manual for syntax) Copies data from files/data bases 51 COUNT COUNT [] [FOR ] [TO ] Counts records 55 CREATE CREATE [] Creates a  ? ? [] Writes data to output device 30%? %? ?? [] Writes data to output device (no preceding CR/LF) 30 @ @ [SAY [USING ]] [GET [PICTURE ]Places/gets info on screen or printer 32 ACCEPT ACCEPT [""] to Gets string da    an individual case in DO CASE group 64%OTHER %OTHER OTHERWISE Begins the default case in a DO CASE group 64%ENDCASE %ENDCASEENDCASE Ends the last case in a DO CASE group 64 EDIT EDIT [n] Edit one or more data base records 65 EJECT EJECT haracters A comment (usually in a command file) 95* * * any characters a comment (normally in a command file) 95 PACK PACK Removes deleted records from data base 96 QUIT QUIT [TO ] Exits dBASE  Indicates statements to run if IF condition is false 76%ENDIF %ENDIF ENDIF Ends IF group 76 INDEX INDEX ON TO Builds an index of a database 77 INPUT INPUT [""] TO Gets data to a memvar  Skip printer to new page 68 ENDDO ENDDO Ends a DO WHILE... group 69 ERASE ERASE Erases all memory variables & clears the screen 70 FIND FIND or '' Finds a record in an indexed file  98 READ READ Instructs dBASE to read data from @...GET commands 99 RECALL RECALL [] [FOR ] Un-deletes one or more records 102 RELEASE RELEASE [] Removes specified memory variables, freeing space 106%RELEASE %RELEASERELEASE ALL  81 INSERT INSERT [BEFORE] [BLANK] Inserts one record into a data base 83 JOIN JOIN TO FOR [FIELDS ] Joins primary and secondary data base creating a new one 86 LIST (See DISPLAY) Same as DISPLAY except scope defaults to ALL 89DISPLAY LOCATE LOCATE [] [FOR ]  71 GO See GOTO See GOTO 74GOTO GOTO GOTO RECORD Sets data base pointer to specified record 74%GOb %GOb GOTO TOP Sets pointer to first record of data base 74%GOc %GOc Se Releases all memory variables 106 REMARK REMARK any characters Displays remarks on output device 107 RENAME RENAME TO Renames a data base or CP/M file 108 REPLACE (See manual for syntax) Replaces data in one or more data base records 109 REPORT REPORT Locates a data base record 90CONTINUE LOOP LOOP Causes immediate beginning of new loop in command files 92 MODIFY MODIFY STRUCTURE Changes a data base structure 93%MOD %MOD MODIFY COMMAND [] Modifies a command file 93 NOTE NOTE any cts data base pointer to specified record 74%GOd %GOd GOTO BOTTOM Sets data base pointer to last record of data base 74%GOe %GOe GOTO Sets data base pointer to record indicated in memvar 74 IF IF Begins IF group 76%ELSE %ELSE ELSE     [FORM

] [TO PRINT] [PLAIN] Creates a report from a data base 112 RESET RESET Tells CP/M that disks have been swapped 121 RESTORE RESTORE FROM Restores memory variables previous saved 122 RETURN RETURN Returns to caller of command file  130%SETb1 %SETb1 SET HEADING to Sets report heading 131%SETb2 %SETb2 SET FORMAT TO SCREEN Sets @ output to go to screen 131%SETb2b %SETb2b SET FORMAT TO PRINT Sets @ output to go to printer 131%SETb2c %SETb2c SET FORMAT TO both data bases 129%SET9 %SET9 SET COLON ON/OFF Sets whether colons should display to border fields 129%SET10 %SET10 SET BELL ON/OFF Determines whether console alarm is sounded 129%SET11 %SET11 SET ESCAPE ON/OFF Determines whether ESC key aborts command files 129%SET12 %SET12 SET EXACT ON/OFF  123 SAVE SAVE TO Saves memory variables to disk 124 SELECT SELECT PRIMARY Selects the primary data base 125%SELECT %SELECT SELECT SECONDARY Selects the secondary data base 125 SET SET ECHO ON/OFF  Specifies where @ commands come from 131%SETb3 %SETb3 SET DEFAULT TO Sets CP/M default drive 131%SETb4 %SETb4 SET ALTERNATE TO Specifies alternate data base name 132%SETb5 %SETb5 SET DATE TO mm/dd/yy Sets date 132%SETb6 %S Determines whether search string must match longer data 129%SET13 %SET13 SET INTENSITY ON/OFF Determines if normal/inverse video is to be used 130%SET14 %SET14 SET DEBUG ON/OFF Sends debug commands to printer (if on) 130%SET15 %SET15 SET CARRY ON/OFF Determines if APPEND carries data to next record 130%SET16 %SET16 Sets display of commands 128%SET1 %SET1 SET STEP ON/OFF Sets single step mode 128%SET3 %SET3 SET TALK ON/OFF Sets display of messages from commands 128%SET4 %SET4 SET PRINT ON/OFF Sets output to printer 128%SET5 %SET5 SEETb6 SET INDEX TO [, ...] Sets one or more index files to be used 133%SETb7 %SETb7 SET MARGIN TO n Sets printer margin 133 SKIP SKIP [+/-][] Moves data base current record pointer 134 SORT SORT ON TO [ASCENDING/DESCENDING] Sorts data o the specified SET CONFIRM ON/OFF Determines whether cursor moves to next field automatically 130%SET17 %SET17 SET EJECT ON/OFF Sends form feed to printer if on 130%SET18 %SET18 SET RAW ON/OFF Places spaces between LIST/DISPLAY fields if on 130%SET19 %SET19 SET SCREEN ON/OFF Sets full-screen mode T CONSOLE ON/OFF Sets output to screen 128%SET6 %SET6 SET ALTERNATE ON/OFF Sets output to go to a disk file 128%SET7 %SET7 SET SCREEN ON/OFF Sets full-screen mode 129%SET8 %SET8 SET LINKAGE ON/OFF Makes sequential commands advance     field 135 STORE STORE to Sets the value of a memory variable 137 SUM SUM [,[ [TO ] [] [FOR ]Computes totals of specified field(s) 138 TOTAL TOTAL ON TO [FIELDS ] [FOR ] Creates a new data base with total values 139 UPDATE (See manual for syntax) E%SELECT ACCEPT ,INPUT  CHANGE CLEAR CONTINUE COPY COUNT CREATE DELETE DISPLAY DO EDIT EJECT ENDDO ERASE !FIND "GO #GOTO (IF +INDEX ACCEPT APPEND BROWSE CANCEL CHANGE CLEAR CONTINUE COPY COUNT CREATE DELETE DISPLAY DO EDIT EJECT ENDDO ERASE !FIND "GO #GOTO (IF +IND *COMMANDE+SEQ !! y \Xz _d ]Š \* a(Ԡź)" ca(ΠϠΠ)E%SELECT ACCEPT ,INPUT  CHANGE CLEAR CONTINUE COPY COUNT CREATE DELETE DISPLAY DO EDIT EJECT ENDDO ERASE !FIND "GO #GOTO (IF +INDEX ACCEPT APPEND BROWSE  Updates one data base with data from another 141 USE USE Specifies the current data base 143%USE %USE USE INDEX [, ...] Sets new current data base & index file(s) 143 WAIT WAIT [TO Waits for keyboard input 144 -INSERT .JOIN /LIST 0LOCATE 1LOOP 2MODIFY 4NOTE 6PACK 7QUIT 8READ 9RECALL :RELEASE <REMARK =RENAME >REPLACE ?REPORT @RESET ARESTORE BRETURN CSAVE DSELECT FSET bSKIP cSORT dSTORE eSUM fTOTAL gUPDATE hUSE jWAIT 7QUIT 8READ 9RECALL :RELEASE <REMARK =RENAME >REPLACE ?REPORT @RESET ARESTORE BRETURN CSAVE DSEL%? %APPEND1%APPEND2%CASE %DEL %DISPLAb%DISPLAc%DISPLAd%DOb %DOc )%ELSE %ENDCASE%ENDDO *%ENDIF $%GOb %%GOc &%GOd '%GOe 3%MOD %OTHER ;%RELEASEE%SELECT G%SET1 O%SET10 P%SET11 Q%SET12 R%SET13 S%SET14 T%SET15 U%SET16 V%SET17 W%SET18 H%SET3 I%SET4 J%SET5 K%SET6 L%SET7 M%SET8 N%SET9 5* ? @ ACC th data bases 129%SET9 %SET9 SET COLON ON/OFF Sets whether colons should display to border fields 129%SET10 %SET10 SET BELL ON/OFF Determines whether console alarm is sounded 129%SET11 %SET11 SET ESCAPE ON/OFF Determines whether ESC key aborts command files 129%SET12 %SET12 SET EXACT ON/OFF  G%SET1 O%SET10 P%SET11 Q%SET12 R%SET13 S%SET14 T%SET15 U%SET16 V%SET17 W%SET18 X%SET19 H%SET3 I%SET4 J%SET5 K%SET6 L%SET7 M%SET8 N%SET9 Y%SETb1 Z%SETb2 [%SETb2b \%SETb2c ]%SETb3 ^%SETb4 _%SETb5 `%SETb6 a%SETb7 i%USE 5* ? @ ACCEPT H%SET3 I%SET4 J%SET5 K%SET6 L%SET7 M%SET8 N%SET9 5* ? @ ACCAPPEND BROWSE CANCEL CHANGE CLEAR CONTINUE COPY COUNT CREATE DELETE DISPLAY DO EDIT EJECT ENDDO ERASE !FIND "GO #GOTO (IF +INDEX ,INPUT -INSERT .JOIN /LIST 0LOCATE 1LOOP 2MODIFY 4NOTE 6PACK 7QUIT 8READ 9RECALL :RELEASE <REMARK =RENAME >REPLACE ?REPORT @RESET ARESTORE BRETURN CSAVE DSEL   ds dat type TRIM (str) - trims trailing blanks" @ 15, 9 SAY "Press any key to continue" @ 15,34 GET choice READ RETURN d of file" @ 6,40 SAY "@(substr, str) - find substring" @ 7, 2 SAY "! (str) - uppercase CHR (num) - number -> ASCII" @ 8, 2 SAY "DATE() - date FILE (dbname) - does file exist?" @ 9, 2 SAY "TYPE (exp) - yiel enddo @ 23,10 say "Press any key to continue" get choice read case choice='3' do help2 case choice='4' do help3 do help4 case choice='0' erase set intensity on set talk on use return endcase enddo >'%' @ y,x say command store x+10 to x endif skip enddo store y+1 to y * * help.cmd * * Glenn Story - 6/10/83 * * This command provides interactive help information about dBASE * use help index help set talk off set intensity off store '?' to choice do while 1=1 do help1 do case case choice='1' erase store " " to xcommand @ 5,5 say "Enter command name" get xcommand read store !(xcommand) to xcommand do while xcommand # " " find &xcommand if #=0 @ 10,5 say "Command not found"  * HELP2.CMD ERASE @ 2,25 SAY "Summary of dBASE Functions" @ 4, 2 SAY "# - record number STR (num,len,dec) - Number -> string" @ 5, 2 SAY "$ (char,start,len) - substring VAL (str) - string -> number" @ 6, 2 SAY "EOF - end of file" @ 6,40 SAY "@(substr, str) - find substring" @ 7, 2 SAY "! (str) - uppercase CHR (num) - number -> ASCII" @ 8, 2 SAY "DATE() - date FILE (dbname) - does file exist?" @ 9, 2 SAY "TYPE (exp) - yiel @ 20,5 say "Press any key to continue" get choice read else do help5 endif store link to xcommand enddo case choice='2' erase @ 2, 32 say "dBASE II Commands" store 4 to y find ? do while .not. eof store 2 to x do while (x<72) .and. (.not. eof) if $(command,1,1)<>'%' @ y,x say command store x+10 to x endif skip enddo store y+1 to y     * HELP3.CMD ERASE @ 2,26 SAY "dBASE II Cursor Control Keys" @ 4,38 SAY "ALL:" @ 6, 2 SAY "^E,A - previous field ^X,F - next field" @ 7, 2 SAY "^S - previous character ^D - next character" @ 8, 2 SAY "^Y - clear field to blanks ^V - Insert toggle" @ 9, 2 SAY "^G - delete character ^Q - abort" @ 11,38 SAY "EDIT:" @ 13, 2 SAY "^U - delete toggle ^R - previous record" @ 14, 2 SAY "^C - next record ^ * HELP4.CMD ERASE @ 2,26 SAY "dBASE II Cursor Control Keys" @ 4,38 SAY "ALL:" @ 6, 2 SAY "^E,A - previous field ^X,F - next field" @ 7, 2 SAY "^S - previous character ^D - next character" @ 8, 2 SAY "^Y - clear field to blanks ^V - Insert toggle" @ 9, 2 SAY "^G - delete character ^Q - abort" @ 11,29 SAY "APPEND, CREATE, INSERT:" @ 13, 2 SAY "^C,R - next record CR - (if no input) exit" @ 15,37 SAY "BROWSE:" @ 17, 2 W - Write and exit" @ 16,37 SAY "MODIFY:" @ 18, 2 SAY "^N - Insert blank line ^T - Deletes line" @ 19, 2 SAY "^C - Scroll down ^R - Scroll up" @ 20, 2 SAY "^W - Write and exit" @ 22,12 SAY "Press any key to continue" @ 22,37 GET choice READ RETURN @ 13, 2 SAY "^U - delete toggle ^R - previous record" @ 14, 2 SAY "^C - next record ^ * HELP5.CMD ERASE @ 8, 4 SAY "Syntax:" @ 8,13 SAY syntax @ 10, 4 SAY "Description:" @ 10,18 SAY desc @ 12, 4 SAY "For more information see dBASE reference manual, page" @ 12,58 SAY page @ 18,10 SAY "Press any key to continue" @ 18,35 GET choice READ RETURNBUF-1 DCR C JZ LTX SUB B JZ ZEROX JC GTX LTX LHLD EOFP MOV D,H MOV E,L CALL ADR SHLD EOFP MVI C,2 CALL RMSAY "^U - Delete toggle ^R - Previous record" @ 18, 2 SAY "^C - next record ^W - Write and exit" @ 19, 2 SAY "^Z - Pan left one field ^B - Pan right one field" @ 22,12 SAY "Press any key to continue" @ 22,37 GET choice READ RETURN, CREATE, INSERT:" @ 13, 2 SAY "^C,R - next record CR - (if no input) exit" @ 15,37 SAY "BROWSE:" @ 17, 2    W-A)*(70/(B-A))+6);"*" 870 GOTO 830 880 PRINT "DO YOU WANT TO PRINT GRAPH NOW":INPUT P$ 881 IF P$="N" THEN 260 890 RETURN 998 DATA -1 999 END  870 GOTO 830 880 PRINT "DO YOU WANT TO PRINT GRAPH NOW":INPUT P$ 881 IF P$="N" THEN 260 890 RETURN 90*(C/(B-A))+5);I; 750 X=X+1 760 NEXT I 770 PRINT 775 REM 780 PRINT " |"; 790 FOR I=0 TO (X-1) 800 PRINT TAB(I*70*(C/(B-A))+7);"+"; 810 NEXT I 820 PRINT 825 RESTORE 828 REM 829 I=0 830 I=I+1 840 READ W 850 IF W<0 THEN 880 860 PRINT I;TAB((HAT IS THE SMALLEST NUMBER YOU WANT"; 281 INPUT A 282 PRINT "WHAT IS THE LARGEST NUMBER YOU WANT"; 283 INPUT B 284 PRINT "STEP 1, 5 OR 10"; 285 INPUT C 286 PRINT "DO YOU WANT TO TEST GRAPH ON SCREEN BEFORE PRINTING":INPUT R$ 287 IF R$="Y" THEN GOSUB 715 303 GOSUB 315 305 PRINT "WANT ANOTHER GRAPH";: INPUT A$ 307 IF A$="Y" THEN 270 309 GOTO 999 315 REM 316 X=0 317 REM 330 FOR I=A TO B STEP C 340 LPRINT TAB(X*70*(C/(B-A))+5);I; 350 X=X+1 360 NEXT I 370 LPRINT 375 REM 380 LPRINT " |"; 390 FOR I=0 TO (X-1) 400 LPRINT TAB(I*70*(C/(B-A))+7);"+"; 410 NEXT I 420 LPRINT 425 RESTORE 428 REM 429 I=0 430 I=I+1 440 READ W 450 IF W<0 THEN 480 460 LPRINT I;TAB((W-A)*(70/(B-A))+6);"*" 470 GOTO 430 480 RETURN 500 PRINT:PRINT "WEEK", "PRICE", "GAIN/LOSS" 501 S=0:D=0 502 Z=0 503 REM 504 I=0 505 I=I+1 510 READ W 520 IF I=1 THEN 560 530 IF W<0 THEN 590 540 D=W-W1 550 S=S+D 560 PRINT I,W,D 570 W1=W 571 Z=Z+W 580 GOTO 505 590 PRINT "AVG. WEEKLY CHANGE:";S/(I-1);"POINTS" 591 PRINT10 PRINT "STOCK RECORD" 11 PRINT "DO YOU WANT TO PRINT THE TABLE OF PRICES ON THE SCREEN" 12 PRINT "INSTEAD OF AT THE PRINTER";:INPUT V$ 13 IF V$="Y" THEN GOSUB 500 14 PRINT "NAME OF STOCK";:INPUT Z$ 15 LPRINT "*************";Z$;"*************" 16 PRINT "ENTER DATE";:INPUT Y$ 17 LPRINT "DATE PREPARED: "; Y$ 20 LPRINT:LPRINT "WEEK", "PRICE", "GAIN/LOSS" 30 S=0:D=0 31 Z=0 40 REM 45 I=0 50 I=I+1 60 READ W 70 IF I=1 THEN 110 80 IF W<0 THEN 140 90 D=W-W1 100 S=S+D 110 LPRINT I,W,D 120 W1=W  "TOTAL CHANGE: ";S;"POINTS" 592 PRINT "AVERAGE PRICE: $";Z/(I-1) 593 PRINT "DO YOU WANT TO PRINT THE TABLE NOW":INPUT U$ 594 IF U$="Y" THEN RESTORE ELSE GOTO 171 595 RETURN 715 REM 716 X=0 717 REM 730 FOR I=A TO B STEP C 740 PRINT TAB(X*70*(C/(B-A))+5);I; 750 X=X+1 760 NEXT I 770 PRINT 775 REM 780 PRINT " |"; 790 FOR I=0 TO (X-1) 800 PRINT TAB(I*70*(C/(B-A))+7);"+"; 810 NEXT I 820 PRINT 825 RESTORE 828 REM 829 I=0 830 I=I+1 840 READ W 850 IF W<0 THEN 880 860 PRINT I;TAB((121 Z=Z+W 130 GOTO 50 140 LPRINT "AVG. WEEKLY CHANGE:";S/(I-1);"POINTS" 160 LPRINT "TOTAL CHANGE: ";S;"POINTS" 161 LPRINT "AVERAGE PRICE: $";Z/(I-1) 170 LPRINT:LPRINT 171 PRINT "HAVE YOU ALREADY ENTERED STOCK NAME AND DATE":INPUT T$ 172 IF T$="Y" THEN GOTO 260 173 PRINT "NAME OF STOCK";:INPUT Z$ 174 LPRINT "*************";Z$;"*************" 175 PRINT "ENTER DATE";:INPUT Y$ 176 LPRINT "DATE PREPARED: "; Y$:LPRINT:LPRINT: 260 PRINT:PRINT "SET RANGE FOR GRAPH" 270 A=0:B=0:C=0 280 PRINT "W    Instructions for STOCGRPH.BAS April 30, 1983 Robert Blacher Washington, D.C. (202) 659-9129 Introduction: Thi i simpl program writte i Microsof Basic t grap the weekly prices of stocks. How to Use Program: 1 ENTE DATA Th firs ste i t creat dat fil wit the prices of the stock you want inte o th screen you'l b aske i yo wan t prin i now I yo answe no th progra wil as yo t se th rang again I yo answe yes the graph will print out. 9. When you're done, exit the program by typing ^C. 10 Yo ca no grap anothe stoc b simpl mergin th data onto the program and running it again. Note: Th progra i se u fo graphin weekl prices However i yo trac price o dail basis jus chang th lto analyze. The file should use line numbers 900 - 997 and be as follows: 900 DATA 22.5, 23.5, 24.75 901 DATA 23.875, 23, 25.625, 28, ETC. SAV thi fil separately i ASCI form usin th nam o th stock as the file name. Example: SAVE "IBM",A 2. LOAD "STOCGRPH". 3. MERGE your data file: e.g., MERGE "IBM". 4. RUN. 5 Th progra wil as yo i yo wan th tabl o price to be displayed on the screen instead of aX+"6# x+:`i* ">!lNX c!I !l c!J / 0!!F!B0!I!)Iv0!I!(Iv0!>)-!()!O w !w !ow  ! w c!I c! !ͪ$h#M !v!v!v'0EK!_$'0EC*!q)##!**'!0E !Xe.0!.͕.!ͼv.0 abel i the appropriate lines. The program is written for an 80 column screen and printer. The program will print the points of the graph using *. Unfortunately, it will not draw the line between the points. Tha yo hav t d b hand I anyon ca figur ou ho t ge th progra t d that I' b intereste i hearin fro you Leave any suggestions for improvements on this BBS.t ge th progra t d that I' b intereste i hearin fro you Leave any suggestiont the printer. Answer (Y)e o (N)o I yo answe no th tabl wil b displayed and then you'll be asked again if you want it to be printed. If you answer yes, you'll be asked to enter the name of the stock and the date so that your printout will be labeled. 6 No you'r read t creat th graph I yo haven' already labeled the printout, the program will ask you to do so. Next i wil as fo th smalles numbe yo wan (e.g th lowest price in your table)!10 !40 !70&! $!.v!v!1v!v!4v!v!7v!v!v! v!v'0EK!'0EÀ*!B!F|g}o|c! /c!I c!I :>:>>y! I :5!@$c!x /̈́/ !/c!B !B!F|g}o|± !'|8)ғy!' >>y'!Kͧ >>!'|8)c!' c'!Kͧ !'F!J'! and the largest number. The th progra wil as yo t se th step fo th graph i 1 o 1 poin increments Ente 1 5 o 1 (actually, you can enter any number you want). 7 You'l b aske whethe yo wan t tes th grap o you scree befor yo prin it It' goo ide t d so t se i you'v se th scal correctly I you're no satisfie with the display, you'll have the opportunity to change it. 8 Afte th grap ha pr   !$JJ>JF!B!F|g}o|by'L! >>c'L! ̈́!{LIST DONE HIT ANY KEY TO CONTINUEHIT ANY KEY TO CONTINUE_  /0 123456789ABCD ACTUAL FILENAME6VALDOCS FILE NAME DATE DOC# 0B:INDXDATA.NDXAREPIpMOUTPUT TO (P)RINTER OR (S)CREEN%oVALDOCS INDEX DISPLAY VER 2.0 8307.13pp [[[[ BASLIB #000000 5.30 - OWNED BY MICROSOFT, 1980 w+DDM  '~ʡ#~#fon& zC}r~@s#6, á |¡!9>g "/>Ì />Æ {/>q.2>!].͹>] .~#¨x>>>>>> !+>>>>>> ~#fo##GN5y5#~#fo~#fo>#4 $ y>y<.H)H)Dax¡űl y<2WF~ڶڶ#~#foyl.O #~#foxʺª#™ú!W4 –2W*W&~o& ~<ʡr~#~#foq.6+"  )  ~ /4 {/4 "/= H~# 5 x2: ; m ͹<%~f :-#Z ͹~i :-#p >2: F#~#fox; %͵ ʬ ~#:-à ͵ ; >":-G:x; -*+~< = ###~ *-!i **~= /<%= > :-; >,:-W*#^ OI+=I:=I-z{a{_S!"!"2͏!"!"2͏!~6#w~!sNʦ, i&ì ʚ8~9U[9U[9U[g9U[gM*" * ##" >22*^#V"##^#V" 2!J!!""!"6#6P>2>2>2ÏÏÆ_>""K3>?ú-:#*#Ͱ2#"#*O*QL{#+V+^"QP*ʴ1ʺ1e!9" !i  !i!i!R"!O" |=> 6#s#r#=2>2>2>22!"!$\">&26#}f|fa STOt Ä *.. . ........ *|‹:*|  s#r  {W w#6"**>2X ~" gJd #&A)",/2#5 8;:$_!4N5* " ~#N#F#ڎh l.Qyxs Q+++6@#yw#xw+++6###!~6ڟʹN* #~#~N, Ø!* " ~#^#V#l.|++~_w#~Ww#ʹ* DM~#^#V#X+z5+{5##{z~#q#p_yMxMDM~#MYP+++" 6@###{_zW+r+sɷʧ*|…, Û>^#V+"w#s#r+++r+s##!*]{z*_?}|~# yGrxq.Grx#N#F& 9U[9U[9U[g9U[gv͔^#V#͠"*v?v^#!pv^#V#͚E"~2" **:.:B.:ͿH44I54Ϳ21 1/l.~#fo^#V#^#V#%.^#V#%..^#V#. ..&))) >O>O>O>O>O>^#V#^#V#î>y>y>y>y>y>^#V#!/î>á>á>á>á>á>^#V#!{/õù G~#fo##6 )62   B.(!9N#F ~#~1 ~+7 ~#~1 +^#V### ### |C ~#fo!K a Internal Error - No Line Number Ó ~# a at line͓ > <ڬ – <ڬ 0- Ҩ }_|W! l.~#fo>a at address|ͅ}ͅ > -> -~#* l.~#foXN8!9"! *% "!F * !v ~@++*"s#r+* #~_#~W, çr+s##6" ###!~#fo. <* " * }o|g6@#s#r#6" *_*]"}w>#w##.D++6+6>g~-#gG~#ʃ#u++͎0:ڙ-HEN PRINT A$:RETURN 370 PRINT LEFT$(A$,75):GO!"*/}/o|/g#"/|)6!/~wɯ2/!" .|á  (?:u!O 2ͨ3L:x!S H4:/2/:/Ҕ͞:/ln|/g}/oͨ3:/ڞ!/”!, Þ:/goW*/|7gҺ:/º+>|/g}/o!G|o& Gȯ|g}o> ~+~?~+#%+ % ʹm~##++Ă>q.+V+^+`+r+s 3~ ڡr͗͗~#~#foq. |¡BKPY |¡BK  o_õ z¡z _o}`iivision By ZerOut of String SpacString Formula Too CompleRESUME without Erro2Field Overflo3Internal Erro4Bad File Numbe5File Not Foun6Bad File Mod7File Already Ope9Disk I/O Erro:File Already Exist=Disk Ful>Input Past En?Bad Record Numbe@Bad File NamCToo Many FileUnprintable Erro h!. >E rw>7 }͍),,! ~#fo"K ! "M  |¡*K }o|g,"K *M "M ͂#s#r++s     )       )  ~        3*/)6!"͈3>>~{#!{!/?>!/{/2F# E!/2!/&͙/>>h>|}+! 1͕6+6!/>K32z/!ý4! 1!/ 1~_#~W#~O7K4!!H45ɇ<o&)6*/*/"/`i"/!/^#V#N#F#!I57x{7!/6͢6wg>*87*:Gw#*%?!/&/!"{/!"*/||2͹ajû L}">2`h̼#*#~,#N#F++ OB'IB'R,*#|B'!"#}_͍)U'+*{͍),z7& g*"##> q.66 &~¡'<,ö'<¶',Õ'!%w#w#w#w~'%) p# '8) _ 7&##<, !#6# (I( 7&2#!#(!#(##,O!#  ~# -y˜(~ ʕ(>. - ‚(: W:ڱ(> - --#r(~*6?# (O!!4(#4(#4y"(,><!{/!ͳ>!?ͦ /{_#zW#yO++*!͡#p#!>X!!>ͦ N#F#*//}o|gk!"/p#=X!ͦ w1_cƤ~@zZrN vH Tʚ;@B''d #~: " " "0?<=:."7-++""OM"HM"+Y"b"ͼH#ʎ"h", ÞM!z"x"}0?)))صoz"M!͠"ڞ"}"0? ڶ"? ))))صoà"a{ ]!":/:/í:22, Þ,~&<"-++".ʠe%EO"l=L=q=QN:h>h~%ʭ#ʾ!ʿdhD"2""m_{_ƒ!"!!" "!!]"!"=!"r2!T,":<2*"#!L)" "# '*|J)##nH$9).C$*# a) 2#‰*"#É* }) 2#Š*"#Ê*,<,=_!~#foʱ)##{)++Ý)*)"q#p#s#4#5++###DM !"#~#fo *+V+^##*#{z)BK^#V+*#s#r! DM**# DMs#r# 6# x* !T]~#fo,x6*y6*~#~+*"s#rɷRT!a*#|w*! s#r#w*2f*}͍),! ^#V:#¬**#{,+s#r! w#w! ~#fo!,*+BK>!)*)#*))* *#= Þ!LL}0L0? L? ))))صoL~E"#=MM~E"#M1M0:P{M>POx:i0PҕM/<  }͍),,!' ~# ##~#`i%#>O #~goPY!' ůw &:(,=,=/$ѯ,<,!% ^#Vr+s }8)!"#}͍)ʄ$ PYz$!q$`i>$!' ~$ &+* }͍),!&¢$! ~+ng }͍),! n&*~,+DM'~$4N#V p$zw w+x*{Aq"/E/D/0,.2+60{=+:w{+p2!6 *{/*}/2E~ʙ:y0y #~j>DGh"{/`i"}/#~+-ʷ0OxG#~ž`xEy ҉>2|҉É"{/`i"}/#W:!!͓ 60ͺ +~00.b!">"w#6+S6-/</ U:#p#w#6!#zچ͋ zg R!{p=g ʘp#6!#:~ ʝ*ʝ+"-+_:{0#"++wÞ6%ڍ!U͹*}_}la),+#x,"`*! "b*!) "d*!}o|g,D+bk:f*ʊ+,Y+ͧ+DM*d**b*+"b*PYͦ+}o|g*`*#"`*'+ͧ+DM*b**d*+"b*PYo+2,*`*! ~#fo,s#r+:,+!+!& $~# x+DMG,,<,! w!( V6 ,zwE,,<,! ~!7,! ^#V! s#rDM4,.,,}͍),g,,`i"!w,"ä,&, !>ì |¡,ʞ,-:,*!r"{rf$%,!,*í,|}!">6>4>?>=>:>7>5>2>3>@>C>, os#r#6#6DM:"%!" s#r#6g%! {zV_%#w<]%<,!! {w:,t%%!! ~#!) ̕%$̕%,~#˜%*~,( ~%+~#5O ~+~%%¤%7>*T]% N#F+q#p###6 % &:(>&>w+w!(͢%7?*' 6#67~,#^#fk_T&N#~:X&++@,y@,,# #&~.‚&͕&7n&#o&2#z ,,> Õ&ʉ&> ®&É& 7&##<,!##> q.7&:#!#,#<,+6%͹8_xg ~ ͺ w Ħ Å_yCE{_xag ~ rg yͪ Og GOͺ }*=g PÎѯʓ7yOzWO/< =60#h w ͦ 60#=s { ͦ />< ><p#=    &ì# ->^ -@ --~ --> - -#-rW* Q-#~+ :-~=-*!":-"> :-> :-:=-> ͂> ͂*8-^#V# .ɷ!/).!{/$./).{/).w#w#w#w#X:rXyO.>{/U.>/:. ~#=Y.!:.Ʌo$ɧGw#u.{z"2> "> "!fXpXXJPs"ڂXbXJP*}|*"ʝXu#ʾ"w!6R#6S#6#ÕYYYTY}UT"Do you want a table of CHI SQUARE values";Q$ 170 IF LEFT$(Q$,1)="Y" OR LEFT$(Q$,1)="y" THEN GOSUB 1210 180 PRINT:PRINT"Input the data directly.":PRINT 190 INPUT"Enter the number of data points ";L:DIM A(L+9),B(11),C(11) 200 IF L<=0 THEN PRINT:PRINT"IMPOSSIBLE":PRINT:STOP 210 IF L>=1001 THEN PRINT:PRINT"SORRY - Can't handle more than 1000 entries": STOP 220 PRINT CHR$(12) 230 FOR I=1 TO L:PRINT"#";I;": ";:INPUT A(I):NEXT I 240 INPUT"Data correction required (YES/NO) ";Q$ 250 IF LEFT$(Q$,1)="N"5g.*h/:j/Oz4%5g.*/:/ 5x<=<5{_zWxG)yOHG}7;6L5777͡5y+F+F+Fw`h|ʙ5gy}5:/O|g}oxG-|q5}l5ÿ6ElaOk5!/~Gx5ƀʜ7w͕6w+ɷl7Ý77x{7!/6͢6wg5z5 >*8|ԏ7{>2/Ϳ6/ZQZgZ][{ZZZ[7[A[Y[][][INCLUDpNBSéӗTUTϖASŘLEAҋALiLOS~INԤSNǥDB̦HROVVVONԖHAI΍OMMOrATVIq6#ҍ/ͽ3//7O/!7!/y#/+¸/7?7ͱ0Ͷ7͈3/ͱ03͔0!/ͽ3R0:/7://NK3e22z/:{/Ͳ27x/F+N+=0!/0!{/>q#p#=0!{/ 1".0 OR LEFT$(Q$,1)="n" THEN 300 260 PRINT CHR$(12):LINE INPUT"Enter Data # to be corrected ";F$ 270 F=VAL(F$) 280 PRINT A(F): INPUT"corrected value = ";G 290 A(F)=G:PRINT CHR$(12):GOTO 240 300 HI=A(1):LO=A(1) 310 FOR I=2 TO L 320 IF A(I)>HI THEN HI=A(I) 330 IF A(I)8 87>{_zW}o|g=8|g}o98CZQ,8 o-yOzW{_xG<8/*/DM^#V#N#F#xy7:/:/7|/G}/O!G}_}W}Oͪ67!/~7w?##wy7O*/*/"/"/ajSX7ʝ7JS\E!/ҝ7/ after question mark appears." 410 FOR I=1 TO 10:INPUT T$(I) 420 IF T$(I)="" THEN LPRINT CHR$(138):GOTO 440 421 XX=LEN(T$(I)) 430 LPRINT TAB((80-XX)/2) T$(I):NEXT I 440 PRINT CHR$(12):LPRINT"Data :":PRINT 450 FOR I=1 TO 1000:LPRINT TAB(10*J);A(I);:J=J+1 460 IF J=6 THEN J=0 470 IF I=L THEN LPRINT:GOTO 490 480 NEXT 490 Q=M-2.5*U:V=M+2.5*U:W=M-3*U:C=M+3*U 500 PRINT CHR$(12):LPRINT CHR$(138):LPRINT TAB(23);"DATA STATISTICS": LPRINT CHR$(138) 510 LPRINT"Low Value = ";LO:LPRINT"High10 ' ***************************************** 20 ' * * 30 ' * Data Reduction Program * 40 ' * by * 50 ' * Jim Barbarello * 60 ' * * 70 ' * Converted to MBASIC 5.1 from program * 80 ' * in 80 Microcomputing of 1/81 p.232 * 90 ' * by Ray Glueck * 100 ' * * 110 ' ***************************************** 120 ' 130 CLEAR :PRINT CHR$(12):PRINT 140 PRINT TAB(10) " D A T A R E D U C T I O N P R O G R A M" 150 PRINT TAB(18) "(for use with line printer)":PRINT 160 PRINT :INP7͈33ͱ03!/2ͱ0Ͷ7͈3+3ͱ03͔0!/1y2/!/.~q+A3qb3NsY+W3M3 W~w+l3e3!/i3)6È3Ͷ7!{/w#Ž37͟3}3ͨ333͕6!~/F#^#V#N}73}/~#3G++Ny7{/3!/Ͷ7>43͘7%474!/6͢6g>*8|~6!>3akͶ7445447!/~+>w7;6K477:/ʿ7^4/<͌67͕6g*8!/4~_#~W#~O}7#4l7.@8}7G~_#~W#~Ox6ÿ6;6í477>ON4;647l67ȯG͡5"h/y2j/Fo̓6͌6!D*/:/O4/4l75%    Value = ";HI:LPRINT"Mean = ";M 520 LPRINT"Variance = ";T:LPRINT"Standard Deviation = ";U:LPRINT CHR$(138) 530 LPRINT"The expected limits are ";W;" to ";C 540 PRINT CHR$(12):PRINT"CALCULATING...":D=Q:H=U/2 550 FOR I=1 TO L 560 IF (A(I)<=D) AND (A(I)>(D-H)) THEN B(K)=B(K)+1 570 NEXT I 580 K=K+1:D=D+H:IF K=11 THEN 600 590 GOTO 550 600 FOR I=1 TO L 610 IF A(I)<(Q-H) THEN B(0)=B(0)+1 620 IF A(I)>V THEN B(11)=B(11)+1 630 NEXT I:PRINT CHR$(12):HI=B(0) 640 FOR I=0 TO 11 650 IF B(I)>HI THEN HI=B(I) 6;" Degrees of Freedom" 1140 LPRINT CHR$(138):LPRINT"Lumped Frequency Values: ";CHR$(10) 1150 FOR I=0 TO 11 1160 LPRINT TAB(I*5+7);B(I); 1170 NEXT I 1180 LPRINT CHR$(10) 1190 PRINT"Analysis Completed" 1200 END 1210 LPRINT" TABLE OF CHI SQUARE VALUES":LPRINT 1220 LPRINT" PROBABILITY 90% 80% 70%" 1230 LPRINT"DOF" 1240 LPRINT" 2 0.211 0.446 0.713" 1250 LPRINT" 3 0.584 1.005 1.424" 1260 LPRINT" 4 1.064 1.649 2.195" 1270 LPRINT" 5 1.610 2.343 3.000" 1280 LPRINT" 6 2.200 3.070 60 NEXT I 670 PRINT"Press =J THEN LPRINT TAB(I*5+8);CHR$(42); 770 NEXT I:LPRINT CHR$(10) 780 NEXT J 790 LPRINT STRING$(64,45) 800 FOR I= 1 TO 12:LPRINT TA10 REM *****MORGAG*****BUSINESS PROGRAM 20 REM MORGAG**********VERSION #1 (7/31/69)*****MORTGAGE ANALYSIS***** 30 REM 40 PRINT "* MORTGAGE ANALYSIS *" 50 PRINT 60 PRINT "IF YOU WANT TO FIND:" 70 PRINT " THE RATE, TYPE '1'" 80 PRINT " THE LIFE, TYPE '2'" 90 PRINT " THE AMOUNT BORROWED, TYPE '3'" 100 PRINT " THE MONTHLY PAYMENT, TYPE '4'" 110 PRINT "WHICH DO YOU WANT"; 120 INPUT Z 130 PRINT 140 IF Z=1 THEN 220 150 PRINT "WHAT IS THE NOMINAL ANNUAL RATE USING 3.828" 1290 LPRINT" 7 2.833 3.822 4.671" 1300 LPRINT" 8 3.490 4.594 5.527" 1310 LPRINT" 9 4.168 5.380 6.393" 1320 LPRINT 1330 LPRINT"NOTE: Data is NOT statistically significant for chi-square" 1340 LPRINT"values GREATER than those indicated in the 70% column (for" 1350 LPRINT"the specific DOF ) OR if DOF is LESS than 2. 1360 LPRINT:LPRINT 1370 RETURN  indicated in 0.584 1.005 1.424" 1260 LPRINT" 4 1.064 1.649 2.195" 1270 LPRINT" 5 1.610 2.343 3.000" 1280 LPRINT" 6 2.200 3.070 B((I-1)*5+7);I;:NEXT 810 LPRINT CHR$(10):LPRINT TAB(31);"Interval":LPRINT CHR$(138) 820 LPRINT"Interval","Ends At";TAB(37);"# of Points in Interval" 830 LPRINT 840 D=Q 850 FOR I= 1 TO 12 860 IF (I=1)+(I=12) THEN 890 870 LPRINT I,D;TAB(37);B(I-1) 880 GOTO 910 890 IF I=1 THEN LPRINT I,"ALL PTS <= ";TAB(37);B(0) 900 IF I=12 THEN LPRINT I,"ALL PTS > ";(D-H);TAB(37);B(11) 910 D=D+H:NEXT I 920 FOR I=1 TO 5 930 FOR J=0 TO 5 940 IF B(J)>=5 THEN 960 950 B(J+1)=B(J+1)+B(J):B(J)=0 960 NEXT J,I 970 FORDECIMAL NOTATION"; 160 INPUT R 170 IF R<1 THEN 200 180 PRINT "IT APPEARS THAT YOU HAVE FORGOTTEN TO USE DECIMAL NOTATION" 190 GOTO 150 200 PRINT 210 IF Z=2 THEN 260 220 PRINT "WHAT IS THE LIFE OF THE MORTGAGE: YEARS, MONTHS"; 230 INPUT Y,M 240 PRINT 250 IF Z=3 THEN 300 260 PRINT "WHAT IS THE AMOUNT TO BE BORROWED"; 270 INPUT A 280 PRINT 290 IF Z=4 THEN 330 300 PRINT "WHAT IS THE AMOUNT OF ONE MONTHLY PAYMENT"; 310 INPUT P 320 PRINT 330 PRINT "WHAT IS THE MONTH (JAN=1, I=1 TO 5 980 FOR J=11 TO 6 STEP -1 990 IF B(J)>5 THEN 1010 1000 B(J-1)=B(J-1)+B(J):B(J)=0 1010 NEXT J,I 1020 FOR I = 1 TO 11 1030 IF B(I)>0 THEN DOF=DOF+1 1040 NEXT I 1050 DOF=DOF-3 1060 C(0)=.0062:C(1)=.0166:C(2)=.044:C(3)=.0919:C(4)=.1498 :C(5)=.1915 1070 C(6)=C(5):C(7)=C(4):C(8)=C(3):C(9)=C(2):C(10)=C(1):C(11)=C(0) 1080 FOR I=0 TO 11 1090 IF B(I)=0 THEN 1120 1100 SUM=((B(I)/L)-C(I))^2/C(I) 1110 CHI=CHI+SUM 1120 NEXT I:LPRINT CHR$(138) 1130 LPRINT"Chi Square Value is ";CHI;" with ";DOF    ETC.), AND YEAR IN WHICH THE MORTGAGE LOAN IS" 340 PRINT "TO BE MADE"; 350 INPUT T1,T2 360 PRINT 370 PRINT "FOR HOW MANY CALENDAR YEARS DO YOU WANT THE MORTGAGE TABLE PRINTED"; 380 INPUT T3 390 PRINT 400 PRINT "TYPE A ONE (1) IF YOU WANT ONLY AN ANNUAL SUMMARY OF THE MORTGAGE" 410 PRINT "TABLE; TYPE A ZERO (0) FOR A MONTHLY TABLE"; 420 INPUT Z1 430 PRINT 440 IF Z=2 THEN 470 450 N=12*Y+M 460 IF Z=1 THEN 660 470 R1=R/12 480 IF Z=3 THEN 580 490 IF Z=4 THEN 610 500 IF (A*R1/A>0 THEN 1690 1610 Z2=1 1620 PRINT T2,S1,S2,A 1630 T2=T2+1 1640 IF M1=12*T3 THEN 1700 1650 IF Z2=1 THEN 1700 1660 S1=0 1670 S2=0 1680 M2=0 1690 NEXT M1 1700 PRINT "**********************************************************************" 1710 RUN "DIR"  M2=0 1690 NEXT M1 1700 PRINT "**********************************************************************" 1560 IF M1=12*T3 THEN 1700 1570 PRINT " ","FOR THE CALENDAR YEAR"T2 1580 GOTO 1660 1590 IF M2=12 THEN 1620 1600 IF 00 PRINT 1010 PRINT "----------------------------------------------------------------------" 1020 PRINT 1030 PRINT " MORTGAGE TABLE" 1040 PRINT 1050 PRINT 1060 Z2=0 1070 S1=0 1080 S2=0 1090 IF T1=12 THEN 1120 1100 M2=T1 1110 GOTO 1140 1120 T2=T2+1 1130 M2=0 1140 M3=M2+1 1150 IF Z1=1 THEN 1230 1160 PRINT " ","BEGINNING" 1170 PRINT " ","PRINCIPAL"," ","PRINCIPAL" 1180 PRINT "MONTH","OUTSTANDING","INTEREST","REPAYMENT" 1190 PRINT 1200P)<1 THEN 530 510 PRINT "THE FIRST MONTHS PAYMENT WILL NOT EVEN COVER ITS INTEREST CHARGE" 520 RUN "DIR" 530 N=-(LOG(1-(A*R1)/P))/LOG(1+R1) 540 N=INT(N)+1 550 Y=INT(N/12) 560 M=N-12*Y 570 GOTO 770 580 A=(P*(1-1/((1+R1)^N)))/R1 590 A=INT((A+5)/10)*10 600 GOTO 770 610 P=(A*R1)/(1-1/((1+R1)^N)) 620 P=(P*1000+5)/10 630 P=INT(P) 640 P=P/100 650 GOTO 770 660 R1=0 670 FOR O=1 TO 5 680 FOR I=1 TO 10 690 Q=I*(1/(10^O))+R1 700 C=(P*(1-1/((1+Q)^N)))/Q 710 IF C(R*A+1) THEN 830 790 PRINT "YOUR FIRST YEARS'S PAYMENTS ARE"12*P 800 PRINT "THE FIRST YEARS'S INTEREST IS"R*A 810 PRINT "THEREFORE, THE LIFE OF THE MORTGAGE IS UNDEFINED" 820 RUN "DIR" 830 PRINT "***********************************************************************" 840 PRINT 850 PRINT " MORTGAGE TERMS" 860 PRINT 870 PRINT " NOMINAL ANNUAL  1590 1430 PRINT M2,A1,I1,P1 1440 IF M2=12 THEN 1470 1450 IF A>0 THEN 1690 1460 Z2=1 1470 PRINT 1480 PRINT " INTEREST PAID DURING";T2;TAB(42);"=";S1 1490 PRINT " PRINCIPLE REPAID DURING";T2;TAB(42);"=";S2 1500 PRINT " PRINCIPLE OUTSTANDING AT YEAR END";TAB(42);"=";A 1510 IF Z2=1 THEN 1700 1520 T2=T2+1 1530 PRINT 1540 PRINT "-----" 1550 PRINT 1560 IF M1=12*T3 THEN 1700 1570 PRINT " ","FOR THE CALENDAR YEAR"T2 1580 GOTO 1660 1590 IF M2=12 THEN 1620 1600 IF RATE =";R*100;"PERCENT" 880 PRINT " LIFE OF MORTGAGE =";Y;"YEARS,";M;"MONTHS" 890 PRINT " AMOUNT BORROWED = $";A 900 PRINT " MONTHLY PAYMENT = $";P 910 IF Z=1 THEN 950 920 IF Z=3 THEN 990 930 IF Z=2 THEN 970 940 GOTO 1000 950 PRINT " (NOTE: THE ANNUAL RATE HAS BEEN ROUNDED TO NEAREST 1/100 PERCENT)" 960 GOTO 1000 970 PRINT " (NOTE: THE MORTGAGE LIFE HAS BEEN ROUNDED UPWARD TO NEAREST MONTH)" 980 GOTO 1000 990 PRINT " (NOTE: THE AMOUNT BORROWED ROUNDED TO NEAREST $10)" 10!   10 REM APPOINTMENT CALENDAR 20 REM LAST UPDATED 10-MAY-81 30 REM *** 40 DIM A0$(41,7) : REM APPOINTMENT STRINGS 42 SQUARES BY 8 APTS 50 DIM A0(41) :REM APPOINT INDEXES 60 DIM M0$(12): REM MONTH NAMES 70 DIM M0(12) : REM MONTHS LENGTHS 80 DIM D0$(7) : REM DAY NAMES 90 REM *** 100 PRINT :PRINT CHR$(27);"E":REM CLEAR THE TERMINAL SCREEN 110 PRINT TAB(20) "APPOINTMENT CALENDAR GENERATOR (VER 2.01)" 112 PRINT TAB(20) "VERSION FOR USE WITH LEGAL PRINTWHEELS" 120 PRINT TAB(10) "MODIFIED FOR CP/M AND UP-SENT 1000 IF M=99 THEN 1090 1010 IF Y<>Y0 THEN 990 1020 IF M<> M0 THEN 990 1030 IF D<1 OR D>D0 THEN 990 1040 D=D9+D-1 : REM ADJUST FOR DAY OF WEEK FOR 1ST DAY. 1050 IF A0(D)<0 THEN 990 : REM DAY FULL 1060 A0$(D,A0(D))=LEFT$(A$+B$,W9) : REM SAVE APPT. STRING IN BOX 1070 A0(D)=A0(D)-1 1080 GOTO 990 1090 CLOSE #2 1100 REM FILL IN DAY NUMBERS 1110 D=1 1120 FOR I=D9 TO D0+D9-1 1130 A$=STR$(D) 1140 A0$(I,0)=LEFT$(A0$(I,0),LEN(A0$(I,0))-LEN(A$))+A$ 1150 D=D+1 1160 NEXT I 1170 RETURN 1180 REM *EN SYSTEM 510 PRINT "ANSWER YES OR NO. ";:GOTO 470 520 REM *** 530 REM *** INITIALIZE 540 REM *** 550 INPUT "LINES PER PAGE? ";L0 560 IF L0<50 THEN PRINT "HUH? ENTER ";:GOTO 550 570 INPUT "COLUMNS PER LINE? ";C0 580 IF C0<80 THEN PRINT "HUH? ENTER ";:GOTO 570 590 REM COMPUTE MAX APTS PER BOX AND LINES TO NEXT PAGE 600 A9=INT((L0-20)/6) 610 IF A9>8 THEN A9=8 620 L1=L0-A9*6-17 630 REM COMPUTE MAX WIDTH OF APT ENTRY 640 W9=INT((C0-8)/7) 650 REM ADJUST NUMBER OF COLUMNS 660 C0=(W9+1)*7+1 670 DATED FOR MBASIC BY BARRY N. TILDS" 130 PRINT:PRINT 132 PRINT "I NEED SOME INFORMATION ON THE PRINTER SETTINGS TO KEEP THINGS IN ORDER:" 140 PRINT :PRINT 150 REM READ MONTH NAMES AND LENGTHS 160 FOR I=1 TO 12: READ M0$(I),M0(I):NEXT I 170 DATA "JANUARY",31,"FEBRUARY",28,"MARCH",31 180 DATA "APRIL",30,"MAY",31,"JUNE",30 190 DATA "JULY",31,"AUGUST",31,"SEPTEMBER",30 200 DATA "OCTOBER",31,"NOVEMBER",30,"DECEMBER",31 210 REM DEFAULT OUTPUT DEVICE AND APT. FILE 220 F2$="CALENDAR.APT" 230 'V$="|" :REM** 1190 REM *** 1200 REM *** GET APPT FILE NAME 1210 REM *** 1220 PRINT "APPOINTMENT FILE NAME <";F2$;">"; 1230 LINE INPUT F9$ 1240 IF F9$<>"" THEN F2$=F9$ 1250 RETURN 1260 REM *** 1270 REM *** PROCESS CALENDAR HEADING 1280 REM *** 1290 REM PREVIOUS AND NEXT MONTH 1300 IF T$="" THEN LPRINT :GOTO 1320 1310 M1=M0-1:Y1=Y0 1320 IF M1<1 THEN M1=12:Y1=Y1-1 1330 M2=M0+1:Y2=Y0 1340 IF M2>12 THEN M2=1:Y2=Y2+1 1350 Y=Y1:M=M1:GOSUB 1960:D1=-D9+1:S1=D8 1360 Y=Y2:M=M2:GOSUB 1960:D2=-D9+1:S2=D8 1370 HRETURN 680 REM *** 690 REM *** GET MONTH,YEAR, NUMBER OF COPIES ETC 700 REM *** 710 LINE INPUT "NAME OF MONTH? ";M9$:M9$=LEFT$(M9$,3) 720 FOR M0=1 TO 12 730 IF M9$=LEFT$(M0$(M0),3) THEN 760 740 NEXT M0 750 PRINT "HUH? ENTER ";:GOTO 710 760 INPUT "YEAR (EG. 1980)? ";Y0 770 IF Y0<1582 THEN PRINT "HUH? ENTER ";:GOTO 760 780 INPUT "NUMBER OF CONSECUTIVE MONTHS? ";N8 790 PRINT :PRINT "EACH CALENDAR TAKES SEVERAL MINUTES TO COMPUTE" 800 PRINT "...... BE PATIENT":PRINT 810 INPUT "NUMBER OF COPIE VERTICAL BAR ... MAY WANT TO CHANGE FOR DIFFERENT PRINTERS 235 V$ = CHR$(27) + "Y" : REM VERTICAL BAR FOR LEGAL PRINTWHEELS 240 B$=" ":REM BLANK STRING 250 H$=" SU MO TU WE TH FR SA " 260 REM READ NAMES OF DAYS 270 FOR I=1 TO 7:READ D0$(I):NEXT I 280 DATA "SUNDAY","MONDAY","TUESDAY","WEDNESDAY" 290 DATA "THURSDAY","FRIDAY","SATURDAY" 300 GOSUB 530: REM INITIALIZE 310 REM DO WHILE MORE MONTHS TO PROCESS 320 GOSUB 1190 : REM GET APPT FILE NAME 330 GOSUB 690:REM GET MONTH,YEAR,#C1$=M0$(M1)+STR$(Y1) 1380 H2$=M0$(M2)+STR$(Y2) 1390 LPRINT TAB((22-LEN(H1$))/2);H1$; 1400 LPRINT TAB(C0-21+(22-LEN(H2$))/2);H2$ 1410 T$=LEFT$(T$,C0-42) 1420 LPRINT H$;SPC((C0-42-LEN(T$))/2);T$;TAB(C0-21);H$ 1430 REM PRINT DAYS OF PREV AND NEX MONTH 1440 GOSUB 1540:GOSUB 1570:LPRINT 1450 GOSUB 1540:GOSUB 1570:LPRINT 1460 GOSUB 1540 1470 LPRINT SPC((C0-42-LEN(M0$(M0))-6)/2);M0$(M0);Y0; 1480 GOSUB 1570:LPRINT 1490 GOSUB 1540:GOSUB 1570:LPRINT 1500 GOSUB 1540:GOSUB 1570:LPRINT 1510 GOSUB 1540 S? ";N9 820 RETURN 830 REM *** 840 REM *** PROCESS APOINTMENT FILE 850 REM *** 860 Y=Y0:M=M0:GOSUB 1960 : REM GET FIRST DAY INDEX 870 I0=D9 : REM SAVE INDEX FOR LATER 880 D0=D8 : REM # DAYS IN MONTH 890 REM INITIALIZE APPT. ARRAYS 900 FOR I=0 TO 41 910 A0(I)=A9-1 920 FOR J=0 TO A9-1 930 A0$(I,J)=LEFT$(B$,W9) 940 NEXT J 950 NEXT I 960 OPEN "I",2,F2$ 970 LINE INPUT #2,T$:REM READ TITLE LINE 980 REM DO WHILE MORE APPT. RECORDS 990 INPUT #2,M,D,Y,A$: REM GET MONTH,DAY,YEAR,APPT STRING OR ENDOPIES,ETC 340 LINE INPUT "POSITION PAPER. HIT RETURN WHEN READY";A$ 350 REM DO NUMBER OF CONSECUTIVE MONTHS 360 FOR N1=1 TO N8+1 370 GOSUB 840 : REM PROCESS APPOINTMENT FILE 380 REM DO WHILE MORE COPIES 390 FOR N=1 TO N9 400 GOSUB 1270:REM PROCESS CALENDAR HEADER 410 GOSUB 1680:REM PROCESS CALENDAR BODY 420 NEXT N 430 REM NEXT CONSEQ MONTH 440 M0=M0+1 450 IF M0>12 THEN M0=1: Y0=Y0+1 460 NEXT N1 470 LINE INPUT "ANY MORE MONTHS? ";Y$ 480 Y$=LEFT$(Y$,1) 490 IF Y$="Y" THEN 310 500 IF Y$="N" TH!    1520 IF D1>S1 AND D2>S2 THEN LPRINT :RETURN 1530 GOSUB 1570:LPRINT :RETURN 1540 REM PRINT PREV MONTH DAYS 1550 D=D1:D1=D1+7:S=S1 1560 GOTO 1600 1570 REM PRINT NEXT MONTH DAYS 1580 D=D2:D2=D2+7:S=S2 1590 LPRINT TAB(C0-21); 1600 FOR I=1 TO 7 1610 IF D<1 OR D>S THEN A$=" ":GOTO 1630 1620 A$=RIGHT$(" "+STR$(D),3) 1630 D=D+1 1640 LPRINT A$; 1650 NEXT I 1660 RETURN 1670 REM *** 1680 REM *** PROCESS BODY OF CALENDAR 1690 REM *** 1700 GOSUB 1920:REM DASHES 1710 FOR I=1 TO 7 1720 J1=INT((W9ll Rights Reserved" 120 PRINT Y$;"39SETTING GRAPHIC CHARACTER CODES":GOSUB 1060 130 PRINT Y$;"37Would You Like Instructions? (y/n)" 140 X$=INPUT$(1):IF X$="Y" OR X$="y" THEN GOSUB 1560 150 PRINT E$;"E";E$;"y5";:INPUT "Number of Variables";V 160 IF V>5 THEN PRINT "Too Many Variables. Enter Again.":GOTO 150 170 PRINT:INPUT "Starting Vertical Entry";V1 180 PRINT:INPUT "Ending Vertical Entry";V3 190 PRINT:INPUT "Vertical Increment";V2 191 LET X=V*((V3-V1)/V2+1)*5/24:LET Y=X*5/3 192 PRINT:PRINT "Height-LEN(D0$(I)))/2) : J2=W9-J1-LEN(D0$(I)) 1730 LPRINT V$;SPC(J1);D0$(I);SPC(J2); 1740 NEXT I 1750 LPRINT V$ 1760 GO14(214(214(214(214(214(214(214(214(214(214(214(214(214(214(214(214(214(214(214(214(214(214(214(214(214(214(214(214(214(214(214(214(214(214(214(214(214(214(214(214(214(214(6 V$; 1830 FOR I3=0 TO 6 : REM 7 BOXES ACROSS 1840 LPRINT A0$(D+I3,I2);V$; 1850 NEXT I3 : LPRINT 1860 NEXT I2 1870 GOSUB 1920 : D=D+7 1880 NEXT I1 1890 REM SPACE TO NEXT PAGE 1900 FOR I=1 TO L1 : LPRINT :NEXT I 19 of Chart Will be:" 193 PRINT " ";X;"Inches for Single Height Bars" 194 PRINT " ";Y;"Inches for Double Height Bars" 195 PRINT:INPUT "Select Single or Double Height Bars (1/2)";DB 200 PRINT:INPUT "Enter Label for Vertical";V$ 210 IF (V3-V1)MOD V2=0 GOTO 230 220 PRINT:PRINT "Scale and Increment do not agree. Enter Again.":GOTO 170 230 LET L=(V3-V1)\V2:IF V*(L+1)>50 THEN GOTO 160 240 DIM N(V-1,L):DIM S(V-1):DIM L$(L):DIM A$(V-1) 250 FOR I=0 TO L:LET J=V1+I*V2:LET L$(I)=STR$(J):NEXT I 260 PRINT E$10 RETURN 1920 REM *** PRINT LINE OF DASHES 1930 FOR I=1 TO C0:LPRINT "-";:NEXT I 1940 LPRINT :RETURN 1950 REM *** 1960 REM *** GET FIRST DAY INDEX (DAY OF WEEK OF 1ST OF MONTH) 1970 REM *** 1980 REM EQUATIONS TAKEN FORM 'DAYOFWK' BY JIM BROCK 1990 IF M>2 THEN GOTO 2020 2000 D9=365*Y+1+31*(M-1)+INT((Y-1)/4)-INT(.75*INT(((Y-1)/100+1))) 2010 GOTO 2030 2020 D9=365*Y+1+31*(M-1)-INT(.4*M+2.3)+INT(Y/4)-INT(.75*(INT(Y/100)+1)) 2030 D9=INT(D9-INT(D9/7)*7) 2040 D9=D9-1: IF D9<0 THEN D9=6 2050 REM COM;"E":INPUT "Minimum Horizontal Dimension";H1 270 PRINT:INPUT "Maximum Horizontal Dimension";H3 280 IF H3>H1 GOTO 290 ELSE PRINT "Maximum Must be Greater Than Minimum.":GOTO 260 290 PRINT:INPUT "Horizontal Increment";H2 300 PRINT:INPUT "Horizontal Width (Inches, 2 to 6)";W 310 IF NOT (H3-H1)MOD H2=0 THEN PRINT "Dimension Wrong. Enter Again.":GOTO 260 320 IF (H3-H1)\H2>2*W THEN PRINT "Increment Too Small. Enter Another.":GOTO 290 330 PRINT:INPUT "Enter Label for Horizontal";H$ 340 LET W=60*W:LET H=H3-10 REM HORIZONTAL BAR CHART; John W. Coviello; 9 August 1982 20 DEFINT A-V:E$=CHR$(27):K$=E$+"K":G$=E$+"G":F$=E$+"F":WIDTH LPRINT 255 30 DEFDBL Z:Y$=E$+"Y":P$=E$+"p":Q$=E$+"q" 40 PRINT E$;"x5";E$;"E";F$;P$ 50 PRINT Y$;"!,";STRING$(56,"w") 60 FOR I=34 TO 48:PRINT Y$;CHR$(I);",ww":NEXT I 70 PRINT Y$;"1,";STRING$(56,"w") 80 FOR I=34 TO 48:PRINT Y$;CHR$(I);"bww":NEXT I 90 PRINT G$;Q$;Y$;"#BHORIZONTAL";Y$;"%CBAR CHART";Y$;"(Gby" 100 PRINT Y$;"*@John W. Coviello";Y$;",AAugust 24, 1982" 110 PRINT Y$;"/>APUTE DAYS IN MONTH 2060 D8=M0(M) 2070 IF M<>2 THEN RETURN 2080 IF INT(Y/4)*4 =Y THEN D8=D8+1 :REM LEAP YEAR IN FEB. 2090 RETURN UH? ENTER ";:GOTO 710 760 INPUT90 IF M>2 THEN GOTO 2020 2000 D9=365*Y+1+31*(M-1)+INT((Y-1)/4)-INT(.75*INT(((Y-1)/100+1))) 2010 GOTO 2030 2020 D9=365*Y+1+31*(M-1)-INT(.4*M+2.3)+INT(Y/4)-INT(.75*(INT(Y/100)+1)) 2030 D9=INT(D9-INT(D9/7)*7) 2040 D9=D9-1: IF D9<0 THEN D9=6 2050 REM COM"   H1:PRINT E$;"E";E$;"F" 350 FOR I=0 TO 5:PRINT E$;"Y";CHR$(32);CHR$(32+10*I);I;STRING$(5,CHR$(C(I))):NEXT I 360 FOR I=0 TO 5:PRINT E$;"Y";CHR$(34);CHR$(32+10*I);I+6;STRING$(5,CHR$(C(I+6))): NEXT I 370 FOR I=O TO 5:PRINT E$;"Y$";CHR$(32+10*I);I+12;P$;STRING$(5,CHR$(C(I)));Q$:NEXT I 380 FOR I=0 TO 5:PRINT E$;"Y&";CHR$(32+10*I);I+18;P$;STRING$(5,CHR$(C(I+6)));Q$:NEXT I 390 PRINT E$;"G";E$;"Y( "; 400 FOR I=0 TO V-1:PRINT "Enter Code for Variable ";CHR$(I+65):INPUT S(I):NEXT I 410 PRINT "Enter Label for Va3,7,7,7,3,0,0,0,16,24,24,24,16,0,16 1150 DATA 24,28,30,31,31,31,31,0,0,0,16,24,28,31,31,0,0,0,31,31,0,0,0,0,0,0,31,31 1160 DATA 0,0,0,1,1,1,31,31,1,1,1,16,16,16,31,31,16,16,16,0,0,1,1,5,3,1,0,0,0,0,0 1170 DATA 8,16,0,0,21,10,21,10,21,10,21,10,10,21,10,21,10,21,10,21,0,0,0,0,31,31 1180 DATA 31,31,0,0,0,0,31,31,31,31,31,31,31,31,30,28,24,16,31,28,24,16,0,0,0,0 1190 DATA 24,12,6,3,3,6,12,24,3,6,12,24,24,12,6,3,0,0,0,1,3,6,12,24,3,6,12,24 1200 DATA 16,0,0,0,24,12,6,3,1,0,0,0,0,0,0,16,24,12,6,3 1210 DIM CNG$(8," "); 770 LET N1=X MOD 256:LET N2=X\256:LPRINT K$;CHR$(N1);CHR$(N2); 780 FOR I=1 TO H\H2:LPRINT STRING$(3,127);STRING$(D,96);:NEXT I 790 LPRINT STRING$(3,127); 800 LPRINT E$;"@" 810 LET T=(H3-H1)/H2:LET T=W/T 820 FOR I=0 TO (H3-H1)/H2:LPRINT TAB(INT(T*I/6+7));H1+H2*I;:NEXT I 830 LPRINT:LPRINT TAB(8+W\12-LEN(H$)); 840 LPRINT E$;CHR$(69);E$;CHR$(83);H$ 850 LPRINT:LPRINT C$ 860 LPRINT E$;"@" 870 PRINT STRING$(70," ") 880 PRINT "Do You Want to Make Another Chart? (y/n)" 890 X$=INPUT$(1):PRINTriable (Up to 10 Characters)." 420 FOR I=0 TO V-1:PRINT " Variable ";CHR$(I+65);:INPUT A$(I):NEXT I 430 PRINT:PRINT "Enter Caption For Chart.":INPUT C$ 440 PRINT:PRINT "Tabular Manual Input or SuperCalc Input? (T/S)" 450 X$=INPUT$(1):IF X$="S" OR X$="s" GOTO 1750 460 PRINT E$;"E" 470 FOR I=0 TO V-1:PRINT "VARIABLE ";CHR$(I+65);", FOR Y=" 480 FOR J=0 TO L 490 PRINT V1+V2*J;"; ";CHR$(I+65);"=";:INPUT; Z 500 IF Z>=H1 AND Z<=H3 GOTO 520 510 PRINT:PRINT "Outside Chart Area. Enter Again.":GOTO 490 520(11) 1220 FOR I=0 TO 11:READ C(I):NEXT I 1230 DATA 32,94,95,96,98,104,105,113,114,119,120,121 1240 RETURN 1250 REM GRAPH PREVIEW 1260 PRINT E$;"E";E$;"x5" 1270 LET I=0 1280 FOR J=1 TO 3:LET S=S(I):IF S>11 THEN LET P=1 ELSE LET P=0 1290 IF S>11 THEN LET S=S-12 1300 PRINT TAB(20*J-10);F$; 1310 IF P=1 THEN PRINT P$; 1320 PRINT STRING$(5,CHR$(C(S)));G$; 1330 IF P=1 THEN PRINT Q$; 1340 PRINT " ";A$(I); 1350 LET I=I+1:IF I=V GOTO 1370 1360 NEXT J:PRINT 1370 PRINT:PRINT 1380 PRINT V$:PRINT F$; 13 E$;"z" 900 IF X$="Y" OR X$="y" THEN CLEAR:GOTO 10 ELSE END 910 LET N1=X MOD 256:LET N2=X\256 920 LET N4=N1 MOD 8:LET N1=N1-N4 925 FOR M=1 TO DB 930 FOR K=0 TO 8 STEP 8 940 LET L1=LEN(L$(Q)) 950 IF K=8 AND R=V\2 AND M=DB THEN LPRINT STRING$(6-L1," ");L$(Q);" ";:GOTO 970 960 LPRINT STRING$(7," "); 970 LPRINT K$;CHR$(6);CHR$(0);STRING$(4,0);CHR$(31);CHR$(31); 980 LPRINT K$;CHR$(N1+N4);CHR$(N2); 990 FOR I=1 TO (N1/8+32*N2):FOR J=K TO K+7 1000 LPRINT CHR$(A(S,J));:NEXT J:NEXT I:IF N4=0 GOTO 1020 10 LET Z=(Z-H1)/H:LET Z=INT(Z*W):LET N(I,J)=Z:PRINT ,:NEXT J:PRINT:NEXT I 530 PRINT:PRINT "Do You Want to Preview Chart? (y/n)" 540 X$=INPUT$(1):IF X$="Y" OR X$="y" THEN GOTO 1250 550 PRINT E$;"x1";P$;Y$;"8 PRINTING NOW, MAKE SURE PRINTER IS ON. ";Q$ 560 LPRINT E$;CHR$(51);CHR$(15):LET N=0 570 FOR K=0 TO 8 STEP 8:LPRINT TAB(10);:FOR Q=1 TO 3:LET S=S(N) 580 LPRINT K$;CHR$(40);CHR$(0); 590 FOR I=0 TO 4:FOR J=K TO K+7:LPRINT CHR$(A(S,J));:NEXT J:NEXT I 600 IF K=0 THEN LPRINT STRING$(13," "); 610 L90 FOR I=0 TO L:FOR J=0 TO V-1 1400 LET X=N(J,I):LET X=X\6:LET S=S(J) 1410 IF S>11 THEN LET P=1 ELSE LET P=0 1420 IF S>11 THEN LET S=S-12 1430 LET L1=LEN(L$(I)) 1440 IF J=V\2 THEN PRINT STRING$(6-L1," ");L$(I);" "; 1450 IF J<>V\2 THEN PRINT STRING$(7," "); 1460 IF S>11 THEN LET S=S-12 1470 IF P=1 THEN PRINT P$; 1480 PRINT STRING$(X,C(S));:IF P=1 THEN PRINT Q$; 1490 PRINT:NEXT J:NEXT I:PRINT 1500 LET Z=(H3-H1)/H2:LET Z=W/Z 1510 FOR I=0 TO (H3-H1)/H2:PRINT TAB(INT(Z*I/6+6));H1+H2*I;:NEXT I:PRINT 10 FOR J=K TO K+N4-1:LPRINT CHR$(A(S,J));:NEXT J 1020 LPRINT:NEXT K:NEXT M:LPRINT STRING$(7,32);K$;CHR$(6);CHR$(0); 1030 IF R<>V-1 THEN LPRINT STRING$(4,0);CHR$(31);CHR$(31) 1040 IF R=V-1 THEN LPRINT STRING$(4,14);CHR$(31);CHR$(31) 1050 RETURN 1060 DIM A(23,15):REM GRAPHIC CHARACTER CODES 1070 FOR I=0 TO 11 1080 FOR J=0 TO 15 1090 READ A(I,J):NEXT J:NEXT I 1100 RESTORE 1110 FOR I=12 TO 23 1120 FOR J=0 TO 15 1130 READ A:LET A(I,J)=31-A:NEXT J:NEXT I 1140 DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,ET X=12-LEN(A$(N)) 620 IF K=8 THEN LPRINT " ";A$(N);STRING$(X," "); 630 LET N=N+1 640 IF N<>V GOTO 670 650 IF K=8 GOTO 690 660 LET N=N-Q:GOTO 680 670 NEXT Q:IF K=0 THEN LET N=N-3 680 NEXT K:GOTO 570 690 LPRINT:LPRINT E$;CHR$(51);CHR$(27) 700 LPRINT E$;CHR$(69);E$;CHR$(83);V$;E$;CHR$(70) 710 LPRINT E$;CHR$(51);CHR$(15) 720 FOR Q=0 TO L:FOR R=0 TO V-1:LET X=N(R,Q):LET S=S(R) 730 GOSUB 910:NEXT R:NEXT Q 740 LET D=INT(W*H2/H):LET X=D*H/H2+3:LET D=D-3 750 LPRINT E$;CHR$(51);CHR$(6) 760 LPRINT STRI"   1520 PRINT G$:PRINT TAB(8+W/12-LEN(H$)/2);H$ 1530 PRINT:PRINT C$ 1540 PRINT E$;"y5";G$;"Press RETURN to Print Chart or 'R' to Redo" 1550 X$=INPUT$(1):IF X$="R" OR X$="r" THEN CLEAR:GOTO 10 ELSE GOTO 550 1560 REM INSTRUCTIONS 1570 PRINT E$;"E" 1580 PRINT "This Program Develops a Bar Chart with Horizontal Bars Representing" 1590 PRINT " up to 5 Variables. The Width of the Chart Can be Between 1 and 5" 1600 PRINT " Inches and is Independent of the Horizontal Scale.":PRINT 1610 PRINT "The Vertical SM: FOLLOWING LINE GARBLED FROM ORIG AS P(1=P(X+1) 330 P(1)=P(X+1) 340 FOR I=2 TO X+1 350 P(I)=P(I-1)+P(I-1)*I1/X 360 NEXT I 370 B$=" ## $#####.## $#####.## $#####.## $#####.##" 380 PRINT USING B$;Y;P(2),P(3),P(4),P(5) 390 NEXT Y 400 END $=" ## $#####.## $#####.## $#####.## $#####.##" 380 PRINT USING B$;Y;P(2),P(3),P(4),P(5) 390 NEXT Y 400 ARTER 3RD QUARTER 4TH QUARTER" 270 PRINT A$ 280 PRINT 290 E1=N*X 300 P(1)=P 310 FOR Y=1 TO N 320 IF Y=1 THEN 340 325 RE=K+1:LET SC$="":IF K<>K1 GOTO 1840 1890 NEXT I:CLOSE #1:GOTO 530 1875 IF K1=V THEN LET N(K,I)=Z ELSE LET N(I,K)=Z 1880 LET K00 IF X$="C" OR X$="c" THEN LET I1=L:LET K1=V ELSE LET I1=V-1:LET K1=L+1 1820 FOR I=0 TO I1 1830 LET J=0:LET K=0:LET SC$="":INPUT #1,X$ 1840 LET J=J+1:LET X1$=MID$(X$,J,1) 1850 IF X1$=" " GOTO 1840 ELSE LET SC$=SC$+X1$ 1860 LET X1$=MID$(X$,J+1,1):IF X1$>"'" AND X1$<":" GOTO 1840 1870 LET Z=VAL(SC$):LET Z=(Z-H1)*W\H 1875 IF K1=V THEN LET N(K,I)=Z ELSE LET N(I,K)=Z 1880 LET Kcale of the Chart Can Use Numbers of up to 5 digits," 1620 PRINT " but There Must be an Integral Relationship Between the Starting" 1630 PRINT " Entry, the Ending Entry, and the Increment.":PRINT 1640 PRINT "The Limitations on the Horizontal Scale are the Same as the Verti-" 1650 PRINT " cal Scale and in Addition, There Must be Enough Room to Print the" 1660 PRINT " Number of Increments Calculated":PRINT 1670 PRINT "To Input Values from SuperCalc, Strip the Borders (Use SC; /G,B) " 1680 PRINT " then Output Only the Values to a Print (????.PRN) File." 1690 PRINT:PRINT "To Exit the Program at any Time, Type a CTRL C.":PRINT 1700 PRINT P$;"NOTE:";Q$;" THE PROGRAM WILL HALT IF THE PRINTER IS NOT ON." 1710 PRINT:PRINT "CTRL 'P' and CTRL 'Q' can be Used to Stop Display Scrolling" 1720 PRINT " While Previewing the Chart. 1730 PRINT:PRINT "Type any Key to Return to Program." 1740 X$=INPUT$(1):RETURN 1750 REM SUPERCALC INPUT FOR VARIABLES 1760 PRINT:PRINT "Enter Filename for SuperCalc File (?:???100 REM: ****************** INVEST *********************** 110 REM: 120 REM: BY BOB SCALF 130 REM: 140 PRINT "INVESTMENT AMOUNT"; 150 INPUT P 160 PRINT "PERCENTAGE RATE"; 170 INPUT I1 180 I1=I1/100 190 PRINT "FOR HOW MANY YEARS"; 200 INPUT N 210 PRINT "COMPOUNDED HOW MANY TIMES PER YEAR"; 220 INPUT X 230 PRINT 240 PRINT 250 PRINT 260 A$="YEAR 1ST QUARTER 2ND QUARTER 3RD QUARTER 4TH QUARTER" 270 PRINT A$ 280 PRINT 290 E1=N*X 300 P(1)=P 310 FOR Y=1 TO N 320 IF Y=1 THEN 340 325 RE?.PRN)":INPUT X$ 1770 OPEN "I",1,X$ 1780 PRINT:PRINT "Are Variables Arranged in Rows or Columns? (R/C)" 1790 X$=INPUT$(1) 1800 IF X$="C" OR X$="c" THEN LET I1=L:LET K1=V ELSE LET I1=V-1:LET K1=L+1 1820 FOR I=0 TO I1 1830 LET J=0:LET K=0:LET SC$="":INPUT #1,X$ 1840 LET J=J+1:LET X1$=MID$(X$,J,1) 1850 IF X1$=" " GOTO 1840 ELSE LET SC$=SC$+X1$ 1860 LET X1$=MID$(X$,J+1,1):IF X1$>"'" AND X1$<":" GOTO 1840 1870 LET Z=VAL(SC$):LET Z=(Z-H1)*W\H 1875 IF K1=V THEN LET N(K,I)=Z ELSE LET N(I,K)=Z 1880 LET K#   PIE2590mi pi41Y6;15;30;4mi sliceur slicehe slicehur sliceI=7 310 PRINT CHR$(27);:PRINT"+"'CLEAR ALL SCREEN MEMORY SOROC 120 320 REM PRINT CHR$(26) CLEARS PAGE ON MY TERMINAL 330 PRINT SPC(10)"The function of this program is to setup housekeeping for" 340 PRINT SPC(10)"the FIN1 program. It will set the number of checks the" 350 PRINT SPC(10)"program will control to sixteen hundred. It will set both" 360 PRINT SPC(10)"your checkbook and bank balance to zero so that if the " 370 PRINT SPC(10)"documentation is followed and it's assumptions are true your" 380 10 REM This program is registered with the US Library of Congress 20 REM Copyright 1983. And is therefore protected under copyright laws. 30 REM Royalty free use of this program is authorized to single end users for 40 REM their personal non-profit use. This program may be freely copied only 50 REM by parties of the above discription for distribution to other parties 60 REM of the same discription. Otherwise all aspects of copyright law are in 70 REM effect for use and distribution of this program. R20005062.55100PIE2590mi pi41Y6;15;30;4mi sliceur slicehe slicehur slicePRINT SPC(10)"startup will be simple. The date you enter here will be" 390 PRINT SPC(10)"changed when you start check entry in FIN1. So give the" 400 PRINT SPC(10)"program todays date. Lowest record number refers to the" 410 PRINT SPC(10)"number you wrote down as part of the startup directions." 420 PRINT SPC(10)"Both data files needed by the FIN1 program will be created" 430 PRINT SPC(10)"on your B: disk." 440 PRINT 450 PRINT:PRINT SPC(20):INPUT"Enter Todays Date MM,DD,YR ";ST(MM),ST(DD),ST(YR) 46oyalty free use of this 80 REM program is cancelled if any part of this notice is altered or omitted. 90 REM Written by Mark B. Fay 12/10/82 telephone 305-964-1139 100 REM I,J,K,L & M are reserved for intergers 110 REM all menue selections use S$ 120 CLEAR 1024,1 130 OPTION #0,"P",0'turn off input prompt 140 OPTION #0,"W",76'set screen width 150 OPTION #2,"N",0,0'no printer nulls 160 OPTION #2,"W",80'set printer width 170 REM balance format statement 180 !$$####.## 190 !##/##/##'rem month day ye0 PRINT:PRINT SPC(20):INPUT"Enter Lowest Record Number #";ST(LC) 470 ST(BC)=0'zero checkbook 480 ST(BB)=0'zero bank 490 ST(BI)=ST(LC)'set record bias to reflect first check 500 ST(LS)=ST(LC)'set cancel counter for convinence 510 ST(LC)=ST(LC)-1'bias to account for increment in A option FIN1 520 REM SETUP ARRAY 530 PRINT CHR$(26);:PRINT"**CREATING ARRAY**" 540 FOR I=0 TO 1600 550 SR(I,0)=1:SR(I,1)=0 560 NEXT I 570 PRINT CHR$(26);:PRINT"**CREATING FILES AND OUTPUTING ARRAY**" 580 OPEN #11,"R","B:Sar format 200 REM format string for record display 210 DIM ST(7),SR(1600,1) 220 REM position 0 contains BC balance checkbook 230 REM position 1 contains BB balance bank 240 REM position 2 contains LC last check number 250 REM position 3 contains LS last stub canceled 260 REM position 4 contains MM month part last date 270 REM position 5 contains DD day part last date 280 REM position 6 contains YR year part last date 290 REM position 7 contains record bias 300 BC=0:BB=1:LC=2:LS=3:MM=4:DD=5:YR=6:B#   TUB.DAT",64'CREATE STUB DATA FILE 590 OPEN #10,"R","B:STATREC.DAT",6'CREATE ARRAY DATA FILE 600 MAT WRITE #10@0,ST,SR'OUTPUT ARRAY TO IT 610 CLOSE'CLOSE BOTH FILES 620 PRINT CHR$(26);:PRINT"**DONE**" o account for increment in A option FIN1 520 REM SETUP ARRAY 530 PRINT CHR$(26);:PRINT"**CREATING ARRAY**" 540 FOR I=0 TO 1600 550 SR(I,0)=1:SR(I,1)=0 560 NEXT I 570 PRINT CHR$(26);:PRINT"**CREATING FILES AND OUTPUTING ARRAY**" 580 OPEN #11,"R","B:S80 : FOR NUM=1 TO LENGTH 1290 : IF MID$(NAM$,NUM,1)="*" THEN NAM$= LEFT$(NAM$,NUM-1)+" " +RIGHT$(NAM$,LENGTH-NUM) 1300 : NEXT NUM 1310 : PRINT MSG$;": ";NAM$ 1320 : RETURN 1330 : FT$(NAM$,NUM-1)+" " +RIGHT$(NAM$,LENGTH-NUUM)+"*" :PRINT RIGHT$(NAM$,LENGTH-NUM+1) +STRING$(LENGTH-NUM+1,8); :NUM=NUM-1:GOTO 1270 1250 : NAM$=LEFT$(NAM$,NUM-1) +CHR$(ANS%)+RIGHT$(NAM$,LENGTH-NUM) 1260 : IF NUM=LENGTH THEN PRINT CHR$(7)+CHR$(8);:NUM=NUM-1 1270 : NEXT NUM 12 REM 'EDITING COMMANDS INCLUDE: 1070 : REM 'MOVE CURSER RIGHT.. > 1080 : REM 'MOVE CURSER LEFT... < OR BS(^H) 1090 : REM 'DELETE CHARACTER... DEL 1100 : REM 'INSERT CHARACTER... ^ 1110 : REM 'RETURN TO PROGRAM... CR 1120 : NAM$=NAM$+STRING$(LENGTH-LEN(NAM$),42) 1130 : PRINT MSG$;": ";NAM$+STRING$(LENGTH,8); 1140 : FOR NUM = 1 TO LENGTH 1150 : ANS%=ASC(INPUT$(1)):PRINT CHR$(ANS%); 1160 : IF ANS%=13 THEN GOTO 1280 1170 : IF ANS%=8 AND NUM=1 THEN PRINT CHR$(32)+MID$(NAM$,NUM,1)+CHR$(8); :NUM=NUM-1:GOTO 1270 1180 : IF ANS%=8 THEN NUM=NUM-2 :GOTO 1270 1190 : IF ANS%=62 AND NUM=LENGTH THEN PRINT CHR$(8) +MID$(NAM$,NUM,1)+CHR$(8)+CHR$(7); :NUM=NUM-1:GOTO 1270 1200 : IF ANS%=62 THEN PRINT CHR$(8)+ MID$(NAM$,NUM,1);:GOTO 1270 1210 : IF ANS%=60 AND NUM>1 THEN PRINT CHR$(8)+ MID$(NAM$,NUM,1)+CHR$(8)+CHR$(8); :NUM=NUM-2:GOTO 1270 1220 : IF ANS%=60 AND NUM=1 THEN PRINT CHR$(8) +MID$(NAM$,NUM,1)+CHR$(8); :NUM=NUM-1:GOTO 1270 1230 : 10 :REM********************* MBASEDIT.BAS ************************ 20 :REM* AL BRENDEL 3/15/81 30 :REM* A DATA ENTRY AND EDITING SUBROUTINE FOR MBASIC 5.X 40 :REM* FOR TERMINALS WITH OR WITHOUT CURSOR CONTROL 50 :REM* ESPECIALLY USEFUL FOR GETTING OR EDITING DATA WITH FIXED 60 :REM* FIELD LENGTHS FOR FORM PRINTING OR RANDOM ACCESS FILES 70 :REM* ( SEE ALSO CBASEDIT.BAS FOR C-BASIC2 VERSION ) 80 :REM* 90 :REM*************** TEST OF THE BASEDIT FUNCTION ******************* 100 :REM 110 DATA NUMBER IF ANS%=94 THEN NAM$=LEFT$(NAM$,NUM-1) +" "+MID$(NAM$,NUM,LENGTH-NUM) :PRINT CHR$(8)+RIGHT$(NAM$,LENGTH-NUM+1) +STRING$(LENGTH-NUM+1,8); :NUM=NUM-1:GOTO 1270 1240 : IF ANS%=127 THEN NAM$=LEFT$(NAM$,NUM-1) +RIGHT$(NAM$,LENGTH-NUM)+"*" :PRINT RIGHT$(NAM$,LENGTH-NUM+1) +STRING$(LENGTH-NUM+1,8); :NUM=NUM-1:GOTO 1270 1250 : NAM$=LEFT$(NAM$,NUM-1) +CHR$(ANS%)+RIGHT$(NAM$,LENGTH-NUM) 1260 : IF NUM=LENGTH THEN PRINT CHR$(7)+CHR$(8);:NUM=NUM-1 1270 : NEXT NUM 12 1 = ,12345,10 120 DATA NUMBER 2 = ,1234567890,20 130 DATA NUMBER 3 = ,ABCDEFG,30 140 FOR X=1 TO 3 150 READ MSG$,NAM$,LENGTH 160 GOSUB 1000 170 ANS$(X)=NAM$ 180 NEXT 190 PRINT ANS$(1),ANS$(2),ANS$(3) 200 END 1000 : REM ********** GET DATA AND EDIT FUNCTION ************* 1010 : REM *TYPICAL APPLICATION: 1020 : REM MSG$="EDIT..":NAM$="1234":LENGTH=20:GOSUB 1000 1030 : REM 'PRINTS MSG AND THEN ALLOWS 1040 : REM 'ENTRY OR MODIFICATION OF NAM$ AND 1050 : REM 'SHOWS LENGTH OF FIELD 1060 :$   BCdEC dBIdBLDdEI3dELYdRESETndBEdEEdBDdEDdBWdEWdBSdESe *********** PRINTEXT COMMAND FILE DOCUMENTATION *********** *+========================== PROGRAM ABSTRACT ==========================+ *| | *|TITLE: PRINTEXT.CMD - dBASE II PROCEDURE TO PRINT TEXT ON MULTIPLE | *| LINES. | *|DATE: 12/15/82 VERSION: 1.0 LANGUAGE: dBASE II (2.3B) | *|SQUEEZED NAME: PRINTEXT.CQD LIBRARY NAME: PRINTEXT.LBR  CHR(15) CHR(18)CHR(27)+CHR(52)CHR(27)+CHR(53)CHR(27)+CHR(45)+'1'CHR(27)+CHR(45)+'0'CHR(27)+CHR(64)CHR(27)+CHR(69)CHR(27)+CHR(70)CHR(27)+CHR(71)CHR(27)+CHR(72)CHR(27)+CHR(87)+'1'CHR(27)+CHR(87)+'0'CHR(27)+CHR(83)+'0'CHR(27)+CHR(84) | *|RELATED FILES: PRINTEXT.DQC->PRINTEXT.DOC | *| | *|SYSTEM: Any system running dBASE II version 2.3B or equivalent | *| | *|PURPOSE: To provide a callable Procedure for printing or displaying | *| a dBASE II text string (field or memory variable) that | *| exceeds one line and have the line break at $   a space or -. | *| | *|SUMMARIZE REVISION: | *| | *| | *|SUBMITTED BY: Melissa Gray, Mountain View, CA (415)965-3267 | *|ORIGINAL AUTHOR: Melissa Gray | *|OTHER CONTRIBUTORS: k character or dash (-) preceding the last non-blank text * in the line. All Blank characters at the beginning of a line will be * ignored (not printed or displayed). * * This Procedure will print/display only the TRIMmed text. Therefore, * a blank record will print/display only one Blank character. This * Procedure will not print/display more than the total number of lines * required to output the text, regardless of Field size. * * To use this procedure, the following Memory Variab | *| | *|REFERENCE: none | *| | *|DOCUMENTATION: Fairly extensive documentation both in the code and in | *| a separate .DOC file. However, with the number of | *| options available, the documentation is not all- | *| together clem the preset left margin. * If MTitleFlag = False, MIndent1 is not required. * * EXAMPLE: STORE 0 TO MIndent1 * * MCPL1 If MTitleFlag = True, MCPL1 = the number of characters * allowed on the first line of output. (This allows for * enlarged characters in the title or other special formatting.) * If MTitleFlag = False, MCPL1 is not required; * * EXAMPLE: STORE 66 TO MCPL1 * * MTControl If MTitleFlag = True * MTControl = True if there is a MPreTitle & MPostTitle * les MUST be set * prior to your DO PRINTEXT: * * MLineNo The line number on the printer page or CRT to which the * first line of output is to be sent. Subsequent lines of * output will be single spaced. The final value of MLineNo * will point to the line immediately following the last * line of actual text output. * * EXAMPLE: STORE 12 TO MLineNo * * MCPL This is the maximum # of characters per line of output. * This number includes the MIndent amounts specified below * and doear. | *| | *|PROGRAM USAGE: Since dBASE II does not seem to be able to print out | *| text that exceeds the capacity of a line and break | *| it at a reasonable place, this procedure should allow | *| more use of dBASE for long text fields. | *| | *|RATING: *** [sl (see below) * MTControl = False if there is no MPreTitle & MPostTitle * If MTitleFlag = False * MTControl, MPreTitle, and MPostTitle are not required * * EXAMPLE: STORE T TO MTControl * * MPreTitle If MTitleFlag = True AND MTControl = True, MPreTitle is * a string of control characters to be output prior to the * MTitleText string for control of special characteristics * of the printer or CRT, such as underlining. * If MTitleFlag = False OR MTControl = False, MPreTitle * is not include the preset left margin amount. This * number is superceded by MCPL1 for the 1st line only if * MTitleFlag = True. * * EXAMPLE: STORE 77 TO MCPL ...where you want to output * through column 80 and the left margin is set to 3. * * MTitleFlag MTitleFlag = True if there is MTitleText (see below) * MTitleFlag = False if there is no MTitleText, MIndent1, * MCPL1, or MTControl * * EXAMPLE: STORE T TO MTitleFlag * * MTitleText If MTitleFlag =ow when called from DO, beginning effort of programmer]| *| | *+======================================================================+ * This dBase II Command File is designed to provide a callable Procedure * for printing or displaying a dBase II Text String Field that exceeds * one line. This Procedure will break lines at a Blank character * immediately following the amount of text that will fit on a line OR * at the Blan%   s not required * * EXAMPLE: STORE CHR(27) + 'X' TO MPreTitle * * MPostTitle If MTitleFlag = True AND MTControl = True, MPostTitle is a * string of control characters to be output at the completion * of the MTitleText string to reset the special characteristics * set by MPreTitle. * If MTitleFlag = False OR MTControl = False, MPostTitle is * not required * * EXAMPLE: STORE CHR(27) + 'Y' TO MPostTitle * * MFieldText This is the actual character string from the Field tobe changed. Therefore, they * can be reused for subsequent calls to this Procedure from one * initial setup. Also note, all memory variables initiated by this * Procedure will be RELEASEd at its completion. * When using this Procedure from a DO PRINTEXT, it runs verrrrry * slow. It would be wise to use dUtil to INCLUDE the command * file, without comments, in the calling command file.  be * output. It should be stored TRIMmed, although only the * TRIMmed length will be output in any case. NOTE: The TRIM * function will always put at least one Blank in the string. * * EXAMPLE: STORE TRIM(fieldname) TO MFieldText * * MIndntRest If MTitleFlag = True, MIndntRest is the number of characters * to indent all lines of text, except the first line, from * the preset left margin. * If MTitleFlag = False, MIndntRest if the number of characters * to indent all lines of text from the preset left margin. * * EXAMPLE: STORE 9 TO MIndntRest * * TxControl TxControl = True if there is a MPreText & MPostText * (see below) * TxControl = False if there is no MPreText & MPostText * * EXAMPLE: STORE T TO TxControl * * MPreText If TxControl = True, MPreText is a string of control * characters to be output prior to the MFieldText string for * control of special characteristics of the printer or CRT, * such as italics. * If TxControl = False, Pretext is not required. * * EXAMPLE: STORE CHR(27) + 'T' + CHR(50)+CHR(49) TO MPreText * * MPostText If TxControl = True, MPostText is a string of control * characters to be output at the completion of the * MFieldText string to reset the special characteristics * set by MPreText. * If TxControl = False, MPostText is not required * * EXAMPLE: STORE CHR(27) + 'A' TO MPostText * * NOTE: The preceding memory variables will not be RELEASEd by this * Procedure, nor will any but MLineNo %   &   &   '   '