MARTICLESD 4ARTICLESDD ) 4DCFORM ASCIF\DCHESHIRASCEIDCREATE ASC'ADDOC ASCeDGET ASC$2DGET+ BAS)&TDHELP ASCO DHELP DOC[0NDLABELS ASC,DLETTERSASC/DNADIN ASCoDPUT ASC"fDSORT ASC#j~DSTAT ASC9xDUNFLAG BASFIELDFORDWS AFORMFORMDWS5\LONGADDRD #=LONGADDRDD %=MEMBERS D 'aMEMBERS DD )aMEMBERS DFO+xMEMBERS DOC2u#SHORT DFOBSHORT1 DFOISHORTADDD OeSHORTADDDD QeSTANDADDD S: STANDADDDD V: STANDADDDFOYSTRIP ASCt Sް\&&r?>#a:%!_+0|m-S N >KEYS,a~TITL,a~AUTH,a~SOUR,a~stop0~ 31~ comprog Basic data-base management system~An Operator-Oriented Data Base Management System~Shapiro~Micro Jan'80 p84 1st of 3~ comprog Basic data-base management DBMS~An Operator-Oriented Data Base Management System part 2~Shapiro~Micro Feb80 p36~ Basic sort pointer linked list data-base management~IMPLEMENTING DYNAMIC DATA STRUCTURES WITH BASIC FILES~Carter~Byte Feb'80p92~comp prog Basic data-base management system~An Operator-Oriented Data Base Management System~Shapiro part III~Micro Mar80 p84~ comp prog Basic data-base management system~SCREEN~Myers~Micro Apr80 p88~ data-base management Basic comp prog~FILEIT~Myers~Micro May80 p180~ hashing data-base management storage~Hashing Revisited~Vizzone~Micro May80 p78~ comp prog ISAM data-base management~Understanding ISAM~Gates~Byte Jun80 p108~ comp prog data-base management sort~A File Sorting Program And Its Diary~Prentice~Micro Jun80 p34 Apple~ SCREEN FILEIT data-base management sort Basic comp prog~SORTIT: A Sort Program~Myers~Micro Jul80 p120~ mailing list data base management magazine~OSI In the Sky (Sky and Telescope)~Shawcross~Micro Oct80 p102 65K subs to micro~ comp prog CP/M data-base management DBMS text~INFORMATION MASTER~Machrone (review)~S-100 Nov/Dec80 p14~ comp prog data-base management binary tree FABS~Fast Access Btree Structure~Computer Control Systems~Life Feb81 p13~ comp PET data-base management prog~Your Data Is In Good Hands (review of Jinsam)~Baker~Micro Feb81 p12~ data-base management DBMS comp prog CBS~Configurable Business System (review)~Paulette~Life Mar81 p9 ISAM~ database management system comp prog relational~Condor~Paulette et al~Life Apr81 p6 (review)~ relational data-base management DBMS~Relational data bases do it more easily~Hamilton et al~Elec Mar24'81 p102~ data compression~An Introduction to Data Compression~Corbin~Byte Apr81 p218~ comp prog data-base management Micro-Ap~SELECTOR IV~Berla+~Life Jun81 p10~ comp network data bases Lockheed~Information Unlimited - Dialog Information Retrieval Service~Miastkowski~Byte Jun81 p88~ comp prog review Aston-Tate dBASE II relational database management~Software Evaluation Group~Patchen et al~Life Aug81 p16~ comp knowledge-based expert systems data-base~Knowledge-Based Expert Systems Come of Age~Duda+~Byte Sept81 p238 Basic prog~ comp database Lockheed DIALOG~The DIALOG Information Retrieval System~Rhodes~DataC 2~ Apple II data-base management comparison review~...File-Management Systems~Blochowiak~Byte Nov81 p274~ Basic comprog data-base management key file~PDQ: A Data Manager for Beginners~Swanson~Byte Nov81 p236~ data-base management comparison review~A Survey of DBMS for Microcomputers~Barley+~Byte Nov81 p208~ comp DBMS data-base management~D.B.M.S.: Powerful Newcomers to Microcomputers~Gagle+~Byte Nov81 p97~ DBMS relational data-base management rules~Fundamentals of Relational Data Organization~Neely+~Byte Nov81 p48~ DBMS comp data-base MDBS ISAM CODASYL many-to-many~D.B.M. fits microsystems, avoids application dependency~Gagle+~ElecNov17'81~ data-base management DBMS screen forms inquiry Basic comprog~A Time-Saver For Your Database~Bailey~Micro Oct81 p206~ comprog DBMS data base management~Ashton-Tate dBase II Computer Software~Warren~PE Jan82 p31~ KEYS,a~TITL,a~AUTH,a~SOUR,a~stop0~ 31~ comprog Basic data-base management system~An Operator-Oriented Data Base Management System~Shapiro~Micro Jan'80 p84 1st of 3~ comprog Basic data-base management DBMS~An Operator-Oriented Data Base Management System part 2~Shapiro~Micro Feb80 p36~ Basic sort pointer linked list data-base management~IMPLEMENTING DYNAMIC DATA STRUCTURES WITH BASIC FILES~Carter~Byte Feb'80p92~comp prog Basic data-base management system~An Operator-Oriented Data Base Management System~Shapiro part III~Micro Mar80 p84~ comp prog Basic data-base management system~SCREEN~Myers~Micro Apr80 p88~ data-base management Basic comp prog~FILEIT~Myers~Micro May80 p180~ hashing data-base management storage~Hashing Revisited~Vizzone~Micro May80 p78~ comp prog ISAM data-base management~Understanding ISAM~Gates~Byte Jun80 p108~ comp prog data-base management sort~A File Sorting Program And Its Diary~Prentice~Micro Jun80 p34 Apple~ SCREEN FILEIT data-base management sort Basic comp prog~SORTIT: A Sort Program~Myers~Micro Jul80 p120~ mailing list data base management magazine~OSI In the Sky (Sky and Telescope)~Shawcross~Micro Oct80 p102 65K subs to micro~ comp prog CP/M data-base management DBMS text~INFORMATION MASTER~Machrone (review)~S-100 Nov/Dec80 p14~ comp prog data-base management binary tree FABS~Fast Access Btree Structure~Computer Control Systems~Life Feb81 p13~ comp PET data-base management prog~Your Data Is In Good Hands (review of Jinsam)~Baker~Micro Feb81 p12~ data-base management DBMS comp prog CBS~Configurable Business System (review)~Paulette~Life Mar81 p9 ISAM~ database management system comp prog relational~Condor~Paulette et al~Life Apr81 p6 (review)~ relational data-base management DBMS~Relational data bases do it more easily~Hamilton et al~Elec Mar24'81 p102~ data compression~An Introduction to Data Compression~Corbin~Byte Apr81 p218~ comp prog data-base management Micro-Ap~SELECTOR IV~Berla+~Life Jun81 p10~ comp network data bases Lockheed~Information Unlimited - Dialog Information Retrieval Service~Miastkowski~Byte Jun81 p88~ comp prog review Aston-Tate dBASE II relational database management~Software Evaluation Group~Patchen et al~Life Aug81 p16~ comp knowledge-based expert systems data-base~Knowledge-Based Expert Systems Come of Age~Duda+~Byte Sept81 p238 Basic prog~ comp database Lockheed DIALOG~The DIALOG Information Retrieval System~Rhodes~DataC 2~ Apple II data-base management comparison review~...File-Management Systems~Blochowiak~Byte Nov81 p274~ Basic comprog data-base management key file~PDQ: A Data Manager for Beginners~Swanson~Byte Nov81 p236~ data-base management comparison review~A Survey of DBMS for Microcomputers~Barley+~Byte Nov81 p208~ comp DBMS data-base management~D.B.M.S.: Powerful Newcomers to Microcomputers~Gagle+~Byte Nov81 p97~ DBMS relational data-base management rules~Fundamentals of Relational Data Organization~Neely+~Byte Nov81 p48~ DBMS comp data-base MDBS ISAM CODASYL many-to-many~D.B.M. fits microsystems, avoids application dependency~Gagle+~ElecNov17'81~ data-base management DBMS screen forms inquiry Basic comprog~A Time-Saver For Your Database~Bailey~Micro Oct81 p206~ comprog DBMS data base management~Ashton-Tate dBase II Computer Software~Warren~PE Jan82 p31~ 1000 DEFINT A-Z 1010 COMMON I,J,K,X,Y,T$,R$,S$,T1$,SKIPPARSE,FT,SEARCH, C,N,NC,P6,P7,P8,P9,PI,S,T,T1,T2,C(),B$(),N$(), SEARCHWORD$(),SEARCHFIELD(),SKIPWORD$(),LOOKFIELD(),DD$(),F$,FT$ 1020 DIM SQ(31),L$(6) 1030 PRINT CHR$(12);:FOR I=1 TO 10:NEXT 'TERM DEP 1040 T1$="1234567890"' 1050 PRINT"DCFORM March 20, 1982 1055 ' by Dan Dugan -- public domain 1060 PRINT"Design your file format on paper first, using forms provided. 1070 PRINT"To change you have to re-enter all data under same file name. 1080 PRINT:PRINT"Position the paper so the printhead is at the upper left corner of the paper. 1090 PRINT"Set the TOF switch. 1100 PRINT:PRINT"Would you like the program to type you a blank form for 1110 PRINT"designing a 24 x 80 screen? (n/y) "; 1120 A$=INPUT$(1):IF A$=CHR$(13) THEN A$="n" 1130 PRINT A$:IF A$="n" THEN 1450 'next form 1140 IF A$="y" THEN 1160 1150 GOTO 1100 1160 ' TYPE SCREEN FORM 1170 ' SET PRINTER 1180 LPRINT CHR$(27);CHR$(31);CHR$(12); ' 11/in 1190 LPRINT CHR$(27);CHR$(30);CHR$(6); ' vert spc 1200 LPRINT CHR$(27);CHR$(137);CHR$(133); ' margin 5 1210 LPRINT CHR$(27);"9";CHR$(13); ' set margin & CR 1220 LPRINT:LPRINT:LPRINT"DIMS CFORM screen design form for file "F$; 1230 LPRINT TAB(48)"Format name:"TAB(67)"Date: 1240 LPRINT:LPRINT SPC(3); 1250 FOR I=1 TO 8 1260 LPRINT SPC(8);STR$(I); 1270 NEXT 1280 LPRINT:LPRINT SPC(3); 1290 T$="1234567890" 1300 FOR I=1 TO 8 1310 LPRINT T$; 1320 NEXT 1330 LPRINT 1340 T$="=========+" 1350 FOR I=1 TO 24 1360 LPRINT USING"## ";I 1370 LPRINT SPC(3); 1380 FOR J=1 TO 8 1390 LPRINT T$; 1400 NEXT 1410 LPRINT 1420 NEXT 1430 LPRINT:LPRINT"(This form is typed 11/in, HMI = 9) 1440 LPRINT CHR$(12) ' FF 1450 PRINT:PRINT "Would you like the program to type you a format specification form? (n/y) "; 1460 A$=INPUT$(1):IF A$=CHR$(13) THEN A$="n" 1470 PRINT A$:IF A$="n" THEN GOTO 2470 ' entry of data 1480 IF A$="y" THEN 1890 1490 GOTO 1450 1500 ' DESCRIPTION OF VARIABLES GENERAL STUFF 1510 DATA"Format file name", FO$ 1520 DATA"Author, date", FFD$ 1530 DATA"Top Margin lines", TM, LTM 1540 DATA"Left Margin spaces", (na), LLM 1550 DATA Width, SW, LW 1560 DATA"Records/screen or page", RS, RP 1570 DATA"Conditional page line", (na), LLP 1580 DATA"120ths of inch per space (10=12/in)", HMI 1590 DATA"48ths of inch per line (8=6/in)", VMI 1600 DATA"(NOT IMPLEMENTED YET) Field separator chars. (use ,'s, 0 at end)",FSC$ 1610 DATA"Screen heading line 1, space at end actuates page no.",HL1$ 1620 DATA"Screen heading line 2", HL2$ 1630 DATA"Screen heading line 3", HL3$ 1640 DATA"Printer heading line 1, ditto page no.",LHL1$ 1650 DATA"Printer heading line 2", LHL2$ 1660 DATA"Printer heading line 3", LHL3$ 1670 DATA"Blank lines after heading (0 or number)", HB, LHB 1680 ' RECORD NUMBER 1690 DATA"Record no. mode (0=off, 1=on)", RM, LRM 1700 DATA"Rec. no. Location Line", RLL, LRLL 1710 DATA"Rec. no. Location Column", RLC, LRLC 1720 DATA"No. blank lines after number", RNB, LRNB 1730 ' SEQUENCE OF FIELDS 1740 DATA"Field no.'s in seq, 0 at end", SQ() 1750 DATA"no. blank lines after record", EB, LEB 1760 ' EACH FIELD 1770 DATA"Field name mode (0/1/2)", FM(), LFM() 1780 DATA"Screen field name (mode 2)", F2$() 1790 DATA"Printer field name (mode 2)", LF2$() 1800 DATA"Name Location Line", NLL(), LNLL() 1810 DATA"Name Location Column", NLC(), LNLC() 1820 DATA"No. blank lines after name", FMB(), LFMB() 1830 DATA"Data Location Line", DLL(), LDLL() 1840 DATA"Data Location Column", DLC(), LDLC() 1850 DATA"Screen numeric PRINT USING string", PU$() 1860 DATA"Printer numeric PRINT USING string", LPU$() 1870 DATA"Field length (0 for random, -1 to skip)", FL(), LFL() 1880 DATA"no. blank lines after field", FB(), LFB() 1890 ' PRINT BLANK FORM 1900 ' SET PRINTER 1910 LPRINT CHR$(27);CHR$(31);CHR$(11); ' 12/in 1920 LPRINT CHR$(27);CHR$(30);CHR$(137); 'vert 6/in 1930 LPRINT CHR$(27);CHR$(137);CHR$(135); 'margin 6 1940 LPRINT CHR$(27);"9";CHR$(13); 'set, CR 1950 T$=STRING$(20,95) 1960 T2$=STRING$(3,95) 1970 RESTORE 1980 GOTO 2080 1990 ' SUBROUTINES 2000 READ A$,B$:RETURN 2010 READ A$,B$,C$:RETURN 2020 LPRINT A$ TAB(40) B$ TAB(46) T2$:RETURN 2030 LPRINT A$ TAB(40) B$ TAB(46) T2$ TAB(53) C$ TAB(61) T2$:RETURN 2040 LPRINT A$ TAB(40) B$ TAB(46) T$:LPRINT:RETURN 2050 GOSUB 2000:GOSUB 2020:RETURN 2060 GOSUB 2010:GOSUB 2030:RETURN 2070 ' BEGIN PRINTING 2080 LPRINT:LPRINT:LPRINT:LPRINT"CFORM for file "F$:LPRINT 2090 LPRINT"DESCRIPTION"TAB(40)"SCREEN"TAB(53)"PRINTER":LPRINT 2100 FOR I=1 TO 2 2110 GOSUB 2000:GOSUB 2040 2120 NEXT 2130 FOR I=1 TO 5:GOSUB 2060:NEXT 2140 LPRINT 2150 LPRINT"The next two items refer to the Diablo only: 2160 FOR I=1 TO 2 2170 GOSUB 2000:LPRINT A$ TAB(53) B$ TAB(61) CHR$(95);CHR$(95);CHR$(95) 2180 NEXT 2190 LPRINT 2200 GOSUB 2000:GOSUB 2040 2210 FOR I=1 TO 3 2220 GOSUB 2000:LPRINT A$+" ("+B$+")": FOR J=1 TO 8:LPRINT T1$;:NEXT:LPRINT:LPRINT:LPRINT 2230 NEXT 2240 FOR I=1 TO 3 2250 GOSUB 2000:LPRINT A$+" ("+B$+")": FOR J=1 TO 9:LPRINT T1$;:NEXT:LPRINT:LPRINT:LPRINT 2260 NEXT 2270 GOSUB 2060:LPRINT 2280 LPRINT TAB(5)"(If Location Line number is 0, then output will scroll. 2290 LPRINT TAB(5)"Use a 'blank line' for CR/LF after last field on line. 2300 LPRINT:LPRINT"Specifications for each record:":LPRINT 2310 FOR I=1 TO 4:GOSUB 2060:NEXT 2320 LPRINT:GOSUB 2000:GOSUB 2040 2330 GOSUB 2060 2340 LPRINT:LPRINT "Specifications for each field in record (fill in names in seq.):" 2350 FOR I=1 TO NC 2360 RESTORE 1760:LPRINT CHR$(12) 2370 LPRINT:LPRINT STRING$(70,"*"):LPRINT 2380 LPRINT"Format instructions for (field name)":LPRINT 2390 GOSUB 2060 2400 LPRINT:FOR J=1 TO 2:GOSUB 2000:GOSUB 2040:NEXT 2410 FOR J=1 TO 5:GOSUB 2060:NEXT 2420 IF I=1 THEN LPRINT:LPRINT"(PRINT USING strings follow MBASIC rules)" 2430 LPRINT:FOR J=1 TO 2:GOSUB 2000:GOSUB 2040:NEXT 2440 FOR J=1 TO 2:GOSUB 2060:NEXT 2450 NEXT 2460 GOTO 1450 2470 ' ENTER DATA 2480 PRINT:PRINT"Do you want to enter data now? (y/n) "; 2490 A$=INPUT$(1):IF A$=CHR$(13) THEN A$="y" 2500 PRINT A$:IF A$="n" THEN 3060 2510 IF A$<>"y" THEN 2480 2520 PRINT:PRINT"ENTER DATA FOR NEW (OR REVISED) FORMAT":PRINT 2530 RESTORE 2540 GOTO 2620 2550 ' subroutines 2560 GOSUB 2000:PRINT A$ TAB(40) B$ TAB(46);:RETURN 'two var 2570 GOSUB 2010:PRINT A$ TAB(40) B$ TAB(46);:RETURN ' with next line makes 3 2580 PRINT TAB(53) C$ TAB(59);:RETURN 2590 GOSUB 2560:LINE INPUT"? ";D$:PRINT#3,D$:RETURN 2600 GOSUB 2570:INPUT;D:GOSUB 2580:INPUT E:PRINT#3,D;E:RETURN 2610 ' BEGIN ENTRY 2620 GOSUB 2560:INPUT D$ ' file name 2630 X$=D$:GOSUB 3170:D$=Y$ ' UCV 2640 OPEN"O",3,DD$(5)+D$+".DFO" 2650 PRINT#3,D$ 2660 GOSUB 2590 'date read back as LINE 2670 FOR I=1 TO 5 2680 GOSUB 2600 2690 NEXT 2700 FOR I=1 TO 2 2710 GOSUB 2000:PRINT A$ TAB(53) B$ TAB(59);:INPUT D 2720 PRINT#3,D 2730 NEXT 2740 GOSUB 2560:LINE INPUT"? ";D$:IF D$="" THEN D$="0" 2750 PRINT#3,D$ 2760 FOR I=1 TO 6 ' heading lines 2770 GOSUB 2000:PRINT A$+" ("+B$+")": FOR J=1 TO 7:PRINT T1$;:NEXT:PRINT"123456789" 2780 LINE INPUT D$:L$(I)=D$: IF I>3 THEN IF D$=";" THEN D$=L$(I-3): PRINT CHR$(13);CHR$(11);D$ 2790 PRINT#3,D$ 2800 NEXT 2810 GOSUB 2600:PRINT 2820 FOR I=1 TO 4:GOSUB 2600:NEXT 2830 GOSUB 2000 ' dummy read 2840 PRINT:PRINT"As many fields as you want may be shown/printed in any order: 2850 PRINT"Enter number of first field to be printed" 2860 INPUT"(enter 0 as 'next' after last field) ";D 2870 PRINT#3,D;:K=1:SQ(K)=D:IF D=0 THEN 2910 ' K saves # fields for below 2880 INPUT"number of next field to be printed ";D 2890 IF D=0 THEN PRINT#3,D:GOTO 2910 ' includes CR 2900 K=K+1:SQ(K)=D:PRINT#3,D;:GOTO 2880 2910 PRINT:GOSUB 2600 2920 FOR I=1 TO K 2930 RESTORE 1760 2940 PRINT:PRINT"Format instructions for field"SQ(I)"- "N$(SQ(I)) 2950 GOSUB 2600 ' mode in D & E 2960 IF D<>2 THEN GOSUB 2000:PRINT#3,:GOTO 2980 2970 GOSUB 2590 2980 IF E<>2 THEN GOSUB 2000:PRINT#3,:GOTO 3000 2990 GOSUB 2590 3000 FOR J=1 TO 5:GOSUB 2600:NEXT 3010 FOR J=1 TO 2:GOSUB 2590:NEXT 3020 FOR J=1 TO 2:GOSUB 2600:NEXT 3030 NEXT 3040 ' FINISH 3050 CLOSE 3:PRINT"Recorded. 3060 PRINT"Do you want to run CFORM again? (n/y) "; 3070 A$=INPUT$(1):IF A$=CHR$(13) THEN A$="n" 3080 PRINT A$:IF A$="n" THEN 3110 3090 IF A$="y" THEN 1100 3100 GOTO 3060 3110 PRINT"Wait while re-loading DEDIT program. 3120 LPRINT CHR$(27);CHR$(31);CHR$(11); ' 12/in 3130 LPRINT CHR$(27);CHR$(30);CHR$(137); ' vert 6/in 3140 LPRINT CHR$(27);CHR$(137);CHR$(133); ' margin 5 3150 LPRINT CHR$(27);"9";CHR$(13); ' set marg & CR 3160 CHAIN DD$(1)+"DEDIT",1000 3170 ' (SUB) UCV 3180 Y$="" 3190 FOR K=1 TO LEN(X$) 3200 Y$=Y$+" " 3210 X=ASC(MID$(X$,K,1)) 3220 IF 963 THEN 1200 1240 FORM=A-1 1242 PRINT:PRINT"Set up printer:" 1244 PRINT"Print head on perforation. 1245 PRINT"Hit return when ready to print":A$=INPUT$(1) 1250 ' RECORD WORK LOOP 1260 LC=0 ' count 1270 COL=0 ' print column 1280 ' 1290 IF DIMS THEN FOR I=T1 TO T2 ' <==== FOR 1300 COL=COL+1:IF COL>4 THEN COL=1 1302 IF COL=1 THEN 1304 ELSE 1310 1304 FOR J=1 TO 4 1305 FOR K=1 TO 4 1306 L$(J,K)="" 1307 NEXT 1308 NEXT 1310 IF DIMS THEN GOSUB 2280 ELSE GOSUB 2520 ' get rec 1320 IF DIMS=0 THEN 1670 1330 IF ASC(T$)=0 THEN PRINT"0";:GOTO 1920 1340 PRINT"+"; 1350 T1$=T$ ' save it 1360 IF SKIPPARSE=1 THEN 1380 1370 GOSUB 1990 ' parse record string 1380 IF SEARCH=0 THEN 1670 1390 ' SEARCH 1400 IF SEARCH<>2 THEN 1450 1410 ' FIND 1420 IF INSTR(T$,SEARCHWORD$(0))=0 THEN 1920 1430 GOSUB 1990 ' parse 1440 GOTO 1670 1450 ' FIELD SEARCH 1460 J=0 ' check for skips first 1470 IF SKIPWORD$(J)="" THEN 1550 ' try search then 1480 IF LOOKFIELD(J)<>0 THEN 1520 ' look in field 1490 IF INSTR(T1$,SKIPWORD$(J))<>0 THEN 1920 ' whole rec search - skip it 1500 J=J+1 1510 GOTO 1470 1520 IF INSTR(B$(LOOKFIELD(J)),SKIPWORD$(J))<>0 THEN 1920 ' field compare - skip 1530 J=J+1 1540 GOTO 1470 1550 IF SEARCHWORD$(0)="" THEN 1650 ' don't care so print it 1560 J=0: GOTO 1580 ' now search 1570 IF SEARCHWORD$(J)="" THEN 1920 ' hesitate no longer 1580 IF SEARCHFIELD(J)<>0 THEN 1620 ' field 1590 IF INSTR(T1$,SEARCHWORD$(J))<>0 THEN 1650 ' found it 1600 J=J+1 1610 GOTO 1570 1620 IF INSTR(B$(SEARCHFIELD(J)),SEARCHWORD$(J))<>0 THEN 1650 1630 J=J+1 1640 GOTO 1570 1650 ' GET READY TO DO IT 1660 IF SKIPPARSE=1 THEN GOSUB 1990 ' parse 1670 ' PAUSE CONTROLS (TERM DEP IF UPPERCASE ONLY) 1680 GOSUB 2080:IF DIMS=0 THEN 1770 ' exit returns A 1690 IF A=122 THEN 1770 ' z means go on 1700 PRINT I;B$(1);TAB(14);"Ready (SPACE/z/r/n/ESC) >"; 1710 A$=INPUT$(1):A=ASC(A$): IF A=27 THEN IF DIMS THEN CLOSE 3:GOTO 1950 ELSE GOTO 50 1720 PRINT A$:IF A=13 OR A=32 OR A=122 THEN 1770 1730 IF A=114 THEN I=IPREV:GOTO 1310 ' r 1740 IF A=110 THEN 1750 ELSE 1670 ' n or loop 1750 INPUT"Enter number of desired record: ";I:GOTO 1310 1760 GOSUB 2080 ' exit 1770 ' STORE LABEL IN 4-UP ARRAY 1780 IF DIMS THEN IPREV=I ELSE I=I+1 1790 IF FORM=1 THEN GOSUB 2360 ' reformat medium to short form 1800 IF FORM=2 THEN GOSUB 2160 ' reformat long to short form 1810 PRINT "("I")" 1820 LIN=1 1830 FOR J=1 TO 3 1840 IF B$(J)="" THEN 1880 1850 IF LEN(B$(J))>MAXLEN THEN B$(J)=LEFT$(B$(J),MAXLEN) 1860 L$(COL,LIN)=B$(J) 1870 LIN=LIN+1 1880 NEXT J 1890 X=LEN(B$(5))+1 1900 IF LEN(B$(4))>MAXLEN-X THEN B$(4)=LEFT$(B$(4),MAXLEN-X) 1910 L$(COL,LIN)=B$(4)+" "+B$(5) 1920 GOSUB 2080 ' check exit 1930 IF COL=4 THEN GOSUB 2900: IF DONE THEN IF DIMS GOTO 1950 ELSE STOP 'print labels 1940 IF DIMS THEN NEXT I ELSE GOTO 1300 ' END OF RECORD WORK LOOP 1942 FOR J=COL+1 TO 4 1944 FOR K=1 TO 4 1945 L$(J,K)="" 1946 NEXT 1947 NEXT 1948 GOSUB 2900 1950 ' GO HOME TO DIMS 1970 PRINT:PRINT:PRINT TAB(17)"Re-loading DEDIT. 1980 CHAIN DD$(1)+"DEDIT",1000 1990 ' (SUB) PARSE STRING 2000 K=0 2010 M=INSTR(T$,CHR$(126)) ' delimiter 2020 IF M=0 THEN RETURN 2030 K=K+1 2040 B$(K)="" 2050 B$(K)=MID$(T$,1,M-1) 2060 T$=MID$(T$,M+1) 2070 GOTO 2010 2080 ' (SUB) EXIT TEST (TERM DEP) 2090 X$=INKEY$ 'use ESC to escape printing 2100 IF X$<>"" THEN A=ASC(X$) 2110 IF A=27 THEN CLOSE 3:IF DIMS GOTO 1970 ELSE GOTO 110 2120 RETURN 2130 ' (SUB) CLEAR SCREEN (TERM DEP) 2140 PRINT CHR$(26); 2150 RETURN 2160 ' (SUB) LONG FORM LABEL RE-FORMAT 2170 IF B$(1)="" AND B$(2)="" OR B$(3)="" THEN 2260 2180 IF B$(2)="" THEN B$(1)=B$(1)+", "+B$(3): GOTO 2200 2190 B$(1)=B$(2)+" "+B$(1)+", "+B$(3) 2200 IF LEN(B$(1))>39 THEN B$(1)=LEFT$(B$(1),39) 2210 B$(2)=B$(4) 2220 B$(3)=B$(5) 2230 B$(4)=B$(6) 2240 B$(5)=B$(7) 2250 RETURN 2260 IF B$(2)+B$(1)="" THEN B$(1)=B$(3) ELSE IF B$(2)="" THEN B$(1)=B$(1) ELSE B$(1)=B$(2)+" "+B$(1) 2270 GOTO 2200 2280 ' (SUB) GET DIMS RECORD "I" IN T$ 2290 T$="" ' necessary! 2300 ON FT GOTO 2330,2310 2310 GET#1,FT*I+2 ' latter half 2320 T$=LEFT$(R$,127) 2330 GET#1,FT*I+1 ' whole or first half 2340 T$=R$+T$ 2350 RETURN 2360 ' (SUB) MEDIUM FORM RE-FORMAT 2370 IF B$(2)="" THEN 2380 ELSE B$(1)=B$(2)+" "+B$(1) 2380 B$(2)=B$(3) 2390 B$(3)=B$(4) 2400 B$(4)=B$(5) 2410 B$(5)=B$(6) 2420 RETURN 2430 ' (SUB) UCV 2440 Y$="" 2450 FOR K=1 TO LEN(X$) 2460 Y$=Y$+CHR$(32) 2470 X=ASC(MID$(X$,K,1)) 2480 IF 96NC THEN 2600 ELSE 2610 2600 PRINT"Input file line"INREC"defective."CHR$(7) 2610 FOR K=1 TO J 'recover quotes encoded by DPUT.BAS 2630 QUOTE=INSTR(B$(K),CHR$(126)) 2640 IF QUOTE THEN MID$(B$(K),QUOTE,1)=CHR$(34):GOTO 2630 2660 NEXT 2670 RETURN 2680 ' (SUB) PARSE COMMA-DELIM. RECORD T$ -> B$ ARRAY 2690 ' returns J = number of fields found 2700 FOR J=1 TO NC:B$(J)="":NEXT 2710 J=0 2720 ' process loop 2730 J=J+1:IF J=NC THEN 2830 2740 X=INSTR(T$,CHR$(44)) 'comma 2750 IF X=0 THEN 2830 'must be last field 2760 Y=INSTR(T$,CHR$(34)) 'quote 2770 IF Y=0 OR ( Y<>0 AND X126 THEN LPRINT TAB(X);:GOTO 3030 ' Diablo abs. tab limit 3020 LPRINT CHR$(27);CHR$(137);CHR$(X+128); 3030 RETURN 3010 IF X>126 THEN LPRINT TAB(X);:GOTO 3030 ' D10 ' DCREATE by Dan Dugan -- public domain 900 GOTO 1015 1000 PRINT CHR$(7):PRINT "To create a new file, you must first 'done' this file and then enter 1005 PRINT"DCREATE from the DIMS main menu. 1010 PRINT:DEFINT A-Z:GOTO 1670 'return to DEDIT 1015 PRINT CHR$(12); 'clear screen (TERM DEP) 1020 PRINT:PRINT"DCREATE March 20, 1982 1030 DEFINT A-Z 1040 ON ERROR GOTO 1950 1050 COMMON I,J,K,X,Y,T$,R$,S$,T1$,SKIPPARSE,FT,SEARCH, C,N,NC,P6,P7,P8,P9,PI,S,T,T1,T2,C(),B$(),N$(), SEARCHWORD$(),SEARCHFIELD(),SKIPWORD$(),LOOKFIELD(),DD$(),F$,FT$ 1060 PRINT: PRINT"Please define the record size for your new file. 1070 PRINT"You can choose size 1 or size 2. Size 2 uses up twice as much disk 1080 PRINT"space as size 1. Your usable storage per record equals the record 1090 PRINT"size minus the number of fields. 1100 PRINT 1110 PRINT" 1 128 characters per record (bytes) 1120 PRINT" 2 255 characters per record (bytes) 1130 PRINT: INPUT" "; FT 'file type 1140 IF FT=0 THEN FT=1 1150 IF FT=1 THEN FT$=" ": GOTO 1190 1160 IF FT=2 THEN FT$="2": GOTO 1190 1170 IF FT<0 OR FT>2 THEN 1670 1180 GOTO 1060 1190 PRINT: PRINT"Here is a directory of the files currently on the disk... 1200 PRINT: WIDTH 70: FILES DD$(3)+"*.D?": WIDTH 255 1210 PRINT:PRINT:PRINT"Remember, if you create a file name which is the same as one ": PRINT"that already exists, you will destroy the old file on the disc.":PRINT 1220 PRINT "Now create a new file..."; 1230 GOSUB 1800 ' open up files 1240 ' DEFINE FILE STRUCTURE 1250 N=0 'number of records in file 1260 C=1 ' change flag 1270 GOSUB 1770 'cs 1280 PRINT F$ 1290 PRINT"Define file structure; enter field name and type: 1300 PRINT"(to finish, enter 'stop')" 1310 FOR I=1 TO 15*FT 1320 PRINT 1330 PRINT"Name (4 char) of field ";:PRINT USING"##";I; 1340 INPUT T$ 1350 IF T$="" THEN GOTO 1330 1360 IF T$="stop" THEN 1500 1370 INPUT"Field type (a or n) ";T1$ 1380 IF T1$="" THEN T1$="a" 1390 IF T1$<>"a" THEN GOTO 1410 1400 GOTO 1450 1410 IF T1$<>"n" THEN GOTO 1430 1420 GOTO 1450 1430 PRINT"Type must be 'a' or 'n' 1440 GOTO 1370 1450 T$=T$+" " 1460 T$=LEFT$(T$,4) ' chop down to 4 char 1470 T$=T$+","+T1$ 1480 N$(I)=T$:C(I)=1 1490 NEXT I 1500 NC=I-1 1510 N$(I)="stop0" ' end cue for many routines 1520 GOSUB 1770 'cs5 1530 PRINT"Structure definition complete." 1540 PRINT: PRINT"Name: "F$; TAB(20); "Type: "FT 1550 PRINT:PRINT"Fields are:" 1560 PRINT 1570 FOR I=1 TO NC 1580 IF LEFT$(N$(I),4)="stop" THEN GOTO 1630 1590 PRINT USING"##"; I; 1600 PRINT ". "; LEFT$(N$(I),4); " "; RIGHT$(N$(I),1) 1610 NEXT I 1620 ' FINISH 1630 PRINT 1640 INPUT"Do you approve? (y/n) ", A$ 1650 IF A$="" THEN A$="y" 1660 IF A$<>"y" THEN CLOSE: GOTO 1060 1670 CHAIN DD$(1)+"DEDIT",1000 1680 ' UCV 1690 Y$="" 1700 FOR J=1 TO LEN(X$) 1710 Y$=Y$+" " 1720 X=ASC(MID$(X$,J, 1)) 1730 IF 963 THEN 1110 1150 ON A GOTO 1170,1430,1640 1160 GOTO 1110 1170 ' DOC WRITE 1180 GOSUB 1050 'cs 1190 ON ERROR GOTO 1230 1200 OPEN"I",3,DD$(5)+F$+".DOC" 1210 ON ERROR GOTO 1610 1220 GOTO 1250 1230 IF ERR=53 AND ERL=1200 THEN OPEN"O",2,DD$(5)+"DOC.$$$": ON ERROR GOTO 1610:RESUME 1320 ' fix 1240 ON ERROR GOTO 0 1250 OPEN"O",2,DD$(5)+"DOC.$$$" 1260 IF EOF(3) THEN 1300 1270 LINE INPUT#3,L$ 1280 PRINT#2,L$ 1290 GOTO 1260 1300 CLOSE 3 1310 KILL DD$(5)+F$+".DOC" 1320 PRINT"Writing on "F$" document file 1330 PRINT 1340 PRINT"Type 'stop' to finish 1350 PRINT 1360 LINE INPUT L$ 1370 IF L$="stop" THEN 1400 1380 PRINT #2,L$ 1390 GOTO 1360 1400 CLOSE 2,3 1410 NAME DD$(5)+"DOC.$$$" AS DD$(5)+F$+".DOC" 1420 GOTO 1110 1430 ' DOC READ 1440 ON ERROR GOTO 1470 1450 OPEN"I",3,DD$(5)+F$+".DOC" 1460 ON ERROR GOTO 1610: GOTO 1490 1470 IF ERR=53 THEN CLOSE 3: PRINT:PRINT"No document file present": ON ERROR GOTO 1610:RESUME 1110 1480 ON ERROR GOTO 1610 1490 GOSUB 1050 'cs 1500 PRINT: PRINT "'"F$"' document file 1510 PRINT 1520 FOR I=1 TO 20 1530 IF EOF(3) THEN CLOSE 3: GOTO 1110 1540 LINE INPUT #3, L$ 1550 PRINT L$ 1560 NEXT I 1570 PRINT"(more)"; 1580 ' PAUSE 1582 X$=INPUT$(1) 1584 IF X$=CHR$(27) THEN 1640 'exit 1590 PRINT 1600 GOTO 1520 1610 ' GENERAL ERROR 1620 IF ERR=61 THEN PRINT:PRINT"Out of disk space.":PRINT:RESUME 1110 1630 ON ERROR GOTO 0 1640 ' FINISH 1645 CLOSE 2,3 'make sure 1650 OPEN"R",2,DD$(4)+F$+".DD"+FT$ 1660 FIELD #2,128 AS S$ 1670 PRINT:PRINT"Re-loading DIMS file editor (DEDIT).":CHAIN"DEDIT",1000 N"R",2,DD$(4)+F$+".DD"+FT$ 1660 FIELD #2,128 AS S$ 1670 PRINT:PRINT"Re-loading DIMS file editor (D10 PRINT"This program must be entered via DIMS 20 STOP 1000 GOSUB 1890 'cs 1010 PRINT:PRINT TAB(29);"DGET 1.03 - October 30, 1983 1020 ' by Dan Dugan -- public domain 1030 PRINT 1040 DEFINT A-Z 1050 COMMON I,J,K,X,Y,T$,R$,S$,T1$,SKIPPARSE,FT,SEARCH, C,N,NC,P6,P7,P8,P9,PI,S,T,T1,T2,C(),B$(),N$(), SEARCHWORD$(),SEARCHFIELD(),SKIPWORD$(),LOOKFIELD(),DD$(),F$,FT$ 1060 DIM DEST(30),USED(30),B1$(30):INREC=0 1070 ' OPEN SOURCE FILE 1080 PRINT:INPUT"Name of source file";X$ 1085 IF X$="" THEN 1820 1090 GOSUB 1920:F2$=Y$ 'ucv 1100 IF MID$(F2$,2,1)=":" THEN 1120 1110 F2$=DD$(5)+F2$ 1120 ' TEST FOR EXISTENCE 1130 ON ERROR GOTO 1160 1140 OPEN"I",3,F2$ 1150 ON ERROR GOTO 0:GOTO 1200 'ok 1160 CLOSE 3 1170 IF ERR=53 THEN CLOSE 3:PRINT"File not found":RESUME 1070 1180 IF ERR=64 THEN PRINT"Bad file name, try again.":RESUME 1070 1190 ON ERROR GOTO 0 1200 ' ENTER SEQUENCE OF FIELDS 1210 PRINT:PRINT"Here's the first line of "F2$". 1220 LINE INPUT#3,T$ 1230 PRINT:PRINT T$ 1240 CLOSE 3:OPEN"I",3,F2$ 1250 PRINT:PRINT"Would you like to re-assign or skip fields? (n/y) ";:A$=INPUT$(1) 1252 IF A$="y" OR A$="Y" THEN 1260 ELSE FOR I=1 TO NC:DEST(I)=I:NEXT:NF=NC:PRINT:GOTO 1370 1260 PRINT:FOR I=1 TO NC:USED(I)=0:NEXT 1265 PRINT:INPUT"Number of fields in source file";NF:PRINT 1270 FOR I=1 TO NF 1280 PRINT"Destination field of field"I"(enter 0 to ignore)";:INPUT DEST(I) 1290 IF DEST(I)>NC THEN PRINT "This file only has"NC"fields.":GOTO 1280 1300 IF DEST(I)=0 THEN 1330 1310 IF USED(DEST(I)) THEN PRINT"Won't accept putting two fields into one.":GOTO 1280 1320 USED(DEST(I))=1 1330 NEXT 1340 PRINT:PRINT"Is this ok (y/n)? "; 1350 A$=INPUT$(1):PRINT A$ 1360 IF A$<>"y" THEN GOTO 1200 1370 C=1:PRINT 1380 ' READ FILE 1390 GOSUB 1840 'exit 1400 IF EOF(3) THEN 1790 1410 FOR I=1 TO NC:B$(I)="":NEXT:NR=NR+1 1420 LINE INPUT #3,T$ 1430 INREC=INREC+1:GOSUB 2010 'parse into B1$ array j=fields found 1440 IF J<>NF THEN 1450 ELSE 1470 1450 IF P9 THEN PRINT CHR$(7);:LPRINT"Input file line"INREC"defective." 1460 PRINT"Input file line"INREC"defective."CHR$(7) 1470 FOR I=1 TO J 1480 IF DEST(I) THEN 1490 ELSE 1520 1490 QUOTE=INSTR(T$,CHR$(126)) 1500 IF QUOTE THEN MID$(T$,QUOTE,1)=CHR$(34):GOTO 1490 1510 B$(DEST(I))=B1$(I) 1520 NEXT 1530 ' ADD RECORD TO DIMS FILE 1540 T$="" 1550 FOR J=1 TO NC 1560 IF LEN(T$)+LEN(B$(J))+1>FT*128 THEN 1570 ELSE 1590 1570 IF P9 THEN LPRINT "Input line"INREC"too long." 1580 PRINT"Input line"INREC"too long."CHR$(7) 1590 T$=T$+B$(J)+CHR$(126) 1600 NEXT 1610 N=N+1:PRINT N;T$; 1620 GOSUB 1650:PRINT"*";:GOSUB 1720:PRINT"!":C=1 1630 ' LOOP 1640 GOTO 1380 1650 ' (SUB) WRITE T$ AS RECORD # N 1660 ON FT GOTO 1690,1670 1670 LSET R$=MID$(T$,129) 'latter half 1680 PUT #1,FT*N+2 1690 LSET R$=LEFT$(T$,128) 'first half 1700 PUT #1,FT*N+1 1710 RETURN 1720 ' (SUB) WRITE T$ AS DUPE REC N 1730 ON FT GOTO 1760,1740 1740 LSET S$=MID$(T$,129) 1750 PUT #2,FT*N+2 1760 LSET S$=LEFT$(T$,128) 1770 PUT #2,FT*N+1 1780 RETURN 1790 ' FINISH 1800 CLOSE 3 1810 PRINT:PRINT NR"records added. 1820 PRINT:PRINT TAB(32)"Re-loading DEDIT. 1830 CHAIN DD$(1)+"DEDIT",1000 1840 ' EXIT TEST (TERM DEP) 1850 X$=INKEY$:X=0 1860 IF X$<>"" THEN X=ASC(X$) 1870 IF X=27 THEN CLOSE 3:GOTO 1790 'use ESC to escape listing 1880 RETURN 1890 ' CLEAR SCREEN (TERM DEP) 1900 PRINT CHR$(12); 1910 RETURN 1920 ' (SUB) UCV 1930 Y$="" 1940 FOR K=1 TO LEN(X$) 1950 Y$=Y$+CHR$(32) 1960 X=ASC(MID$(X$,K,1)) 1970 IF 96 B1$ ARRAY 2020 ' returns J = number of fields found 2030 FOR J=1 TO NF:B1$(J)="":NEXT 2040 J=0 2050 ' process loop 2060 J=J+1:IF J=NF THEN 2170 2070 X=INSTR(T$,CHR$(44)) 'comma 2080 IF X=0 THEN 2170 'must be last field 2090 Y=INSTR(T$,CHR$(34)) 'quote 2100 IF Y=0 OR ( Y<>0 AND Xd 5 :"File not found": .nd @ "Bad file name, try again.": .|d d: ENTER SEQUENCE OF FIELDS d:"Here's the first line of "F2$".d #,T$d: T$d :"I",,F2$jr Jj| (B$(LOOKFIELD(J)),SKIPWORD$(J))  : field compare - skipj B$(LOOKFIELD(J))"" SKIPWORD$(J)"_"  :blankjJJj Jk SEARCHWORD$()""  : don't care so print it/kJ:  : now searchdk SEARCHWORD$(J)""  : hesitate no longerk SEARCHFIELD(J)  : fieldk (T1$,SEARCHWORD$(J))  : found itkJJk l (B$(SEARCHFIELD(J)),SEARCHWORD$(J)) =l B$(SEARCHFIELD(J))"" SEARCHWORD$(J)"_" GlJJQl pl: GET READY TO DO IT l&: PAUSE CONTROLS (TERM DEP IF UPPERCASE ONLY) l0 j : exit returns Al: Az 4 : z means go onmD INREC;B$(););"Ready (SPACE/z/ESC) > ";MmNA$$():A(A$): A 8 : finishrmX A$;: A A Az 4mb j : exitm4: ADD RECORD TO DIMS FILE m>T$"":NRNRmH J NCmR (T$)(B$(J))FT \ : p'n\ P9 "Input line"INREC"too long."Onf "Input line"INREC"too long."()gnp T$T$B$(J)(~)mnznNN: INREC"="N: T$;n :" *";: :"!":Cn: LOOP n dn: (SUB) WRITE T$ AS RECORD # N o FT ,$o R$(T$,) :latter half4o #,FTNUo R$(T$,) :first halfeo #,FTNkoo: (SUB) WRITE T$ AS DUPE REC N o FT  , o S$(T$,)o #,FTNo S$(T$,)o$ #,FTNo. p8 : FINISH pB *pL : NR"records added.IpV :  )"Re-loading DEDIT.bp` DD$()"DEDIT",pj : EXIT TEST (TERM DEP) pt X$p~ X$"" A(X$)p A : 8 :use ESC to escape listingp q : CLEAR SCREEN (TERM DEP) q ( );q 4q : (SUB) UCV >q Y$""Qq K (X$)cq Y$Y$( )yq X((X$,K,))q `X X{ (Y$,K,)(X ):  q (Y$,K,)(X$,K,)q q r : (SUB) PARSE ,-DELIM. RECORD T$ > B1$ ARRAY 6r : returns J = number of fields foundQr( J NF:B1$(J)"":Yr2 Jnr< : process looprF JJ: JNF  rP X(T$,(,)) :commarZ X  :must be last fieldrd Y(T$,(")) :quote'sn Y ( Y XY )  : x :comma before quote?sx Z(Y,T$,("))}s X(Z,T$,(,)):loc of next comma after close quotes B1$(J)(T$,,X):  s : TRIM OFF USED PARTs T$(T$,X): < s : LAST FIELDs B1$(J)T$:  t (t : (SUB) TRIM QUOTES OFF STRINGct (B1$(J),)(") B1$(J)(B1$(J),(B1$(J)))t (B1$(J),)(") B1$(J)(B1$(J),(B1$(J)))t ct 10 PRINT"This program must be entered from DIMS. 20 STOP 1000 ' HELP Command March 20, 1982 1005 ' by Dan Dugan -- public domain 1010 DEFINT A-Z 1020 COMMON I,J,K,X,Y,T$,R$,S$,T1$,SKIPPARSE,FT,SEARCH, C,N,NC,P6,P7,P8,P9,PI,S,T,T1,T2,C(),B$(),N$(), SEARCHWORD$(),SEARCHFIELD(),SKIPWORD$(),LOOKFIELD(),DD$(),F$,FT$ 1030 GOTO 1070 1040 ' (SUB) CLEAR SCREEN (TERM DEP) 1050 PRINT CHR$(12); 1060 RETURN 1070 ' HELP COMMAND 1080 GOSUB 1040 'cs 1090 ' TEST FOR PRESENCE OF FILE 1100 ON ERROR GOTO 1130 1110 OPEN"I",3,DD$(5)+"DHELP.DOC" 1120 ON ERROR GOTO 0: GOTO 1160 ' if OK then go on 1130 IF ERR=53 THEN PRINT:PRINT"No help text file present": RESUME 1260 1140 ON ERROR GOTO 0 1150 ' READ 23 LINES AT A TIME 1160 GOSUB 1040 'cs 1170 FOR I=1 TO 23 1180 IF EOF(3) THEN CLOSE 3: GOTO 1290 'last 1190 LINE INPUT #3, L$ 1200 PRINT L$ 1210 NEXT I 1220 PRINT"For next page, hit SPACE; use '\' to go back, ESC to return to editor."; 1225 A$=INPUT$(1) 1226 GOSUB 1040 1230 IF A$=CHR$(27) THEN 1260 'done 1240 IF A$="\" THEN CLOSE 3:GOTO 1070 1250 GOTO 1170 1260 ' FINISH 1270 CLOSE 3 1280 PRINT"Re-loading DIMS file editor (DEDIT).":CHAIN DD$(1)+"DEDIT",1000 1290 ' LAST PAGE 1300 PRINT"Last help page. Hit SPACE to return to editor, or '\' to read again."; 1310 A$=INPUT$(1) 1312 GOSUB 1040 1314 IF A$=CHR$(27) THEN 1260 1320 IF A$="\" THEN CLOSE 3:GOTO 1070 1330 GOTO 1260 ."; 1310 A$=INPUT$(1) 1312 GOSUB 1040 1314 IF A$=CHR$(27) TDIMS editor help file - January 13, 1984 If there's a record number or a pair of record numbers anywhere in the command line, the command will be done on the specified range of records. The words "from" "to" "all" "end" or "last" may be used when talking about record numbers. "." instead of a number means use the most recently dis- played record. All the built-in commands may be shortened to three letters. For example, all the following are valid commands: add delete from 10 to 20 delete 10 20 print to 75 print select labels find Wombat from . to 500 change 57 change . (means change last record shown) 10 20 list from 10 to 20 (same result as "10 20" select copy delete DIMS editor help screen 2 ---> Final commands <--- These commands are normally the last word in the command sentence, any fol- lowing words except record numbers will be ignored. add Appends records to the end of the file, prompting field by field. In this mode the following commands take effect: "stop" alone in any field quits adding. "\" (backslash) at end of any field skips back 1 field. ";" alone in the field copies data from last record shown. done Closes file and returns to no-file menu fields Allows "hiding" fields you don't want to show. You may un-hide them with the same command. Controls output of 'put.' format 0 Installs default display and print formats. formats Shows available format definition files. format Installs named format definition for screen and printer. backup Makes complete new backup file from main file. Rarely used since backup file is maintained automatically. DIMS editor help screen 3 renumber Renumbers all records sequentially from the top in both main and backup files, closing up holes from deleted records. The following commands may be given freely anywhere in the command line: change <#> Shows record or records field by field, new data may be entered for each field or the old data may be kept by just hittin RETURN T eras fiel, ente jus on space then RETURN. Backslash '\' and RETURN backs up to previous field. delete <#> Shows record or records and asks approval to erase. list Shows records. Assumed if no final command is given. find Finds records containing the exact word string. A phrase can be found if underlines_are_used_instead_of_spaces. select Finds records containing up to 10 different words or phrases, (you will be asked for them) in all fields or in specific fields. You also can specify up to 10 words or phrases that will cause the record to be skipped. DIMS editor help screen 4 -- more free-form command words print Prints on list device rather than screen in current format. copy Copies data records and adds them on to the end of another DIMS file. You will be asked for the name. You may create a new file this way or add to an existing one, but the field definitions must be the same. New records have no auto backup. and Permitted, ignored. page Sets page number to start printout with. margin Sets printer margin if you don't want the default setting. flag In combination with an add or a change to a range of records, asks you for a string to be added to any (one) field in the record. programs Shows a directory of available "transient commands," i.e. various batch processes than can work on the file. DIMS editor help screen 5 --> TRANSIENT COMMANDS <-- Transient commands are sub-programs which do a batch of work and then return you to DEDIT. Where appropriate, they will take a range of records and selec- tion criteria from the command line. Example: print select labels 100 to 150 cform Process for creating format definition files. Complicated. doc A "notepad" where you can read or write notes associated with the data file. The doc file can be edited later with WordStar. Useful for remembering codes you invent for your file. labels Prints a batch of labels (use "print labels") with blank fields closed up. Works only with three standard address file formats that will do for most jobs, not hard to modify if necessary. letters Merges an address file with a form letter. A personal salutation line or other data lines may be included if desired. DLETTERS.BAS must be modified for each job. sort Sorts the records into a new sequence in the whole file or a range of the file. Asks questions for set-up. Sorts alphabetically unless all fields specified for keys are numeric. May overlay or make a new file. DIMS editor help screen 6 -- more transient commands stat Computes descriptive statistics for a selected field. put Makes an output file in standard Basic sequential form for further processing with other programs. You may use a range of records in the invoking command line, selection specifications, and omit fields by using the "fields" command first. get Stuffs a conventional Basic sequential data file into the DIMS file from which it is called, adding records to the end. Allows skipping and re-ordering of fields. nadin Inputs from a NAD-like data file to a DIMS "standard" form mailing list. cheshir Prints 4-up labels on wide paper for Cheshire automatic labelling process. Can also be used w/o DIMS, reading a standard comma-delimited data file. 10 PRINT"This program must be entered from DEDIT.":STOP 1000 GOSUB 2060 'cs 1010 PRINT:PRINT TAB(25);"DLABELS 1.02 - October 17, 1982 1015 ' by Dan Dugan -- public domain 1020 PRINT 1030 DEFINT A-Z 1040 COMMON I,J,K,X,Y,T$,R$,S$,T1$,SKIPPARSE,FT,SEARCH, C,N,NC,P6,P7,P8,P9,PI,S,T,T1,T2,C(),B$(),N$(), SEARCHWORD$(),SEARCHFIELD(),SKIPWORD$(),LOOKFIELD(),DD$(),F$,FT$ 1060 ' SET-UP LABELS 1070 PRINT:PRINT"Please indicate the form that this list is in: 1080 PRINT:PRINT" 1. Short form, (NAME, N2, ADDR, C-ST, ZIP) 1085 PRINT" 2. Standard form, (LNAM, FNAM, N2, ADDR, C-ST, ZIP) 1090 PRINT" 3. Long form, (LNAM, FNAM, TITL, ORG, ADDR etc.) 1100 PRINT:PRINT"Enter 1, 2 or 3: "; 1110 A$=INPUT$(1): IF A$=CHR$(13) THEN A$="1" 1120 PRINT A$: A=VAL(A$): IF A=0 THEN 1740 1125 IF A<1 OR A>3 THEN 1100 1130 PL=A-1 1140 GOSUB 1870 ' align labels 1150 ' RECORD WORK LOOP 1160 C2=0 ' first time 1170 LC=0 ' count 1180 ' 1190 FOR I=T1 TO T2 ' <==== FOR 1200 GOSUB 2210 ' get rec 1205 IF ASC(T$)=0 THEN PRINT"0";:GOTO 1720 1210 PRINT"+"; 1220 T1$=T$ ' save it 1230 IF SKIPPARSE=1 THEN 1250 1240 GOSUB 1780 ' parse record string 1250 IF SEARCH=0 THEN 1540 1260 ' SEARCH 1270 IF SEARCH<>2 THEN 1320 1275 ' FIND 1280 IF INSTR(T$,SEARCHWORD$(0))=0 THEN 1720 1300 GOSUB 1780 ' parse 1310 GOTO 1540 1320 ' FIELD SEARCH 1330 J=0 ' check for skips first 1340 IF SKIPWORD$(J)="" THEN 1420 ' try search then 1350 IF LOOKFIELD(J)<>0 THEN 1390 ' look in field 1360 IF INSTR(T1$,SKIPWORD$(J))<>0 THEN 1720 ' whole rec search - skip it 1370 J=J+1 1380 GOTO 1340 1390 IF INSTR(B$(LOOKFIELD(J)),SKIPWORD$(J))<>0 THEN 1720 ' field compare - skip 1395 IF B$(LOOKFIELD(J))="" AND SKIPWORD$(J)="_" THEN 1720 'blank 1400 J=J+1 1410 GOTO 1340 1420 IF SEARCHWORD$(0)="" THEN 1520 ' don't care so print it 1430 J=0: GOTO 1450 ' now search 1440 IF SEARCHWORD$(J)="" THEN 1720 ' hesitate no longer 1450 IF SEARCHFIELD(J)<>0 THEN 1490 ' field 1460 IF INSTR(T1$,SEARCHWORD$(J))<>0 THEN 1520 ' found it 1470 J=J+1 1480 GOTO 1440 1490 IF INSTR(B$(SEARCHFIELD(J)),SEARCHWORD$(J))<>0 THEN 1520 1495 IF B$(SEARCHFIELD(J))="" AND SEARCHWORD$(J)="_" THEN 1520 1500 J=J+1 1510 GOTO 1440 1520 ' GET READY TO DO IT 1530 IF SKIPPARSE=1 THEN GOSUB 1780 ' parse 1540 ' PAUSE CONTROLS (TERM DEP IF UPPERCASE ONLY) 1541 GOSUB 2030 ' exit returns A 1542 IF A=122 THEN 1560 ' z means go on 1543 PRINT I;B$(1);TAB(30);"Ready (SPACE/z/r/n/ESC) >"; 1544 A$=INPUT$(1):A=ASC(A$):IF A=27 THEN CLOSE 3:GOTO 1740 1545 PRINT A$:IF A=13 OR A=32 OR A=122 THEN 1560 1546 IF A=114 THEN I=IPREV:GOTO 1200 ' r 1547 IF A=110 THEN 1548 ELSE 1540 ' n or loop 1548 INPUT"Enter number of desired record: ";I:GOTO 1200 1550 GOSUB 2030 ' exit 1560 ' PRINT LABEL 1562 LC=LC+1:IPREV=I 1570 IF PL=1 THEN GOSUB 2290 ' reformat medium to short form 1575 IF PL=2 THEN GOSUB 2090 ' reformat long to short form 1580 IF P9=0 THEN PRINT 1590 PRINT"("I")" 1600 T3=0 ' counts blank lines 1610 FOR J=1 TO 3 1620 IF B$(J)="" OR B$(J)=" " THEN T3=T3+1: GOTO 1640 1630 IF P9=1 THEN LPRINT B$(J) ELSE PRINT B$(J) 1640 NEXT J 1650 IF P9=1 THEN LPRINT B$(4); ELSE PRINT B$(4); 1660 IF P9=1 THEN IF LPOS(0)<15 THEN LPRINT TAB(15); 1670 IF P9=0 THEN IF POS(0)<15 THEN PRINT TAB(15); 1680 IF P9=1 THEN LPRINT" "B$(5) ELSE PRINT" "B$(5) 1690 FOR J=1 TO T3+2 1700 IF P9=1 THEN LPRINT ELSE PRINT 1710 NEXT J 1720 GOSUB 2030 ' check exit 1730 NEXT I ' END OF RECORD WORK LOOP 1740 ' FINISH 1750 IF P9 THEN LPRINT"count:"LC:FOR J=1 TO 5:LPRINT:NEXT 1760 PRINT:PRINT:PRINT TAB(32)"Re-loading DEDIT. 1770 CHAIN DD$(1)+"DEDIT",1000 1780 ' (SUB) PARSE STRING 1790 K=0 1800 M=INSTR(T$,CHR$(126)) ' delimiter 1810 IF M=0 THEN RETURN 1820 K=K+1 1830 B$(K)="" 1840 B$(K)=MID$(T$,1,M-1) 1850 T$=MID$(T$,M+1) 1860 GOTO 1800 1870 ' (SUB) ALIGN LABELS 1880 PRINT"Print test label? (y/n) "; 1890 A$=INPUT$(1): PRINT A$: IF A$=CHR$(13) THEN A$="y" 1900 IF A$="n" THEN RETURN 1910 IF A$<>"y" THEN 1880 1920 A$(1)="<------- Dan Dugan Sound Design ------>" ' 39 wide 1930 A$(2)="File: "+F$+" Date:" 1940 A$(3)="Selection:" 1950 IF P9 THEN LPRINT A$(1) ELSE PRINT A$(1) 1960 IF P9 THEN LPRINT A$(2) ELSE PRINT A$(2) 1970 IF P9 THEN LPRINT A$(3) ELSE PRINT A$(3) 1980 IF P9 THEN LPRINT A$(1) ELSE PRINT A$(1) 1990 FOR J=1 TO 2 2000 IF P9=1 THEN LPRINT ELSE PRINT 2010 NEXT J 2020 GOTO 1870 2030 ' (SUB) EXIT TEST (TERM DEP) 2040 X$=INKEY$ 2042 IF X$<>"" THEN A=ASC(X$) 2045 IF A=27 THEN CLOSE 3:GOTO 1740 'use ESC to escape listing 2050 RETURN 2060 ' (SUB) CLEAR SCREEN (TERM DEP) 2070 PRINT CHR$(12); 2080 RETURN 2090 ' (SUB) LONG FORM LABEL RE-FORMAT 2100 IF B$(1)="" AND B$(2)="" OR B$(3)="" THEN 2190 2110 IF B$(2)="" THEN B$(1)=B$(1)+", "+B$(3): GOTO 2130 2120 B$(1)=B$(2)+" "+B$(1)+", "+B$(3) 2130 IF LEN(B$(1))>39 THEN B$(1)=LEFT$(B$(1),39) 2140 B$(2)=B$(4) 2150 B$(3)=B$(5) 2160 B$(4)=B$(6) 2170 B$(5)=B$(7) 2180 RETURN 2190 IF B$(2)+B$(1)="" THEN B$(1)=B$(3) ELSE IF B$(2)="" THEN B$(1)=B$(1) ELSE B$(1)=B$(2)+" "+B$(1) 2200 GOTO 2130 2210 ' (SUB) GET RECORD "I" IN T$ 2220 T$="" ' necessary! 2230 ON FT GOTO 2260,2240 2240 GET#1,FT*I+2 ' latter half 2250 T$=LEFT$(R$,127) 2260 GET#1,FT*I+1 ' whole or first half 2270 T$=R$+T$ 2280 RETURN 2290 ' (SUB) MEDIUM FORM RE-FORMAT 2300 B$(1)=B$(2)+" "+B$(1) 2310 B$(2)=B$(3) 2320 B$(3)=B$(4) 2330 B$(4)=B$(5) 2340 B$(5)=B$(6) 2350 RETURN  RE-FORMAT 2310 PRINT"This program must be entered via DIMS. 20 STOP 1000 GOSUB 1930 'cs 1010 PRINT:PRINT TAB(25);"DLETTERS 1.02 - October 17, 1982 1015 ' by Dan Dugan -- public domain 1020 PRINT:PRINT"In this program you control printing in the same way that 1030 PRINT"you control listing on the screen in DEDIT. The 'pause prompt' 1040 PRINT"Ready> will accept SPACE or RETURN to print, 'z' to print and keep 1050 PRINT"going without pausing, or ESCAPE to abort and return to DEDIT. 1051 PRINT:PRINT"It will also accept two commands special to the letters 1052 PRINT"program. 'r' will cause the previous letter to repeat, and 1053 PRINT"'n' will ask for a record number to start from. 1060 PRINT:PRINT"While printing without pause, hitting the space bar during 1070 PRINT"a letter will cancel the 'z' and cause the program to pause before 1080 PRINT"starting the next letter. 1090 ON ERROR GOTO 1780 1100 DEFINT A-Z 1110 COMMON I,J,K,X,Y,T$,R$,S$,T1$,SKIPPARSE,FT,SEARCH, C,N,NC,P6,P7,P8,P9,PI,S,T,T1,T2,C(),B$(),N$(), SEARCHWORD$(),SEARCHFIELD(),SKIPWORD$(),LOOKFIELD(),DD$(),F$,FT$ 1130 GOTO 1160 1140 PRINT:PRINT"Wait while editor program is re-loaded 1150 CHAIN DD$(1)+"DEDIT",1000 1160 ' PRINT LETTER SET-UP 1170 INPUT"Enter text file name (use prefix: to identify disk)"; G$ 1180 IF G$="x" OR G$="" THEN 1670 1190 X$=G$: GOSUB 1810 ' UCV 1200 G$=Y$ 1210 OPEN "I",3,G$ ' test 1220 CLOSE 3 1230 ' RECORD WORK LOOP 1240 C2=0 ' first time 1250 ' 1260 FOR I=T1 TO T2 ' <==== FOR 1270 GOSUB 2510 ' get rec 1280 IF ASC(T$)=0 THEN PRINT"0";:GOTO 1640 ELSE PRINT"+"; 1290 T1$=T$ ' save it 1300 IF SKIPPARSE=1 THEN 1320 1310 GOSUB 1690 ' parse record string 1320 IF SEARCH=0 THEN 1620 1330 ' SEARCH 1340 IF SEARCH<>2 THEN 1410 1350 IF INSTR(T$,SEARCHWORD$(0))=0 THEN 1640 1360 ' speed search 1370 LPRINT CHR$(7); ' found it 1380 GOSUB 1690 ' parse 1390 GOTO 1620 1400 ' field search 1410 J=0 ' check for skips first 1420 IF SKIPWORD$(J)="" THEN 1500 ' try search then 1430 IF LOOKFIELD(J)<>0 THEN 1470 ' look in field 1440 IF INSTR(T1$,SKIPWORD$(J))<>0 THEN 1640 1450 J=J+1 1460 GOTO 1420 1470 IF INSTR(B$(LOOKFIELD(J)),SKIPWORD$(J))<>0 THEN 1640 1475 IF B$(LOOKFIELD(J))="" AND SKIPWORD$(J)="_" THEN 1640 1480 J=J+1 1490 GOTO 1420 1500 IF SEARCHWORD$(0)="" THEN 1600 ' don't care so print it 1510 J=0: GOTO 1530 ' now search 1520 IF SEARCHWORD$(J)="" THEN 1640 1530 IF SEARCHFIELD(J)<>0 THEN 1570 ' field 1540 IF INSTR(T1$,SEARCHWORD$(J))<>0 THEN 1600 ' found it 1550 J=J+1 1560 GOTO 1520 1570 IF INSTR(B$(SEARCHFIELD(J)),SEARCHWORD$(J))<>0 THEN 1600 1575 IF B$(SEARCHFIELD(J))="" AND SEARCHWORD$(J)="_" THEN 1600 1580 J=J+1 1590 GOTO 1520 1600 LPRINT CHR$(7); 1610 IF SKIPPARSE=1 THEN GOSUB 1690 ' parse 1620 ' zag to do it 1630 GOTO 1960 1640 ' END OF RECORD WORK LOOP 1650 IPREV=I ' for repeat command 1660 NEXT 1670 ' FINISH 1680 GOTO 1140 ' exit 1690 ' (SUB) PARSE STRING 1700 K=0 1710 J=INSTR(T$,CHR$(126)) ' delimiter 1720 IF J=0 THEN RETURN 1730 K=K+1 1740 B$(K)=MID$(T$,1,J-1) 1750 T$=MID$(T$,J+1) 1760 GOTO 1710 1770 ' ERROR HANDLING 1780 IF ERL=1210 AND ERR=53 THEN CLOSE 3:PRINT"FILE NOT FOUND": RESUME 1160 1790 IF ERL=1210 AND ERR=64 THEN CLOSE 3:PRINT"UNACCEPTABLE FILE NAME": RESUME 1160 1800 ON ERROR GOTO 0 1810 ' (SUB) UCV 1820 Y$="" 1830 FOR J=1 TO LEN(X$) 1840 Y$=Y$+" " 1850 X=ASC(MID$(X$,J, 1)) 1860 IF 96"" THEN X=ASC(X$) 1915 IF X=27 THEN CLOSE 3:GOTO 1670 ' use ESC to escape listing 1920 RETURN 1930 ' (SUB) CLEAR SCREEN (TERM DEP) 1940 PRINT CHR$(12); 1950 RETURN 1960 ' PRINT LETTER (insert above) 1970 ' PAUSE CONTROLS (TERM DEP if uppercase) 1980 GOSUB 1900 ' exit 2000 IF X=122 THEN 2090 ' go on 2010 PRINT I;B$(1);TAB(20);"Ready>"; 2020 A$=INPUT$(1):PRINT A$ 2030 IF A$=CHR$(13) OR A$=CHR$(32) THEN 2090 2040 IF A$="z" THEN 2090 2050 IF A$="r" THEN I=IPREV:GOTO 1270 2060 IF A$="n" THEN 2070 ELSE 2080 2070 INPUT"Enter number of desired record: ";I:GOTO 1270 2080 GOTO 1970 ' loop 2090 ' DO IT 2100 C1=0 'counts data lines 2110 OPEN "I",3,G$ ' open each time to restore 2120 IF P9=0 THEN GOSUB 1930 ' clear screen 2130 IF EOF(3) THEN 2140 ELSE 2180 2140 ' END OF TEXT FILE 2150 IF P9=1 THEN LPRINT CHR$(12); ' form feed 2160 CLOSE 3 2170 GOTO 1640 ' next record 2180 ' GET LINE & TEST 2190 LINE INPUT #3,L$ 2200 IF LEFT$(L$,3)=".da" THEN 2210 ELSE 2450 2210 ' LINE IS DATA LINE 2220 C1=C1+1:IF C1>NC THEN 2130 2230 ON C1 GOTO 2240, 2310, 2340, 2370, 2400, 2430 ' six lines 2240 ' FIRST DATA LINE 2250 IF B$(1)="" AND B$(2)="" THEN 2300 2260 IF B$(1)="" THEN A$=B$(2):GOTO 2300 2270 IF B$(2)="" THEN A$=B$(1):GOTO 2300 2280 A$=B$(2)+CHR$(32)+B$(1) 2290 GOSUB 2480 2300 GOTO 2130 2310 ' DATA LINE 2 2320 IF B$(3)="" THEN 2130 2330 A$=B$(3):GOSUB 2480:GOTO 2130 2340 ' DATA LINE 3 2350 IF B$(4)="" THEN 2130 2360 A$=B$(4):GOSUB 2480:GOTO 2130 2370 ' DATA LINE 4 2380 IF B$(5)="" THEN 2130 2390 A$=B$(5):GOSUB 2480:GOTO 2130 2400 ' DATA LINE 5 2410 A$=B$(6)+CHR$(32)+B$(7) 2420 GOSUB 2480:GOTO 2130 2430 ' DATA LINE 6 2440 A$=B$(10):GOSUB 2480:GOTO 2130 2450 ' PRINT TEXT LINE 2460 IF P9 THEN LPRINT L$ ELSE PRINT L$ 2470 GOTO 2130 2480 ' (SUB) PRINT DATA LINE 2490 IF P9 THEN LPRINT A$ ELSE PRINT A$ 2500 RETURN 2510 ' GET RECORD "I" IN T$ SUB 2520 T$="" ' necessary! 2530 ON FT GOTO 2560,2540 2540 GET#1,FT*I+2 ' latter half 2550 T$=LEFT$(R$,127) 2560 GET#1,FT*I+1 ' whole or first half 2570 T$=R$+T$ 2580 RETURN  2540 GET#1,FT*I+2 ' latter half 2550 T$=LEFT$(R$,127) 2560 GET#1,FT*I+1 ' w1000 GOSUB 1790 'cs 1010 PRINT:PRINT TAB(27);"NADIN 1.02 - October 9, 1983 1020 ' by Dan Dugan -- public domain 1030 PRINT:PRINT"Inputs from a NAD-like data file to a DIMS 'standard' format mailing list. 1040 PRINT 1050 DEFINT A-Z 1060 COMMON I,J,K,X,Y,T$,R$,S$,T1$,SKIPPARSE,FT,SEARCH, C,N,NC,P6,P7,P8,P9,PI,S,T,T1,T2,C(),B$(),N$(), SEARCHWORD$(),SEARCHFIELD(),SKIPWORD$(),LOOKFIELD(),DD$(),F$,FT$ 1070 DIM V$(5) 1080 ' OPEN SOURCE FILE 1090 PRINT:INPUT"Name of source file";X$ 1100 GOSUB 1820:F2$=Y$ 'ucv 1110 IF MID$(F2$,2,1)=":" THEN 1130 1120 F2$=DD$(5)+F2$ 1130 ' TEST FOR EXISTENCE 1140 ON ERROR GOTO 1170 1150 OPEN"I",3,F2$ 1160 ON ERROR GOTO 0:GOTO 1210 'ok 1170 CLOSE 3 1180 IF ERR=53 THEN CLOSE 3:PRINT"File not found":RESUME 1080 1190 IF ERR=64 THEN PRINT"Bad file name, try again.":RESUME 1080 1200 ON ERROR GOTO 0 1210 ' READ FILE, PARSE 1220 GOSUB 1740 'exit 1230 IF EOF(3) THEN 1690 1240 FOR I=1 TO NC:B$(I)="":NEXT:NR=NR+1 1250 LINE INPUT #3,L$ 1260 PRINT L$ 1270 L1$=MID$(L$,2,92):STATE$=MID$(L$,97,2):ZIP$=MID$(L$,102,5):NOTE$=MID$(L$,110,13):L$="" 1280 X=INSTR(L1$,"*") 1281 IF X<>0 THEN 1290 1282 X=INSTR(L1$,CHR$(34)) 1283 X$=LEFT$(L1$,X-1):GOSUB 1940:V$(1)=X$:V$(2)="":L1$=MID$(L1$,X+3):GOTO 1320 1290 V$(1)=LEFT$(L1$,X-1):L1$=MID$(L1$,X+1) 1300 X=INSTR(L1$,CHR$(34)) 1310 X$=LEFT$(L1$,X-1):GOSUB 1940:V$(2)=X$:L1$=MID$(L1$,X+3) 1320 X=INSTR(L1$,CHR$(34)) 1330 V$(3)=LEFT$(L1$,X-1):L1$=MID$(L1$,X+3) 1340 X=INSTR(L1$,CHR$(34)) 1350 V$(4)=LEFT$(L1$,X-1) 1360 V$(5)=MID$(L1$,X+3):L1$="" 1370 ' PUT INTO DIMS ARRAY 1380 B$(1)=V$(1) 1390 B$(2)=V$(2) 1400 IF V$(4)="" THEN 1410 ELSE 1430 1410 B$(3)="":B$(4)=V$(3):B$(5)=V$(5)+" "+STATE$:B$(6)=ZIP$ 1420 X$=NOTE$:GOSUB 1910:B$(9)=X$:GOTO 1450 1430 B$(3)=V$(3):B$(4)=V$(4):B$(5)=V$(5)+" "+STATE$:B$(6)=ZIP$ 1440 X$=NOTE$:GOSUB 1910:B$(9)=X$ 1450 ' ADD RECORD TO DIMS FILE 1460 T$="" 1470 FOR J=1 TO NC 1480 IF LEN(T$)+LEN(B$(J))+1>FT*128 THEN PRINT"Record too long." 1490 T$=T$+B$(J)+CHR$(126) 1500 NEXT 1510 N=N+1:PRINT N;T$ 1520 GOSUB 1550:PRINT"*";:GOSUB 1620:PRINT"!":C=1 1530 ' LOOP 1540 GOTO 1210 1550 ' (SUB) WRITE T$ AS RECORD # N 1560 ON FT GOTO 1590,1570 1570 LSET R$=MID$(T$,129) 'latter half 1580 PUT #1,FT*N+2 1590 LSET R$=LEFT$(T$,128) 'first half 1600 PUT #1,FT*N+1 1610 RETURN 1620 ' (SUB) WRITE T$ AS DUPE REC N 1630 ON FT GOTO 1660,1640 1640 LSET S$=MID$(T$,129) 1650 PUT #2,FT*N+2 1660 LSET S$=LEFT$(T$,128) 1670 PUT #2,FT*N+1 1680 RETURN 1690 ' FINISH 1700 CLOSE 3 1710 PRINT:PRINT NR"records added. 1720 PRINT:PRINT TAB(32)"Re-loading DEDIT. 1730 CHAIN DD$(1)+"DEDIT",1000 1740 ' EXIT TEST (TERM DEP) 1750 X$=INKEY$:X=0 1760 IF X$<>"" THEN X=ASC(X$) 1770 IF X=27 THEN CLOSE 3:GOTO 1690 'use ESC to escape listing 1780 RETURN 1790 ' CLEAR SCREEN (TERM DEP) 1800 PRINT CHR$(12); 1810 RETURN 1820 ' (SUB) UCV 1830 Y$="" 1840 FOR K=1 TO LEN(X$) 1850 Y$=Y$+CHR$(32) 1860 X=ASC(MID$(X$,K,1)) 1870 IF 962 THEN 5180 5135 ' FIND 5140 IF INSTR(T$,SEARCHWORD$(0))=0 THEN 5630 5160 GOSUB 5700 ' parse 5170 GOTO 5500 5180 ' FIELD SEARCH 5190 J=0 ' check for skips first 5200 IF SKIPWORD$(J)="" THEN 5280 ' try search then 5210 IF LOOKFIELD(J)<>0 THEN 5250 ' look in field 5220 IF INSTR(T1$,SKIPWORD$(J))<>0 THEN 5630 ' whole rec search - skip it 5230 J=J+1 5240 GOTO 5200 5250 IF INSTR(B$(LOOKFIELD(J)),SKIPWORD$(J))<>0 THEN 5630 ' field compare - skip 5255 IF B$(LOOKFIELD(J))="" AND SKIPWORD$(J)="_" THEN 5630 5260 J=J+1 5270 GOTO 5200 5280 IF SEARCHWORD$(0)="" THEN 5380 ' don't care so print it 5290 J=0: GOTO 5310 ' now search 5300 IF SEARCHWORD$(J)="" THEN 5630 ' hesitate no longer 5310 IF SEARCHFIELD(J)<>0 THEN 5350 ' field 5320 IF INSTR(T1$,SEARCHWORD$(J))<>0 THEN 5380 ' found it 5330 J=J+1 5340 GOTO 5300 5350 IF INSTR(B$(SEARCHFIELD(J)),SEARCHWORD$(J))<>0 THEN 5380 5355 IF B$(SEARCHFIELD(J))="" AND SEARCHWORD$(J)="_" THEN 5380 5360 J=J+1 5370 GOTO 5300 5380 ' GET READY TO DO IT 5390 IF SKIPPARSE=1 THEN GOSUB 5700 ' parse 5500 ' DO WORK 5510 PRINT CHR$(40);I;CHR$(41) 5520 FOR J=1 TO NC 5530 IF C(J)=0 THEN 5610 5540 ' Substitute "~" for quote chars. 5550 QUOTE=INSTR(B$(J),CHR$(34)) 5560 IF QUOTE THEN MID$(B$(J),QUOTE,1)=CHR$(126):GOTO 5550 5570 ' Put quotes around strings with commas in 'em 5580 IF INSTR(B$(J),CHR$(44)) THEN B$(J)=CHR$(34)+B$(J)+CHR$(34) 5590 IF J>1 THEN PRINT#3,CHR$(44);:PRINT CHR$(44); 5600 PRINT#3,B$(J);:PRINT B$(J); 5610 NEXT 5620 PRINT#3,:PRINT:NR=NR+1 5630 GOSUB 5790 ' check exit 5640 NEXT I ' END OF RECORD WORK LOOP 5650 ' FINISH 5660 CLOSE 3 5670 PRINT:PRINT NR"records. 5680 PRINT:PRINT TAB(32)"Re-loading DEDIT. 5690 CHAIN DD$(1)+"DEDIT",1000 5700 ' PARSE STRING 5710 K=0 5720 M=INSTR(T$,CHR$(126)) ' delimiter 5730 IF M=0 THEN RETURN 5740 K=K+1 5750 B$(K)="" 5760 B$(K)=MID$(T$,1,M-1) 5770 T$=MID$(T$,M+1) 5780 GOTO 5720 5790 ' (SUB) EXIT TEST 5800 X$=INKEY$:X=0 5810 IF X$<>"" THEN X=ASC(X$) 5820 IF X=27 THEN CLOSE 3:GOTO 5650 'use ESC to escape process 5830 RETURN 5840 ' (SUB) CLEAR SCREEN (TERM DEP) 5850 PRINT CHR$(12); 5860 RETURN 5870 ' (SUB) GET RECORD "I" IN T$ 5880 T$="" ' necessary! 5890 ON FT GOTO 5920,5900 5900 GET#1,FT*I+2 ' latter half 5910 T$=LEFT$(R$,127) 5920 GET#1,FT*I+1 ' whole or first half 5930 T$=R$+T$ 5940 RETURN 5950 ' (SUB) UCV 5960 Y$="" 5970 FOR K=1 TO LEN(X$) 5980 Y$=Y$+CHR$(32) 5990 X=ASC(MID$(X$,K,1)) 6000 IF 96NC THEN PRINT"Field"S(I,1)"??? Enter again." GOTO 1280 1310 S(I,2)=0:IF RIGHT$(N$(S(I,1)),1)="n" THEN S(I,2)=1 ELSE S6=0 1320 '(if just one is alpha, do alpha sort) 1330 INPUT"Number of characters in field to use (RETURN for all)";S(I,3) 1332 IF S(I,3) THEN 1334 ELSE 1340 1334 S(I,4)=0:PRINT"Do you want to pad shorter fields to that length? (n/y) "; :A$=INPUT$(1):IF A$=CHR$(13) THEN A$="n" 1335 PRINT A$:IF A$="y" THEN S(I,4)=1 1340 IF S(I,3) THEN 1350 ELSE PRINT"You want to sort on all characters of "; :GOTO 1360 1350 PRINT"You want to sort on the first"S(I,3)"characters of "; 1360 PRINT LEFT$(N$(S(I,1)),4)"? (y/n) ";: A$=INPUT$(1):IF A$=CHR$(13) THEN A$="y" 1370 PRINT A$:IF A$="x" THEN 3400 1380 IF A$<>"y" THEN PRINT"Entry cancelled; ready for key"I"again.":GOTO 1280 1390 IF S(I,3) THEN KLEN=KLEN+S(I,3) ELSE KLEN=KLEN+10:KLENFLAG=1 1400 PRINT 1410 NEXT I 1420 NK=I-1 1430 IF S(1,1)=0 THEN 3400 'quit 1435 GOTO 1480 'skip this because of bug in desc. sort 1440 PRINT:PRINT"Ascending order? (y/n) "; 1450 A$=INPUT$(1): IF A$=CHR$(13) THEN A$="y" 1460 PRINT A$: IF A$="n" THEN S8=1 1470 IF A$="x" THEN 3400 1480 ' OUTPUT SWITCH (P7) 1490 P7=0 1500 PRINT:PRINT"Shall the product of the sort overlay the original file? (y/n) "; 1510 A$=INPUT$(1): IF A$=CHR$(13) THEN A$="y" 1520 PRINT A$:IF A$="x" THEN 3400 1530 IF A$="n" THEN P7=1:GOTO 1600 1540 IF A$<>"y" THEN 1500 1550 ' YES, OVERLAY 1560 IF (T1=1 AND T2=N) OR S9=1 THEN 1630 1570 PRINT:PRINT"NOT ALLOWED - Overlaying part of file on file will erase records 1580 PRINT"outside of range.": PRINT:GOTO 1480 1590 ' NAME OUTPUT FILE 1600 PRINT:INPUT"Name of sort product file (no prefix or suffix) ";F2$ 1610 IF F2$="" THEN 1480 1620 X$=F2$:GOSUB 3920:F2$=Y$ ' ucv 1630 ' SHOW SORT SET-UP 1640 GOSUB 4010 'cs 1650 PRINT"SETUP FOR SORT 1660 PRINT: IF T1=1 AND T2=N THEN PRINT"Sort all records ("N")": GOTO 1710 1670 PRINT"Sorting range of records from"T1"to"T2" 1680 ON S9+1 GOTO 1690,1700 1690 PRINT"The output will be the range of records only.": GOTO 1710 1700 PRINT"The output will be the entire file with the selected range sorted. 1710 PRINT:PRINT"Records will be put in order by examining": PRINT"the contents of the sort key fields." 1720 PRINT:FOR I=1 TO NK 1730 PRINT TAB(29);:PRINT USING"##";I;: PRINT". "LEFT$(N$(S(I,1)),4); 1740 PRINT TAB(40);:IF S(I,3) THEN PRINT S(I,3) ELSE PRINT" all" 1750 NEXT I 1760 PRINT:IF KLENFLAG THEN 1762 ELSE 1766 1762 PRINT"ESTIMATED string space needed for the key array is"KLEN*(T2-T1+1): GOTO 1768 1766 PRINT"String space needed for the key array is"KLEN*(T2-T1+1) 1768 PRINT"and the available space is"FRE(X$)". 1770 PRINT"This program can't tell whether there is enough space on disk " DD$(5)" for tempo- 1780 PRINT"rary storage of the key array. 1790 PRINT:PRINT"The records will be sorted in "; 1800 IF S8=0 THEN PRINT"ascending ";: GOTO 1820 1810 PRINT"descending "; 1820 IF S6=0 THEN PRINT"alphabetical ";: GOTO 1840 1830 PRINT"numerical "; 1840 PRINT"order." 1850 PRINT: PRINT"The output of the sort will "; 1860 IF P7=0 THEN PRINT"overlay the original file.":GOTO 1880 1870 PRINT"create a new DIMS file "F2$" on disk "DD$(4)"." 1880 PRINT:IF P7=0 AND (T1<>1 OR T2<>N) AND S9=0 THEN PRINT"You are aware that this process will erase records? 1885 IF P7 THEN 1890 ELSE 1900 1890 PRINT"The new file "F2$" will replace the safety copy of "F$". 1892 PRINT"You must then use PIP to move "F2$" to another disk, 1894 PRINT"and use the DEDIT 'backup' command on "F$" to re-create a 1896 PRINT"safety copy. 1900 ' FINAL APPROVAL 1910 PRINT:PRINT"Is this exactly what you want? (y/n) "; 1920 A$=INPUT$(1): IF A$=CHR$(13) THEN A$="y" 1930 PRINT A$ 1940 IF A$="x" THEN 3400 1950 IF A$="n" THEN PRINT"Try again.":GOTO 1090 1960 IF A$<>"y" THEN GOTO 1910 1970 GOTO 2110 1980 ' SORT CONTROLS GUIDE 1990 ' S() array holds key orders (field#, num? (1=num), length, pad?) 2000 ' NK = number of keys specified 2010 ' S6 = 0 alpha sort 2020 ' 1 numeric sort 2030 ' S7 = 0 don't rename dupe file 2040 ' 1 rename dupe file as F2$.D 2050 ' S8 = 0 ascending order 2060 ' 1 descending order 2070 ' S9 = 0 output only sorted range of records 2080 ' 1 output records above and below sorted range 2090 ' P7 = 0 overlay main file 2100 ' 1 output to named file 2110 ' PUT KEYS IN TEMP FILE 2120 GOSUB 4010 2130 PRINT"SORTING '"F$"' 2140 PRINT:PRINT"Extracting keys.":PRINT 2150 OPEN"O",3,DD$(5)+"KEYS.$$$" 2160 FOR I=T1 TO T2 2170 GOSUB 4270:GOSUB 4110 ' get record 2180 IF ASC(T$)=0 THEN X$=CHR$(126)+"(del)":GOTO 2320 ' sorts deletes to end 2190 GOSUB 3540 ' parse 2200 X$="" 2210 FOR X=1 TO NK 2220 IF S(X,3) THEN 2230 ELSE X$=X$+B$(S(X,1))+CHR$(32):GOTO 2280 2230 Z$=LEFT$(B$(S(X,1)),S(X,3)) 2240 Y=LEN(Z$) 2250 IF S(X,2)=1 THEN Y$=STRING$(S(X,3)-Y,CHR$(48)): X$=X$+Y$+Z$:GOTO 2280 'pad num field with left 0's 2252 IF S(X,4) THEN 2260 ELSE Y$="":GOTO 2270 2260 Y$=STRING$(S(X,3)-Y,CHR$(32)) 'spaces to pad right 2270 X$=X$+Z$+Y$ 2280 NEXT 2290 IF X$="" THEN X$=CHR$(126):GOTO 2320 ' makes empties go later 2300 IF S6 THEN 2320 2310 GOSUB 3920:X$=Y$ 'ucv 2320 PRINT I,X$ 2330 PRINT#3,X$ 2340 NEXT 2350 CLOSE 3 2360 ' LOAD INDEX AND KEY ARRAYS 2370 PRINT:PRINT"Loading key array:":PRINT 2380 OPEN"I",3,DD$(5)+"KEYS.$$$" 2390 I=T1:J=1:D$(0)=CHR$(0) 2400 IF EOF(3) THEN 2450 2410 LINE INPUT#3,D$(J) 2420 D(J)=I 2430 I=I+1:J=J+1 2440 GOTO 2400 2450 CLOSE 3 2460 KILL DD$(5)+"KEYS.$$$" 2470 ' READY TO SORT ARRAY 2480 PRINT:PRINT"Sorting array.":PRINT 2490 ' from QUICKSORT by Sylvan Rubin DDJ #33 p.42 2500 LND=1:HND=J-1:STP=0 2510 ' PARTITION 2520 GOSUB 4270 'exit 2530 IF LND>=HND THEN 2910 ' pop stack 2540 PRINT CHR$(80);:CTR=INT((LND+HND+1)/2) ' use center for pivot 2550 SWAP D(CTR),D(HND):SWAP D$(CTR),D$(HND) 2560 LO=LND-1:HI=HND 2570 PIV$=D$(HND):GOTO 2600 ' scan-l 2580 ' EXCHANGE 2590 SWAP D(LO),D(HI):SWAP D$(LO),D$(HI) 2600 ' SCAN-L 2610 LO=LO+1:ON S6+1 GOTO 2620,2630 ' alph, num 2620 ON S8+1 GOTO 2640,2650 ' asc, desc 2630 ON S8+1 GOTO 2660,2670 2640 IF D$(LO)PIV$ THEN 2610 ELSE 2680 2660 IF VAL(D$(LO))VAL(PIV$) THEN 2610 ELSE 2680 2680 ' SCAN-H 2690 HI=HI-1:ON S6+1 GOTO 2700,2710 2700 ON S8+1 GOTO 2720,2730 2710 ON S8+1 GOTO 2740,2750 2720 IF D$(HI)>PIV$ THEN 2690 ELSE 2760 2730 IF D$(HI)VAL(PIV$) THEN 2690 ELSE 2760 2750 IF VAL(D$(HI))(HND-LO) THEN 2860 ' stack low 2810 ' STACK HIGH 2820 IF LO+2>HND THEN 2840 2830 STP=STP+1:LST(STP)=LO+1:HST(STP)=HND 2840 ' SHIFT HIGHEND 2850 HND=HI:GOTO 2510 ' partition 2860 ' STACK LOW 2870 IF LND+1>HI THEN 2900 ' shift lowend 2880 STP=STP+1:LST(STP)=LND:HST(STP)=HI 2890 ' SHIFT LOWEND 2900 LND=LO+1:GOTO 2510 ' partition 2910 ' POP STACK 2920 IF STP=0 THEN 2950 ' done 2930 LND=LST(STP):HND=HST(STP) 2940 STP=STP-1:GOTO 2510 ' partition 2950 PRINT:PRINT:PRINT"Array sorted. 2960 ' OUTPUT 2970 NR=0 ' counts number of records in product file 2980 CLOSE 2:KILL DD$(4)+F$+".DD"+FT$:GOSUB 4080 2990 IF S9=0 GOTO 3060 3000 ' COPY BLOCK BELOW T1 3010 IF T1=1 THEN 3060 3020 PRINT:PRINT"Outputting records below range. 3030 FOR I=1 TO T1-1 3040 GOSUB 3430 'output record 3050 NEXT 3060 ' MOVE RECORDS PER INDEX ARRAY 3070 PRINT:PRINT"Now moving records from " DD$(3)" to "DD$(4)" in sorted order per index array.":PRINT 3080 ERASE D$ ' don't need strings 3090 FOR J=1 TO T2-T1+1 3100 I=D(J):GOSUB 3430 3110 NEXT 3120 ' COPY BLOCK ABOVE 3130 IF S9=0 OR T2=N THEN 3180 ' skip block copy 3140 PRINT:PRINT"Outputting records above range 3150 FOR I=T2+1 TO N 3160 GOSUB 3430 ' output 3170 NEXT 3180 ' SAVE HEADER AND TIDY UP 3190 PRINT:PRINT"Saving header;"NR"records 3200 T$="" 3210 I=0 3220 I=I+1 3230 T$=T$+N$(I)+CHR$(126) 3240 IF LEFT$(N$(I),4)="stop" THEN 3260 3250 GOTO 3220 3260 T$=T$+STR$(NR)+CHR$(126) ' NR at end 3270 NR=0 ' for header 3280 GOSUB 3470 ' put it 3290 PRINT"!" 3300 IF P7 THEN 3330 'rename product 3310 GOSUB 3620 ' copy dupe to main 3320 GOTO 3380 3330 ' RENAME OUTPUT FILE 3340 CLOSE 2:NAME DD$(4)+F$+".DD"+FT$ AS DD$(4)+F2$+".D"+FT$:GOSUB 4080 3350 PRINT"Product file "F2$" is now on disk "DD$(4)" (backup erased). 3360 PRINT"After moving product to desired disk, use 'backup' command on "F$ 3370 INPUT"to restore safety copy. Hit RETURN to continue. ";A$ 3380 PRINT:PRINT:PRINT"Sort completed 3390 PRINT CHR$(7); 'beep 3400 ' RETURN TO DEDIT 3410 PRINT:PRINT"Re-loading DEDIT. 3420 CHAIN DD$(1)+"DEDIT",1000 3430 ' (SUB) OUTPUT RECORD "I" 3440 GOSUB 4110:PRINT T$ ' get rec I 3450 GOSUB 4270 ' exit 3460 NR=NR+1 ' # records in prod. file 3470 ' PUT RECORD NR 3480 ON FT GOTO 3510,3490 3490 LSET S$=MID$(T$,129) 3500 PUT #2,FT*NR+2 3510 LSET S$=LEFT$(T$,128) 3520 PUT #2,FT*NR+1 3530 RETURN 3540 ' (SUB) PARSE STRING 3550 K=0 3560 J=INSTR(T$,CHR$(126)) ' delimiter 3570 IF J=0 THEN RETURN 3580 K=K+1 3590 B$(K)=MID$(T$,1,J-1) 3600 T$=MID$(T$,J+1) 3610 GOTO 3560 3620 ' (SUB) ERASE ORIGINAL FILE AND COPY DUP TO ORIG 3630 CLOSE 3640 PRINT 3650 KILL DD$(3)+F$+".D"+FT$ 3660 PRINT"Copying dupe, overlaying original file.":PRINT 3670 GOSUB 4040 ' open both files 3680 FOR J=1 TO FT*(N+1) 3690 GET #2,J 3700 PRINT"&"; 3710 LSET R$=S$ 3720 PUT #1,J 3730 PRINT"*"; 3740 NEXT J 3750 RETURN 3760 ' ERROR HANDLING 3770 IF ERR=61 THEN RESUME 3780 ELSE 3810 3780 PRINT CHR$(7)"Sorry - process halted because there isn't enough disk space 3790 PRINT"for the key file. 3800 INPUT"Hit return to recover.";A$:CLOSE:T=8:CHAIN DD$(1)+"DIMS",1000 3810 IF ERR=7 OR ERR=14 THEN RESUME 3820 ELSE 3850 3820 PRINT CHR$(7)"Sorry - process halted because key array needed more memory 3830 PRINT"than is available. Try again with shorter key specifications. 3840 INPUT"Hit return to try again.";A$:CLOSE 3:GOTO 1090 3850 IF ERR=58 THEN RESUME 3860 ELSE 3910 3860 PRINT"Sorry - file named "F2$" already exists. 3870 INPUT"Enter another name for the output file here: ";X$ 3880 IF X$="" THEN 3870 3890 GOSUB 3920:F2$=Y$ 'ucv 3900 GOTO 3330 3910 ON ERROR GOTO 0 3920 ' (SUB) UCV 3930 Y$="" 3940 FOR J=1 TO LEN(X$) 3950 Y$=Y$+" " 3960 X=ASC(MID$(X$,J,1)) 3970 IF 96CHR$(27) THEN RETURN 4290 PRINT:PRINT"Process paused by ESCAPE from keyboard. 4300 PRINT"Do you want to continue (y,n or x) ? "; 4310 A$=INPUT$(1):IF A$=CHR$(13) THEN A$="y" 4320 PRINT A$:IF A$="x" THEN CLOSE 3:GOTO 3400 4330 IF A$<>"y" THEN CLOSE 3:GOTO 1090 4340 RETURN  A$=CHR$(13) THEN A$="y" 4320 PRINT 5 ' DSTAT by Dan Dugan -- public domain 10 PRINT"This program must be entered from DEDIT.":STOP 1000 DEFINT A-T 1010 DEFSNG U-Z 1015 FF$=CHR$(12) 'depends on your printer 1020 COMMON I,J,K,X%,Y%,T$,R$,S$,T1$,SKIPPARSE,FT,SEARCH, C,N,NC,P6,P7,P8,P9,PI,S,T,T1,T2,C(),B$(),N$(), SEARCHWORD$(),SEARCHFIELD(),SKIPWORD$(),LOOKFIELD(),DD$(),F$,FT$ 1040 ON ERROR GOTO 2330 1050 IF N=0 THEN PRINT"File is empty.": GOTO 2210 1060 NX=0 1070 PRINT 1080 GOSUB 2400 ' cs 1090 ' 1100 PRINT"DSTAT 1.02 - October 17, 1982 1110 LINE INPUT"Enter date: ",DATE$ 1115 PRINT:PRINT"Here are the numeric fields in ";F$ 1120 GOSUB 2510 'show fields 1130 INPUT"Number of field to work on (or 0 to quit)";STATFX 1135 IF STATFX=0 THEN 2210 1140 IF STATFX>NC THEN PRINT"FILE HAS"NC"FIELDS": GOTO 1130 1150 IF RIGHT$(N$(STATFX),1)="n" THEN 1180 1160 PRINT"Only numeric fields can be used; enter again." 1170 GOTO 1130 1180 IF STATFX=0 THEN GOTO 2210 ' abort 1190 PRINT:INPUT"Enter cue for missing data, if other than blank: ",MISS$ 1191 IF P9=0 THEN 1200 1192 ' PRINT HEADING 1194 FOR X=1 TO 5:LPRINT:NEXT 1195 LPRINT"DESCRIPTIVE STATISTICS FOR FILE "F$", FIELD "LEFT$(N$(STATFX),4)" "DATE$ 1196 LPRINT 1200 ' RECORD WORK LOOP 1210 ' zero variables here if go-around allowed 1220 ' 1230 FOR I=T1 TO T2 ' <==== FOR 1240 GOSUB 2430 ' get rec 1250 IF ASC(T$)=0 THEN PRINT"0 ";CHR$(13);:GOTO 1760 ELSE PRINT I;CHR$(13); 1260 T1$=T$ ' save it 1270 IF SKIPPARSE=1 THEN 1290 1280 GOSUB 2240 ' parse record string 1290 IF SEARCH=0 THEN 1580 1300 ' SEARCH 1310 IF SEARCH<>2 THEN 1370 1320 ' FIND 1330 IF INSTR(T$,SEARCHWORD$(0))=0 THEN 1760 1340 GOSUB 2240 ' parse 1350 GOTO 1580 1360 ' LOOK FOR SKIPS 1370 J=0 1380 IF SKIPWORD$(J)="" THEN 1460 ' try search then 1390 IF LOOKFIELD(J) THEN 1430 ' look in field 1400 IF INSTR(T1$,SKIPWORD$(J)) THEN 1760 ' whole rec search - skip it 1410 J=J+1 1420 GOTO 1380 1430 IF INSTR(B$(LOOKFIELD(J)),SKIPWORD$(J)) THEN 1760 ' field compare - skip 1435 IF B$(LOOKFIELD(J))="" AND SKIPWORD$(J)="_" THEN 1760 'blank field 1440 J=J+1 1450 GOTO 1380 1460 IF SEARCHWORD$(0)="" THEN 1560 ' don't care so print it 1470 J=0: GOTO 1490 ' now search 1480 IF SEARCHWORD$(J)="" THEN 1760 ' hesitate no longer 1490 IF SEARCHFIELD(J) THEN 1530 ' field 1500 IF INSTR(T1$,SEARCHWORD$(J)) THEN 1560 ' found it 1510 J=J+1 1520 GOTO 1480 1530 IF INSTR(B$(SEARCHFIELD(J)),SEARCHWORD$(J))<>0 THEN 1560 1535 IF B$(SEARCHFIELD(J))="" AND SEARCHWORD$(J)="_" THEN 1560 1540 J=J+1 1550 GOTO 1480 1560 IF SKIPPARSE=1 THEN GOSUB 2240 ' parse 1570 ' MISSING DATA 1580 IF B$(STATFX)=MISS$ THEN 1760 ' skip 1590 ' WORK ON RECORD 1595 GOSUB 2370 ' exit 1600 X=VAL(B$(STATFX)) 1610 IF P9 THEN LPRINT"(";I;")"; 1620 PRINT"("I")"; 1630 IF P9 THEN LPRINT,X 1640 PRINT,X 1650 IF NX=0 THEN XMAX=X:XMIN=X:GOTO 1680 1660 IF X>XMAX THEN XMAX=X 1670 IF X2 THEN 1960 1950 PRINT"Records containing '"SEARCHWORD$(0)"'" 1955 IF P9 THEN LPRINT"Records containing '"SEARCHWORD$(0)"'" 1957 GOTO 2100 1960 PRINT"Subset selection: 1965 IF P9 THEN LPRINT:LPRINT"Subset selection: 1970 IF SEARCHWORD$(0)="" GOTO 2050 1980 PRINT" Selection instructions: 1985 IF P9 THEN LPRINT" Selection instructions: 1990 J=0 2000 PRINT TAB(8);"FIELD NAME";TAB(20)"EXPRESSION 2005 IF P9 THEN LPRINT TAB(8);"FIELD NAME";TAB(20)"EXPRESSION 2010 PRINT TAB(11);LEFT$(N$(SEARCHFIELD(J)),4);TAB(20);SEARCHWORD$(J) 2015 IF P9 THEN LPRINT TAB(11);LEFT$(N$(SEARCHFIELD(J)),4);TAB(20);SEARCHWORD$(J) 2020 J=J+1 2030 IF SEARCHWORD$(J)="" GOTO 2050 2040 GOTO 2010 2050 IF SKIPWORD$(0)="" GOTO 2100 2060 PRINT" Rejection instructions: 2065 IF P9 THEN LPRINT" Rejection instructions: 2070 PRINT TAB(8);"FIELD NAME";TAB(20);"EXPRESSION 2075 IF P9 THEN LPRINT TAB(8)"FIELD NAME"TAB(20)"EXPRESSION 2080 J=0 2090 PRINT TAB(11);LEFT$(N$(LOOKFIELD(J)),4);TAB(20);SKIPWORD$(J) 2095 IF P9 THEN LPRINT TAB(11);LEFT$(N$(LOOKFIELD(J)),4);TAB(20);SKIPWORD$(J) 2097 J=J+1 2098 IF SKIPWORD$(J)<>"" THEN 2090 2100 ' 2110 PRINT"Statistics calculated for field '";LEFT$(N$(STATFX),4);"'" 2115 IF P9 THEN LPRINT:LPRINT"Statistics calculated for field ";LEFT$(N$(STATFX),4) 2120 PRINT:PRINT,"Number",NX 2125 IF P9 THEN LPRINT:LPRINT,"Number",NX 2130 PRINT,"Minimum",XMIN 2135 IF P9 THEN LPRINT,"Minimum",XMIN 2140 PRINT,"Maximum",XMAX 2145 IF P9 THEN LPRINT,"Maximum",XMAX 2150 PRINT,"Range",XMAX-XMIN 2155 IF P9 THEN LPRINT,"Range",XMAX-XMIN 2160 PRINT,"Sum",UX 2165 IF P9 THEN LPRINT,"Sum",UX 2170 PRINT,"Mean",WX 2175 IF P9 THEN LPRINT,"Mean",WX 2180 PRINT,"Standard Dev.",ZSD 2185 IF P9 THEN LPRINT,"Standard Dev.",ZSD 2190 PRINT,"Standard Err.",ZSE 2195 IF P9 THEN LPRINT,"Standard Err.",ZSE 2197 IF P9 THEN LPRINT FF$; 2200 PRINT:INPUT"Hit return to return to editor. ",A$ 2210 ' FINISH 2220 PRINT:PRINT"Re-loading DEDIT program. 2230 CHAIN DD$(1)+"DEDIT",1000 2240 ' (SUB) PARSE STRING 2250 K=0 2260 M=INSTR(T$,CHR$(126)) ' delimiter 2270 IF M=0 THEN RETURN 2280 K=K+1 2290 B$(K)="" 2300 B$(K)=MID$(T$,1,M-1) 2310 T$=MID$(T$,M+1) 2320 GOTO 2260 2330 ' GENERAL ERROR ROUTINES 2340 IF ERR=11 THEN RESUME 2350 ELSE 2360 2350 PRINT:PRINT"Division by zero error in line"ERL:GOTO 2210 2360 ON ERROR GOTO 0 2370 ' (SUB) EXIT TEST (TERM DEP) 2380 X$=INKEY$:IF X$=CHR$(27) THEN 2210 2390 RETURN 2400 ' (SUB) CLEAR SCREEN (TERM DEP) 2410 PRINT CHR$(12); 2420 RETURN 2430 ' (SUB) GET RECORD "I" IN T$ 2440 T$="" ' necessary! 2450 ON FT GOTO 2480,2460 2460 GET#1,FT*I+2 ' latter half 2470 T$=LEFT$(R$,127) 2480 GET#1,FT*I+1 ' whole or first half 2490 T$=R$+T$ 2500 RETURN 2510 ' (SUB) SHOW FIELDS 2515 PRINT 2520 FOR J=1 TO NC 2525 X$=RIGHT$(N$(J),1):IF X$<>"n" THEN 2550 2530 PRINT TAB(29); 2540 PRINT USING"##";J;:PRINT". "LEFT$(N$(J),4)" "RIGHT$(N$(J),1) 2550 NEXT:PRINT 2560 RETURN  2550 2530 PRINT TAB(29); 2540 PRINT USING"##";J;:PRINT". "LEFT$(N$(J),4)" "RIGHT$(N$(J),1)a "This program must be entered from DEDIT.":a   :csb: );"DUNFLAG March 11, 1984";hA$$():A(A$): A : i  A$: A A Az @i  Ar IIPREV:  : rfi  An   :  : n or loopi "Enter number of desired record: ";I: i  : exiti: DO IT i"TEST(B$(F),FLAG$)i, TEST 6 : j6B$(F)(B$(F),TEST)(B$(F),TESTL)Lj@: ASSEM CHANGED REC STR & PUT TO DISKVjJT$""ejT J NC}j^ T$T$B$(J)(~)jhjr . :"*";: t :"!"j  : check exitj I : END OF RECORD WORK LOOPj: FINISH k::  )"Re-loading DEDIT.-k DD$()"DEDIT",Pk: (SUB) PARSE STRING XkKykM(T$,(~)) : delimiterk M kKKk&B$(K)""k0B$(K)(T$,,M)k:T$(T$,M)kD k: (SUB) EXIT TEST (TERM DEP) lX$l X$"" A(X$)Pl A :  :use ESC to escape listingVll : (SUB) CLEAR SCREEN (TERM DEP) l ( );l l: (SUB) GET RECORD "I" IN T$ lT$"" : necessary!l FT , m #,FTI : latter halfm T$(R$,)Gm #,FTI : whole or first halfUm T$R$T$[m{m: SHOW FIELDS (SUB) m K NCm );m "##";K;:". "(N$(K),)" "(N$(K),)m m$ m. : PUT T$ AS RECORD I (SUB) n8 FT V ,B 0nB R$(T$,) :latter half@nL #,FTISnV R$(T$,)cn` #,FTIinj nt : PUT T$ AS DUPE REC I (SUB) n~ FT  , n S$(T$,)n #,FTIn S$(T$,)n #,FTIn  PUT T$ AS DUPE REC I (SUB) n~ FT  , n S$.. --------------------------------------------------------------------- .. FIELD ________ (put name here for clarity) .. The FIELD NAME MODE may be 0, 1 or 2. 0 means no field name, 1 means .. the 4-char. default name, and 2 indicates a name will be entered .. FM(): LFM(): 1 2 .. F2$(): Screen field name (whole line - used in mode 2 only). .. LF2$(): Printer field name (whole line - used in mode 2 only). - .. NLL(): Field name loc. ln. LNLL(): Field name location line 0 0 .. NLC(): Name location col. LNLC(): Field name location column 0 0 .. The number of CR/LF's after the field name: .. FMB(): LFMB(): 0 0 .. The location line to print the field data: .. DLL(): LDLL(): 0 0 .. The column at which to print the field data: .. DLC(): LDLC(): 8 0 .. If the field is a numeric field and the following lines are not blank, .. the line will be used as a PRINT USING string. .. PU$(): Numeric PRINT USING string for screen. .. LPU$(): Numeric PRINT USING string for printer. .. Field length: Fields may be truncated to any number of characters to fit .. into the space designed. 0 means that whatever random length the field is .. will be printed in full. -1 means that the field will be skipped (so you .. can show a field on the screen but skip it on the printer). Any other .. number will truncate the field above that maximum number of characters. .. FL(): LFL(): 0 0 .. Number of CR/LF's after this field (use 1 at end of line if necess.) .. FB(): LFB(): 1 0 .. (end field) .. FORMFORM.DWS January 15, 1984 .op .mt 0 .hm 0 .fm 0 .mb 0 .po 0 .. DIMS has a built-in facility for designing a form for the display and .. printing of a file. To make DIMS use your form design, you must create .. a format control file with all the detailed specifications in it. There .. are two ways to make this ".DFO" file. One is to use the transient com- .. mand "cform" which can type a form for you to fill out and then accept the .. specifications. Another way is to use that form but skip entering the .. data and instead edit this file with WordStar, changing the numbers to .. fit your design. Once a ".DFO" file has been created, you can switch .. the dislay to that form by typing "format " as a DEDIT command. .. DEDIT will respond with "Format loaded." .. .. To make a format control file for the DIMS file , start Word- .. Star, select the N mode and make your file name .DWS. As soon .. as you're in the file, do ^KR, and give the name FORMFORM.DWS. This will .. read in this file into your workfile. This file contains all the .. values which produce the default format (format 0). You will want to .. edit these values to design your forms. You may then delete these instruc- .. tions to save space, but the single "." commands at the top are essential. .. .. A single format specification controls both screen display and the form .. on the printer. These forms may be the same or as different as you .. like. Only the sequence of fields must be the same for both. Note in .. the form below that many items have two values on the line. The second .. value is for the printer. The DEDIT variable names into which the .. the parameters are read are given for debugging. THE LINES WITH NO DOTS .. BECOME THE FORM CONTROL FILE, THEY MUST KEEP EXACTLY THE SAME NUMBER OF .. LINES AND THE SAME NUMBER ITEMS IN EACH LINE. .. .. After you have made all the changes you need, save and print it to a .. disk file .DFO, which will make all the .. lines disappear. .. Then edit the .DFO file in N mode and delete the extra blank lines .. which appear at the end. Try out the format on the DIMS file. To make .. corrections edit .DWS again, and "re-assemble" the .DFO file by .. printing to disk again. .. .. Words and numbers will be read as data input items by a Basic INPUT# .. statement. Therefore there must be the expected number of words on .. each line, or everything after the error will be loaded into DEDIT .. wrong, and you will get the message "Error in loading format." and/or .. DEDIT will crash. Some of the items (i.e. headings) are input by DEDIT .. as whole lines with LINE INPUT#, and these can have commas or anything .. you want. .. .. Code begins here. Don't delete any lines with no dots! ..-------------------------------------------------------------------------- .. FO$ Name of this format DEFAULT .. FFD$ Who wrote it, date of last update Dan Dugan 1/15/84 ..-------------------------------------------------------------------------- .. PARAMETERS FOR THE WHOLE SCREEN AND PAGE .. .. TM: Top margin lines LTM: Top margin lines (printer) 0 4 .. (not used for screen) LLM: Left margin 0 3 .. SW: Screen width LW: Printing width 80 95 .. .. The following parameters, if not 0, will position a form on the screen .. and not use scrolling. This type of form may have bugs in DEDIT. .. RS: Records/screen RP: Records/page 0 0 .. .. If the printer is at or past the conditional page line, it will ad- .. vance to the next page. Set to the number of lines on the page minus .. the top plus bottom margins, minus the normal number of lines used by .. a record. This deals with the fact that extra-long data items in for- .. mats that don't limit the length of the field may overflow into extra .. lines on the printer. Dims keeps track of this. .. (not used for screen) LLP: Conditional page line 0 52 .. .. These parameters apply to printers with variable character and line .. spacing, DEDIT is set up for Diablo 1610/1620. .. HMI: 120th of an inch per character (use 10 for 12 per inch) 10 .. VMI: 48ths of an inch per line (use 8 for 6 per inch) 8 .. FSC$: Reserved for future enhancement. 0 .. .. The next three lines are heading lines for the screen display. They .. will be printed only if something is entered on the line. You must .. keep three lines here whether you enter anything on them or not. .. HL1$: If this line ends on a space, "PAGE" and the page number will .. be added automatically. .. HL2$: .. HL3$: .. .. The next three lines are heading lines for each printed page. Same .. as above. .. LHL1$: If this line ends on a space, the page number will print after. .. LHL2$: .. LHL3$: .. .. HB: Blank lines after head. LHB: Blank lines after heading. 0 1 ..-------------------------------------------------------------------------- .. PARAMETERS FOR EACH RECORD OF THE FILE .. .. The record number mode can be 0 (don't show number) or 1 (on). .. RM: LRM: 1 1 .. .. Location line parameters are used for forms which don't scroll. They .. display fields at fixed positions on the screen or page. Make all .. location line parameters 0 in a scrolling format. The top line of the .. screen is line 1. The first location line parameter is the line to print .. the record number on: .. RLL: LRLL: 0 0 .. .. Location column parameters position the printhead or cursor. If there .. is no CR/LF after the previous item and the location column is 0, the .. item will be printed after the previous item, wherever that may have .. left the printhead. To print "Lastname, Firstname" define the field .. name for the Firstname field as ", ". Use Column 1 to position at the .. left margin; 0 means put it wherever it is. .. .. Record number location column: .. RLC: LRLC: 0 0 .. The number of CR/LF's after the record number: .. RNB: LRNB: 1 0 .. .. The following sequence of numbers determines the order in which the .. fields of the file will be printed, on both the screen and the prin- .. ter. MAKE IT THE NUMBERS AND ORDER YOU WANT. THERE MUST BE A ZERO .. TO TERMINATE THE SEQUENCE. .. SQ(): 1 2 3 4 5 6 7 8 0 .. .. Number of CR/LF's or blank lines after the whole record: .. EB: LEB: 0 1 .. .. PARAMETERS FOR EACH FIELD IN RECORD. USE ^KR TO READ IN "FIELDFOR.DWS" .. AS MANY TIMES AS THERE ARE FIELDS TO BE SHOWN IN THE FORMAT. .. FIELDS ARE DESCRIBED IN THE ORDER THAT THEY APPEAR IN THE FORMAT. LNAM,a~FNAM,a~TITL,a~ORG ,a~ADDR,a~C-ST,a~ZIP ,n~PHON,a~CODE,a~NOTE,a~stop0~ 1~ Dugan~Dan~Proprietor~Dan Dugan Sound Design~290 Napoleon Street, Studio E~San Francisco, California~94124~(415) 821-9776~~DIMS~ LNAM,a~FNAM,a~TITL,a~ORG ,a~ADDR,a~C-ST,a~ZIP ,n~PHON,a~CODE,a~NOTE,a~stop0~ 1~ Dugan~Dan~Proprietor~Dan Dugan Sound Design~290 Napoleon Street, Studio E~San Francisco, California~94124~(415) 821-9776~~DIMS~ LNAM,a~FNAM,a~N2 ,a~ADDR,a~C-ST,a~ZIP ,n~PHON,a~ST ,a~BLK ,a~o/v ,a~MEMB,a~CODE,a~NOTE,a~stop0~ 1~ Dugan~Dan~~290 Napoleon St., Studio E~San Francisco, CA~94124~821-9776~nap~2~v~79-83~mdto1n1f2~treas. 80,81, president 82, 83~ LNAM,a~FNAM,a~N2 ,a~ADDR,a~C-ST,a~ZIP ,n~PHON,a~ST ,a~BLK ,a~o/v ,a~MEMB,a~CODE,a~NOTE,a~stop0~ 1~ Dugan~Dan~~290 Napoleon St., Studio E~San Francisco, CA~94124~821-9776~nap~2~v~79-83~mdto1n1f2~treas. 80,81, president 82, 83~ MEMBERS Dan 11/14/80 0 4 0 6 79 90 0 0 0 60 10 8 0 DUBOCE TRIANGLE NEIGHBORHOOD ASSOCIATION 0 2 1 1 0 0 0 0 1 0 1 2 3 4 5 6 7 11 12 0 0 0 1 0 0 0 0 0 0 0 0 0 8 6 0 0 1 0 1 2 , 0 0 0 0 0 0 0 0 8 0 0 0 1 0 1 2 0 0 0 0 0 0 0 0 8 0 0 0 1 0 1 0 0 0 0 0 0 0 0 0 8 35 0 20 1 0 1 0 0 0 0 0 0 0 0 0 8 56 0 6 1 0 1 0 0 0 0 0 0 0 0 0 8 63 0 5 1 0 1 0 0 0 0 0 0 0 0 0 8 69 0 0 1 1 1 0 0 0 0 0 0 0 0 0 8 15 0 0 1 0 1 2 0 0 0 0 0 0 0 0 8 0 0 0 1 1  .op .he Duboce Triangle Neighborhood Association page # .po 13 ..adj margin .. ----!----!----!---------------!-------------------------------------------- DUBOCE TRIANGLE NEIGHBORHOOD ASSOCIATION Notes on file format and codes, February 9, 1981 ST field: Enter only these standard abbreviations: dub, 14, hen, 15, bea, 16, cas, noe, wal, san, bel, chu; FOR OUT-OF-TRIANGLE addresses, enter "[" plus 3 lets. of st. FOR OUT-OF-TOWN addresses, enter "[[" (These codes cause these addresses to be sorted to the end) BLK field: Enter the number of hundreds or 0 for the first block. Example: for 833, enter 8. For 83, enter 0. o/v field: Enter only "o" for the odd side of the street, "e" for even. MEMB field: Enter each year as dues are paid, example "7980." Enter "*" to show year of new member, "-" for inclusive range, example: "*8081" means new in 80, paid in 81 also. "79-81" means 79 thru 81. CODE field: b = business b1 = donated goods or services to street fair b2 = donated cash to street fair d = member dues class d2 = $2 or granted d5 = $5 d10 = $10 d25 = $25 or more (don't use in-between figures in these codes) m = mail newsletter n = newsletter volunteer n0 = distributor, see details in N2 field n1 = news production n2 = ad sales person o = officers o0 = emeritus o1 = officer o2 = board member o3 = activist o9 = burnout, emergency only f = street fair f0 = organizer f1 = food f2 = stage f3 = donor of $ v = volunteer (other than distribution or fair) v0 = phone c = contact; where we got the name into the list c0 = regular meeting sign-in c1 = safety meeting sign-in c2 = earthquake meeting sign-in Sort keys for block/side canvassing order listing: 8, ST (3), 9, BLK (2), 10, o/v (1), 4, ADDR (6). SHORT Dan, 7-4-80 0 3 0 6 79 255 0 0 0 60 10 8 0 NUMB NAME COMPANY ADDRESS CITY ZIP PHONE 0 2 1 1 0 0 1 1 0 0 1 2 3 4 5 6 7 8 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 7 7 33 0 0 0 0 2 0 0 0 0 0 0 0 0 0 40 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 20 35 0 20 1 0 0 0 0 0 0 0 0 0 0 0 0 0 20 56 41 6 0 0 2 0 ZIP: 0 0 0 60 0 0 0 0 0 66 63 0 5 1 0 0 0 0 0 0 0 0 0 0 0 0 0 25 69 0 0 1 1 2 0 CODE: 0 0 0 30 0 0 0 0 0 37 0 0 -1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 30 0 0 -1 1 0  0 0 0 0MAILING Dan 2/10/81 0 4 0 13 79 95 0 0 0 58 10 8 0 HEARTS OF SPACE MAILING LIST 0 2 1 1 0 0 0 0 1 0 1 6 2 7 3 4 5 0 0 1 0 0 0 0 0 0 0 0 0 0 1 6 39 39 0 0 0 0 0 0 0 0 0 0 0 0 45 50 0 0 1 1 0 0 0 0 0 0 0 0 0 0 1 6 39 39 0 0 0 0 0 0 0 0 0 0 0 0 45 50 0 0 1 1 0 0 0 0 0 0 0 0 0 0 1 6 39 39 1 1 0 0 0 0 0 0 0 0 0 0 1 6 0 0 0 0 2 2 0 0 0 0 0 0 0 0 0 0 ##### ##### 0 0 1 1 0 0 NAME,a~N2 ,a~ADDR,a~C-ST,a~ZIP ,n~PHON,a~CODE,a~NOTE,a~stop0~ 1~ Dan Dugan~Dan Dugan Sound Design~290 Napoleon St., Studio E~San Francisco, CA~94124~(415) 821-9776~~DIMS~ NAME,a~N2 ,a~ADDR,a~C-ST,a~ZIP ,n~PHON,a~CODE,a~NOTE,a~stop0~ 1~ Dan Dugan~Dan Dugan Sound Design~290 Napoleon St., Studio E~San Francisco, CA~94124~(415) 821-9776~~DIMS~ LNAM,a~FNAM,a~N2 ,a~ADDR,a~C-ST,a~ZIP ,n~PHON,a~CODE,a~NOTE,a~stop0~ 1~ Dugan~Dan~Dan Dugan Sound Design~290 Napoleon St., Studio E~San Francisco, CA~94124~(415) 821-9776~~DIMS~ Fudd~Elmer~Fudd International~833 14th Street~San Francisco, CA~94114~(415) 621-0781~~DIMS~ LNAM,a~FNAM,a~N2 ,a~ADDR,a~C-ST,a~ZIP ,n~PHON,a~CODE,a~NOTE,a~stop0~ 1~ Dugan~Dan~Dan Dugan Sound Design~290 Napoleon St., Studio E~San Francisco, CA~94124~(415) 821-9776~~DIMS~ Fudd~Elmer~Fudd International~833 14th Street~San Francisco, CA~94114~(415) 621-0781~~DIMS~ STANDADD for standard address file: LNAM, FNAM, N2, ADDR, C-ST, ZIP, PHON, CODE, NOTE - Dan 9/23/82 0 2 0 13 80 84 0 0 0 54 10 8 0 0 1 1 1 0 0 0 0 0 0 1 2 3 4 7 5 6 8 9 0 0 0 0 0 0 0 0 0 0 0 0 0 6 6 0 0 0 0 2 2 , , 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 54 50 0 0 1 1 0 0 0 0 0 0 0 0 0 0 11 11 0 0 0 0 0 0 0 0 0 0 0 0 0 0 59 55 0 0 1 1 0 0 0 0 0 0 0 0 0 0 11 11 0 0 0 0 2 2 ZIP: 0 0 64 0 0 0 0 0 0 0 ##### ##### 0 0 1 1 0 0 0 0 0 0 0 0 0 0 16 16 0 0 0 0 2 2 , , 0 0 0 0 0 0 0 0 0 0 0 0 1 1 10 PRINT"STRIP - March 20, 1982 20 DEFINT A-Z 30 PRINT:INPUT"Enter name of the 'source file': ",F$ 40 X$=F$:GOSUB 350:F$=Y$ 50 PRINT:INPUT"Enter name of the 'destination file': ",F2$ 55 PRINT:PRINT 60 X$=F2$:GOSUB 350:F2$=Y$ 70 ' OPEN FILE AND TEST TO BE SURE IT'S ASCII 80 OPEN"I",1,F$ 90 LINE INPUT#1,L$ 100 IF ASC(LEFT$(L$,1))=255 THEN 110 ELSE 140 110 PRINT"Program is saved in binary form. Load it and save it with 120 PRINT"the 'A' option, then run STRIP again. 130 PRINT:PRINT:END 140 ' START STRIPPING If an apostrophe is found, the rest of the line is cut off, except inside a quoted string. 150 OPEN"O",2,F2$ 160 LENGTH=LEN(L$):QUOTE=0 170 ' CRANK THRU THE LINE CHAR BY CHAR 180 FOR J=1 TO LENGTH 190 A$=MID$(L$,J,1) 200 IF A$=CHR$(34) THEN 210 ELSE 230 210 IF QUOTE=0 THEN QUOTE=1:GOTO 240 220 IF QUOTE=1 THEN QUOTE=0:GOTO 240 230 IF QUOTE=0 AND A$="'" THEN 320 240 NEXT 250 ' PRINT THE LINE 260 PRINT#2,L$ 270 PRINT L$ 280 ' GET THE NEXT LINE 290 IF EOF(1) THEN 292 ELSE 300 292 CLOSE 294 PRINT:PRINT"All done.":PRINT:END 300 LINE INPUT#1, L$ 310 GOTO 160 320 ' TRUNCATE LINE 330 L$=LEFT$(L$,J) 340 GOTO 250 350 ' (SUB) UCV 360 Y$="" 370 FOR K=1 TO LEN(X$) 380 Y$=Y$+" " 390 X=ASC(MID$(X$,K,1)) 400 IF 96