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