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