home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / DATABASE / DIMS103.ARK / DEDIT.ASC < prev    next >
Text File  |  1986-12-07  |  26KB  |  1,028 lines
  1. 10 '            ******* DEDIT *******
  2.  
  3. 15 PRINT"DEDIT must be entered from DIMS.
  4. 20 STOP
  5. 1000 '
  6.  
  7.                 PROGRAM BEGINS HERE
  8.  
  9. 1010 PRINT:PRINT TAB(26);"DEDIT 1.03 - January 10, 1984
  10. 1020 DEFINT A-Z
  11. 1030 COMMON I,J,K,X,Y,T$,R$,S$,T1$,SKIPPARSE,FT,SEARCH,
  12.     C,N,NC,P6,P7,P8,P9,PI,S,T,T1,T2,C(),B$(),N$(),
  13.     SEARCHWORD$(),SEARCHFIELD(),SKIPWORD$(),LOOKFIELD(),DD$(),F$,FT$
  14. 1031 'use of PI discontinued as of v. 1.03
  15. 1040 ON ERROR GOTO 7000
  16. 1050 '
  17.         DIM FOR FORMAT
  18.  
  19. 1060 DIM SQ(NC+1),FM(NC),LFM(NC),F2$(NC),LF2$(NC)
  20. 1070 DIM NLL(NC),LNLL(NC),NLC(NC),LNLC(NC)
  21. 1080 DIM PU$(NC),LPU$(NC),DLL(NC),LDLL(NC),DLC(NC),LDLC(NC)
  22. 1090 DIM FMB(NC),LFMB(NC),FL(NC),LFL(NC),FB(NC),LFB(NC)
  23. 1100 GOSUB 7870 ' load default format
  24. 1110 IF T=0 THEN T1=N:T2=N:PRINT:PRINT"Here's the last record:":GOTO 2900
  25. 1120 '
  26.  
  27.         COMMAND PROCESSOR
  28.         ENTER HERE AFTER FINISHING COMMAND
  29.  
  30. 1130 E$="" ' error msg
  31. 1140 '
  32.  
  33.         ENTER WITH ERROR
  34.  
  35. 1150 FOR I=1 TO 10:C$(I)="":NEXT ' clear
  36. 1160 '
  37.  
  38.         ACCEPT COMMAND
  39.  
  40. 1170 IF E$<>"" THEN PRINT CHR$(7);
  41. 1180 PRINT CHR$(13);
  42. 1190 IF RS THEN X=24:Y=1:GOSUB 6700
  43. 1200 PRINT SPC(79); CHR$(13);
  44. 1210 PRINT E$"  ";:E$="":PRINT"Edit ";F$;": ";
  45. 1212 IF RS THEN LINE INPUT;A$: GOTO 1220
  46. 1214 LINE INPUT A$
  47. 1220 IF A$="" THEN 1210
  48. 1230 '
  49.  
  50.         PARSE COMMAND
  51.  
  52. 1240 A$=A$+" "
  53. 1250 J=0
  54. 1260 K=INSTR(A$,CHR$(32))
  55. 1265 IF J=10 THEN 1320
  56. 1270 J=J+1
  57. 1280 IF K=0 THEN 1320
  58. 1290 C$(J)=MID$(A$,1,K-1)
  59. 1300 A$=MID$(A$,K+1)
  60. 1310 GOTO 1260
  61. 1320 C$(J)=CHR$(13)
  62. 1330 '
  63.  
  64.  
  65. 1340 IF LEFT$(C$(1),3)="rep" THEN J=2: GOSUB 1790: GOTO 2580
  66. 1345 '
  67.  
  68.         DEFAULTS
  69.  
  70. 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:
  71.     FLAG=0:FLAG$=""
  72. 1360 '
  73.  
  74.         PROCESS WORD MATRIX
  75. 1370 J=0
  76. 1380 '
  77.  
  78.         LOOP TO HERE TO CHECK NEXT WORD
  79.  
  80. 1390 J=J+1
  81. 1400 GOSUB 1790 ' range
  82. 1410 IF C$(J)=CHR$(13) THEN 2580 ' do it
  83. 1420 C1$=LEFT$(C$(J),3)
  84. 1430 '
  85.  
  86.         FINAL COMMANDS
  87.  
  88. 1440 IF C1$="add" THEN T=1: GOTO 2580
  89. 1450 IF C1$="fie" THEN GOSUB 2060:GOTO 1120
  90. 1460 IF C1$="ins" THEN T=4:
  91.     GOTO 1390 '                    unfinished
  92. 1470 IF C1$="don" THEN T=9: GOTO 2580
  93. 1490 IF C1$="ren" THEN T=12: GOTO 2580 ' renumber
  94. 1500 IF C1$="for" THEN 2170
  95. 1505 IF C1$="bac" THEN T=11:GOTO 2580
  96. 1506 IF C1$="pro" THEN 8620
  97. 1507 IF C1$="got" THEN T=7:B$(0)=C$(J+1):GOTO 2580    'goto
  98. 1510 '
  99.  
  100.         RECIRCULATING COMMANDS
  101.  
  102. 1514 IF C1$="cha" THEN T=3:GOTO 1390
  103. 1515 IF C1$="del" THEN T=10:GOTO 1390
  104. 1520 IF C1$="lis" THEN T=2:GOTO 1390
  105. 1530 IF C1$="fin" THEN 1532 ELSE 1540
  106. 1532    J=J+1:SEARCH=2:SKIPPARSE=1
  107. 1534    X=INSTR(C$(J),CHR$(95)):IF X THEN Y=LEN(C$(J)):GOTO 1535 ELSE 1538
  108. 1535    C$(J)=LEFT$(C$(J),X-1)+" "+RIGHT$(C$(J),Y-X)
  109. 1536 GOTO 1534
  110. 1538    SEARCHWORD$(0)=C$(J):GOTO 1390
  111. 1540 IF C1$="sel" THEN SEARCH=1:GOTO 1390
  112. 1550 IF C1$="pri" THEN P9=1:GOTO 1390
  113. 1560 IF C1$="cop" THEN P7=1:GOTO 1390 'dims out
  114. 1570 IF C1$="wri" THEN P6=1:GOTO 1390 ' not implem.
  115. 1580 IF C1$="and" THEN GOTO 1390
  116. 1590 IF C1$="pag" THEN PG=VAL(C$(J+1)):LPG=PG: J=J+1: GOTO 1390
  117. 1600 IF C1$="mar" THEN LLM=VAL(C$(J+1)): J=J+1: GOTO 1390
  118. 1610 IF C1$="fla" THEN GOSUB 8550:GOTO 1390
  119. 1620 '
  120.  
  121.         TRANSIENT COMMANDS
  122.  
  123. 1630 X$=C$(J): GOSUB 7070: C$(J)=Y$ ' UCV
  124. 1640 ON ERROR GOTO 1740
  125. 1650 ' open this way to test
  126. 1660 OPEN"I",3,DD$(2)+"D"+C$(J)+".BAS"
  127. 1670 ' if it's there, close it and chain
  128. 1680 CLOSE 3: T$=C$(J):J=J+1
  129. 1690 '
  130.  
  131.         GO CHAIN
  132.  
  133. 1700 GOSUB 1790
  134. 1705 IF T2=0 THEN T2=N
  135. 1710 IF P9 THEN GOSUB 7160
  136. 1720 IF SEARCH=1 THEN GOSUB 7460
  137. 1725 PRINT:PRINT TAB(19);"Please wait while transient program loads.
  138. 1730 CHAIN DD$(2)+"D"+T$,1000
  139. 1740 '
  140.  
  141.         NO CHAIN
  142.  
  143. 1750 IF ERR=53 OR ERR=64 THEN 1770
  144. 1760 ON ERROR GOTO 0
  145. 1770 CLOSE 3: ON ERROR GOTO 7000: E$=C$(J)+"?": RESUME 1140
  146. 1780 '
  147.  
  148.  
  149.                 (SUB) GET RANGE
  150.  
  151. 1790 '
  152.  
  153.         TEST WORD
  154.  
  155. 1800 IF C1 THEN RETURN ' range done flag
  156. 1810 C3=VAL(C$(J))
  157. 1820 IF C3>0 THEN 1830 ELSE 1850
  158. 1830 IF C3>N THEN C3=N
  159. 1840 T1=C3: GOTO 1910
  160. 1850 IF C$(J)="from" THEN J=J+1: T2=N:GOTO 1790
  161. 1860 IF C$(J)="all" THEN T1=1: T2=N: GOTO 2050
  162. 1870 IF C$(J)="."THEN T1=T0: GOTO 1910
  163. 1880 IF C$(J)="next"THEN T1=T0+1: GOTO 1910
  164. 1890 IF C$(J)="to" THEN GOTO 1910
  165. 1900 RETURN
  166. 1910 '
  167.         LOOK FOR 2nd #
  168.  
  169. 1920 J=J+1:IF C$(J)=CHR$(13) THEN 2030
  170. 1930 C3=VAL(C$(J))
  171. 1940 IF C3>0 THEN 1950 ELSE 1980
  172. 1950 IF C3>N THEN C3=N
  173. 1960 T2=C3: IF T1>T2 THEN SWAP T1,T2
  174. 1970 GOTO 2050
  175. 1980 IF C$(J)="to" THEN 1920
  176. 1990 IF C$(J)="." THEN T2=T0: GOTO 2050
  177. 2000 IF C$(J)="next" THEN T2=T0+1: GOTO 2050
  178. 2010 IF C$(J)="end" THEN T2=N: GOTO 2050
  179. 2020 IF C$(J)="last" THEN T2=N:GOTO 2050
  180. 2030 IF T2=0 THEN T2=T1:C1=1 ' if only one number
  181. 2040 RETURN
  182. 2050 J=J+1:C1=1:RETURN
  183. 2060 '
  184.  
  185.         (SUB) HIDE FIELDS
  186.  
  187. 2070 PRINT TAB(24)"Here are the fields in "F$:PRINT
  188. 2075 FOR I=1 TO NC:C(I)=1:NEXT            ' set all to show
  189. 2080 GOSUB 7800
  190. 2110 FOR I=1 TO NC
  191. 2120    PRINT TAB(27)"Show "LEFT$(N$(I),4)"? (y/n) ";
  192. 2130    A$=INPUT$(1):IF A$=CHR$(13) THEN A$="y"
  193. 2140    PRINT A$:IF A$="n" THEN C(I)=0
  194. 2150 NEXT
  195. 2160 RETURN
  196. 2170 '
  197.  
  198.                 FORMAT COMMAND
  199.  
  200. 2190 IF C$(J+1)="0" THEN 2290
  201. 2200 IF C$(J+1)=CHR$(13) THEN 2202 ELSE 2210
  202. 2202 '
  203.  
  204.         SHOW AVAILABLE FORMATS
  205.  
  206. 2203 PRINT:PRINT"Here are the available formats:":PRINT
  207. 2204 WIDTH 70:FILES DD$(5)+"*.DFO":WIDTH 255:PRINT:PRINT
  208. 2205 INPUT"Enter the desired format name or just RETURN:  ",X$
  209. 2206 IF X$="" THEN 2290 ELSE GOSUB 7070:GOTO 2220
  210. 2210 J=J+1:X$=C$(J):GOSUB 7070 'UCV
  211. 2220 FO$=Y$
  212. 2230 ON ERROR GOTO 2260
  213. 2240 OPEN"I",3,DD$(5)+FO$+".DFO"
  214. 2250 ON ERROR GOTO 7000:GOTO 2330 ' do this if OK
  215. 2260    IF ERR=64 OR ERR=53 THEN 2280
  216. 2270    ON ERROR GOTO 0
  217. 2280 ON ERROR GOTO 7000:E$="Format "+FO$+" not available on this disk.":
  218.     CLOSE 3:RESUME 1140
  219. 2290 '
  220.  
  221.         LOAD FORMAT 0
  222.  
  223. 2300 FO$="0"
  224. 2310 GOSUB 7870 'do it
  225. 2320 GOTO 1120
  226. 2330 '
  227.  
  228.         LOAD FORMAT FILE
  229.  
  230. 2335 ON ERROR GOTO 2572
  231. 2340 INPUT#3,FO$ ' filename
  232. 2350 LINE INPUT #3,A$ 'dummy for date$
  233. 2360 INPUT#3,TM,LTM,LM,LLM,SW,LW,RS,RP,LS,LLP,HMI,VMI
  234. 2370 LINE INPUT#3,A$ 'dummy for FSC$ not implemented yet
  235. 2380 LINE INPUT#3,HL1$:LINE INPUT#3,HL2$:LINE INPUT #3,HL3$
  236. 2390 LINE INPUT#3,LHL1$:LINE INPUT#3,LHL2$:LINE INPUT#3,LHL3$
  237. 2400 INPUT#3,HB,LHB,RM,LRM,RLL,LRLL,RLC,LRLC,RNB,LRNB
  238. 2410 I=0
  239. 2420    I=I+1:IF I>NC+1 THEN 2440
  240. 2425    INPUT#3,SQ(I):IF SQ(I)=0 THEN 2440
  241. 2427    IF SQ(I)>NC THEN SQ(I)=NC 'limiter
  242. 2430    GOTO 2420
  243. 2440 INPUT#3,EB,LEB
  244. 2450 FOR J=1 TO NC
  245. 2460    IF EOF(3) THEN 2570
  246. 2470    K=SQ(J)
  247. 2480    INPUT#3,FM(K),LFM(K)
  248. 2490    LINE INPUT#3,F2$(K):LINE INPUT#3,LF2$(K)
  249. 2500    INPUT#3,NLL(K),LNLL(K),NLC(K),LNLC(K),FMB(K),LFMB(K)
  250. 2510    INPUT#3,DLL(K),LDLL(K),DLC(K),LDLC(K)
  251. 2520    LINE INPUT#3,PU$(K):LINE INPUT#3,LPU$(K)
  252. 2530    INPUT #3,FL(K),LFL(K),FB(K),LFB(K)
  253. 2540        X=LEN(PU$(K)):IF X THEN FL(K)=X
  254. 2550 NEXT
  255. 2555 ON ERROR GOTO 7000
  256. 2570 CLOSE 3:E$="Format "+FO$+" loaded.":GOTO 1140
  257. 2572 ON ERROR GOTO 7000:RESUME 2575
  258. 2575 CLOSE 3:E$="Error in loading format.":GOTO 1140
  259. 2580 '
  260.  
  261.  
  262.                 EXECUTIVE BRANCH
  263.  
  264.  
  265. 2590 '
  266.         JUNK TRAP
  267.  
  268. 2600 IF P9 AND T=1 THEN E$="Not allowed, try again.":GOTO 1140
  269. 2610 IF T2=0 THEN T2=N ' fix
  270. 2620 IF N=0 AND NOT (T=1 OR T=9) THEN E$="File is empty.": GOTO 1140
  271. 2630 '
  272.         SET-UPS
  273.  
  274. 2640 IF P9 THEN GOSUB 7160
  275. 2650 IF P7 THEN GOSUB 8020
  276. 2660 IF E$<>"" THEN GOTO 1140
  277. 2670 IF SEARCH=1 THEN GOSUB 7460
  278. 2690 '         1    2    3    4    5    6    7    8    9    10   11   12
  279. 2700 ON T GOTO 2730,2900,2770,1120,1120,1120,2720,1120,2720,2900,2720,2720
  280. 2710 GOTO 1120 '    junk trap
  281. 2720 '
  282.  
  283.  
  284.                 EXIT TO DIMS
  285.  
  286. 2725 PRINT:PRINT TAB(27)"Waiting while loading DIMS.":CHAIN DD$(1)+"DIMS",1000
  287. 2730 '
  288.  
  289.  
  290.                 ADD COMMAND
  291.  
  292. 2740 N1=0 ' start
  293. 2750 I=N+1
  294. 2760 GOTO 4000
  295. 2770 '
  296.  
  297.  
  298.                 SET-UP CHANGE
  299.  
  300. 2780 IF T1=T2 THEN 2810
  301. 2790 PRINT:PRINT TAB(20);"Select fields to change? (n/y) ";:
  302.     A$=INPUT$(1):IF A$=CHR$(13) THEN A$="n"
  303. 2800 PRINT A$: IF A$="y" THEN 2830
  304. 2810 FOR I=1 TO NC:
  305.     IF C(I)<>0 THEN C(I)=2
  306. 2820 NEXT I: GOTO 2900 ' all 2's
  307. 2830 PRINT
  308. 2840 FOR I=1 TO NC
  309. 2850    IF C(I)=0 THEN 2890
  310. 2860    IF C(I)=2 THEN C(I)=1
  311. 2870    PRINT TAB(25);"Change "LEFT$(N$(I),4)"? (y/n) ";:
  312.     A$=INPUT$(1):IF A$=CHR$(13) THEN A$="y"
  313. 2880    PRINT A$:
  314.     IF A$="y" THEN C(I)=2
  315. 2890 NEXT I
  316. 2900 '
  317.  
  318.  
  319.  
  320.                 RECORD WORK LOOP
  321.  
  322. 2910 C0=0:RC=0:LRC=0'first time
  323. 2930 FOR I=T1 TO T2 '            <-------- FOR
  324. 2940 GOSUB 6200 ' get rec
  325. 2950 IF ASC(T$)=0 THEN PRINT"0";:GOTO 5770
  326. 2960 PRINT"+";
  327. 2970 T1$=T$ ' save it
  328. 2980 IF SKIPPARSE THEN 3010
  329. 2990 GOSUB 6500 ' parse record string
  330. 3000 IF T=0 THEN 4000
  331. 3010 IF SEARCH=0 THEN 3310
  332. 3020 '
  333.  
  334.  
  335.                 SEARCH
  336.  
  337. 3030 IF SEARCH<>2 THEN 3100
  338. 3035 '
  339.  
  340.     FIND
  341.  
  342. 3040 IF INSTR(T1$,SEARCHWORD$(0))=0 THEN 5770
  343. 3060 IF P9=0 THEN PRINT CHR$(7); ' found it
  344. 3070 GOSUB 6500 ' parse
  345. 3080 GOTO 3310
  346. 3090 '
  347.     LOOK FOR SKIPS
  348.  
  349. 3100 J=0
  350. 3110 IF SKIPWORD$(J)="" THEN 3190 ' try search then
  351. 3120 IF LOOKFIELD(J) THEN 3160 ' look in field
  352. 3130 IF INSTR(T1$,SKIPWORD$(J)) THEN 5770 ' whole rec search
  353. 3140 J=J+1
  354. 3150 GOTO 3110
  355. 3160 IF INSTR(B$(LOOKFIELD(J)),SKIPWORD$(J)) THEN 5770 ' field compare
  356. 3165 IF B$(LOOKFIELD(J))="" AND SKIPWORD$(J)="_" THEN 5770 'blank field
  357. 3170 J=J+1
  358. 3180 GOTO 3110
  359. 3185 '
  360.  
  361.     SEARCH
  362.  
  363. 3190 IF SEARCHWORD$(0)="" THEN 3290 ' only when skips are all you want
  364. 3200 J=0: GOTO 3220 '        now search
  365. 3210 IF SEARCHWORD$(J)="" THEN 5770 ' hesitate no longer
  366. 3220 IF SEARCHFIELD(J) THEN 3260 ' field
  367. 3230 IF INSTR(T1$,SEARCHWORD$(J)) THEN 3290 '    unparsed search
  368. 3240 J=J+1
  369. 3250 GOTO 3210
  370. 3260 IF INSTR(B$(SEARCHFIELD(J)),SEARCHWORD$(J)) THEN 3290
  371. 3265 IF B$(SEARCHFIELD(J))="" AND SEARCHWORD$(J)="_" THEN 3290
  372. 3270 J=J+1
  373. 3280 GOTO 3210
  374. 3290 
  375.     IF P9=0 THEN PRINT CHR$(7);            'TERM DEP
  376. 3300 IF SKIPPARSE THEN GOSUB 6500 ' parse
  377. 3310 '
  378.  
  379.  
  380.                 PAUSE
  381.  
  382. 3320 IF C0=0 OR T=3 OR T=10 OR P7 OR P9 THEN 4000
  383.     ' when not to pause, C0 is for first time
  384. 3330 GOSUB 6100 ' exit
  385. 3340 IF A=122 THEN 4000        'z
  386. 3350 IF RS THEN IF RC=RS THEN X=24:Y=1:GOSUB 6700
  387. 3360 PRINT I"Ready>";
  388. 3370 A$=INPUT$(1):A=ASC(A$)
  389. 3372 IF A=27 THEN IF (P6 OR P7) THEN GOSUB 8410:GOTO 1120
  390.                 ELSE GOTO 1120
  391. 3375 PRINT A$:IF A=104 THEN 3400 ELSE 4000    'h
  392. 3400 '
  393.  
  394.         PAUSE HELP
  395.  
  396. 3410 PRINT:PRINT TAB(5)"The program is waiting for just one keystroke;
  397. 3420 PRINT:PRINT TAB(10)"h will print this message,
  398. 3430 PRINT TAB(10)"SPACE will show the next record,
  399. 3440 PRINT TAB(10)"z will show the next record and keep going until you SPACE,
  400. 3450 PRINT TAB(10)"ESC will quit the sequence you're in and go to edit command level.
  401. 3460 PRINT:GOTO 3330
  402. 4000 '
  403.  
  404.                 ADD, CHA OR SHOW REC I
  405.  
  406. I=rec #, J=seq #, K=field #, L=rec length
  407. C0=not first time, C3=backup flag
  408. C(K): 0=skip field, 1=norm, 2=change
  409.  
  410. 4010 T0=I
  411. 4020 IF P9 AND T<>10 THEN 5040
  412. 4030 '
  413.         NEW SCREEN?
  414.  
  415. 4040 C0=1
  416. 4050 IF RS=0 OR (RC>0 AND RC<RS) THEN 4160
  417. 4060 GOSUB 7430 'cs
  418. 4070 RC=0:PG=PG+1
  419. 4080 PRINT CHR$(13);'CR
  420. 4090 X=TM:GOSUB 6730 ' top margin
  421. 4100 IF HL1$<>"" THEN PRINT HL1$;
  422. 4110 IF RIGHT$(HL1$,1)=" " THEN PRINT"PAGE"PG:GOTO 4130
  423. 4120 PRINT
  424. 4130 IF HL2$<>"" THEN PRINT HL2$
  425. 4140 IF HL3$<>"" THEN PRINT HL3$
  426. 4150 X=HB:GOSUB 6730
  427. 4160 '
  428.         NEW REC - PRINT #?
  429.  
  430. 4170 L=0:RC=RC+1
  431. 4180 IF E$<>"" THEN PRINT CHR$(7);:PRINT:PRINT E$:E$=""
  432. 4190 IF RM=0 THEN 4240
  433. 4200 PRINT
  434. 4210 IF RLL THEN X=RLL:Y=RLC:GOSUB 6700:GOTO 4230
  435. 4220 IF RLC THEN PRINT TAB(RLC);
  436. 4230 PRINT I;:X=RNB:GOSUB 6730
  437. 4240 J=0
  438. 4250 '
  439.         NEW FIELD
  440.  
  441. 4260 J=J+1:C3=0'backup flag
  442. 4270 K=SQ(J) ' current field number (may be in any order)
  443. 4280 IF K=0 THEN X=EB:GOSUB 6730:GOTO 5040 ' next function
  444. 4290 IF C3=1 AND C(K)=0 THEN 4300 ELSE 4320    ' hidden field
  445. 4300    J=J-1:IF J=0 THEN L=0:GOTO 4250
  446. 4310    K=SQ(J):L=L-LEN(B$(K))-1:GOTO 4290
  447. 4320 IF C(K)=0 OR FL(K)<0 THEN
  448.         IF T=1 THEN B$(K)="":L=L+1:GOTO 4250
  449.         ELSE L=L+LEN(B$(K))+1:GOTO 4250 ' skip fwd
  450. 4330 '
  451.         RE-ENTER
  452.  
  453. 4340 IF E$<>"" THEN PRINT:PRINT CHR$(7); E$:E$=""
  454. 4350 GOSUB 4820 'print name
  455. 4360 '
  456.  
  457.         BRANCH
  458.  
  459. 4370 GOSUB 4940 'pos
  460. 4380 IF T=3 AND FLAG=K THEN B$(K)=B$(K)+FLAG$
  461. 4390 IF T=1 GOTO 4410
  462. 4400 IF T=3 AND C(K)=2 THEN GOSUB 4980:PRINT CHR$(10);:GOSUB 4940
  463.     ELSE 4750
  464. 4410 '
  465.  
  466.         CURSOR
  467.  
  468. 4420 L1=FT*128-L-NC+J ' L1=avail space in rec
  469. 4430 IF FL(K) THEN EFL=FL(K) ELSE EFL=SW-POS(0) ' EFL=avail screen space
  470. 4440 IF L1>=EFL THEN 4460
  471. 4450 PRINT SPC(L1-1);"<";:GOSUB 4940 ' pos
  472. 4460 '
  473.         ENTER NEW DATA
  474.  
  475. 4470 IF T=1 AND K=FLAG THEN PRINT FLAG$;
  476. 4480 LINE INPUT; T9$:IF T=1 AND FLAG=K THEN T9$=FLAG$+T9$
  477. 4490 '
  478.         CONTROL ENTRIES
  479.  
  480. 4500    IF T=3 THEN IF T9$="" OR T9$=";" OR T9$="+" THEN
  481.             T9$=B$(K):GOTO 4680 ' no cha
  482. 4510    IF T=1 AND (T9$=";" OR T9$="+") THEN 4520 ELSE 4540
  483. 4520        T9$=B$(K):IF T9$="" THEN T9$=" "
  484. 4530        GOSUB 4940:PRINT T9$;
  485. 4540    IF T9$="stop" THEN IF T=1 THEN E$=STR$(N1)+" records added.":
  486.         T0=I-1:GOTO 1140 ELSE 1120
  487. 4550    IF RIGHT$(T9$,1)<>CHR$(92) THEN 4590
  488. 4560        C3=1:J=J-1:IF J=0 THEN L=0:GOTO 4250
  489. 4570        K=SQ(J):L=L-LEN(B$(K))-1:IF FB(K) THEN PRINT
  490. 4580        GOTO 4280
  491. 4590    IF T9$=" "THEN T9$=""' enter 1 sp to cha to blank
  492. 4600 '
  493.         STRIP RT. SPC
  494.  
  495. 4610 IF RIGHT$(T9$,1)=CHR$(32) THEN T9$=LEFT$(T9$,LEN(T9$)-1):GOTO 4610
  496. 4620 '
  497.         NUM CHECK
  498.  
  499. 4630 IF RIGHT$(N$(K),1)<>"n" THEN 4680
  500. 4640 FOR I1=1 TO LEN(T9$)
  501. 4650    T3=ASC(MID$(T9$,I1,1))
  502. 4660    IF T3<45 OR T3>57 THEN E$="Re-enter; only numbers allowed.":
  503.     GOTO 4330
  504. 4670 NEXT
  505. 4680 '
  506.         LENGTH CHECK
  507.  
  508. 4690 L=L+LEN(T9$)+1
  509. 4700 IF L+NC-J>FT*128 THEN E$="Record too long.  Re-enter, shorter.":GOTO 4160
  510. 4710 '
  511.  
  512.         SAVE IT
  513.  
  514. 4720 B$(K)=T9$
  515. 4730 '
  516.         RE-DISP IN FORM
  517.  
  518. 4740 IF DLL(K) THEN GOSUB 4950:GOTO 4750 ELSE 4770
  519. 4750 '
  520.  
  521.         SHOW DATA
  522.  
  523. 4760 GOSUB 4980 ' print dat
  524. 4770 '
  525.  
  526.         FINISH FIELD
  527.  
  528. 4780 X=FB(K):GOSUB 6730
  529. 4790 GOTO 4250 ' next field
  530. 4800 '
  531.  
  532.         SCREEN DONE
  533.  
  534. 4810 GOTO 5040 ' skip subs
  535. 4820 '
  536.         (SUB) FIELD NAME
  537.  
  538. 4830 IF NLL(K) THEN X=NLL(K):Y=NLC(K):GOSUB 6700:GOTO 4850
  539. 4840 IF NLC(K) THEN PRINT TAB(NLC(K));
  540. 4850 ON FM(K) GOTO 4870,4910 ' plain or special
  541. 4860 GOTO 4930 'skip if 0
  542. 4870 '
  543.     NAME MODE 1
  544.  
  545. 4880  IF RIGHT$(N$(K),1)="n" THEN PRINT LEFT$(N$(K),4)" # ";:GOTO 4930
  546. 4890 PRINT LEFT$(N$(K),4)" : ";
  547. 4900 GOTO 4930
  548. 4910 '
  549.     NAME MODE 2
  550.  
  551. 4920 PRINT F2$(K);
  552. 4930 X=FMB(K):GOSUB 6730:RETURN
  553. 4940 '
  554.         (SUB) POSITION DATA (TERM DEP -- BACKSPACE)
  555.  
  556. 4950 IF DLL(K) THEN X=DLL(K):Y=DLC(K):GOSUB 6700:GOTO 4970
  557. 4960 IF DLC(K) THEN IF POS(I)>DLC(K) THEN
  558.             PRINT STRING$(POS(I)-DLC(K),8);
  559.             ELSE PRINT TAB(DLC(K));
  560. 4970 RETURN
  561. 4980 '
  562.         (SUB) PRINT DATA
  563.  
  564. 4990 IF RIGHT$(N$(K),1)="n" AND PU$(K)<>"&" AND PU$(K)<>""
  565.     THEN N1!=VAL(B$(K)):GOTO 5020
  566. 5000 IF FL(K) THEN X$=LEFT$(B$(K),FL(K)) ELSE X$=B$(K)
  567. 5010 PRINT X$;:GOTO 5030
  568. 5020 PRINT USING PU$(K);N1!;
  569. 5030 RETURN
  570. 5040 '
  571.  
  572.         LPRINT AND WRITE
  573.  
  574. LP=real prnt pos
  575. LTM=top marg    LPG=pg count
  576. RP=rec/pg    LRC=rec count
  577. LLP=cond. pg    LLC=line count
  578.  
  579. 5050 IF T=0 GOTO 5790
  580. 5060 IF P9=0 THEN 5580 ' done
  581. 5070 '
  582.         START PRINTING
  583.  
  584. 5080 IF C0=0 THEN C0=1:LRC=0:LLC=1:
  585.     IF LPG=1 THEN X=LTM:GOSUB 7310:
  586.         LPRINT"FILE:  "F$ TAB(30)"DATE:"TAB(50)"SELECTION:":
  587.         LLC=LLC+1:GOTO 5120
  588.     ELSE 5120
  589. 5090 '
  590.         NEW PAGE?
  591.  
  592. 5100 IF (RP AND LRC=RP) OR LLC>LLP THEN GOSUB 7410 ELSE 5190 'FF
  593. 5110 '
  594.     PRINT HEADING
  595.  
  596. 5120 X=LTM:GOSUB 7310 'CR
  597. 5130 IF LHL1$<>"" THEN LPRINT LHL1$; ELSE 5160
  598. 5140 IF RIGHT$(LHL1$,1)=CHR$(32) THEN LPRINT"PAGE"LPG:GOTO 5160
  599. 5150 LPRINT:LLC=LLC+1
  600. 5160 IF LHL2$<>"" THEN LPRINT LHL2$:LLC=LLC+1
  601. 5170 IF LHL3$<>"" THEN LPRINT LHL3$:LLC=LLC+1
  602. 5180 X=LHB:GOSUB 7310 'CR
  603. 5190 '
  604.         NEW REC - LPRINT #?
  605.  
  606. 5200 LRC=LRC+1 ' counts recs on pg
  607. 5210 IF LRM=0 THEN 5250
  608. 5220 IF LRLL THEN X=LRLL:Y=LRLC:GOSUB 7330:GOTO 5240
  609. 5230 IF LRLC THEN Y=LRLC:GOSUB 7360 ' tab
  610. 5240 C1=LPOS(0):A$=STR$(I):A$=RIGHT$(A$,LEN(A$)-1):
  611.     LPRINT A$;:LP=LP+LPOS(0)-C1:X=LRNB:GOSUB 7310 ' CR
  612. 5250 J=0
  613. 5260 '
  614.         NEW FIELD
  615.  
  616. 5270 J=J+1
  617. 5280 K=SQ(J)
  618. 5290 IF K=0 THEN X=LEB:GOSUB 7310:GOTO 5580 ' done  ======>
  619. 5300 IF (C(K)=0) OR (LFL(K)<0) THEN 5260 'skip
  620. 5310 GOSUB 5340 'name
  621. 5320 GOSUB 5470:GOSUB 5510 'pos & lprint data
  622. 5330 X=LFB(K):GOSUB 7310:GOTO 5270 'next field
  623. 5340 '
  624.  
  625.         (SUB) LPRINT FIELD NAME
  626.  
  627. 5350 IF LNLL(K) THEN X=LNLL(K):Y=LNLC(K):GOSUB 7330:GOTO 5370
  628. 5360 IF LNLC(K) THEN Y=LNLC(K):GOSUB 7360 ' tab
  629. 5370 ON LFM(K) GOTO 5390,5420
  630. 5380 GOTO 5450 'skip if 0
  631. 5390 '
  632.     NAME MODE 1
  633.  
  634. 5400 LPRINT LEFT$(N$(K),4)" : ";
  635. 5410 LP=LP+7:GOTO 5450
  636. 5420 '
  637.     NAME MODE 2
  638.  
  639. 5422 Y=LEN(LF2$(K)):IF LP+Y>LW THEN X=1:GOSUB 7310:LPRINT SPACE$(5);:LP=6
  640. 5430 LPRINT LF2$(K);:LP=LP+Y
  641. 5440 '
  642.     DONE NAME
  643.  
  644. 5450 X=LFMB(K):GOSUB 7310
  645. 5460 RETURN
  646. 5470 '
  647.         (SUB) POSITION LPRINT DATA
  648.  
  649. 5480 IF LDLL(K) THEN X=LDLL(K):Y=LDLC(K):GOSUB 7330:GOTO 5500
  650. 5490 IF LDLC(K) THEN Y=LDLC(K):GOSUB 7360 ' tab
  651. 5500 RETURN
  652. 5510 '
  653.         (SUB) LPRINT DATA
  654.  
  655. 5520 C1=LPOS(0)
  656. 5530 IF RIGHT$(N$(K),1)="n" AND LPU$(K)<>"&" AND LPU$(K)<>""
  657.     THEN N1!=VAL(B$(K)):GOTO 5560
  658. 5540 IF LFL(K) THEN X$=LEFT$(B$(K),LFL(K)) ELSE X$=B$(K)
  659. 5542 IF LP+LEN(X$)>LW THEN X=1:GOSUB 7310:LPRINT SPACE$(5);:C1=LPOS(0)
  660. 5550 LPRINT X$;:GOTO 5570
  661. 5560 LPRINT USING LPU$(K);N1!;
  662. 5570 LP=LP+LPOS(0)-C1:RETURN
  663. 5580 '
  664.  
  665.         DONE LPRINT & WRITE - BRANCH
  666.  
  667. 5590 IF T=10 OR P7<>0 THEN 5600 ELSE 5680
  668. 5600 '
  669.  
  670.         COPY & DELETE PAUSE
  671.  
  672. 5610 GOSUB 6100 'exit
  673. 5612 IF A=122 THEN 5650        'z
  674. 5620 IF RS THEN X=24:Y=1:GOSUB 6700
  675. 5622 IF P7 THEN PRINT"Copy ";
  676. 5624 IF P7<>0 AND T=10 THEN PRINT"& ";
  677. 5626 IF T=10 THEN PRINT"Delete ";
  678. 5630 PRINT"this record?  n/y/z/esc >";:
  679.     A$=INPUT$(1):A=ASC(A$):IF A=13 THEN A$="n"
  680. 5632 IF A=27 THEN PRINT"ESC":GOTO 5634 ELSE 5640
  681. 5634 IF (P6 OR P7) THEN GOSUB 8410    'close output file
  682. 5636 GOTO 1120
  683. 5640 PRINT A$:IF A$="y" OR A$="z" THEN 5650 ELSE 5770
  684. 5650 '
  685.  
  686.         COPY
  687.  
  688. 5660 IF P7 THEN NR=NR+1:GOSUB 6600:PRINT"!";
  689. 5665 '
  690.  
  691.         DELETE
  692.  
  693. 5670 IF T=10 THEN T$=CHR$(0):GOSUB 6300    'change rec to null
  694. 5680 '                BRANCH
  695. 5685 IF T=3 OR T=1 THEN 5690 ELSE 5770
  696. 5690 '
  697.  
  698.  
  699.                 ASSEM NEW/CHANGED REC STR AND PUT TO DISK
  700.  
  701. 5700 T$=""
  702. 5710 FOR J=1 TO NC
  703. 5730    T$=T$+B$(J)+CHR$(126)
  704. 5740 NEXT J
  705. 5750 GOSUB 6300:PRINT"*";:GOSUB 6400:PRINT"!" ' put record, dupe
  706. 5760 IF T=1 THEN N=N+1:C=1:I=I+1:N1=N1+1:GOTO 4000
  707. 5770 '
  708.  
  709.         WIND UP
  710.  
  711. 5780    GOSUB 6100         ' check exit
  712. 5790 NEXT I            '<=========== END OF RECORD WORK LOOP
  713. 5800 IF P7 THEN GOSUB 8410    'close 2
  714. 5805 IF P9 THEN GOSUB 7410    'FF
  715. 5810 IF T2=N THEN E$="End of file.":GOTO 1140
  716. 5820 GOTO 1120
  717. 6100 '
  718.  
  719.                 (SUB) EXIT TEST
  720.                 returns character value in A
  721.  
  722. 6110 X$=INKEY$
  723. 6120 IF X$<>"" THEN A=ASC(X$)
  724. 6130 IF A<>27 THEN RETURN
  725. 6140 IF (P6 OR P7) THEN GOSUB 8410 ' put head & close out file
  726. 6145 IF P9 THEN GOSUB 7410    'FF
  727. 6150 GOTO 1120
  728. 6200 '
  729.  
  730.  
  731.                 (SUB) GET RECORD "I" IN T$
  732.  
  733. 6210 T$="" ' necessary!
  734. 6220 ON FT GOTO 6250,6230
  735. 6230    GET#1,FT*I+2 ' latter half
  736. 6240    T$=LEFT$(R$,127)
  737. 6250    GET#1,FT*I+1 ' whole or first half
  738. 6260    T$=R$+T$
  739. 6270 RETURN
  740. 6300 '
  741.  
  742.  
  743.                 (SUB) WRITE T$ AS RECORD # I
  744.  
  745. 6310 ON FT GOTO 6340,6320
  746. 6320 LSET R$=MID$(T$,129) ' latter half
  747. 6330 PUT #1,FT*I+2
  748. 6340 LSET R$=LEFT$(T$,128) ' first half
  749. 6350 PUT #1,FT*I+1
  750. 6360 RETURN
  751. 6400 '
  752.  
  753.                 (SUB) WRITE T$ AS DUPE REC I
  754.  
  755. 6410 ON FT GOTO 6440,6420
  756. 6420    LSET S$=MID$(T$,129)
  757. 6430    PUT #2,FT*I+2
  758. 6440    LSET S$=LEFT$(T$,128)
  759. 6450    PUT #2,FT*I+1
  760. 6460 RETURN
  761. 6500 '
  762.  
  763.  
  764.                 (SUB) PARSE STRING
  765.  
  766. 6510 K=0
  767. 6520 J=INSTR(T$,CHR$(126)) ' delimiter
  768. 6530 IF J=0 THEN RETURN
  769. 6540 K=K+1
  770. 6550 B$(K)=MID$(T$,1,J-1)
  771. 6560 T$=MID$(T$,J+1)
  772. 6570 GOTO 6520
  773. 6600 '
  774.  
  775.                 (SUB) PUT T1$ AS OUTPUT REC NR
  776.  
  777. 6610 ON FT GOTO 6640,6620
  778. 6620    LSET S$=MID$(T1$,129)
  779. 6630    PUT#3,FT*NR+2
  780. 6640    LSET S$=LEFT$(T1$,128)
  781. 6650    PUT#3,FT*NR+1
  782. 6660 RETURN
  783. 6700 '
  784.  
  785.  
  786.                 (SUB) POSITION CONSOLE CURSOR (TERM DEP)
  787. X=line (1 to 24)
  788. Y=column (1 to 80)
  789. 6710 PRINT CHR$(20);CHR$(X+127);CHR$(Y+127);    'ACT-5A
  790. 6720 RETURN
  791. 6730 '
  792.  
  793.                 (SUB) CR
  794.  
  795. 6740 FOR I1=1 TO X:PRINT:NEXT:RETURN
  796. 7000 '
  797.  
  798.                 GENERAL ERROR ROUTINES
  799.  
  800. 7005 IF ERR=53 THEN E$="File not found.":RESUME 1140
  801. 7010 IF ERR=61 THEN 7040    'disk full
  802. 7020 IF ERR=6 THEN 7060        'overflow
  803. 7030 ON ERROR GOTO 0
  804. 7040 IF (P6 OR P7) THEN
  805.     E$="Disk full ... fix then repeat last copy command":RESUME 1140
  806. 7050 CLOSE:PRINT:PRINT"Disk full .. files forced closed ..":
  807.     PRINT"N ="N;" .. adds since last 'done' not updated in header ..":
  808.     PRINT"Hit return for re-open attempt...then do 'done'. ":
  809.     INPUT A$:T=8:RESUME 2720
  810. 7060 PRINT CHR$(7):PRINT"That number was too big!  Try again.":PRINT:RESUME NEXT
  811. 7070 '
  812.  
  813.  
  814.                 (SUB) UCV
  815.  
  816. 7080 Y$=""
  817. 7090 FOR K=1 TO LEN(X$)
  818. 7100    Y$=Y$+" "
  819. 7110    X=ASC(MID$(X$,K, 1))
  820. 7120    IF 96<X AND X<123 THEN MID$(Y$,K,1)=CHR$(X-32): GOTO 7140
  821. 7130    MID$(Y$,K,1)=MID$(X$,K,1)
  822. 7140 NEXT
  823. 7150 RETURN
  824. 7160 '
  825.  
  826.                 (SUB) SET UP PRINTER
  827.  
  828. 7180 PRINT:PRINT"Check printer:
  829. 7190 PRINT TAB(10)"Power on?":PRINT TAB(10)"Head at upper left corner?
  830. 7200 PRINT TAB(10)"TOF switch pushed?":PRINT TAB(10)"1200 baud?
  831. 7210 PRINT TAB(20)"(y/n) ";
  832. 7220 A$=INPUT$(1):IF A$=CHR$(13) THEN A$="y"
  833. 7230 PRINT A$:IF A$<>"y" THEN 1140
  834. 7240 WIDTH LPRINT LW+1    'backup to LP process
  835. 7250 LPRINT CHR$(27);CHR$(31);CHR$(HMI+129);
  836. 7260 LPRINT CHR$(27);CHR$(30);CHR$(VMI+129);
  837. 7270 LPRINT CHR$(27);CHR$(137);CHR$(LLM+129);
  838. 7280 LPRINT CHR$(27); "9"; CHR$(13); 'esc 9 sets margin, CR
  839. 7300 RETURN
  840. 7310 '
  841.  
  842.                 (SUB) LCR
  843.  
  844. 7320 FOR I1=1 TO X:LPRINT:LP=1:NEXT:LLC=LLC+X:RETURN    'lp=1 stays inside!
  845. 7330 '
  846.  
  847.                 (SUB) POSITION LPRINT HEAD (DIABLO)
  848.  
  849. 7340 LPRINT CHR$(27);CHR$(11);CHR$(X);CHR$(27);CHR$(137);CHR$(Y+128+LLM);
  850. 7350 LLC=X:LP=Y:RETURN
  851. 7360 '
  852.  
  853.                 (SUB) TAB LPRINT (DIABLO)
  854.  
  855. 7370 IF LP>Y AND RP=0 THEN X=1:GOSUB 7310 ' addl line if too long
  856. 7380 Y1=Y+LLM:IF Y1>126 THEN LPRINT SPACE$(Y1-LP+LLM);:GOTO 7400 ' sim tab
  857. 7390 LPRINT CHR$(27);CHR$(137);CHR$(Y1+128);
  858. 7400 LP=Y:RETURN
  859. 7410 '
  860.                 (SUB) FORM FEED
  861.  
  862. 7420 LPRINT CHR$(12);CHR$(13);:LRC=0:LLC=1:LPG=LPG+1:LP=1:RETURN
  863. 7430 '
  864.  
  865.  
  866.                 (SUB) CLEAR SCREEN, HOME CURSOR (TERM DEP)
  867.  
  868. 7440 PRINT CHR$(12);
  869. 7450 RETURN
  870. 7460 '
  871.  
  872.  
  873.                 (SUB) SETSEARCH
  874.  
  875. 7470 IF T1=T2 THEN RETURN
  876. 7480 GOSUB 7430 'cs
  877. 7490 X=5:Y=1:GOSUB 6700
  878. 7500 SKIPPARSE=1 ' flag
  879. 7510 PRINT"Here are the fields in "F$: GOSUB 7800
  880. 7520 FOR J=0 TO 9
  881. 7530    INPUT"Number of field to search (RETURN for all fields)";A$
  882. 7540        IF A$="" THEN SEARCHFIELD(J)=0: GOTO 7590
  883. 7550        A=VAL(A$)
  884. 7560            IF A<1 OR A>NC THEN PRINT"NO FIELD"A: GOTO 7530
  885. 7570        SEARCHFIELD(J)=A
  886. 7580        SKIPPARSE=0
  887. 7590    PRINT TAB(13);:LINE INPUT"Expression to look for ( _ for blank)? ";A$
  888. 7600    SEARCHWORD$(J)=A$
  889. 7610    IF A$="" THEN 7630
  890. 7620 NEXT J
  891. 7630 PRINT: PRINT"Do you want to select records to exclude? (n/y) ";
  892. 7640 A$=INPUT$(1):IF A$=CHR$(13) THEN A$="n"
  893. 7655    PRINT A$
  894. 7660    IF A$<>"y" THEN SKIPWORD$(0)="": RETURN
  895. 7670 PRINT:FOR J=0 TO 9
  896. 7680    INPUT"Number of field to search (RETURN for all fields)";A$
  897. 7690        IF A$="" THEN LOOKFIELD(J)=0: GOTO 7740
  898. 7700        A=VAL(A$)
  899. 7710            IF A<1 OR A>NC THEN PRINT"NO FIELD"A: GOTO 7680
  900. 7720        LOOKFIELD(J)=A
  901. 7730        SKIPPARSE=0
  902. 7740    PRINT TAB(13);:LINE INPUT"Expression to look for ( _ for blank)? ";A$
  903. 7750    SKIPWORD$(J)=A$
  904. 7760    IF A$="" THEN 7780
  905. 7770 NEXT J
  906. 7780 PRINT
  907. 7790 RETURN
  908. 7800 '
  909.  
  910.  
  911.                 (SUB) SHOW FIELDS
  912.  
  913. 7810 FOR K=1 TO NC
  914. 7820    PRINT TAB(29);
  915. 7830    PRINT USING"##";K;:PRINT".  "LEFT$(N$(K),4)"  "RIGHT$(N$(K),1)
  916. 7840 NEXT
  917. 7850 PRINT
  918. 7860 RETURN
  919. 7870 '
  920.  
  921.  
  922.                 (SUB) LOAD DEFAULT FORMAT CONTROLS
  923.  
  924. 7880 PRINT:PRINT TAB(31)"Installing format 0.
  925. 7890 FO$="0":FFN$="":FFD$="":TM=0:LTM=4:LM=0:LLM=3:SW=79:LW=95:RS=0:RP=0
  926. 7900 LLP=66-LTM-2
  927. 7910 HMI=10:VMI=8:FSC$="":HL1$=""
  928. 7920 HL2$=""
  929. 7930 HL3$=""
  930. 7940 LHL1$=F$+" ":LHL2$="":LHL3$="":HB=1:LHB=1
  931. 7950 RM=1:LRM=1:RLL=0:LRLL=0:RLC=0:LRLC=0:RNB=1:LRNB=0
  932. 7955 EB=0:LEB=2
  933. 7960 FOR I=1 TO NC
  934. 7970    SQ(I)=I:FM(I)=1:LFM(I)=2:F2$(I)="":LF2$(I)=" - ":
  935.     NLL(I)=0:LNLL(I)=0:NLC(I)=0:LNLC(I)=0:FMB(I)=0:LFMB(I)=0
  936. 7980    PU$(I)="&":LPU$(I)="&":DLL(I)=0:LDLL(I)=0:DLC(I)=8:LDLC(I)=0:
  937.     FL(I)=0:LFL(I)=0:FB(I)=1:LFB(I)=0
  938. 7990 NEXT
  939. 8000 SQ(I)=0
  940. 8010 RETURN
  941. 8020 '
  942.  
  943.                 (SUB) OPEN COPY OUTPUT FILE
  944.  
  945. 8030 PRINT:PRINT"Output file name (prefix optional, default "DD$(3)")";:
  946.     INPUT F2$:IF F2$="" THEN E$="?":GOTO 8360
  947. 8040 X$=F2$:GOSUB 7070:F2$=Y$'ucv
  948. 8050 IF MID$(F2$,2,1)=":" THEN 8070
  949. 8060 F2$=DD$(3)+F2$
  950. 8070 ON ERROR GOTO 8100
  951. 8080    OPEN"I",3,F2$+".D"+FT$
  952. 8090    CLOSE 3:ON ERROR GOTO 7000:GOTO 8200'found
  953. 8100 CLOSE 3:ON ERROR GOTO 7000
  954. 8110 IF ERR=53 THEN RESUME 8160
  955. 8120 IF ERR=61 THEN E$="Sorry, disk is full.":RESUME 8360
  956. 8130 IF ERR=64 THEN PRINT"Bad file name, try again.":RESUME 8030
  957. 8140 IF ERR=67 THEN E$="Directory full.":RESUME 8360
  958. 8150 GOTO 7000
  959. 8160 ' make new file
  960. 8170 PRINT"Opening new file "F2$
  961. 8180 NR=0:GOSUB 8380
  962. 8190 GOTO 8360
  963. 8200 '
  964.  
  965.         OPEN & LOAD HEADER
  966.  
  967. 8210 GOSUB 8380
  968. 8220 T$=""
  969. 8230 ON FT GOTO 8260,8240
  970. 8240    GET#3,2
  971. 8250    T$=LEFT$(S$,127)
  972. 8260    GET#3,1
  973. 8270    T$=S$+T$
  974. 8280 GOSUB 6500'parse
  975. 8290 FOR I=1 TO 31
  976. 8300    IF LEFT$(B$(I),4)="stop" GOTO 8320
  977. 8310 NEXT
  978. 8320 T3=I-1
  979. 8330 IF T3<>NC THEN
  980.     E$="Copy aborted; output file has a different number of columns"
  981.     +CHR$(13)+CHR$(10):GOTO 8360
  982. 8340 IF F2$=DD$(3)+F$ THEN NR=N ELSE NR=VAL(B$(I+1))
  983. 8350 PRINT"File open, NR ="NR
  984. 8360 RETURN
  985. 8370 '
  986.  
  987.                 (SUB) OPEN THE OUTPUT FILE
  988.  
  989. 8380 OPEN"R",3,F2$+".D"+FT$
  990. 8390 FIELD #3,128 AS S$
  991. 8400 RETURN
  992. 8410 '
  993.  
  994.                 (SUB) CLOSE DIMS OUT FILE
  995.  
  996. 8420 IF F2$=DD$(3)+F$ THEN C=1:N=NR:GOTO 8530
  997. 8430 PRINT:PRINT"Closing output file,"NR"records.
  998. 8440 PRINT:PRINT"Backup of copied records is not automatic.  The 'backup' command
  999. 8450 PRINT"must be used on the file you copied to.
  1000. 8460 T$=""
  1001. 8470 FOR I=1 TO 31
  1002. 8480    T$=T$+N$(I)+CHR$(126)
  1003. 8490    IF LEFT$(N$(I),4)="stop" THEN 8510
  1004. 8500 NEXT
  1005. 8510 T1$=T$+STR$(NR)+CHR$(126)
  1006. 8520 NR=0:GOSUB 6600
  1007. 8530 CLOSE 3
  1008. 8540 RETURN
  1009. 8550 '
  1010.  
  1011.                 (SUB) FLAGSET
  1012.  
  1013. 8560 PRINT:PRINT"Here are the fields in "F$:PRINT:GOSUB 7800
  1014. 8570 INPUT"Number of field to flag ";A:IF A=0 THEN 8610
  1015. 8580 IF A>NC THEN PRINT A"???":GOTO 8570
  1016. 8590 FLAG=A
  1017. 8600 LINE INPUT"Enter flag; may include blanks:  ";FLAG$:IF FLAG$="" THEN 8610
  1018. 8610 RETURN
  1019. 8620 '
  1020.  
  1021.                 SHOW TRANSIENT PROGRAMS
  1022.  
  1023. 8630 PRINT:PRINT"Here are the available transient programs;  to use one as a command
  1024. 8640 PRINT:PRINT"skip the 'D' on the front and the '.BAS'."
  1025. 8650 PRINT:WIDTH 70:FILES DD$(2)+"D???????.BAS":WIDTH 255:PRINT:PRINT
  1026. 8660 GOTO 1140
  1027.  the 'D' on the front and the '.BAS'."
  1028. 8650 P