1000 GOSUB 5840 'cs 1010 PRINT:PRINT TAB(29);"DPUT - 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$ 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"+"; 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 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 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