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