10 '			******* DEDIT *******


15 PRINT"DEDIT must be entered from DIMS.
20 STOP
1000 '


				PROGRAM BEGINS HERE


1010 PRINT:PRINT TAB(31);"DEDIT March 20, 1982
1020 DEFINT A-Z
1030 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 7000
1050 '

		DIM FOR FORMAT


1060 DIM SQ(NC+1),FM(NC),LFM(NC),F2$(NC),LF2$(NC)
1070 DIM NLL(NC),LNLL(NC),NLC(NC),LNLC(NC)
1080 DIM PU$(NC),LPU$(NC),DLL(NC),LDLL(NC),DLC(NC),LDLC(NC)
1090 DIM FMB(NC),LFMB(NC),FL(NC),LFL(NC),FB(NC),LFB(NC)
1100 GOSUB 7870 ' load default format
1110 IF T=0 THEN T1=N:T2=N:PRINT:PRINT"Here's the last record:":GOTO 2900
1120 '


		COMMAND PROCESSOR

		ENTER HERE AFTER FINISHING COMMAND


1130 E$="" ' error msg
1140 '


		ENTER WITH ERROR


1150 FOR I=1 TO 10:C$(I)="":NEXT ' clear
1160 '


		ACCEPT COMMAND


1170 IF E$<>"" THEN PRINT CHR$(7);
1180 PRINT CHR$(13);
1190 IF RS THEN X=22:Y=1:GOSUB 6700
1200 PRINT SPC(79); CHR$(13);
1210 PRINT E$"  ";:E$="":PRINT"Edit ";F$;": ";: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


2180 PI=0
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
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
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=22: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<RS) THEN 4160
4060 GOSUB 7430 'cs
4070 RC=0:PG=PG+1
4080 PRINT CHR$(13);'CR
4090 X=TM:GOSUB 6730 ' top margin
4100 IF HL1$<>"" 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 pg
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


5430 LPRINT LF2$(K);:LP=LP+LEN(LF2$(K))
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)
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=22: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 

	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
5800 IF P7 THEN GOSUB 8410'close 2
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
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<X AND X<123 THEN MID$(Y$,K,1)=CHR$(X-32): GOTO 7140
7130	MID$(Y$,K,1)=MID$(X$,K,1)
7140 NEXT
7150 RETURN
7160 '


				(SUB) SET UP PRINTER


7170 IF PI=1 THEN RETURN
7180 PRINT:PRINT"Check printer:
7190 PRINT TAB(10)"Power on?":PRINT TAB(10)"Head at upper left corner?
7200 PRINT TAB(10)"TOF switch pushed?":PRINT TAB(10)"1200 baud?
7210 PRINT TAB(20)"(y/n) ";
7220 A$=INPUT$(1):IF A$=CHR$(13) THEN A$="y"
7230 PRINT A$:IF A$<>"y" THEN 1140
7240 WIDTH LPRINT LW
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
7290 PI=1 ' done
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 '



				SETSEARCH SUB


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 if you don't care "; 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(32);:LINE INPUT"Expression to look for? "; 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$(1)="": RETURN
7670 PRINT:FOR J=0 TO 9
7680	INPUT"Number of field to search - RETURN if you don't care ";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(32);:LINE INPUT"Expression to look for? "; 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 '



				LOAD DEFAULT FORMAT CONTROLS


7880 PRINT:PRINT TAB(31)"Installing format 0.
7890 FO$="0":FFN$="":FFD$="":TM=0:LTM=4:LM=0:LLM=13:SW=79:LW=79:RS=0:RP=0
7900 LLP=66-LTM-NC-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=1
7955 EB=0:LEB=1
7960 FOR I=1 TO NC
7970	SQ(I)=I:FM(I)=1:LFM(I)=1: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)=8:

	FL(I)=0:LFL(I)=0:FB(I)=1:LFB(I)=1
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"Number 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