1000 GOSUB 7180 'cs
1010 PRINT:PRINT TAB(29);"DGET - March 20, 1982
1015 ' by Dan Dugan -- public domain
1020 PRINT
1030 DEFINT A-Z
1040 COMMON I,J,K,X,Y,T$,R$,S$,T1$,SKIPPARSE,FT,SEARCH,
C,N,NC,P6,P7,P8,P9,PI,S,T,T1,T2,C(),B$(),N$(),
SEARCHWORD$(),SEARCHFIELD(),SKIPWORD$(),LOOKFIELD(),DD$(),F$,FT$
1055 DIM DEST(30),USED(30)
1060 '
OPEN SOURCE FILE
1070 PRINT:INPUT"Name of source file";X$
1080 GOSUB 7290:F2$=Y$ 'ucv
1090 IF MID$(F2$,2,1)=":" THEN 1120
1100 F2$=DD$(5)+F2$
1120 '
TEST FOR EXISTENCE
1130 ON ERROR GOTO 1160
1140 OPEN"I",3,F2$
1150 ON ERROR GOTO 0:GOTO 1210 'ok
1160 CLOSE 3
1170 IF ERR=53 THEN CLOSE 3:PRINT"File not found":RESUME 1060
1180 IF ERR=64 THEN PRINT"Bad file name, try again.":RESUME 1060
1190 ON ERROR GOTO 0
1210 '
ENTER SEQUENCE OF FIELDS
1212 PRINT:PRINT"Here's the first line of "F2$".
1214 LINE INPUT#3,T1$
1216 PRINT:PRINT T1$
1218 CLOSE 3:OPEN"I",3,F2$
1220 PRINT:INPUT"Number of fields in the source file records";NF
1225 PRINT:FOR I=1 TO NC:USED(I)=0:NEXT
1230 FOR I=1 TO NF
1240 PRINT"Destination field of field"I;:INPUT DEST(I)
1245 IF DEST(I)>NC THEN 1240
1247 IF DEST(I)=0 THEN 1270
1250 IF USED(DEST(I)) THEN 1240
1260 USED(DEST(I))=1
1270 NEXT
1280 PRINT:PRINT"Is this ok (y/n)?";
1282 A$=INPUT$(1):PRINT A$
1284 IF A$<>"y" THEN CLOSE 3:GOTO 1060
1286 C=1:PRINT
1300 '
READ FILE
1305 GOSUB 7140 'exit
1310 IF EOF(3) THEN 7020
1315 FOR I=1 TO NC:B$(I)="":NEXT:NR=NR+1
1320 FOR I=1 TO NF
1330 IF EOF(3) THEN 7020
1340 INPUT#3,T1$
1350 IF DEST(I) THEN 1352 ELSE 1360
1352 QUOTE=INSTR(T1$,CHR$(126))
1353 IF QUOTE THEN MID$(T1$,QUOTE,1)=CHR$(34):GOTO 1352
1355 B$(DEST(I))=T1$
1360 NEXT
1370 '
ADD RECORD TO DIMS FILE
1380 T$=""
1390 FOR J=1 TO NC
1400 IF LEN(T$)+LEN(B$(J))+1>FT*128
THEN PRINT"Record too long."
1410 T$=T$+B$(J)+CHR$(126)
1420 NEXT
1425 N=N+1:PRINT N;T$;
1430 GOSUB 1450:PRINT"*";:GOSUB 1520:PRINT"!":C=1
1440 '
LOOP
1445 GOTO 1300
1450 '
(SUB) WRITE T$ AS RECORD # N
1460 ON FT GOTO 1490,1470
1470 LSET R$=MID$(T$,129) 'latter half
1480 PUT #1,FT*N+2
1490 LSET R$=LEFT$(T$,128) 'first half
1500 PUT #1,FT*N+1
1510 RETURN
1520 '
(SUB) WRITE T$ AS DUPE REC N
1530 ON FT GOTO 1560,1540
1540 LSET S$=MID$(T$,129)
1550 PUT #2,FT*N+2
1560 LSET S$=LEFT$(T$,128)
1570 PUT #2,FT*N+1
1580 RETURN
7020 '
FINISH
7024 CLOSE 3
7025 PRINT:PRINT NR"records added.
7030 PRINT:PRINT TAB(32)"Re-loading DEDIT.
7040 CHAIN DD$(1)+"DEDIT",1000
7140 '
EXIT TEST (TERM DEP)
7150 X$=INKEY$:X=0
7152 IF X$<>"" THEN X=ASC(X$)
7160 IF X=27 THEN CLOSE 3:GOTO 7020 'use ESC to escape listing
7170 RETURN
7180 '
CLEAR SCREEN (TERM DEP)
7190 PRINT CHR$(12);
7200 RETURN
7290 '
(SUB) UCV
7300 Y$=""
7310 FOR K=1 TO LEN(X$)
7320 Y$=Y$+CHR$(32)
7330 X=ASC(MID$(X$,K,1))
7340 IF 96<X AND X<123 THEN MID$(Y$,K,1)=CHR$(X-32):GOTO 7360
7350 MID$(Y$,K,1)=MID$(X$,K,1)
7360 NEXT
7370 RETURN
