IMD 1.16: 31/05/2007 20:08:40 FOGCPM.119 ååååååååååååååå--FOGCPM119DCFORM ASCF DCHESHIRASCE DCREATE ASCDEDIT ASC€ !"#$%&'(DEDIT ASCL)*+,-./012-07-00 86 ­DGET ASC$34567DGET BAS/89:;<=DIMS ASCM>?@ABCDEFGDLABELS ASC,HIJKLMDLETTERSASC/NOPQRSDNADIN ASCTUVWDPUT ASC"XYZ[\DSORT ASCj]^_`abcdefghijDSTAT ASC9klmnopqrDUNFLAG BAS!stuvwSTRIP ASC xyREAD-ME 103(z{|}~DINSTALLDOC€€�‚ƒ„…†‡ˆ‰Š‹Œ�ŽDINSTALLDOC€��‘’“”•–—˜™š›œ�žDINSTALLDOClŸ ¡¢£¤¥¦§¨©ª«¬-CPM119 DOC®¯°åååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååThis is the disk name. åååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååå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 962 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 26010 ' ******************************** 20 ' * NOTICE * 30 ' * COPYRIGHT (c) 1983 DAN DUGAN * 40 ' ******************************** 50 ' STANDALONE ENTRY 60 PRINT:PRINT "CHESHIR 1.03 November 2, 1983 70 PRINT:PRINT "This program prints 4-up Cheshire labels from a sequential data file. 80 PRINT 90 DEFINT A-Z 100 WIDTH LPRINT 255 105 I=0 110 ' OPEN SOURCE FILE 120 PRINT:INPUT"Name of source file";X$ 130 IF X$="" THEN STOP 140 GOSUB 2430:F2$=Y$ 'ucv 150 IF MID$(F2$,2,1)=":" THEN 170 160 F2$=DD$(5)+F2$ 170 ' TEST FOR EXISTENCE 180 ON ERROR GOTO 210 190 OPEN"I",3,F2$ 200 ON ERROR GOTO 0:GOTO 260 'ok 210 ' LOCAL ERROR TRAP 220 CLOSE 3 230 IF ERR=53 THEN CLOSE 3:PRINT"File not found":RESUME 110 240 IF ERR=64 THEN PRINT"Bad file name, try again.":RESUME 110 250 ON ERROR GOTO 0 260 ' SHOW AND ASK 270 PRINT:PRINT"Here's the first line of "F2$". 280 LINE INPUT#3,T$ 290 PRINT:PRINT T$ 300 CLOSE 3:OPEN"I",3,F2$ 310 PRINT: INPUT"Please enter the total number of fields in the source file: ",NC 320 IF NC=0 THEN CLOSE:STOP 330 DIM B$(NC),L$(4,NC) 340 DIMS=0 'switch for sequential file 350 GOTO 1090 1000 ' DIMS ENTRY 1010 GOSUB 2130 'cs 1020 PRINT:PRINT TAB(16);"CHESHIRE 1.03 October 26, 1983 1030 PRINT"Prints Cheshire labels 4-up 1040 ' by Dan Dugan -- public domain 1050 PRINT 1060 DEFINT A-Z 1070 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$ 1080 DIMS=1 'switch for dims data file 1090 ' INITIALIZATION FOR BOTH MODES 1100 DIM COLPOS(4) 1110 ' COLUMN PRINT POSITIONS 1120 COLPOS(1)=2:COLPOS(2)=43:COLPOS(3)=84:COLPOS(4)=124 1130 ' MAXIMUM FIELD LENGTH 1140 MAXLEN=34 1145 DONE=0 'EOF flag 1150 ' SET-UP LABELS 1160 PRINT:PRINT"Please indicate the form that this list is in: 1170 PRINT:PRINT" 1. Short form, (NAME, N2, ADDR, C-ST, ZIP) 1180 PRINT" 2. Medium form, (LNAM, FNAM, N2, ADDR, C-ST, ZIP) 1190 PRINT" 3. Long form, (LNAM, FNAM, TITL, ORG, ADDR etc.) 1200 PRINT:PRINT"Enter 1, 2 or 3: "; 1210 A$=INPUT$(1): IF A$=CHR$(13) THEN A$="1" 1220 PRINT A$: A=VAL(A$): IF A=0 THEN 1950 1230 IF A<1 OR A>3 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 ' Dast field 2760 Y=INSTR(T$,CHR$(34)) 'quote 2770 IF Y=0 OR ( Y<>0 AND X2 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 96"" THEN PRINT CHR$(7); 1180 PRINT CHR$(13); 1190 IF RS THEN X=24:Y=1:GOSUB 6700 1200 PRINT SPC(79); CHR$(13); 1210 PRINT E$" ";:E$="":PRINT"Edit ";F$;": "; 1212 IF RS THEN LINE INPUT;A$: GOTO 1220 1214 LINE INPUT A$ 1220 IF A$="" THEN 1210 1230 ' PARSE COMMAND 1240 A$=A$+" " 1250 J=0 1260 K=INSTR(A$,CHR$(32)) 1265 IF J=10 THEN 1320 1270 J=J+1 1280 IF K=0 THEN 1320 1290 C$(J)=MID$(A$,1,K-1) 1300 A$=MID$(A$,K+1) 1310 GOTO 1260 1320 C$(J)=CHR$(13) 1330 ' 1340 IF LEFT$(C$(1),3)="rep" THEN J=2: GOSUB 1790: GOTO 2580 1345 ' DEFAULTS 1350 A=0:T=2:T1=1:T2=0:C1=0:SEARCH=0:SKIPPARSE=0:P6=0:P7=0:P9=0:PG=1:LPG=1: FLAG=0:FLAG$="" 1360 ' PROCESS WORD MATRIX 1370 J=0 1380 ' LOOP TO HERE TO CHECK NEXT WORD 1390 J=J+1 1400 GOSUB 1790 ' range 1410 IF C$(J)=CHR$(13) THEN 2580 ' do it 1420 C1$=LEFT$(C$(J),3) 1430 ' FINAL COMMANDS 1440 IF C1$="add" THEN T=1: GOTO 2580 1450 IF C1$="fie" THEN GOSUB 2060:GOTO 1120 1460 IF C1$="ins" THEN T=4: GOTO 1390 ' unfinished 1470 IF C1$="don" THEN T=9: GOTO 2580 1490 IF C1$="ren" THEN T=12: GOTO 2580 ' renumber 1500 IF C1$="for" THEN 2170 1505 IF C1$="bac" THEN T=11:GOTO 2580 1506 IF C1$="pro" THEN 8620 1507 IF C1$="got" THEN T=7:B$(0)=C$(J+1):GOTO 2580 'goto 1510 ' RECIRCULATING COMMANDS 1514 IF C1$="cha" THEN T=3:GOTO 1390 1515 IF C1$="del" THEN T=10:GOTO 1390 1520 IF C1$="lis" THEN T=2:GOTO 1390 1530 IF C1$="fin" THEN 1532 ELSE 1540 1532 J=J+1:SEARCH=2:SKIPPARSE=1 1534 X=INSTR(C$(J),CHR$(95)):IF X THEN Y=LEN(C$(J)):GOTO 1535 ELSE 1538 1535 C$(J)=LEFT$(C$(J),X-1)+" "+RIGHT$(C$(J),Y-X) 1536 GOTO 1534 1538 SEARCHWORD$(0)=C$(J):GOTO 1390 1540 IF C1$="sel" THEN SEARCH=1:GOTO 1390 1550 IF C1$="pri" THEN P9=1:GOTO 1390 1560 IF C1$="cop" THEN P7=1:GOTO 1390 'dims out 1570 IF C1$="wri" THEN P6=1:GOTO 1390 ' not implem. 1580 IF C1$="and" THEN GOTO 1390 1590 IF C1$="pag" THEN PG=VAL(C$(J+1)):LPG=PG: J=J+1: GOTO 1390 1600 IF C1$="mar" THEN LLM=VAL(C$(J+1)): J=J+1: GOTO 1390 1610 IF C1$="fla" THEN GOSUB 8550:GOTO 1390 1620 ' TRANSIENT COMMANDS 1630 X$=C$(J): GOSUB 7070: C$(J)=Y$ ' UCV 1640 ON ERROR GOTO 1740 1650 ' open this way to test 1660 OPEN"I",3,DD$(2)+"D"+C$(J)+".BAS" 1670 ' if it's there, close it and chain 1680 CLOSE 3: T$=C$(J):J=J+1 1690 ' GO CHAIN 1700 GOSUB 1790 1705 IF T2=0 THEN T2=N 1710 IF P9 THEN GOSUB 7160 1720 IF SEARCH=1 THEN GOSUB 7460 1725 PRINT:PRINT TAB(19);"Please wait while transient program loads. 1730 CHAIN DD$(2)+"D"+T$,1000 1740 ' NO CHAIN 1750 IF ERR=53 OR ERR=64 THEN 1770 1760 ON ERROR GOTO 0 1770 CLOSE 3: ON ERROR GOTO 7000: E$=C$(J)+"?": RESUME 1140 1780 ' (SUB) GET RANGE 1790 ' TEST WORD 1800 IF C1 THEN RETURN ' range done flag 1810 C3=VAL(C$(J)) 1820 IF C3>0 THEN 1830 ELSE 1850 1830 IF C3>N THEN C3=N 1840 T1=C3: GOTO 1910 1850 IF C$(J)="from" THEN J=J+1: T2=N:GOTO 1790 1860 IF C$(J)="all" THEN T1=1: T2=N: GOTO 2050 1870 IF C$(J)="."THEN T1=T0: GOTO 1910 1880 IF C$(J)="next"THEN T1=T0+1: GOTO 1910 1890 IF C$(J)="to" THEN GOTO 1910 1900 RETURN 1910 ' LOOK FOR 2nd # 1920 J=J+1:IF C$(J)=CHR$(13) THEN 2030 1930 C3=VAL(C$(J)) 1940 IF C3>0 THEN 1950 ELSE 1980 1950 IF C3>N THEN C3=N 1960 T2=C3: IF T1>T2 THEN SWAP T1,T2 1970 GOTO 2050 1980 IF C$(J)="to" THEN 1920 1990 IF C$(J)="." THEN T2=T0: GOTO 2050 2000 IF C$(J)="next" THEN T2=T0+1: GOTO 2050 2010 IF C$(J)="end" THEN T2=N: GOTO 2050 2020 IF C$(J)="last" THEN T2=N:GOTO 2050 2030 IF T2=0 THEN T2=T1:C1=1 ' if only one number 2040 RETURN 2050 J=J+1:C1=1:RETURN 2060 ' (SUB) HIDE FIELDS 2070 PRINT TAB(24)"Here are the fields in "F$:PRINT 2075 FOR I=1 TO NC:C(I)=1:NEXT ' set all to show 2080 GOSUB 7800 2110 FOR I=1 TO NC 2120 PRINT TAB(27)"Show "LEFT$(N$(I),4)"? (y/n) "; 2130 A$=INPUT$(1):IF A$=CHR$(13) THEN A$="y" 2140 PRINT A$:IF A$="n" THEN C(I)=0 2150 NEXT 2160 RETURN 2170 ' FORMAT COMMAND 2190 IF C$(J+1)="0" THEN 2290 2200 IF C$(J+1)=CHR$(13) THEN 2202 ELSE 2210 2202 ' SHOW AVAILABLE FORMATS 2203 PRINT:PRINT"Here are the  available formats:":PRINT 2204 WIDTH 70:FILES DD$(5)+"*.DFO":WIDTH 255:PRINT:PRINT 2205 INPUT"Enter the desired format name or just RETURN: ",X$ 2206 IF X$="" THEN 2290 ELSE GOSUB 7070:GOTO 2220 2210 J=J+1:X$=C$(J):GOSUB 7070 'UCV 2220 FO$=Y$ 2230 ON ERROR GOTO 2260 2240 OPEN"I",3,DD$(5)+FO$+".DFO" 2250 ON ERROR GOTO 7000:GOTO 2330 ' do this if OK 2260 IF ERR=64 OR ERR=53 THEN 2280 2270 ON ERROR GOTO 0 2280 ON ERROR GOTO 7000:E$="Format "+FO$+" not available on this disk.": CLOSE 3:RESUME 1140 2290 ' LOAD FORMAT 0 2300 FO$="0" 2310 GOSUB 7870 'do it 2320 GOTO 1120 2330 ' LOAD FORMAT FILE 2335 ON ERROR GOTO 2572 2340 INPUT#3,FO$ ' filename 2350 LINE INPUT #3,A$ 'dummy for date$ 2360 INPUT#3,TM,LTM,LM,LLM,SW,LW,RS,RP,LS,LLP,HMI,VMI 2370 LINE INPUT#3,A$ 'dummy for FSC$ not implemented yet 2380 LINE INPUT#3,HL1$:LINE INPUT#3,HL2$:LINE INPUT #3,HL3$ 2390 LINE INPUT#3,LHL1$:LINE INPUT#3,LHL2$:LINE INPUT#3,LHL3$ 2400 INPUT#3,HB,LHB,RM,LRM,RLL,LRLL,RLC,LRLC,RNB,LRNB 2410 I=0  2420 I=I+1:IF I>NC+1 THEN 2440 2425 INPUT#3,SQ(I):IF SQ(I)=0 THEN 2440 2427 IF SQ(I)>NC THEN SQ(I)=NC 'limiter 2430 GOTO 2420 2440 INPUT#3,EB,LEB 2450 FOR J=1 TO NC 2460 IF EOF(3) THEN 2570 2470 K=SQ(J) 2480 INPUT#3,FM(K),LFM(K) 2490 LINE INPUT#3,F2$(K):LINE INPUT#3,LF2$(K) 2500 INPUT#3,NLL(K),LNLL(K),NLC(K),LNLC(K),FMB(K),LFMB(K) 2510 INPUT#3,DLL(K),LDLL(K),DLC(K),LDLC(K) 2520 LINE INPUT#3,PU$(K):LINE INPUT#3,LPU$(K) 2530 INPUT #3,FL(K),LFL(K),FB(K),LFB(K) 2540 X=LEN(PU$(K)):IF X THEN FL(K)=X 2550 NEXT 2555 ON ERROR GOTO 7000 2570 CLOSE 3:E$="Format "+FO$+" loaded.":GOTO 1140 2572 ON ERROR GOTO 7000:RESUME 2575 2575 CLOSE 3:E$="Error in loading format.":GOTO 1140 2580 ' EXECUTIVE BRANCH 2590 ' JUNK TRAP 2600 IF P9 AND T=1 THEN E$="Not allowed, try again.":GOTO 1140 2610 IF T2=0 THEN T2=N ' fix 2620 IF N=0 AND NOT (T=1 OR T=9) THEN E$="File is empty.": GOTO 1140 2630 ' SET-UPS 2640 IF P9 THEN GOSUB 7160 2650 IF P7 THEN GOSUB 8020 2660 IF E$<>"" THEN GOTO 1140 2670 IF SEARCH=1 THEN GOSUB 7460 2690 ' 1 2 3 4 5 6 7 8 9 10 11 12 2700 ON T GOTO 2730,2900,2770,1120,1120,1120,2720,1120,2720,2900,2720,2720 2710 GOTO 1120 ' junk trap 2720 ' EXIT TO DIMS 2725 PRINT:PRINT TAB(27)"Waiting while loading DIMS.":CHAIN DD$(1)+"DIMS",1000 2730 ' ADD COMMAND 2740 N1=0 ' start 2750 I=N+1 2760 GOTO 4000 2770 ' SET-UP CHANGE 2780 IF T1=T2 THEN 2810 2790 PRINT:PRINT TAB(20);"Select fields to change? (n/y) ";: A$=INPUT$(1):IF A$=CHR$(13) THEN A$="n" 2800 PRINT A$: IF A$="y" THEN 2830 2810 FOR I=1 TO NC: IF C(I)<>0 THEN C(I)=2 2820 NEXT I: GOTO 2900 ' all 2's 2830 PRINT 2840 FOR I=1 TO NC 2850 IF C(I)=0 THEN 2890 2860 IF C(I)=2 THEN C(I)=1 2870 PRINT TAB(25);"Change "LEFT$(N$(I),4)"? (y/n) ";: A$=INPUT$(1):IF A$=CHR$(13) THEN A$="y" 2880 PRINT A$: IF A$="y" THEN C(I)=2 2890 NEXT I 2900 ' RECORD WORK LOOP 2910 C0=0:RC=0:LRC=0'first time 2930 FOR I=T1 TO T2 ' <-------- FOR 2940 GOSUB 6200 ' get rec 2950 IF ASC(T$)=0 THEN PRINT"0";:GOTO 5770 2960 PRINT"+"; 2970 T1$=T$ ' save it 2980 IF SKIPPARSE THEN 3010 2990 GOSUB 6500 ' parse record string 3000 IF T=0 THEN 4000 3010 IF SEARCH=0 THEN 3310 3020 ' SEARCH 3030 IF SEARCH<>2 THEN 3100 3035 ' FIND 3040 IF INSTR(T1$,SEARCHWORD$(0))=0 THEN 5770 3060 IF P9=0 THEN PRINT CHR$(7); ' found it 3070 GOSUB 6500 ' parse 3080 GOTO 3310 3090 ' LOOK FOR SKIPS 3100 J=0 3110 IF SKIPWORD$(J)="" THEN 3190 ' try search then 3120 IF LOOKFIELD(J) THEN 3160 ' look in field 3130 IF INSTR(T1$,SKIPWORD$(J)) THEN 5770 ' whole rec search 3140 J=J+1 3150 GOTO 3110 3160 IF INSTR(B$(LOOKFIELD(J)),SKIPWORD$(J)) THEN 5770 ' field compare 3165 IF B$(LOOKFIELD(J))="" AND SKIPWORD$(J)="_" THEN 5770 'blank field 3170 J=J+1 3180 GOTO 3110 3185 ' SEARCH 3190 IF SEARCHWORD$(0)="" THEN 3290 ' only when skips are all you want 3200 J=0: GOTO 3220 ' now search 3210 IF SEARCHWORD$(J)="" THEN 5770 ' hesitate no longer 3220 IF SEARCHFIELD(J) THEN 3260 ' field 3230 IF INSTR(T1$,SEARCHWORD$(J)) THEN 3290 ' unparsed search 3240 J=J+1 3250 GOTO 3210 3260 IF INSTR(B$(SEARCHFIELD(J)),SEARCHWORD$(J)) THEN 3290 3265 IF B$(SEARCHFIELD(J))="" AND SEARCHWORD$(J)="_" THEN 3290 3270 J=J+1 3280 GOTO 3210 3290 IF P9=0 THEN PRINT CHR$(7); 'TERM DEP 3300 IF SKIPPARSE THEN GOSUB 6500 ' parse 3310 ' PAUSE 3320 IF C0=0 OR T=3 OR T=10 OR P7 OR P9 THEN 4000 ' when not to pause, C0 is for first time 3330 GOSUB 6100 ' exit 3340 IF A=122 THEN 4000 'z 3350 IF RS THEN IF RC=RS THEN X=24:Y=1:GOSUB 6700 3360 PRINT I"Ready>"; 3370 A$=INPUT$(1):A=ASC(A$) 3372 IF A=27 THEN IF (P6 OR P7) THEN GOSUB 8410:GOTO 1120 ELSE GOTO 1120 3375 PRINT A$:IF A=104 THEN 3400 ELSE 4000 'h 3400 ' PAUSE HELP 3410 PRINT:PRINT TAB(5)"The program is waiting for just one keystroke; 3420 PRINT:PRINT TAB(10)"h will print this message, 3430 PRINT TAB(10)"SPACE will show the next record, 3440 PRINT TAB(10)"z will show the  next record and keep going until you SPACE, 3450 PRINT TAB(10)"ESC will quit the sequence you're in and go to edit command level. 3460 PRINT:GOTO 3330 4000 ' ADD, CHA OR SHOW REC I I=rec #, J=seq #, K=field #, L=rec length C0=not first time, C3=backup flag C(K): 0=skip field, 1=norm, 2=change 4010 T0=I 4020 IF P9 AND T<>10 THEN 5040 4030 ' NEW SCREEN? 4040 C0=1 4050 IF RS=0 OR (RC>0 AND RC"" THEN PRINT HL1$; 4110 IF RIGHT$(HL1$,1)=" " THEN PRINT"PAGE"PG:GOTO 4130 4120 PRINT 4130 IF HL2$<>"" THEN PRINT HL2$ 4140 IF HL3$<>"" THEN PRINT HL3$ 4150 X=HB:GOSUB 6730 4160 ' NEW REC - PRINT #? 4170 L=0:RC=RC+1 4180 IF E$<>"" THEN PRINT CHR$(7);:PRINT:PRINT E$:E$="" 4190 IF RM=0 THEN 4240 4200 PRINT 4210 IF RLL THEN X=RLL:Y=RLC:GOSUB 6700:GOTO 4230 4220 IF RLC THEN PRINT TAB(RLC); 4230 PRINT I;:X=RNB:GOSUB 6730 4240 J=0 4250 ' NEW FIELD 4260 J=J+1:C3=0'backup flag 4270 K=SQ(J) ' current field number (may be in any order) 4280 IF K=0 THEN X=EB:GOSUB 6730:GOTO 5040 ' next function 4290 IF C3=1 AND C(K)=0 THEN 4300 ELSE 4320 ' hidden field 4300 J=J-1:IF J=0 THEN L=0:GOTO 4250 4310 K=SQ(J):L=L-LEN(B$(K))-1:GOTO 4290 4320 IF C(K)=0 OR FL(K)<0 THEN IF T=1 THEN B$(K)="":L=L+1:GOTO 4250 ELSE L=L+LEN(B$(K))+1:GOTO 4250 ' skip fwd 4330 ' RE-ENTER 4340 IF E$<>"" THEN PRINT:PRINT CHR$(7); E$:E$="" 4350 GOSUB 4820 'print name 4360 ' BRANCH 4370 GOSUB 4940 'pos 4380 IF T=3 AND FLAG=K THEN B$(K)=B$(K)+FLAG$ 4390 IF T=1 GOTO 4410 4400 IF T=3 AND C(K)=2 THEN GOSUB 4980:PRINT CHR$(10);:GOSUB 4940 ELSE 4750 4410 ' CURSOR 4420 L1=FT*128-L-NC+J ' L1=avail space in rec 4430 IF FL(K) THEN EFL=FL(K) ELSE EFL=SW-POS(0) ' EFL=avail screen space 4440 IF L1>=EFL THEN 4460 4450 PRINT SPC(L1-1);"<";:GOSUB 4940 ' pos 4460 ' ENTER NEW DATA 4470 IF T=1 AND K=FLAG THEN PRINT FLAG$; 4480 LINE INPUT; T9$:IF T=1 AND FLAG=K THEN T9$=FLAG$+T9$ 4490 ' CONTROL ENTRIES 4500 IF T=3 THEN IF T9$="" OR T9$=";" OR T9$="+" THEN T9$=B$(K):GOTO 4680 ' no cha 4510 IF T=1 AND (T9$=";" OR T9$="+") THEN 4520 ELSE 4540 4520 T9$=B$(K):IF T9$="" THEN T9$=" " 4530 GOSUB 4940:PRINT T9$; 4540 IF T9$="stop" THEN IF T=1 THEN E$=STR$(N1)+" records added.": T0=I-1:GOTO 1140 ELSE 1120 4550 IF RIGHT$(T9$,1)<>CHR$(92) THEN 4590 4560 C3=1:J=J-1:IF J=0 THEN L=0:GOTO 4250 4570 K=SQ(J):L=L-LEN(B$(K))-1:IF FB(K) THEN PRINT 4580 GOTO 4280 4590 IF T9$=" "THEN T9$=""' enter 1 sp to cha to blank 4600 ' STRIP RT. SPC 4610 IF RIGHT$(T9$,1)=CHR$(32) THEN T9$=LEFT$(T9$,LEN(T9$)-1):GOTO 4610 4620 ' NUM CHECK 4630 IF RIGHT$(N$(K),1)<>"n" THEN 4680 4640 FOR I1=1 TO LEN(T9$) 4650 T3=ASC(MID$(T9$,I1,1)) 4660 IF T3<45 OR T3>57 THEN E$="Re-enter; only numbers allowed.": GOTO 4330 4670 NEXT 4680 ' LENGTH CHECK 4690 L=L+LEN(T9$)+1 4700 IF L+NC-J>FT*128 THEN E$="Record too long. Re-enter, shorter.":GOTO 4160 4710 ' SAVE IT 4720 B$(K)=T9$ 4730 ' RE-DISP IN FORM 4740 IF DLL(K) THEN GOSUB 4950:GOTO 4750 ELSE 4770 4750 ' SHOW DATA 4760 GOSUB 4980 ' print dat 4770 ' FINISH FIELD 4780 X=FB(K):GOSUB 6730 4790 GOTO 4250 ' next field 4800 ' SCREEN DONE 4810 GOTO 5040 ' skip subs 4820 ' (SUB) FIELD NAME 4830 IF NLL(K) THEN X=NLL(K):Y=NLC(K):GOSUB 6700:GOTO 4850 4840 IF NLC(K) THEN PRINT TAB(NLC(K)); 4850 ON FM(K) GOTO 4870,4910 ' plain or special 4860 GOTO 4930 'skip if 0 4870 ' NAME MODE 1 4880 IF RIGHT$(N$(K),1)="n" THEN PRINT LEFT$(N$(K),4)" # ";:GOTO 4930 4890 PRINT LEFT$(N$(K),4)" : "; 4900 GOTO 4930 4910 ' NAME MODE 2 4920 PRINT F2$(K); 4930 X=FMB(K):GOSUB 6730:RETURN 4940 ' (SUB) POSITION DATA (TERM DEP -- BACKSPACE) 4950 IF DLL(K) THEN X=DLL(K):Y=DLC(K):GOSUB 6700:GOTO 4970 4960 IF DLC(K) THEN IF POS(I)>DLC(K) THEN PRINT STRING$(POS(I)-DLC(K),8); ELSE PRINT TAB(DLC(K)); 4970 RETURN 4980 ' (SUB) PRINT DATA 4990 IF RIGHT$(N$(K),1)="n" AND PU$(K)<>"&" AND PU$(K)<>"" THEN N1!=VAL(B$(K)):GOTO 5020 5000 IF FL(K) THEN X$=LEFT$(B$(K),FL(K)) ELSE X$=B$(K) 5010 PRINT X$;:GOTO 5030 5020 PRINT USING PU$(K);N1!; 5030 RETURN 5040 ' LPRINT AND WRITE LP=real prnt pos LTM=top marg LPG=pg count RP=rec/pg LRC=rec count LLP=cond. pg LLC=line count 5050 IF T=0 GOTO 5790 5060 IF P9=0 THEN 5580 ' done 5070 ' START PRINTING 5080 IF C0=0 THEN C0=1:LRC=0:LLC=1: IF LPG=1 THEN X=LTM:GOSUB 7310: LPRINT"FILE: "F$ TAB(30)"DATE:"TAB(50)"SELECTION:": LLC=LLC+1:GOTO 5120 ELSE 5120 5090 ' NEW PAGE? 5100 IF (RP AND LRC=RP) OR LLC>LLP THEN GOSUB 7410 ELSE 5190 'FF 5110 ' PRINT HEADING 5120 X=LTM:GOSUB 7310 'CR 5130 IF LHL1$<>"" THEN LPRINT LHL1$; ELSE 5160 5140 IF RIGHT$(LHL1$,1)=CHR$(32) THEN LPRINT"PAGE"LPG:GOTO 5160 5150 LPRINT:LLC=LLC+1 5160 IF LHL2$<>"" THEN LPRINT LHL2$:LLC=LLC+1 5170 IF LHL3$<>"" THEN LPRINT LHL3$:LLC=LLC+1 5180 X=LHB:GOSUB 7310 'CR 5190 ' NEW REC - LPRINT #? 5200 LRC=LRC+1 ' counts recs on p g 5210 IF LRM=0 THEN 5250 5220 IF LRLL THEN X=LRLL:Y=LRLC:GOSUB 7330:GOTO 5240 5230 IF LRLC THEN Y=LRLC:GOSUB 7360 ' tab 5240 C1=LPOS(0):A$=STR$(I):A$=RIGHT$(A$,LEN(A$)-1): LPRINT A$;:LP=LP+LPOS(0)-C1:X=LRNB:GOSUB 7310 ' CR 5250 J=0 5260 ' NEW FIELD 5270 J=J+1 5280 K=SQ(J) 5290 IF K=0 THEN X=LEB:GOSUB 7310:GOTO 5580 ' done ======> 5300 IF (C(K)=0) OR (LFL(K)<0) THEN 5260 'skip 5310 GOSUB 5340 'name 5320 GOSUB 5470:GOSUB 5510 'pos & lprint data 5330 X=LFB(K):GOSUB 7310:GOTO 5270 'next field 5340 ' (SUB) LPRINT FIELD NAME 5350 IF LNLL(K) THEN X=LNLL(K):Y=LNLC(K):GOSUB 7330:GOTO 5370 5360 IF LNLC(K) THEN Y=LNLC(K):GOSUB 7360 ' tab 5370 ON LFM(K) GOTO 5390,5420 5380 GOTO 5450 'skip if 0 5390 ' NAME MODE 1 5400 LPRINT LEFT$(N$(K),4)" : "; 5410 LP=LP+7:GOTO 5450 5420 ' NAME MODE 2 5422 Y=LEN(LF2$(K)):IF LP+Y>LW THEN X=1:GOSUB 7310:LPRINT SPACE$(5);:LP=6 5430 LPRINT LF2$(K);:LP=LP+Y 5440 ' DONE NAME 5450 X=LFMB(K):GOSUB 7310 5460 RETURN 5470 ' (SUB) POSITION LPRINT DATA 5480 IF LDLL(K) THEN X=LDLL(K):Y=LDLC(K):GOSUB 7330:GOTO 5500 5490 IF LDLC(K) THEN Y=LDLC(K):GOSUB 7360 ' tab 5500 RETURN 5510 ' (SUB) LPRINT DATA 5520 C1=LPOS(0) 5530 IF RIGHT$(N$(K),1)="n" AND LPU$(K)<>"&" AND LPU$(K)<>"" THEN N1!=VAL(B$(K)):GOTO 5560 5540 IF LFL(K) THEN X$=LEFT$(B$(K),LFL(K)) ELSE X$=B$(K) 5542 IF LP+LEN(X$)>LW THEN X=1:GOSUB 7310:LPRINT SPACE$(5);:C1=LPOS(0) 5550 LPRINT X$;:GOTO 5570 5560 LPRINT USING LPU$(K);N1!; 5570 LP=LP+LPOS(0)-C1:RETURN 5580 ' DONE LPRINT & WRITE - BRANCH 5590 IF T=10 OR P7<>0 THEN 5600 ELSE 5680 5600 ' COPY & DELETE PAUSE 5610 GOSUB 6100 'exit 5612 IF A=122 THEN 5650 'z 5620 IF RS THEN X=24:Y=1:GOSUB 6700 5622 IF P7 THEN PRINT"Copy "; 5624 IF P7<>0 AND T=10 THEN PRINT"& "; 5626 IF T=10 THEN PRINT"Delete "; 5630 PRINT"this record? n/y/z/esc >";: A$=INPUT$(1):A=ASC(A$):IF A=13 THEN A$="n" 5632 IF A=27 THEN PRINT"ESC":GOTO 5634 ELSE 5640 5634 IF (P6 OR P7) THEN GOSUB 8410 'close output file 5636 GOTO 1120  5640 PRINT A$:IF A$="y" OR A$="z" THEN 5650 ELSE 5770 5650 ' COPY 5660 IF P7 THEN NR=NR+1:GOSUB 6600:PRINT"!"; 5665 ' DELETE 5670 IF T=10 THEN T$=CHR$(0):GOSUB 6300 'change rec to null 5680 ' BRANCH 5685 IF T=3 OR T=1 THEN 5690 ELSE 5770 5690 ' ASSEM NEW/CHANGED REC STR AND PUT TO DISK 5700 T$="" 5710 FOR J=1 TO NC 5730 T$=T$+B$(J)+CHR$(126) 5740 NEXT J 5750 GOSUB 6300:PRINT"*";:GOSUB 6400:PRINT"!" ' put record, dupe 5760 IF T=1 THEN N=N+1:C=1:I=I+1:N1=N1+1:GOTO 4000 5770 ' WIND UP 5780 GOSUB 6100 ' check exit 5790 NEXT I '<=========== END OF RECORD WORK LOOP 5800 IF P7 THEN GOSUB 8410 'close 2 5805 IF P9 THEN GOSUB 7410 'FF 5810 IF T2=N THEN E$="End of file.":GOTO 1140 5820 GOTO 1120 6100 ' (SUB) EXIT TEST returns character value in A 6110 X$=INKEY$ 6120 IF X$<>"" THEN A=ASC(X$) 6130 IF A<>27 THEN RETURN 6140 IF (P6 OR P7) THEN GOSUB 8410 ' put head & close out file 6145 IF P9 THEN GOSUB 7410 'FF 6150 GOTO 1120 6200 ' (SUB) GET RECORD "I" IN T$ 6210 T$="" ' necessary! 6220 ON FT GOTO 6250,6230 6230 GET#1,FT*I+2 ' latter half 6240 T$=LEFT$(R$,127) 6250 GET#1,FT*I+1 ' whole or first half 6260 T$=R$+T$ 6270 RETURN 6300 ' (SUB) WRITE T$ AS RECORD # I 6310 ON FT GOTO 6340,6320 6320 LSET R$=MID$(T$,129) ' latter half 6330 PUT #1,FT*I+2 6340 LSET R$=LEFT$(T$,128) ' first half 6350 PUT #1,FT*I+1 6360 RETURN 6400 ' (SUB) WRITE T$ AS DUPE REC I 6410 ON FT GOTO 6440,6420 6420 LSET S$=MID$(T$,129) 6430 PUT #2,FT*I+2 6440 LSET S$=LEFT$(T$,128) 6450 PUT #2,FT*I+1 6460 RETURN 6500 ' (SUB) PARSE STRING 6510 K=0 6520 J=INSTR(T$,CHR$(126)) ' delimiter 6530 IF J=0 THEN RETURN 6540 K=K+1 6550 B$(K)=MID$(T$,1,J-1) 6560 T$=MID$(T$,J+1) 6570 GOTO 6520 6600 ' (SUB) PUT T1$ AS OUTPUT REC NR 6610 ON FT GOTO 6640,6620 6620 LSET S$=MID$(T1$,129) 6630 PUT#3,FT*NR+2 6640 LSET S$=LEFT$(T1$,128) 6650 PUT#3,FT*NR+1 6660 RETURN 6700 ' (SUB) POSITION CONSOLE CURSOR (TERM DEP) X=line (1 to 24) Y=column (1 to 80) 6710 PRINT CHR$(20);CHR$(X+127);CHR$(Y+127); 'ACT-5A 6720 RETURN 6730 ' (SUB) CR 6740 FOR I1=1 TO X:PRINT:NEXT:RETURN 7000 ' GENERAL ERROR ROUTINES 7005 IF ERR=53 THEN E$="File not found.":RESUME 1140 7010 IF ERR=61 THEN 7040 'disk full 7020 IF ERR=6 THEN 7060 'overflow 7030 ON ERROR GOTO 0 7040 IF (P6 OR P7) THEN E$="Disk full ... fix then repeat last copy command":RESUME 1140 7050 CLOSE:PRINT:PRINT"Disk full .. files forced closed ..": PRINT"N ="N;" .. adds since last 'done' not updated in header ..": PRINT"Hit return for re-open attempt...then do 'done'. ": INPUT A$:T=8:RESUME 2720 7060 PRINT CHR$(7):PRINT"That number was too big! Try again.":PRINT:RESUME NEXT 7070 ' (SUB) UCV 7080 Y$="" 7090 FOR K=1 TO LEN(X$) 7100 Y$=Y$+" " 7110 X=ASC(MID$(X$,K, 1)) 7120 IF 96"y" THEN 1140 7240 WIDTH LPRINT LW+1 'backup to LP process 7250 LPRINT CHR$(27);CHR$(31);CHR$(HMI+129); 7260 LPRINT CHR$(27);CHR$(30);CHR$(VMI+129); 7270 LPRINT CHR$(27);CHR$(137);CHR$(LLM+129); 7280 LPRINT CHR$(27); "9"; CHR$(13); 'esc 9 sets margin, CR 7300 RETURN 7310 ' (SUB) LCR 7320 FOR I1=1 TO X:LPRINT:LP=1:NEXT:LLC=LLC+X:RETURN 'lp=1 stays inside! 7330 ' (SUB) POSITION LPRINT HEAD (DIABLO) 7340 LPRINT CHR$(27);CHR$(11);CHR$(X);CHR$(27);CHR$(137);CHR$(Y+128+LLM); 7350 LLC=X:LP=Y:RETURN 7360 ' (SUB) TAB LPRINT (DIABLO) 7370 IF LP>Y AND RP=0 THEN X=1:GOSUB 7310 ' addl line if too long 7380 Y1=Y+LLM:IF Y1>126 THEN LPRINT SPACE$(Y1-LP+LLM);:GOTO 7400 ' sim tab 7390 LPRINT CHR$(27);CHR$(137);CHR$(Y1+128);  7400 LP=Y:RETURN 7410 ' (SUB) FORM FEED 7420 LPRINT CHR$(12);CHR$(13);:LRC=0:LLC=1:LPG=LPG+1:LP=1:RETURN 7430 ' (SUB) CLEAR SCREEN, HOME CURSOR (TERM DEP) 7440 PRINT CHR$(12); 7450 RETURN 7460 ' (SUB) SETSEARCH 7470 IF T1=T2 THEN RETURN 7480 GOSUB 7430 'cs 7490 X=5:Y=1:GOSUB 6700 7500 SKIPPARSE=1 ' flag 7510 PRINT"Here are the fields in "F$: GOSUB 7800 7520 FOR J=0 TO 9 7530 INPUT"Number of field to search (RETURN for all fields)";A$ 7540 IF A$="" THEN SEARCHFIELD(J)=0: GOTO 7590 7550 A=VAL(A$) 7560 IF A<1 OR A>NC THEN PRINT"NO FIELD"A: GOTO 7530 7570 SEARCHFIELD(J)=A 7580 SKIPPARSE=0 7590 PRINT TAB(13);:LINE INPUT"Expression to look for ( _ for blank)? ";A$ 7600 SEARCHWORD$(J)=A$ 7610 IF A$="" THEN 7630 7620 NEXT J 7630 PRINT: PRINT"Do you want to select records to exclude? (n/y) "; 7640 A$=INPUT$(1):IF A$=CHR$(13) THEN A$="n" 7655 PRINT A$ 7660 IF A$<>"y" THEN SKIPWORD$(0)="": RETURN 7670 PRINT:FOR J=0 TO 9 7680 INPUT"Number of field to search (RETURN for all fields)";A$ 7690 IF A$="" THEN LOOKFIELD(J)=0: GOTO 7740 7700 A=VAL(A$) 7710 IF A<1 OR A>NC THEN PRINT"NO FIELD"A: GOTO 7680 7720 LOOKFIELD(J)=A 7730 SKIPPARSE=0 7740 PRINT TAB(13);:LINE INPUT"Expression to look for ( _ for blank)? ";A$ 7750 SKIPWORD$(J)=A$ 7760 IF A$="" THEN 7780 7770 NEXT J 7780 PRINT 7790 RETURN 7800 ' (SUB) SHOW FIELDS 7810 FOR K=1 TO NC 7820 PRINT TAB(29); 7830 PRINT USING"##";K;:PRINT". "LEFT$(N$(K),4)" "RIGHT$(N$(K),1) 7840 NEXT 7850 PRINT 7860 RETURN 7870 ' (SUB) LOAD DEFAULT FORMAT CONTROLS 7880 PRINT:PRINT TAB(31)"Installing format 0. 7890 FO$="0":FFN$="":FFD$="":TM=0:LTM=4:LM=0:LLM=3:SW=79:LW=95:RS=0:RP=0 7900 LLP=66-LTM-2 7910 HMI=10:VMI=8:FSC$="":HL1$="" 7920 HL2$="" 7930 HL3$="" 7940 LHL1$=F$+" ":LHL2$="":LHL3$="":HB=1:LHB=1 7950 RM=1:LRM=1:RLL=0:LRLL=0:RLC=0:LRLC=0:RNB=1:LRNB=0 7955 EB=0:LEB=2 7960 FOR I=1 TO NC 7970 SQ(I)=I:FM(I)=1:LFM(I)=2:F2$(I)="":LF2$(I)=" - ": NLL(I)=0:LNLL(I)=0:NLC(I)=0:LNLC(I)=0:FMB(I)=0:LFMB(I)=0 7980 PU$(I)="&":LPU$(I)="&":DLL(I)=0:LDLL(I)=0:DLC(I)=8:LDLC(I)=0: FL(I)=0:LFL(I)=0:FB(I)=1:LFB(I)=0 7990 NEXT 8000 SQ(I)=0 8010 RETURN 8020 ' (SUB) OPEN COPY OUTPUT FILE 8030 PRINT:PRINT"Output file name (prefix optional, default "DD$(3)")";: INPUT F2$:IF F2$="" THEN E$="?":GOTO 8360 8040 X$=F2$:GOSUB 7070:F2$=Y$'ucv 8050 IF MID$(F2$,2,1)=":" THEN 8070 8060 F2$=DD$(3)+F2$ 8070 ON ERROR GOTO 8100 8080 OPEN"I",3,F2$+".D"+FT$ 8090 CLOSE 3:ON ERROR GOTO 7000:GOTO 8200'found 8100 CLOSE 3:ON ERROR GOTO 7000 8110 IF ERR=53 THEN RESUME 8160 8120 IF ERR=61 THEN E$="Sorry, disk is full.":RESUME 8360 8130 IF ERR=64 THEN PRINT"Bad file name, try again.":RESUME 8030 8140 IF ERR=67 THEN E$="Directory full.":RESUME 8360 8150 GOTO 7000 8160 ' make new file 8170 PRINT"Opening new file "F2$ 8180 NR=0:GOSUB 8380 8190 GOTO 8360 8200 ' OPEN & LOAD HEADER 8210 GOSUB 8380 8220 T$="" 8230 ON FT GOTO 8260,8240 8240 GET#3,2 8250 T$=LEFT$(S$,127) 8260 GET#3,1 8270 T$=S$+T$ 8280 GOSUB 6500'parse 8290 FOR I=1 TO 31 8300 IF LEFT$(B$(I),4)="stop" GOTO 8320 8310 NEXT 8320 T3=I-1 8330 IF T3<>NC THEN E$="Copy aborted; output file has a different number of columns" +CHR$(13)+CHR$(10):GOTO 8360 8340 IF F2$=DD$(3)+F$ THEN NR=N ELSE NR=VAL(B$(I+1)) 8350 PRINT"File open, NR ="NR 8360 RETURN 8370 ' (SUB) OPEN THE OUTPUT FILE 8380 OPEN"R",3,F2$+".D"+FT$ 8390 FIELD #3,128 AS S$ 8400 RETURN 8410 ' (SUB) CLOSE DIMS OUT FILE 8420 IF F2$=DD$(3)+F$ THEN C=1:N=NR:GOTO 8530 8430 PRINT:PRINT"Closing output file,"NR"records. 8440 PRINT:PRINT"Backup of copied records is not automatic. The 'backup' command 8450 PRINT"must be used on the file you copied to. 8460 T$="" 8470 FOR I=1 TO 31 8480 T$=T$+N$(I)+CHR$(126) 8490 IF LEFT$(N$(I),4)="stop" THEN 8510 8500 NEXT 8510 T1$=T$+STR$(NR)+CHR$(126) 8520 NR=0:GOSUB 6600 8530 CLOSE 3 8540 RETURN 8550 ' (SUB) FLAGSET 8560 PRINT:PRINT"Here are the fields in "F$:PRINT:GOSUB 7800 8570 INPUT"Numb er of field to flag ";A:IF A=0 THEN 8610 8580 IF A>NC THEN PRINT A"???":GOTO 8570 8590 FLAG=A 8600 LINE INPUT"Enter flag; may include blanks: ";FLAG$:IF FLAG$="" THEN 8610 8610 RETURN 8620 ' SHOW TRANSIENT PROGRAMS 8630 PRINT:PRINT"Here are the available transient programs; to use one as a command 8640 PRINT:PRINT"skip the 'D' on the front and the '.BAS'." 8650 PRINT:WIDTH 70:FILES DD$(2)+"D???????.BAS":WIDTH 255:PRINT:PRINT 8660 GOTO 1140  the 'D' on the front and the '.BAS'." 8650 PTHEN C=1:N=NR:GOTO 8530 8430 PRINT:PRINT"Closing output file,"NR"records. 8440 PRINT:PRINT"Backup of copied records is not automatic. The 'backup' command 8450 PRINT"must be used on the file you copied to. 8460 T$="" 8470 FOR I=1 TO 31 8480 T$=T$+N$(I)+CHR$(126) 8490 IF LEFT$(N$(I),4)="stop" THEN 8510 8500 NEXT 8510 T1$=T$+STR$(NR)+CHR$(126) 8520 NR=0:GOSUB 6600 8530 CLOSE 3 8540 RETURN 8550 ' (SUB) FLAGSET 8560 PRINT:PRINT"Here are the fields in "F$:PRINT:GOSUB 7800 8570 INPUT"Numb10 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 X 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 XNC 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 PRINT 1380 ' READ FILE 1390 GOSUB 2410 'exit 1400 IF EOF(3) THEN 2360 1410 FOR I=1 TO NC:B$(I)="":NEXT 1420 LINE INPUT #3,T$ 1430 PRINT"+";:INREC=INREC+1:GOSUB 2580 'parse into B1$ array j=fields found 1440 IF J<>NF THEN 1450 ELSE 1470 1450 IF P9 THEN PRINT CHR$(7);:LPRINT:LPRINT"Input file line"INREC"defective." 1460 PRINT: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 ' SEARCH 1540 IF SEARCH<>2 THEN 1590 1550 ' FIND 1560 IF INSTR(T$,SEARCHWORD$(0))=0 THEN 2200 'skip 1580 GOTO 1830 1590 ' FIELD SEARCH 1600 J=0 ' check for skips first 1610 IF SKIPWORD$(J)="" THEN 1700 ' try search then 1620 IF LOOKFIELD(J)<>0 THEN 1660 ' look in field 1630 IF INSTR(T1$,SKIPWORD$(J))<>0 THEN 2200 ' check whole rec - skip it 1640 J=J+1 1650 GOTO 1610 1660 IF INSTR(B$(LOOKFIELD(J)),SKIPWORD$(J))<>0 THEN 2200 ' field compare - skip 1670 IF B$(LOOKFIELD(J))="" AND SKIPWORD$(J)="_" THEN 2200 'blank 1680 J=J+1 1690 GOTO 1610 1700 IF SEARCHWORD$(0)="" THEN 1810 ' don't care so print it 1710 J=0: GOTO 1730 ' now search 1720 IF SEARCHWORD$(J)="" THEN 2200 ' hesitate no longer 1730 IF SEARCHFIELD(J)<>0 THEN 1770 ' field 1740 IF INSTR(T1$,SEARCHWORD$(J))<>0 THEN 1810 ' found it 1750 J=J+1 1760 GOTO 1720 1770 IF INSTR(B$(SEARCHFIELD(J)),SEARCHWORD$(J))<>0 THEN 1810 1780 IF B$(SEARCHFIELD(J))="" AND SEARCHWORD$(J)="_" THEN 1810 1790 J=J+1 1800 GOTO 1720 1810 ' GET READY TO DO IT 1830 ' PAUSE CONTROLS (TERM DEP IF UPPERCASE ONLY) 1840 GOSUB 2410 ' exit returns A 1850 IF A=122 THEN 2100 ' z means go on 1860 PRINT INREC;B$(1);TAB(30);"Ready (SPACE/z/ESC) > "; 1870 A$=INPUT$(1):A=ASC(A$):IF A=27 THEN 2360 ' finish 1880 PRINT A$;:IF A=13 OR A=32 OR A=122 THEN 2100 1890 GOSUB 2410 ' exit 2100 ' ADD RECORD TO DIMS FILE 2110 T$="":NR=NR+1 2120 FOR J=1 TO NC 2130 IF LEN(T$)+LEN(B$(J))+1>FT*128 THEN 2140 ELSE 2160 2140 IF P9 THEN LPRINT "Input line"INREC"too long." 2150 PRINT"Input line"INREC"too long."CHR$(7) 2160 T$=T$+B$(J)+CHR$(126) 2170 NEXT 2180 N=N+1:PRINT INREC"="N:PRINT T$; 2190 GOSUB 2220:PRINT" *";:GOSUB 2290:PRINT"!":C=1 2200 ' LOOP 2210 GOTO 1380 2220 ' (SUB) WRITE T$ AS RECORD # N 2230 ON FT GOTO 2260,2240 2240 LSET R$=MID$(T$,129) 'latter half 2250 PUT #1,FT*N+2 2260 LSET R$=LEFT$(T$,128) 'first half 2270 PUT #1,FT*N+1 2280 RETURN 2290 ' (SUB) WRITE T$ AS DUPE REC N 2300 ON FT GOTO 2330,2310 2310 LSET S$=MID$(T$,129) 2320 PUT #2,FT*N+2 2330 LSET S$=LEFT$(T$,128) 2340 PUT #2,FT*N+1 2350 RETURN 2360 ' FINISH 2370 CLOSE 3 2380 PRINT:PRINT NR"records added. 2390 PRINT:PRINT TAB(32)"Re-loading DEDIT. 2400 CHAIN DD$(1)+"DEDIT",1000 2410 ' EXIT TEST (TERM DEP) 2420 X$=INKEY$ 2430 IF X$<>"" THEN A=ASC(X$) 2440 IF A=27 THEN CLOSE 3:GOTO 2360 'use ESC to escape listing 2450 RETURN 2460 ' CLEAR SCREEN (TERM DEP) 2470 PRINT CHR$(12); 2480 RETURN 2490 ' (SUB) UCV 2500 Y$="" 2510 FOR K=1 TO LEN(X$) 2520 Y$=Y$+CHR$(32) 2530 X=ASC(MID$(X$,K,1)) 2540 IF 96 B1$ ARRAY 2590 ' returns J = number of fields found 2600 FOR J=1 TO NF:B1$(J)="":NEXT 2610 J=0 2620 ' process loop 2630 J=J+1:IF J=NF THEN 2730 2640 X=INSTR(T$,CHR$(44)) 'comma 2650 IF X=0 THEN 2730 'must be last field 2660 Y=INSTR(T$,CHR$(34)) 'quote 2670 IF Y=0 OR ( Y<>0 AND X"" THEN PRINT E$:PRINT 1110 PRINT:PRINT TAB(22)"Here are the data files on this disk: 1120 PRINT:FILES DD$(3)+"*.D?" 1125 WIDTH 255 1130 PRINT:PRINT:PRINT TAB(16);"************* DIMS NO-FILE MENU ************** 1140 PRINT:PRINT TAB(16);"Open any data file shown above ............... 1 1150 PRINT TAB(16);"Install new disks ............................ 2 1160 PRINT 1170 PRINT TAB(16);"Design structure of a new file (DCREATE) ..... 3 1180 PRINT TAB(16);"Change number of disk drives for this session. 4 1190 PRINT 1200 PRINT TAB(16);"Exit DIMS to Basic ........................... 9 1210 PRINT TAB(16);"Exit DIMS to CP/M ............................ 0 1220 PRINT:PRINT TAB(16);STRING$(48,42):PRINT 1230 PRINT TAB(16);: PRINT"To continue enter a number ................... "; 1240 A$=INPUT$(1): IF A$=CHR$(13) THEN A$="1" 1250 PRINT A$ 1255 RESET ' safety for floppies 1260 IF A$="0" THEN SYSTEM 1270 IF A$="1" THEN GOTO 1650 1280 IF A$="2" THEN GOTO 1000 1290 IF A$="3" THEN CHAIN DD$(2)+"DCREATE" 1300 IF A$="4" THEN GOSUB 1330:GOTO 1000 1310 IF A$="9" THEN GOSUB 3420:STOP 1320 GOTO 1230 1330 ' (SUB) ASK # DISKS 1340 PRINT:PRINT TAB(27);:INPUT"Number of disks in system";NDRIVES 1345 PRINT:IF NDRIVES<1 THEN 1000 1350 IF NDRIVES>4 THEN 1340 1360 ' (SUB) INSTALL DISK NAMES 1370 RESTORE 1390 1380 ' DD$(1) (2) (3) (4) (5) ' file groups 1382 ' main trans data dupe misc 1383 ' pgms pgms file file files 1390 DATA 1,"A:","A:","A:","A:","A:" 1400 DATA 2,"A:","B:","A:","B:","B:" 1410 DATA 3,"A:","A:","B:","C:","A:" 1420 DATA 4,"A:","A:","B:","C:","D:" 1430 READ J 1440 FOR K=1 TO 5 1450 READ DD$(K) 1460 NEXT 1470 IF J<>NDRIVES THEN 1430 1480 IF A$<>"4" THEN RETURN 1490 ON NDRIVES GOTO 1500,1510,1540,1580 1500 PRINT"One disk system - all files and programs on A.":GOTO 1630 1510 PRINT"Two disk system: A: = main program and main data files 1520 PRINT TAB(19)"B: = transient programs, backup data files, aux. data files 1530 GOTO 1630 1540 PRINT "Three disk system: A: = main program, transient programs, aux data files 1550 PRINT TAB(21)"B: = main data files 1560 PRINT TAB(21)"C: = backup data files 1570 GOTO 1630 1580 PRINT"Four disk system: A: = main and transient programs 1590 PRINT TAB(20)"B: = main data files 1600 PRINT TAB(20)"C: = backup data files 1610 PRINT TAB(20)"D: = aux. data files 1630 PRINT:PRINT TAB(29)"Hit return to continue.":A$=INPUT$(1) 1640 RETURN 1650 ' LOAD HEADER 1660 GOSUB 3480 ' get name & open up files 1670 GOSUB 3420 'cs 1690 GOSUB 3750 ' get record 1700 GOSUB 1880 'parse into B$'s 1710 FOR I=1 TO 31 1720 N$(I)=B$(I) 'load names 1730 IF LEFT$(N$(I),4)="stop" GOTO 1760 1740 C(I)=1 1750 NEXT I 1760 N=VAL(B$(I+1)) 1770 NC=I-1 ' # cols 1780 PRINT TAB(20)"File "F$" is open. It has"N"records." 1790 ' EXIT TO DEDIT 1795 PRINT:PRINT TAB(24)"Waiting while DEDIT is loading." 1800 CHAIN DD$(1)+"DEDIT",1000 1810 ' (SUB) WRITE T$ AS RECORD # I 1820 ON FT GOTO 1850,1830 1830 LSET R$=MID$(T$,129) ' latter half 1840 PUT #1,FT*I+2 1850 LSET R$=LEFT$(T$,128) ' first half 1860 PUT #1,FT*I+1 1870 RETURN 1880 ' (SUB) PARSE STRING 1890 K=0 1900 J=INSTR(T$,CHR$(126)) ' delimiter 1910 IF J=0 THEN RETURN 1920 K=K+1 1930 B$(K)=MID$(T$,1,J-1) 1940 T$=MID$(T$,J+1) 1950 GOTO 1900 1970 ' (SUB) SAVE HEADERS 1990 PRINT:PRINT TAB(31)"Saving file header":PRINT TAB(39); 2000 T$="" 2010 FOR I=1 TO 31: T$=T$+N$(I)+CHR$(126): T1$=LEFT$(N$(I),4): IF T1$="stop" THEN 2030 2020 NEXT I 2030 T$=T$+STR$(N)+CHR$(126) 'add N at end 2040 I=0 2050 GOSUB 1810 ' put rec 0 2060 PRINT "*"; 2062 NR=0:T1$=T$:GOSUB 3960 'put dupe head 2064 PRINT"!" 2070 RETURN 2100 ' BACKUP makes dupe file 2110 CLOSE 2:KILL DD$(4)+F$+".DD"+FT$ 2120 GOSUB 3720 ' open up .DD on 2 2130 PRINT"Copying main file to dupe file, same numbers.":PRINT 2140 FOR I=0 TO N 2150 IF INKEY$=CHR$(27) THEN PRINT:PRINT:PRINT"Copy aborted.":GOTO 3260 2160 GOSUB 3750: PRINT"+"; ' get record I in T$ 2170 NR=I:T1$=T$:GOSUB 3960:PRINT"*"; ' put record NR 2180 NEXT 2190 PRINT:GOTO 3260 ' to DEDIT 3000 ' RENUMBER COPY MAIN TO DUPE 3010 CLOSE 2:KILL DD$(4)+F$+".DD"+FT$ 3020 GOSUB 3720 ' open 2 3030 PRINT"Copying main file to dupe file, renumbering.":PRINT 3040 NR=0 3050 FOR I=1 TO N 3060 IF INKEY$=CHR$(27) THEN PRINT:PRINT:PRINT"Renumber aborted.":GOTO 3260 3070 GOSUB 3750 ' get rec I in T$ 3080 IF ASC(T$)=0 THEN PRINT"0";:GOTO 3100' skip it 3090 PRINT"+";:NR=NR+1:T1$=T$:GOSUB 3960:PRINT"!"; ' put rec NR 3100 NEXT 3110 GOSUB 4030 ' save header (NR) 3120 ' ERASE MAIN FILE AND COPY DUPE TO MAIN 3130 CLOSE 3140 PRINT:PRINT"The following operation removes space from deleted records: 3150 PRINT: PRINT"Erasing main file. 3160 KILL DD$(3)+F$+".D"+FT$ 3170 PRINT:PRINT:PRINT"Copying dupe to main file.":PRINT 3180 GOSUB 3680 ' open both files 3190 FOR J=1 TO FT*(NR+1) 3200 GET #2,J 3210 PRINT"&"; 3220 LSET R$=S$ 3230 PUT #1,J 3240 PRINT"*"; 3250 NEXT J 3251 N=NR 3252 PRINT:GOSUB 1970 'put header 3255 ' RETURN TO DEDIT 3260 GOTO 1790 3280 ' GENERAL ERROR ROUTINES 3290 IF ERL=1120 AND ERR=53 THEN RESUME 1130 ' if disk empty 3300 IF ERL=1740 AND ERR=9 THEN CLOSE:E$="CAN'T READ HEADER PROPERLY":RESUME 1000 3310 IF ERR=61 THEN PRINT:PRINT"Out of disk space.":PRINT:CLOSE:RESUME 1000 3312 IF ERR=53 THEN E$="FILE NOT FOUND":RESUME 1080 3320 ON ERROR GOTO 0 3330 ' UCV 3340 Y$="" 3350 FOR K=1 TO LEN(X$) 3360 Y$=Y$+" " 3370 X=ASC(MID$(X$,K, 1)) 3380 IF 963 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 23=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 10 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 ' w=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 1000 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 96"" 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)) 10 PRINT"This program must be entered via DIMS. 20 STOP 1000 GOSUB 5840 'cs 1010 PRINT:PRINT TAB(25);"DPUT 1.03 - November 1, 1983 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 ' OPEN OUTPUT FILE 1070 PRINT:INPUT"Name of destination file";X$ 1080 GOSUB 5950 'ucv 1085 F2$=Y$ 1090 ' DISK NAME 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 CLOSE 3:ON ERROR GOTO 0 1152 PRINT:PRINT F2$" exists already. Use a different name.":GOTO 1060 1160 CLOSE 3 1170 IF ERR=53 THEN RESUME 1210 'not found 1180 IF ERR=61 THEN PRINT:PRINT"Sorry, disk full.":RESUME 5650 'exit 1190 IF ERR=64 THEN PRINT"Bad file name, try again.":RESUME 1060 1195 IF ERR=67 THEN PRINT:PRINT"Out of directory space.":RESUME 5650 1200 ON ERROR GOTO 0 1210 ' OPEN NEW FILE 1220 OPEN"O",3,F2$ 1230 NR=0 5000 ' RECORD WORK LOOP 5030 ' 5040 FOR I=T1 TO T2 ' <==== FOR 5050 GOSUB 5870 ' get rec 5060 IF ASC(T$)=0 THEN PRINT"0";:GOTO 5630 5070 PRINT"+"; 5075 GOSUB 7000 'strip linefeeds 5080 T1$=T$ ' save it 5090 IF SKIPPARSE=1 THEN 5110 5100 GOSUB 5700 ' parse record string 5110 IF SEARCH=0 THEN 5500 5120 ' SEARCH 5130 IF SEARCH<>2 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 96"" 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 (SUB) CLEAR SCREEN(TERM DEP) 4020 PRINT CHR$(12) 4030 RETURN 4040 ' (SUB) OPEN UP FILES 4050 CLOSE 4060 OPEN"R",1,DD$(3)+F$+".D"+FT$ 4070 FIELD #1,128 AS R$ 4080 OPEN"R",2,DD$(4)+F$+".DD"+FT$ 4090 FIELD #2,128 AS S$ 4100 RETURN 4110 ' (SUB) GET RECORD "I" IN T$ 4120 T$="" 4130 ON FT GOTO 4160,4140 4140 GET#1,FT*I+2 ' latter half 4150 T$=LEFT$(R$,127) 4160 GET#1,FT*I+1 4170 T$=R$+T$ 4180 RETURN 4190 ' (SUB) SHOW FIELDS 4200 FOR J=1 TO NC 4210 IF C(J)=0 THEN 4240 4220 PRINT TAB(29); 4230 PRINT USING"##";J;:PRINT". "LEFT$(N$(J),4)" "RIGHT$(N$(J),1) 4240 NEXT 4250 PRINT 4260 RETURN 4270 ' (SUB) EXIT TEST 4280 X$=INKEY$ 4282 IF X$<>CHR$(27) THEN RETURN 4290 PRINT:PRINT"Process paused by ESCA5 ' 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) 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)10 PRINT"This program must be entered from DEDIT.":STOP 1000 GOSUB 2060 'cs 1010 PRINT:PRINT TAB(29);"DUNFLAG March 11, 1984 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 1065 PRINT"Here are the fields in "F$":" 1070 GOSUB 2290 'show fields 1075 PRINT 1080 INPUT"Number of field to unflag? ",F 1085 IF F=0 THEN 1740 'quit 1090 PRINT:INPUT"String to find and remove";FLAG$ 1100 L=LEN(FLAG$) 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 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 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(14);"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 ' DO IT 1570 TEST=INSTR(B$(F),FLAG$) 1580 IF TEST THEN 1590 ELSE 1720 1590 B$(F)=LEFT$(B$(F),TEST-1)+MID$(B$(F),TEST+L) 1600 ' ASSEM CHANGED REC STR & PUT TO DISK 1610 T$="" 1620 FOR J=1 TO NC 1630 T$=T$+B$(J)+CHR$(126) 1640 NEXT 1650 GOSUB 2350:PRINT"*";:GOSUB 2420:PRINT"!" 1720 GOSUB 2030 ' check exit 1730 NEXT I ' END OF RECORD WORK LOOP 1740 ' FINISH 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 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 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 ' SHOW FIELDS (SUB) 2300 FOR K=1 TO NC 2310 PRINT TAB(29); 2320 PRINT USING"##";K;:PRINT". "LEFT$(N$(K),4)" "RIGHT$(N$(K),1) 2330 NEXT 2340 RETURN 2350 ' PUT T$ AS RECORD I (SUB) 2360 ON FT GOTO 2390,2370 2370 LSET R$=MID$(T$,129) 'latter half 2380 PUT #1,FT*I+2 2390 LSET R$=LEFT$(T$,128) 2400 PUT #1,FT*I+1 2410 RETURN 2420 ' PUT T$ AS DUPE REC I (SUB) 2430 ON FT GOTO 2460,2440 2440 LSET S$=MID$(T$,129) 2450 PUT #2,FT*I+2 2460 LSET S$=LEFT$(T$,128)  2470 PUT #2,FT*I+1 2480 RETURN FT GOTO 2460,2440 2440 LSET S$=MID$(T$,129) 2450 PUT #2,FT*I+2 2460 LSET S$=LEFT$(T$,128) SC(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 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 ' SHOW FIELDS (SUB) 2300 FOR K=1 TO NC 2310 PRINT TAB(29); 2320 PRINT USING"##";K;:PRINT". "LEFT$(N$(K),4)" "RIGHT$(N$(K),1) 2330 NEXT 2340 RETURN 2350 ' PUT T$ AS RECORD I (SUB) 2360 ON FT GOTO 2390,2370 2370 LSET R$=MID$(T$,129) 'latter half 2380 PUT #1,FT*I+2 2390 LSET R$=LEFT$(T$,128) 2400 PUT #1,FT*I+1 2410 RETURN 2420 ' PUT T$ AS DUPE REC I (SUB) 2430 ON FT GOTO 2460,2440 2440 LSET S$=MID$(T$,129) 2450 PUT #2,FT*I+2 2460 LSET S$=LEFT$(T$,128) 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¢ á lisô oæ thå optionó therå ió showî � in response to "h". .he DIMS Installation Notes - Release 1.03 - INSTALLATION page #  .cp 9 ŠINSTALLATION BASIC VERSION DIFFERENCES Therå arå twï criticaì differenceó betweeî Microsofô Basic-8° versioî � 4.µ anä 5.x® Onå ió thaô thå CLEAÒ statemenô haó changeä syntax® Thió � statemenô ió useä once¬ iî thå maiî menõ prograí DIMS® Iæ yoõ arå instal� linç witè 4.µ uså "CLEAÒ 1000¢ whicè setó strinç space® Iæ yoõ arå usinç � versioî 5.x¬ uså "CLEAR,,1000¢ whicè setó stack“ space® Iî 5.ø strinç spacå � ió useä dynamically¬ buô thå stacë spacå ió determineä froí aî algorithí � whicè wilì resulô iî DIMÓ crashinç witè aî "Ouô oæ Memory¢ erroò whicè wilì � bå puzzlinç becauså fre(x© wilì stilì sho÷ plentù oæ memory. Thå seconä differencå ió thaô Basic-8° versioî µ haó thå commanä � "INKEY$¢ whicè allowó checkinç thå keyboarä withouô stopping® Iæ yoõ neeä � tï instalì DIMÓ oî versioî 4.5¬ yoõ wilì havå tï eitheò givå uð thå "z¢ � scrollinç controì command¬ oò writå codå thaô lookó aô youò hardwarå ports® � Instead of X$=INKEY$ use X=INP(KEYBD.DATA.PORT). MEMORY REQUIREMENT DIMÓ ió currentlù beinç developeä oî á 59K-sizå CP/Í system¬ actuallù á � 62Ë Morro÷ harä disë system® Á smalleò systeí maù noô havå rooí foò alì oæ � thå filå editoò DEDIT¬ whicè ió big® Thå prograí STRIP.BAÓ ió provideä anä � maù bå useä tï removå commentó froí DEDIT® Iô wilì theî fiô oî á 54Ë � system® Iæ youò systeí ió smalleò anä you'rå adepô aô Basic¬ yoõ coulä � shrinë DEDIÔ bù takinç ouô alì thå codå relatinç tï thå formaô commanä anä � replacinç alì thå complicateä positioninç codå witè simplå listinç iî thå � defaulô format® Iæ yoõ strið thå commentó keeð youò developmenô versioî � witè thå commentó in¬ anä theî strið iô foò running¬ sï you'lì havå thå � commentó tï guidå yoõ iî makinç modifications. .cp 4 MODIFYING THE PROGRAMS FOR YOUR TERMINAL AND PRINTER DIMÓ useó thå clear-screeî anä cursoò positioninç functionó oæ youò � terminal® Sincå alì terminaló arå different¬ ALÌ THÅ DIMÓ PROGRAMÓ MUSÔ BÅ � MODIFIEÄ TÏ SUIÔ YOUÒ TERMINAL® Iî thå codå (TERÍ DEP© wilì appeaò iî � commentó aô eacè placå wherå customizatioî ió necessary® Uså youò texô � editoò tï searcè foò theså spots® DEDIÔ useó thå mosô functionó anä there� forå requireó thå mosô work® Thå supplieä transienô programó don'ô uså � cursoò positioninç buô theù dï uså screeî cleaò anä keyboarä testing® ALÌ � THÅ PROGRAÍ SEGMENTÓ MUSÔ BÅ LOADEÄ ANÄ RE-SAVEÄ becauså DIMÓ useó CHAIÎ � anä programó storeä iî ASCIÉ formaô wilì aô firsô appeaò tï chaiî buô wilì � crash soon after with misleading error messages. Wheî writinç Basic-80¬ enterinç á line-feeä produceó á ne÷ linå iî thå � listinç whicè ió noô counteä aó á linå bù Basic® Thå combinatioî oæ theså � anä tabó makeó iô possiblå tï geô á loô oæ clarifyinç whitå spacå intï thå � codå witè verù littlå cosô iî termó oæ characters® Wheî É ediô á � program.ASà filå witè WordStaò (iî "n¢ mode)¬ É seå extrá lineó inserteä � anä signó oæ confusioî iî thå righô hanä column® Thió ió becauså Basiã haó � puô linefeeä followeä bù carriagå return¬ thå oppositå oæ thå usuaì � sequence¬ iî thå file® WordStaò can'ô ediô thió sequence® Jusô leavå �Šthoså effectó alonå wheî usinç WordStaò anä alì wilì bå well. Speciaì problemó caî ariså iî thå caså oæ aî upper-caså onlù terminal® � Iæ yoõ musô uså one¬ copù alì thå prograí ANÄ DATÁ fileó witè PIÐ usinç thå � [uÝ option® Theî uså á texô editoò tï finä alì "CHR$(¢ occurrenceó iî thå � programó anä changå thoså numberó whicè represenô lower-caså characteró (9· � tï 122© tï upper-caså codeó (subtracô 32). .cp 5 PRINTER Thå DIMÓ systeí aó delivereä ió writteî foò á Diablï 161° oò 162° � printer¬ anä useó manù oæ itó speciaì controì sequences¬ likå settinç � verticaì anä horizontaì pitcè foò listinç iî á pre-recordeä form¬ anä higè � speeä absolutå tabbing® Uså witè otheò printeró wilì requirå re-writinç � thió code® Diablï controì sequenceó starô witè ESCAPE¬ whicè ió CHR$(27)® � DIMÓ wilì allo÷ yoõ tï creatå á formaô specificatioî whicè useó reverså � scrollinç oî thå printer¬ buô don'ô dï iô unlesó yoõ havå á bidirectionaì � formó tractor. .he DIMS Installation Notes - Release 1.03 - DESCRIPTIONS OF FILES PAGE # .cp 9 DESCRIPTIONS OF FILES PROVIDED *** GROUP 0 - Development *** Keeð theså fileó oî youò "DIMÓ Development¢ seô oæ disks® Theù arå noô � needed for working with files under DIMS. READ-ME .103 Release letter DINSTALL.DOC Installation and Operation Manual STRIP .BAS Basic-80 utility for making DEDIT smaller FORMFORM.DWÓ Sourcå filå tï bå copieä wheî designinç screen/printeò � formats with the aid of WordStar FIELDFOR.DWS Source file to be appended to copies of FORMFORM.DWS *** GROUP 1 - Main Programs *** Thå followinç Basic-8° programó arå provideä iî ASCIÉ formaô foò easå iî � transmission¬ scanning¬ anä editinç durinç installation® THEÙ MUSÔ THEÎ BÅ � SAVEÄ IÎ THÅ BASIC-8° COMPRESSEÄ FORMAÔ WITÈ NAME.BAÓ TÏ RUN. DIMS .ASC Opening menu program. DEDIT .ASC The file editor program .cp 10 Š *** GROUÐ ² - Transienô Programó *** Alì theså excepô DCREATÅ chaiî froí anä returî tï thå filå editor¬ DEDIT. DCFORM .ASC Command for creating a screen/printer format for a file. DCHESHIR.ASà Commanä foò printinç labeló 4-acrosó oî widå papeò foò � Cheshirå automatiã labeì applicatioî machine® Can alsï bå � useä aó á stand-alonå prograí tï prinô froí á comma-delimiteä � data file. DCREATE .ASC Program to create a new file format. Chains from DIMS main menu program. DDOà .ASà Commanä thaô displayó oò writeó tï á texô filå oæ noteó � associated with a data file. DGEÔ .ASà Commanä whicè getó á sequentiaì filå anä addó iô tï á DIMÓ file. DHELÐ .ASà Commanä whicè displayó screenó describinç filå editoò commands. The screens are stored in the file DHELP.DOC. DLABELS .ASC Command for printing 1-up mailing labels. DLETTERS.ASC Command for printing form letters with file data inserted. DNADIÎ .ASà Commanä foò inputtinç á NAD-likå datá filå tï á DIMÓ � "standard" form mailing list file. DPUT .ASC Command which puts a set of records out to a sequential file. DSORT .ASC Command for sorting files. DSTAÔ .ASà Commanä foò calculatinç descriptivå statisticó foò datá iî á � numeric field. *** GROUP 3 - Main Data Files *** LONGADDR.D Example data file for long form address lists. STANDADD.D Example data file for standard form address lists. SHORTADD.D Example data file for short form address lists. ARTICLES.D Example data file for magazine articles. MEMBERS .D Example data file for neighborhood association *** GROUP 4 - Backup Data Files *** LONGADDR.DD Example backup data file. (etc.) .DD Š *** GROUP 5 - Auxiliary Files *** SHORT .DFO Example format control file. SHORT1 .DFO Example format control file. STANDADD.DFO Example format control file. MEMBERS .DFO Example format control file - used for printer listing. MEMBERS .DOC Example of a notes file read and written via "doc" command when editing MEMBERS file. DHELP .DOC Screen texts used by help command. .he DIMS Installation Notes - Release 1.03 - PLACING THE FILES PAGE # .cp 5 PLACING THE FILES ON THE APPROPRIATE DRIVES É recommenä thaô besideó thå distributioî master¬ yoõ keeð á seô oæ � diskó calleä "Dimó Development¢ whicè consistó oæ alì thå releaså fileó iî � compresseä form¬ thå demonstratioî files¬ anä smalì sampleó oæ thå datá � fileó yoõ creatå foò yourself® Uså thió seô oæ diskó tï creatå anä tesô � formató anä anä tï creatå anä tesô youò owî transienô utilities® Theî havå � setó oæ workinç disks¬ whicè wilì bå changeä iî pairs¬ witè jusô thå DIMS � componentó yoõ neeä anä plentù oæ spacå foò datá files® Witè threå diskó É � uså Á foò everydaù prograí librarù anä  anä à foò data¬  ¦ à gettinç � changeä foò differenô setó oæ fileó (seå below). Afteò eacè prograí segmenô ió checkeä oveò anä modifieä foò youò termi� nal¬ savå iô iî thå standarä compresseä formaô witè name.bas® Theî thå � name.asã filå maù bå erased® Dependinç oî ho÷ manù driveó yoõ have¬ yoõ � musô copù thå fileó provideä oî thå distributioî disë tï diskó oî thå � appropriatå driveó oæ youò system® Theî changå thå initiaì valuå oæ thå � variablå NDRIVEÓ neaò thå beginninç oæ DIMS.BAÓ tï thå numbeò oæ driveó yoõ � arå using. Iæ yoõ arå usinç á harä disk¬ commenô ouô thå twï RESEÔ statementó neaò � thå toð oæ DIMS.BAS® Theù arå necessarù foò changinç floppies¬ whicè ió � onlù alloweä aô thå no-filå menu® .cp 21 ŠIÎ Á TWÏ DRIVÅ SYSTEÍ ..® programó arå spliô betweeî Aº anä Bº, attemptinç � tï makå balanceä spacå foò datá (.D© anä backuð (.DD© files. Drive A: Drive B: MBASIC .COM DCFORM .BAS DIMS .BAS DCHESHIR.BAS DEDIT .BAS DCREATE .BAS LONGADDR.D DDOC .BAS STANDADD.D DGET .BAS SHORTADD.D DHELP .BAS ARTICLES.D DLABELS .BAS MEMBERS .D DLETTERS.BAS DNADIN .BAS DPUT .BAS DSORT .BAS DSTAT .BAS SHORT .DFO SHORT1 .DFO MEMBERS .DFO STANDADD.DFO MEMBERS .DOC DHELP .DOC LONGADDR.DD STANDADD.DD SHORTADD.DD ARTICLES.DD MEMBERS .DD OÎ AÎ OSBORNÅ ± OÒ SMALL-CAPACITÙ 2-DRIVÅ SYSTEÍ ..® Thå minimuí needeä tï � builä á datá baså ió shown® Tï givå thå maximuí possiblå spacå foò data¬ � MBASIC.COÍ ió storeä oî drivå Bº Thå systeí ió starteä froí drivå Aº bù � typing "b:mbasic dims". On an O-1, you can add 400 data records. Drive A: Drive B: DIMS .BAS MBASIC .COM DEDIT .BAS STANDADD.DD STANDADD.D .cp 22 ŠIÎ Á THREÅ DRIVÅ SYSTEÍ ..® thå prograí librarù ió kepô togetheò oî Aº anä � Bº anä Cº arå saveä foò largå datá files® Á datá filå caî bå aó biç aó thå � whole user disk space, and still have 100% backup on the other disk. Drive A: Drive B: Drive C: MBASIC .COM LONGADDR.D LONGADDR.DD DIMS .BAS STANDADD.D STANDADD.DD DEDIT .BAS SHORTADD.D SHORTADD.DD DCFORM .BAS ARTICLES.D ARTICLES.DD DCHESHIR.BAS MEMBERS .D MEMBERS .DD DCREATE .BAS DDOC .BAS DGET .BAS DHELP .BAS DLABELS .BAS  DLETTERS.BAS DNADIN .BAS DPUT .BAS DSORT .BAS DSTAT .BAS SHORT .DFO SHORT1 .DFO STANDADD.DFO MEMBERS .DFO DHELP .DOC MEMBERS .DOC .cp 17 IÎ Á FOUÒ DRIVÅ SYSTEÍ ..® auxiliarù fileó (.DOC¬ .DFÏ anä temporarù .$$$© � are kept on the fourth drive. Drive A: Drive B: Drive C: Drive D: MBASIC .COM LONGADDR.D LONGADDR.DD SHORT .DFO DIMS .BAS STANDADD.D STANDADD.DD SHORT1 .DFO DEDIT .BAS SHORTADD.D SHORTADD.DD STANDADD.DFO DCFORM .BAS ARTICLES.Ä ARTICLES.DÄ MEMBERS .DFO DCHESHIR.BAS MEMBERS .D MEMBERS .DD MEMBERS .DOC DCREATE .BAS DHELP .DOC DDOC .BAS DGET .BAS DHELP .BAS DLABELS .BAS DLETTERS.BAS DNADIN .BAS DPUT .BAS DSORT .BAS DSTAT .BAS .he DIMS Installation Notes - Release 1.03 - OPERATING INSTRUCTIONS PAGE # .pa Š OPERATING INSTRUCTIONS: MAIN MENU Afteò thå fileó havå beeî puô oî thå appropriatå drives¬ modifieä foò � youò terminaì anä drivå configuration¬ anä saveä iî standarä compresseä � formaô (ASCIÉ fileó won'ô CHAIN)¬ thå systeí ió starteä bù runninç DIMS® � Yoõ shoulä geô thå no-filå menõ witè á directorù oæ thå provideä tesô datá � fileó displayed® Iæ yoõ theî hiô return¬ yoõ wilì geô menõ choicå no® 1¬ � opeî á file® Enteò thå namå oæ onå oæ thå existinç files¬ jusô thå maiî � parô oæ thå name¬ skippinç thå extension® Iô maù bå iî eitheò loweò oò � uppeò case. DEDIÔ shoulä loaä anä displaù thå lasô recorä iî thå file® (Iæ yoõ geô � "BAÄ FILÅ MODÅ IÎ 6250¢ iô meanó DEDIÔ hasn'ô beeî saveä iî normaì compres� seä format.) Typå "help¢ foò á serieó oæ screenó explaininç thå availablå � commands® Aô thå "pauså prompt¢ "Ready>¢ iæ yoõ typå "h¢ á menõ oæ pauså � optionó wilì appear. Wheî yoõ arå editinç á filå thå onlù safå exiô ió tï typå thå commanä � "done¢ (don)® Thió wilì returî yoõ tï thå maiî menu® Otheò choiceó � availablå froí thå no-filå menõ includå á reseô whicè ió intendeä tï sho÷ � thå ne÷ directorù wheî datá diskó havå beeî changed® Iæ DIMÓ haó beeî � properlù installeä (twï RESEÔ statementó enabled)¬ nï harí wilì comå iæ yoõ � skið thió steð anä opeî á file® Therå ió alsï á commanä foò changinç thå � numbeò oæ diskó iî thå systeí foò thå currenô session® Thió ió foò emer� gencù use® Iô ió necessarù tï firsô uså PIÐ tï movå thå fileó arounä tï � thå appropriatå driveó iæ yoõ intenä tï dï this. Thå no-filå menõ includeó DCREATE¬ thå sub-prograí thaô setó uð á ne÷ � filå froí scratch® Iô askó foò thå name¬ anä choicå oæ size® 128-bytå � recordó arå jusô righô foò mailinç listó anä mosô things» thå 256-bytå � recorä sizå ió availablå foò recordó thaô neeä morå space® Yoõ arå askeä � tï givå thå defaulô 4-characteò namå foò eacè field¬ anä whetheò iô ió aî � alphabetiã oò numeriã field® Yoõ caî jusô hiô RETURÎ foò alphabetic® � Everywher å iî DIMÓ dialogueó jusô hittinç RETURÎ giveó yoõ thå firsô choicå � iî thå menõ oò options® Enteò "stop¢ wheî alì fieldó havå beeî defined¬ � and after approval the new file will be opened. Iæ yoõ wanô tï makå á ne÷ filå witè thå samå fielä schemå aó aî � existinç one¬ there'ó aî easieò way® Jusô opeî thå filå anä copù onå � recorä ("copù 1")¬ givinç thå ne÷ filå name® Theî "done¢ thå olä file¬ � opeî thå ne÷ filå anä uså "change¢ tï puô ne÷ datá iî thå copieä record® � Theî yoõ caî starô adding. .he DIMS Operating manual - Release 1.03 - DEDIT commands PAGE # .cp 5 ŠFILE EDITING COMMANDS DEDIÔ haó twï prompts¬ "Ediô FILENAME:¢ anä "Ready>"® "Ediô FILENAME¢ � ió thå commanä level¬ anä acceptó á commanä line® "Ready>¢ ió thå "pauså � prompt¢ betweeî recordó iî á sequencå beinç ruî thrõ iî responså tï á � commanä line® Thå pauså prompô "Ready>¢ takeó single-letteò instanô com� mandó SPACE¬ ú oò ESC® Hittinç thå spacå baò wilì sho÷ thå nexô record® � Hittinç ú wilì starô continuouó scrollinç untiì spacå ió hiô tï stop® Thå � ESCAPÅ keù wilì alwayó quiô thå sequencå anä givå yoõ "Ediô FILENAME". "Ediô FILENAME¢ takeó á somewhaô free-forí commanä line® Thió linå ió � madå uð oæ onlù valiä commanä words® Thå sequencå caî bå prettù loose¬ buô � afteò á "final¢ commanä everythinç elså wilì bå ignoreä excepô foò range-� of-recordó wordó anä numbers¬ likå "froí 1° tï 20." Iæ there'ó á recorä numbeò oò á paiò oæ recorä numberó anywherå iî thå command line, the command will be done on the specified range of records. Thå wordó "from¢ "to¢ "all¢ "end¢ "next¢ oò "last¢ maù bå useä wheî talkinç � abouô recorä numbers® ".¢ insteaä oæ á numbeò meanó uså thå mosô recentlù � displayeä record® Alì thå built-iî commandó maù bå shorteneä tï threå � letters. For example, all the following are valid commands: add delete from 10 to 20 delete 10 20 print to 75  print select labels change 57 cha . (means change last record shown) 10 20 list from 10 to 20 (same result as "10 20" select copy delete (moves records to another file) "FINAL" COMMANDS Theså commandó arå normallù thå lasô worä iî thå commanä sentence® Anù � followinç wordó excepô recorä numberó wilì bå 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 the file and returns to the no-file menu. gotï Closeó thå filå anä openó anù nameä filå oî thå same disks. 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. format Installs named format definition for screen and printer. formats Shows available format definition files. backup Makes complete new backup file from main file. Rarely used since backup file is maintained automatically. renumber Renumbers all records sequentially from the top in both main and backup files, closing up holes from deleted records. MISCELLANEOUS COMMANDS 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® Backslasè '\§ backó uð tï previouó field® Iæ á �                 changå commanä includeó morå thaî onå record¬ yoõ wilì bå �                 giveî thå optioî tï selecô fieldó tï change¬ whicè speedó �                 uð thå procesó oæ doinç somethinç likå jusô addinç zipcodeó �                 to an existing file. delete <#> Shows record or records and asks approval to erase. list Shows records. Assumed if no other 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 Findó recordó containinç uð tï 1° differenô wordó oò �                 phrases® Spaceó arå OK¬ buô nï upper/loweò caså conversioî �                 ió done® Iæ yoõ hiô returî wheî askeä whaô fielä tï looë �                 iî thå worä wilì bå searcheä foò iî alì fields® Yoõ alsï �                 caî specifù uð tï 1° wordó oò phraseó thaô wilì causå thå �                 recorä! tï bå skipped® Desigî youò codinç systeí tï worë �                 witè this® print Prints on list device rather than screen in the 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 for clarity, ignored. page Sets the page number to start the printout with. margin Setó thå printeò margiî iæ yoõ don'ô wanô thå margiî thaô �                 comeó witè thå forí you'rå using. Š flag Combineä witè "add¢ oò "change¢ tï á rangå oæ records¬ askó �                 yoõ foò á strinç tï bå addeä automaticallù tï anù (one© �                 fielä iî thå record. programs Shows a directory of available "transient commands," i.e.                 various batch processes than can work on the file. .cp 4 TRANSIENT COMMANDS                 Transienô commandó arå sub-programó whicè dï á batcè oæ worë anä theî � returî yoõ tï DEDIT® Wherå appropriate¬ theù wilì takå á rangå oæ recordó � anä selectioî criteriá froí thå commanä line® Exampleº "prinô selecô � labeló 10° tï 150." The most commonly used are described here: cform Process for creating format definition files. Complicated. doc A "notepad" where you can read or write notes associated with thå datá file® Thå doã filå caî bå editeä lateò witè á �                 texô editor® Usefuì foò documentinç oî thå spoô codeó yoõ �                 invenô foò youò file. labels Printó á batcè oæ mailinç labeló (uså "prinô labels"© witè �                 blanë fieldó closeä up® Workó onlù witè threå standarä �                 addresó filå formats® It'ó noô harä tï modifù iæ neces�                 sary® Afteò thå labeló arå aligned¬ hiô spacå tï prinô onå �                 aô á timå tï makå sure® Theî hiô ú tï causå continuouó �                 printing® Hiô spacå agaiî tï pause¬ ESà tï abort. letters Printó á texô filå witè datá froí á DIMÓ filå inserted® �                 Á personaì salutatioî linå oò otheò datá lineó maù bå �                 includeä iæ desired® DLETTERS.BAÓ musô bå modifieä foò �                 eacè job® Iæ yoõ havå MailMergå it'ó easieò tï uså "put¢ �                 tï makå á sequentiaì datá filå whicè ió á subseô oæ thå �                 DIMÓ data file anä uså MailMergå witè that. sort Sortó thå recordó intï á ne÷ sequencå iî thå wholå filå oò �                 jusô á rangå oæ thå file® Askó questionó foò set-up® �                 Alphabetiã keyó maù bå truncateä and/oò blank-filleä tï á �                 specifieä length® Sortó alphabeticallù unlesó alì fieldó �                 specifieä foò keyó arå numeric® Thå sorteä producô maù �                 replacå thå olä filå oò makå á ne÷ file® Limiteä bù memorù �                 space to smaller files. stat Computes descriptive statistics for a selected numeric field. put Makes an output file in standard Basic sequential form for further processing with other programs. You may select a range of records in the invoking command line, and selection specifications® Hiddeî fieldó (seå "fields"© wilì bå � skipped get Addó datá froí á conventionaì Basiã sequentiaì datá filå tï �                 thå enä oæ thå DIMÓ filå froí whicè iô ió called¬ addinç �                 recordó tï thå end® Allowó skippinç anä re-orderinç oæ fields. Š .cp 5 FILE STYLES Iæ you'rå openinç uð á ne÷ mailinç lisô file¬ it'ó convenienô tï uså � onå oæ threå establisheä setó oæ fielä nameó ® Looë aô thå examplå fileó � provided¬ LONGADDR¬ STANDADD¬ anä SHORTADD® Thå transienô commanä "labels¢ � haó codå built-iî tï deaì witè anù oæ theså threå forms® Thå lonç forí ió � useä foò governmenô oò academiã worë wherå titleó anä organizationó abound® � Thå standarä forí ió foò generaì purposes® Thå shorô forí ió foò shorô � fileó thaô won'ô neeä tï bå sorteä intï lasô namå order. Tï makå á special-purposå mailinç lisô sucè aó aî organizatioî whicè � woulä wanô membershið statuó oò otheò speciaì fields¬ imitate onå oæ thå � threå standarä fielä layoutó foò everythinç uð tï thå zið code¬ theî desigî � thå layouô beyonä thaô poinô tï suiô thå application® Thió waù thå labeló � prograí wilì worë witè thå file® Foò example¬ studù "MEMBERS.DOC,¢ whicè � explains the fields of "MEMBERS.D." Thå ZIÐ fielä ió oæ thå numeriã typå sï iô wilì rejecô un-sortablå � mistakeó likå usinç "l¢ foò "1"® Puô Europeaî anä Canadiaî postaì codeó � afteò thå provincå iî thå C-SÔ field¬ anä leavå thå ZIÐ fielä blank. DESIGNING CODES FOR RECORD SELECTION Iæ codå fieldó arå compatiblù designed¬ thå limiteä selection/rejectioî � logiã iî DIMÓ caî dï quitå á gooä "joâ oæ pullinç ouô á subset® Thå � techniquå thaô I'vå developeä thaô workó reaì welì ió tï uså codeó madå uð � oæ onå lower-caså letteò anä onå digit¬ sucè aó a0¬ a1¬ b0¬ c8¬ etc® Anù � numbeò oæ codeó caî bå jumbleä iî anù ordeò iî á singlå codå field® Thió � makeó iô easù tï adä codeó tï thå schemå aó iô developó - yoõ caî uså thå � "doc¢ commanä tï notå theiò meaninç wheî yoõ thinë theí up® Iæ thió forí � oæ codinç ió strictlù adhereä tï á subseô oæ á singlå codå maù bå pulleä � verù rapidlù usinç "find,¢ sincå thió combinatioî oæ letteò anä digiô � doesn't occur anywhere else in the fields. For example: print find a2 labels .he DIMS Operating Manual - Release 1.03 - SCREEN & PRINTER FORMATS PAGE # DESIGNING AND CREATING SCREEN & PRINTER FORMATS Yoõ caî creatå formats¬ thaô is¬ totallù designeä wayó oæ naminç anä � displayinç thå datá oî thå screeî anä oî thå printer® Opeî thå examplå � filå SHORTADÄ anä trù thå samplå formató SHORÔ anä SHORT± ouô oî it® Yoõ � caî seå thå nameó oæ thå formató (.DFÏ files© availablå bù typinç thå � commanä "formats.¢ Á formaô ió usuallù designeä foò uså witè á particulaò file¬ thougè iæ � thå fieldó arå compatiblå there'ó nï reasoî whù á wholå familù oæ fileó � couldn'ô uså thå samå one® Á formaô specificatioî includeó botè thå screeî � anä thå printeò images® Yoõ caî desigî eitheò scrollinç oò screen-orienteä � forms® Thå designeró oæ commerciaì data-entrù programó (e.g® DataStar¬ � dBASÅ II© seeí tï bå preferrinç screen-orienteä displayó theså days¬ wherå � thå screeî showó yoõ jusô onå filå recorä aô á timå displayeä iî á designeä �Šform® Yoõ caî desigî fixed-positioî formató foò DIMS® É prefeò scrollinç � datá entrù becauså yoõ caî orienô yourselæ tï whaô yoõ jusô did® É haven'ô � useä fixed-positioî formaô designó anä consequentlù É musô warî yoõ thaô � thougè provideä foò iî DIMÓ thió modå hasn'ô beeî fullù testeä anä therå � maù bå bugs. USING CFORM TO CREATE A FORMAT CONTROL FILE Therå arå twï wayó oæ creatinç thå formaô specificatioî file¬ � .DFO® Thå firsô ió tï givå thå commanä "cform¢ iî DEDIT® Thå cforí � transienô allowó yoõ tï prinô ouô á lonç papeò forí oî whicè yoõ filì ouô � youò desigî foò thå screeî anä printeò form® Screeî and/oò pagå headingó � maù bå madå uð tï threå lineó long® Theså lineó wilì onlù bå printeä iæ � non-blank® Fielä nameó (prompts© maù bå omitted¬ thå defaulô 4-characteò � fielä namå maù bå used¬ oò á custoí namå maù bå printeä anywhere® Iî � positioninç nameó anä datá fields¬ iæ thå linå ió specifieä thå iteí wilì � alwayó bå printeä aô thaô line. Iæ thå linå ió ° iô wilì bå printeä wher� eveò thå cursoò oò printheaä waó lefô aô thå enä oæ thå previouó field® � Similarly¬ iæ á columî ió specifieä thå datá wilì bå printeä there¬ anä iæ � columî ° ió giveî iô wilì prinô aô thå columî wherå iô waó lefô bù thå � previouó operation® Thió allows¬ foò example¬ printinç Firstnamå Lastname bù defininç thå fielä namå prompô foò "Lastname¢ aó á singlå space¬ aô linå � ° anä columî 0. Takå carå wheî enterinç thå datá froí thå filled-ouô form¬ becauså � cforí doesn'ô bacë up® Iæ yoõ makå aî erroò yoõ musô starô over® Enteò � alì thå specificationó anä tesô iô oî youò datá file® Wheî you'rå debug� ginç á formaô design¬ yoõ caî takå á shorô cuô bù usinç á texô editoò � prograí oî thå .DFÏ filå thaô cforí createä froí thå specificatioî entrù � dialogue® Comparå thå numberó oî thå papeò forí witè thå filå imagå tï � figurå ouô wherå iî thå formaô controì filå yoõ are® Thå filå ió reaä aó á � sequentiaì filå wheî iô ió useä bù DIMS¬ sï takå greaô carå tï preservå thå � exacô numbeò oæ lineó anä itemó peò line® USING WORDSTAR TO CREATE A FORMAT CONTROL FILE Iæ yoõ havå WordStar¬ aî easiest methoä maù bå used® Á WordStaò filå � witè promptó includeä aó non-printinç commentó ió editeä tï filì iî alì thå � desireä specifications® Thå filå ió theî printeä tï disë tï creatå thå � controì file® Starô WordStar® Typå "n¢ tï begiî á "non-document¢ typå oæ � file¬ anä namå thå ne÷ filå witè á ne÷ name® É suggesô usinç thå � suffix .DWS for this type of file. Aô thå toð oæ thå blanë ne÷ file¬ typå ^KR¬ anä givå thå namå � "formform.dws"® Thå loadeä filå containó completå promptó anä � instructionó foò creatinç thå formaô controì file® Wheî needed¬ thå filå � "fieldfor.dws" is also read in. Thå filå ió printeä usinç thå optioî oæ printinç tï á disë file® Thå � producô file'ó namå musô havå thå extensioî .DFO® Thå .DFÏ filå musô bå �Šediteä tï removå extrá blanë lineó froí thå end® Theî iô maù bå trieä ouô � whilå editinç thå DIMÓ file® Afteò correctionó arå noted¬ worë oî thå .DWÓ � source file and print it again. .he DIMS Operating Instructions - Release 1.03 - CRASH RECOVERY PAGE # CRASH RECOVERY DIMÓ recordó everù recorä thaô yoõ enteò oò updatå immediatelù iî twï � places¬ thå maiî anä backuð datá files® Hopefullù youò systeí wilì bå seô � uð sï thaô theså arå oî differenô disks¬ givinç protectioî agai#nsô eveî á � crashed file directory on one disk. Wheî á disë ió baä anä yoõ crasè tï onå oæ CP/M'ó cryptiã "BDOÓ ERROR¢ � messages¬ alì youò datá excepô thå lasô recorä yoõ werå enterinç ió stilì � good® Iæ yoõ werå iî thå procesó oæ addinç recordó alì thå newly-addeä � recordó wilì bå iî thå filå buô thå numbeò oæ recordó wilì noô havå beeî � updateä iî thå DIMÓ filå headeò record® Iæ yoõ remembeò whaô thå highesô � recorä numbeò was¬ skið thå nexô paragraph. Uså CP/M'ó staô utilitù tï looë aô thå datá file® Notå thå numbeò oæ � recordó showî iî thå left-hanä column® Iæ youò filå ió 128-bytå records¬ � thå numbeò oæ datá recordó (thå numbeò yoõ want© ió thaô numbeò minuó one® � Iæ thå filå ió double-sizå records¬ thå numbeò oæ datá recordó ió thå � numbeò oæ CP/Í recordó divideä bù two¬ theî minuó one® Re-starô DIMS® � Open the file. Notå thaô DIMÓ stilì thinkó thaô thå filå haó thå numbeò oæ recordó � thaô iô haä wheî yoõ diä thå lasô "done.¢ Hiô control-C® Enteò "N=986¢ � (uså youò owî number)® Enteò "C=1"® Enteò "cont¢ theî RETURÎ anä seå iæ � thå filå appearó tï bå normaì now® Dï "done." Iæ á crasè occuró whilå thå sorô commanä ió writinç itó outpuô oveò thå � backuð file¬ thå backuð filå ió invalid® Uså "backup¢ tï restorå it® � Shoulä thå maiî oò backuð filå bå lost¬ PIÐ caî bå useä tï copù onå oò thå � other¬ anä theî thå CP/Í "ren¢ commanä tï renamå thå file® Thå maiî anä � backup data files are identical. .he DIMS Interface and Modification - Release 1.03 - FILE COMPATIBILITY PAGE # INTERFACE AND MODIFICATION FILE COMPATIBILITY DIMÓ fileó arå ASCIÉ datá iî fixed-lengtè randoí accesó blocks¬ anä alì � recordó arå eitheò standarä 12¸ bytå lengtè oò 25¶ bytå lengtè dependinç oî � whicè waó choseî wheî thå filå waó created® Thió haó nothinç tï dï witè � youò diskó beinç doublå oò singlå density® MBASIà anä CP/Í pacë thå re� cordó oî thå disë witè nï carriagå returnó betweeî theí anä nï control-Ú aô � thå end® Withiî eacè recorä thå fieldó arå jammeä sequentiallù witè thå � delimiteò characteò "~¢ (chr$(126)© betweeî thå fieldó anä thå left-oveò � spacå filleä witè blanks® Thió characteò maù noô bå useä iî data¬ buô � commaó anä quoteó maù bå entereä freely® Herå ió aî examplå oæ whaô á filå � recorä lookó likå oî thå disk: .cp 8 Š(headeò recorä - thå lasô iteí ió thå numbeò oæ recordó iî thå file.) LNAM,a~FNAM,a~N2 ,a~ADDR,a~C-ST,a~ZIP ,n~PHON,a~CODE,a~NOTE,a~stop0~ 1~ (data record 1) Dugan~Dan~Daî Dugaî Sounä Design~29° Napoleoî Street¬ Studiï E~Saî � Francisco¬ CA~94124~(415© 821-9776~~DIMS~ Thå filå maù bå dumpeä witè thå CP/Í "type¢ command¬ oò examineä anä � repaireä witè EÄ oò WordStaò versioî ± (versioî ³ wilì crash© iî thå non-� documenô mode® Christensens'ó DU.COÍ utilitù maù bå useä tï repaiò á � crasheä file® SuperSorô doeó noô accepô DIMÓ fileó directlù becauså iô � insistó oî comma-delimiteä oò fixed-lengtè fielä files. Thå DIMÓ transienô programó "DPUT¢ anä "DGET¢ providå á convenienô � meanó foò interfacinç tï otheò programs® DPUÔ outputó á standarä Basiã � sequentiaì filå oæ comma-delimiteä records® Iô caî bå invokeä iî á commanä � linå witè rangå anä selectioî commandó tï outpuô á subseô file¬ likå � "selecô put.¢ DGEÔ doeó thå exacô reverse¬ loadinç á standarä sequentiaì � filå intï á DIMÓ file¬ anä allowó stuffinç thå fieldó iî anù combinatioî oò � order. Quoteó anä commaó maù bå useä freelù iî DIMÓ datá fields® Tï makå � fileó compatiblå witè otheò programs¬ DPUÔ automaticallù putó quoteó arounä � fieldó containinç commas® Iô encodeó existinç quoteó iî thå filå intï thå � characteò "~"¬ CHR$(126)® DGEÔ dropó thå surroundinç quoteó anä convertó þ � bacë tï ". Á DIMÓ filå maù bå re-designeä bù usinç thå 'put§ commanä tï outpuô thå � datá tï á temporarù file¬ usinç DCREATÅ (maiî menu© tï creatå á ne÷ DIMÓ � filå witè thå desireä fielä names¬ anä usinç thå 'get§ commanä tï stufæ thå � datá bacë iî iî thå desireä order. .he DIMS Interface and Modification - Release 1.03 - YOUR TRANSIENTS PAGE # .cp 4 WRITING YOUR OWN 'TRANSIENT' PROGRAMS Whaô É usuallù dï wheî É wanô tï writå á ne÷ transienô functioî ió � loaä "DLABELS.BAS¢ anä theî replacå thå workinç sectioî (usually¬ jusô thå � insidå oæ thå "I¢ loop© witè ne÷ codå thaô doeó whaô É want® Theî É savå � thå filå witè á ne÷ name® Keeð thå beginninç excepô foò thå questionó anä � whateveò subroutineó yoõ need® Remembeò thaô yoõ enteò á transienô prograí � witè thå rangå oæ records¬ printinç anä selectioî criteriá alreadù speci� fieä froí thå DEDIÔ commanä line. Cautioî -- Don'ô changå thå COMMOÎ statement® Alì DIMÓ programó arå � entereä aô linå 100° excepô foò thå cold-starô oæ DIMS.BAS® DEDIÔ automa� ticallù recognizeó transienô programó iæ they'rå oî thå righô drivå anä � theiò nameó starô witè Ä anä enä witè .BAS. .he DIMS Interface and Modification - Release 1.03 - MODIFICATION PAGE # MODIFICATION GUIDELINES Notå thaô alì GOTO'ó anä GOSUB'ó poinô tï remarë lines¡ Thió ió thå � oppositå oæ ad$vicå commonlù heard® Thå speeä penaltù foò thió ió infini�Štesmal® Thå advantageó arå firsô yoõ caî seå whaô GOSU nnnî doeó bù � typinç "lisô nnnn,¢ anä seconä it'ó easieò tï adä á linå aô thå beginninç � oæ thå subroutine¬ somethinç É seeí tï neeä tï dï often. Regardinç speed¬ É reaä somewherå thaô Basiã searcheó thå wholå prograí � froí thå starô foò thå destinationó oæ branchinç statements¬ anä thaô it'ó � supposeä tï bå fasteò iæ thå subroutineó arå aô thå beginninç oæ thå � program® É spenô á fe÷ houró re-organizinç DEDIÔ tï trù this¬ anä iô � wasn'ô wortè it¬ thå timå foò searchinç 10° recordó waó thå same® É puô � thå subó bacë wherå theù grew® I'vå hearä thaô thå samå goeó foò variablå � storage¬ thaô thoså thaô arå defineä earlieò iî thå ruî arå quickeò tï use® � Foò thió reasoî thå commoî looð indexinç variableó arå includeä iî thå � COMMOÎ statement¬ thougè mosô oæ theí aren'ô useä foò parameteò passing® .he DIMS Interface and Modification - Release 1.03 - VARIABLES PAGE # DEFINITION OF COMMON VARIABLES B$() Array holds field data of current record C Change flag = 1 when the file has been added to C() Controls display and changing of fields, value 0, 1 or 2 DD$() Array holds drive names for five types of files F$ Current file name FT Current file type, 1 or 2 - determines 128 or 256 byte recs. FT$ Added to extension of file name, blank or 2 I,J,K Loop index variables. Be sure they're free before re-using. LOOKFIELD() - Numbers of fields for which select skips are set N The current number of records in the file N$() Default names for fields, comma, and "a" or "n" for type NC The number of fields in the current file P6 Flag, reserved for "write" function not implemented P7 Flag, = 1 when "copy" in effect P8 Flag, reserved P9 Flag, = 1 when "print" in effect PI Flag, = 1 when printer is assumed ready R$  Disk data string read/written in main data file S S$ Disk data string read/written in backup data file SEARCHFIELD () - Numbers of fields for which select keys have been set SEARCHWORD$() - Key words or phrases for record selection SKIPWORD$() - Key words or phrases for record skipping T Command code, set by some DEDIT commands to control branching T$ Data record string going to or from storage T1 Lowest record number in the batch T2 Highest record number in the batch T1$ Temporary data string X,Y Local parameter passing variables .he DIMS Interface and Modification - Release 1.03 - BUGS PAGE # .CP 5 KNOWN BUGS AND SUGGESTED IMPROVEMENTS Display of non-scrolling forms in DEDIT hasn't been fully debugged. Á harmlesó slightlù garbleä displaù happenó iæ yoõ uså backslasè tï trù � tï bacë uð froí thå firsô fielä oæ á record. Š Thå recorä selectioî logiã ió rudimentary¬ anä coulä bå improveä tï � includå AND/OÒ anä greater/lesó thaî comparisons® Thió woulä requirå � adding some common variables and updating all programs in the system. "Undelete¢ woulä bå easù tï implemenô bù gettinç datá froí thå backuð � file® Lotó oæ thingó coulä bå addeä tï DEDIÔ iæ iô weren'ô sï faô already® � Thå "sort¢ commanä onlù sortó iî ascendinç order® Therå ió codå � writteî iî thå prograí foò descendinç ordeò sortó buô thió switcè haó beeî � commenteä ouô aó iô causeó aî unsolveä data-dependenô crash. .he DIMS Installation Notes - Release 1.03 - HISTORY PAGE # HISTORY OF DIMS É starteä witè mù S-10° microcomputeò aô thå enä oæ 1977® Aô thaô timå � therå waó nï generalizeä data-baså managemenô prograí available® É studieä � á full-fledgeä systeí writteî iî Basiã calleä RISÓ whicè ió publisheä aó á � booë (bù Meldmaî eô al¬ Vaî Nostranä Reinholä Co® '78© Iô waó toï compleø � foò må tï understand® É spuî mù wheeló foò á yeaò untiì É sa÷ aî aä foò � Scelbé Publications§ PIMÓ -- Personaì Informatioî Managemenô System® Thió � ió á completå functioninç data-baså manageò foò cassette-baseä computeró � likå TRS-8° oò PET® É boughô iô foò $10¬ typeä iô iî anä goô iô tï work. Tï backsteð foò á moment¬ thió prograí waó firsô publisheä aó "Á � People'ó Datá Baså System¢ bù Madaî Guptá anä Brenô Landeò iî 1977® Theî � Scelbi published PIMS by Gupta in 1979. Witè PIMÓ É haä á workinç frameworë whicè É converteä tï disë random-� accesó files® Afteò thaô thå prograí immediatelù wenô tï worë foò må anä � mù clients¬ anä jusô gre÷ anä gre÷ aó thå pressurå oæ doinç reaì worë � determined® É renteä machinå timå tï thå Saî Franciscï Charteò Revisioî � Commissioî foò theiò mailinç lists¬ anä madå manù improvementó tï thå � prograí aó thaô projecô grew® Thå systeí oæ chaininç thå transienô pro� gramó developeä wheî thå prograí goô toï biç tï bå alì iî memorù aô thå � samå time® É havå neveò changeä thå variablå names¬ storagå formaô oò � defaulô listinç for%maô froí PIMS® I'vå puô mù largå personaì addresó listó ontï DIMS¬ anä á successfuì � systeí foò storinç technicaì magazinå articlå citations® Á book¬ Thå � Heartó oæ Spacå Guidå Tï Cosmic¬ Transcendenô anä Innerspacå Musiã starteä � ouô aó á DIMÓ datá file¬ waó transformeä (bù á purpose-builô transient© tï � WordStaò wheî thå datá waó complete¬ theî senô tï thå typesetteò oî á CP/Í � disk® É alsï havå partó listó foò mù productó anä thå membershið lisô foò � mù neighborhooä association® Alì thió activitù madå må wanô morå real-timå � availabilitù oæ mù datá bases¬ anä iî '8± É useä alì mù availablå crediô tï � instalì á Morro÷ M2¶ harä disk® DIMÓ runó witè á satisfyinç speeä increaså � oî thå harä disk® Iî '81-8² pre-releaså versionó werå uð oî twï systemó iî � mù laâ anä fivå otheò CP/Í systemó belonginç tï friends. DIMÓ versioî 1.° waó releaseä tï thå publiã domaiî bù Daî Dugaî Sounä � Desigî oî Marcè 20¬ 1983¬ mù 39tè birthday® Iî Apriì '8² Jií Ayeró madå � thå wholå systeí availablå oî thå bulletiî boarä oæ Computeò Systemó oæ � Marin. .cp 3 Š Thå prograí waó subsequentlù releaseä aó SIG/Í disë #61® Iô receiveä á � ravå revie÷ froí Chrió Terrù iî Microsystemó, May '83® Hå saiä "Iæ yoõ can'ô � afforä dBASÅ II¬ geô DIMS.¢ É aí usinç dBASÅ IÉ also¬ anä prefeò iô foò mù � financiaì records® É stilì prefeò DIMÓ foò mailinç listó becauså it'ó � easier for me. Thå mosô recenô growtè iî DIMÓ haó beeî stimulateä bù á mailinç lisô É � aí keepinç foò á clienô whicè haó growî tï 750° names® Currentlù thå � updatå cyclå ió workinç likå thisº Nameó arå entereä anä editeä iî DIMS® � Tï prinô labels¬ É uså "put¢ tï writå thå datá tï á sequentiaì file¬ uså � SuperSorô tï sorô thaô filå bù zið codes¬ anä prinô labeló witè � DCHESHIR.BAÓ readinç thå sorteä sequentiaì file® Thå zip-sorteä filå ió � re-sorteä tï alphabeticaì bù SuperSort® Thå originaì DIMÓ filå ió archiveä � tï á floppù anä thå harä disë filå ió erased® Á alphabetiã sorteä ne÷ DIMÓ � filå ió madå usinç "get¢ froí thå sorteä sequentiaì file® Thå sequentiaì � filå ió theî eraseä anä á listinç oæ thå DIMÓ filå ió printeä aó á guidå � foò correctionó anä editinç durinç thå nexô cycle. Thió worë requireä writinç DCHESHIR.BAS¬ bullet-proofinç DGET.BAS¬ anä � designinç á mucè betteò defaulô printeò listinç format® Theså improvementó � anä somå generaì improvements/fixeó compriså versioî 1.03¬ beinç releaseä � iî January¬ 1983. 50° names® Currentlù thå � updatå cyclå ió workinç likå thisº Nameó arå entereä anä editeä iî DIMS® � Tï prinô labels¬ É uså "put¢ tï writå thå datá tï á sequentiaì file¬ uså � SuperSorô tï sorô thaô filå bù zið codes¬ anä prinô labeló witè � DCHESHIR.BAÓ readinç thå sorteä sequentiaì file® Thå zip-sorteä filå ió � re-sorteä tï alphabeticaì bù SuperSort® Thå originaì DIMÓ filå ió archiveä � tï á floppù anä thå harä disë filå ió erased® Á alphabetiã sorteä ne÷ DIMÓ � filå ió madå usinç "get¢ froí thå s This is the release date of the disk. READ-ME 103 €zDINSTALLDOC à¶åINSTALLDOC �@åINSTALLDOC Ÿ6-CPM119 DOC €®€ ååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååDNADIN .ASC 6F 92 3456 27 DPUT .ASC B6 66 4352 34 DSORT .ASC 7E 85 13568 106 DSTAT .ASC 78 D1 7296 57 DUNFLAG .BAS 0B 4E 4224 33 STRIP .ASC 9B 01 1536 12 READ-ME .103 16 7D 5120 40 DINSTALL.DOC 2E 5A 46592 364 åååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååå Fog Library Disk FOG-CPM.119 Copyright (1986) by Fog International Computer Users Group to the extent not copyrighted by the original author for the exclusive use and enjoyment of its members. Any reproduction or distribution for profit or personal gain is strictly forbidden. For information, contact FOG, P. O. Box 3474, Daly City, CA. 94015-0474. as part of the description of a file indicates that the program is distributed on a "try first, pay if you like it" basis. If you find the program(s) meet your need, please refer to the author's documentation for information on becoming a registered user. Only by registering and paying for the programs you like and use will the authors of such programs continue development. Often, more complete documentation, additional modules, and new releases are available only to registered users. DISK 1 of 2. Dan's Information Management System. Filename Description -07-00 .86 This is the release date& of the disk. -CPM119 .DOC This is the description of the disk contents. DCFORM .ASC 5CA4 9K ver. 1.03 [Dan's Info System 1 of 37] A database program in MBasic, this is a comprehensive list- management system that can be installed for almost any CP/M system. Custom report formats can easily be designed. DCHESHIR.ASC 49BC 9K ver. 1.03 [Dan's Info System 2 of 37] DCREATE .ASC 4127 4K ver. 1.03 [Dan's Info System 3 of 37] DEDIT .ASC D36D 26K ver. 1.03 [Dan's Info System 4 of 37] DGET .ASC 32F4 5K ver. 1.03 [Dan's Info System 5 of 37] DGET .BAS 7F96 6K ver. 1.03 [Dan's Info System 6 of 37] DIMS .ASC 118C 10K ver. 1.03 [Dan's Info System 7 of 37] DLABELS .ASC D0DF 6K ver. 1.03 [Dan's Info System 8 of 37] DLETTERS.ASC F5CA 6K ver. 1.03 [Dan's Info System 9 of 37] DNADIN .ASC 6F92 4K ver. 1.03 [Dan's Info System 10 of 37] DPUT .ASC B666 5K ver. 1.03 [Dan's Info System 11 of 37] DSORT .ASC 7E85 14K ver. 1.03 [Dan's Info System 12 of 37] DSTAT .ASC 78D1 8K ver. 1.03 [Dan's Info System 13 of 37] DUNFLAG .BAS 0B4E 5K ver. 1.03 [Dan's Info System 14 of 37] STRIP .ASC 9B01 2K ver. 1.03 [Dan's Info System 15 of 37] READ-ME .103 167D 5K ver. 1.03 [Dan's Info System 16 of 37] DINSTALL.DOC 2E5A 46K ver. 1.03 [Dan's Info System 17 of 37] r. 1.03 [Dan's Info System 2 of 37] DCREATE .ASC 4127 4K ver. 1.03 [Dan's Info System 3 of 37] DEDIT .ASC D36D 26K verååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååååå'ååååå