home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / cpm / database / dims103.ark / DNADIN.ASC < prev    next >
Encoding:
Text File  |  1986-12-07  |  3.4 KB  |  140 lines
  1. 1000 GOSUB 1790 'cs
  2. 1010 PRINT:PRINT TAB(27);"NADIN 1.02 - October 9, 1983
  3. 1020 ' by Dan Dugan -- public domain
  4. 1030 PRINT:PRINT"Inputs from a NAD-like data file to a DIMS 'standard' format mailing list.
  5. 1040 PRINT
  6. 1050 DEFINT A-Z
  7. 1060 COMMON I,J,K,X,Y,T$,R$,S$,T1$,SKIPPARSE,FT,SEARCH,
  8.  
  9.     C,N,NC,P6,P7,P8,P9,PI,S,T,T1,T2,C(),B$(),N$(),
  10.  
  11.     SEARCHWORD$(),SEARCHFIELD(),SKIPWORD$(),LOOKFIELD(),DD$(),F$,FT$
  12. 1070 DIM V$(5)
  13. 1080 '
  14.  
  15.  
  16.                 OPEN SOURCE FILE
  17.  
  18.  
  19. 1090 PRINT:INPUT"Name of source file";X$
  20. 1100 GOSUB 1820:F2$=Y$        'ucv
  21. 1110 IF MID$(F2$,2,1)=":" THEN 1130
  22. 1120 F2$=DD$(5)+F2$
  23. 1130 '
  24.  
  25.  
  26.         TEST FOR EXISTENCE
  27.  
  28.  
  29. 1140 ON ERROR GOTO 1170
  30. 1150    OPEN"I",3,F2$
  31. 1160    ON ERROR GOTO 0:GOTO 1210    'ok
  32. 1170 CLOSE 3
  33. 1180 IF ERR=53 THEN CLOSE 3:PRINT"File not found":RESUME 1080
  34. 1190 IF ERR=64 THEN PRINT"Bad file name, try again.":RESUME 1080
  35. 1200 ON ERROR GOTO 0
  36. 1210 '
  37.  
  38.  
  39.                 READ FILE, PARSE
  40.  
  41.  
  42. 1220 GOSUB 1740            'exit
  43. 1230 IF EOF(3) THEN 1690
  44. 1240 FOR I=1 TO NC:B$(I)="":NEXT:NR=NR+1
  45. 1250 LINE INPUT #3,L$
  46. 1260 PRINT L$
  47. 1270 L1$=MID$(L$,2,92):STATE$=MID$(L$,97,2):ZIP$=MID$(L$,102,5):NOTE$=MID$(L$,110,13):L$=""
  48. 1280 X=INSTR(L1$,"*")
  49. 1281    IF X<>0 THEN 1290
  50. 1282    X=INSTR(L1$,CHR$(34))
  51. 1283    X$=LEFT$(L1$,X-1):GOSUB 1940:V$(1)=X$:V$(2)="":L1$=MID$(L1$,X+3):GOTO 1320
  52. 1290 V$(1)=LEFT$(L1$,X-1):L1$=MID$(L1$,X+1)
  53. 1300 X=INSTR(L1$,CHR$(34))
  54. 1310 X$=LEFT$(L1$,X-1):GOSUB 1940:V$(2)=X$:L1$=MID$(L1$,X+3)
  55. 1320 X=INSTR(L1$,CHR$(34))
  56. 1330 V$(3)=LEFT$(L1$,X-1):L1$=MID$(L1$,X+3)
  57. 1340 X=INSTR(L1$,CHR$(34))
  58. 1350 V$(4)=LEFT$(L1$,X-1)
  59. 1360 V$(5)=MID$(L1$,X+3):L1$=""
  60. 1370 '                PUT INTO DIMS ARRAY
  61. 1380 B$(1)=V$(1)
  62. 1390 B$(2)=V$(2)
  63. 1400 IF V$(4)="" THEN 1410 ELSE 1430
  64. 1410 B$(3)="":B$(4)=V$(3):B$(5)=V$(5)+" "+STATE$:B$(6)=ZIP$
  65. 1420 X$=NOTE$:GOSUB 1910:B$(9)=X$:GOTO 1450
  66. 1430 B$(3)=V$(3):B$(4)=V$(4):B$(5)=V$(5)+" "+STATE$:B$(6)=ZIP$
  67. 1440 X$=NOTE$:GOSUB 1910:B$(9)=X$
  68. 1450 '
  69.  
  70.  
  71.                 ADD RECORD TO DIMS FILE
  72.  
  73.  
  74. 1460 T$=""
  75. 1470 FOR J=1 TO NC
  76. 1480    IF LEN(T$)+LEN(B$(J))+1>FT*128
  77.  
  78.     THEN PRINT"Record too long."
  79. 1490    T$=T$+B$(J)+CHR$(126)
  80. 1500 NEXT
  81. 1510 N=N+1:PRINT N;T$
  82. 1520 GOSUB 1550:PRINT"*";:GOSUB 1620:PRINT"!":C=1
  83. 1530 '
  84.  
  85.  
  86.                 LOOP
  87.  
  88.  
  89. 1540 GOTO 1210
  90. 1550 '
  91.  
  92.  
  93.         (SUB) WRITE T$ AS RECORD # N
  94.  
  95.  
  96. 1560 ON FT GOTO 1590,1570
  97. 1570 LSET R$=MID$(T$,129)    'latter half
  98. 1580 PUT #1,FT*N+2
  99. 1590 LSET R$=LEFT$(T$,128)    'first half
  100. 1600 PUT #1,FT*N+1
  101. 1610 RETURN
  102. 1620 '
  103.  
  104.  
  105.         (SUB) WRITE T$ AS DUPE REC N
  106.  
  107.  
  108. 1630 ON FT GOTO 1660,1640
  109. 1640 LSET S$=MID$(T$,129)
  110. 1650 PUT #2,FT*N+2
  111. 1660 LSET S$=LEFT$(T$,128)
  112. 1670 PUT #2,FT*N+1
  113. 1680 RETURN
  114. 1690 '
  115.  
  116.  
  117.                 FINISH
  118.  
  119.  
  120. 1700 CLOSE 3
  121. 1710 PRINT:PRINT NR"records added.
  122. 1720 PRINT:PRINT TAB(32)"Re-loading DEDIT.
  123. 1730 CHAIN DD$(1)+"DEDIT",1000
  124. 1740 '
  125.  
  126.  
  127.  
  128.                 EXIT TEST (TERM DEP)
  129.  
  130.  
  131. 1750 X$=INKEY$:X=0
  132. 1760 IF X$<>"" THEN X=ASC(X$)
  133. 1770 IF X=27 THEN CLOSE 3:GOTO 1690    'use ESC to escape listing
  134. 1780 RETURN
  135. 1790 '
  136.  
  137.  
  138.  
  139.                 CLEAR SCREEN (TERM DEP)
  140.  
  141.  
  142. 1800 PRINT CHR$(12);
  143. 1810 RETURN
  144. 1820 '
  145.  
  146.  
  147.                 (SUB) UCV
  148.  
  149.  
  150. 1830 Y$=""
  151. 1840 FOR K=1 TO LEN(X$)
  152. 1850    Y$=Y$+CHR$(32)
  153. 1860    X=ASC(MID$(X$,K,1))
  154. 1870    IF 96<X AND X<123 THEN MID$(Y$,K,1)=CHR$(X-32):GOTO 1890
  155. 1880    MID$(Y$,K,1)=MID$(X$,K,1)
  156. 1890 NEXT
  157. 1900 RETURN
  158. 1910 '                (SUB) TRIM LEFT SPACES from X$
  159. 1920 IF LEFT$(X$,1)=" " THEN X$=RIGHT$(X$,LEN(X$)-1) ELSE RETURN
  160. 1930 GOTO 1920
  161. 1940 '                (SUB) TRIM RIGHT SPACES from X$
  162. 1950 IF RIGHT$(X$,1)=" " THEN X$=LEFT$(X$,LEN(X$)-1) ELSE RETURN
  163. 1960 GOTO 1950
  164. 
  165. 1940 '                (SU