home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / cpm / database / dims103.ark / DSORT.ASC < prev    next >
Encoding:
Text File  |  1986-12-07  |  13.3 KB  |  484 lines
  1. 10 PRINT"DSORT must be entered via DIMS
  2. 20 STOP
  3. 1000 DEFINT A-Z
  4. 1010 ON ERROR GOTO 3760
  5. 1020 COMMON I,J,K,X,Y,T$,R$,S$,T1$,SKIPPARSE,FT,SEARCH,
  6.  
  7.     C,N,NC,P6,P7,P8,P9,PI,S,T,T1,T2,C(),B$(),N$(),
  8.  
  9.     SEARCHWORD$(),SEARCHFIELD(),SKIPWORD$(),LOOKFIELD(),DD$(),F$,FT$
  10. 1040 NK=0:DIM S(NC,4)        'field #, num?, length, pad?
  11. 1050 Y=T2-T1+1
  12. 1060 DIM D(Y)
  13. 1070 X=INT(LOG(Y)/LOG(2))
  14. 1080 DIM LST(X),HST(X)        'lo and hi stacks
  15. 1090 '
  16.  
  17.  
  18.                 ENTER HERE TO RE-SPECIFY
  19.  
  20.  
  21. 1100 GOSUB 4010
  22. 1110 D$(0)="":ERASE D$:DIM D$(T2-T1+1)    ' do here for recycle (erased below)
  23. 1120 PRINT"SORT 1.03 -- January 13, 1984
  24. 1125 ' by Dan Dugan -- public domain
  25. 1130 PRINT:PRINT"Arranges a selected set of records in numerical or alphabetical order.
  26. 1140 PRINT"To quit this activity, enter 'x' in response to a 'y/n' question.
  27. 1150 IF T1=1 AND T2=N THEN GOTO 1200
  28. 1160 PRINT:PRINT"Shall the output include the records outside the range sorted? (n/y) ";
  29. 1170 A$=INPUT$(1): IF A$=CHR$(13) THEN A$="n"
  30. 1180 PRINT A$: IF A$="y" THEN S9=1
  31. 1190 IF A$="x" THEN 3400
  32. 1200 PRINT
  33. 1210 PRINT"Please define the key fields for sorting in '"F$".'  The fields are:
  34. 1220 PRINT: GOSUB 4190 ' show
  35. 1230 PRINT"The file will be re-arranged according to the contents of the key fields.
  36. 1240 PRINT"Enter the primary key field number first, then any others you wish to
  37. 1250 PRINT"be sorted within that order, etc.
  38. 1260 S6=1:KLEN=0:KLENFLAG=0 ' any alph field will change S6 to 0; key length
  39. 1270 PRINT:FOR I=1 TO NC
  40. 1280    PRINT I;".  ";:
  41.  
  42.     INPUT"Enter field number of key field (0 when done) ";S(I,1)
  43. 1290    IF S(I,1)=0 THEN 1420
  44. 1300    IF S(I,1)<1 OR S(I,1)>NC THEN PRINT"Field"S(I,1)"???  Enter again."
  45.  
  46.         GOTO 1280
  47. 1310    S(I,2)=0:IF RIGHT$(N$(S(I,1)),1)="n" THEN S(I,2)=1 ELSE S6=0
  48. 1320        '(if just one is alpha, do alpha sort)
  49. 1330    INPUT"Number of characters in field to use (RETURN for all)";S(I,3)
  50. 1332    IF S(I,3) THEN 1334 ELSE 1340
  51. 1334    S(I,4)=0:PRINT"Do you want to pad shorter fields to that length? (n/y) ";
  52.  
  53.         :A$=INPUT$(1):IF A$=CHR$(13) THEN A$="n"
  54. 1335    PRINT A$:IF A$="y" THEN S(I,4)=1
  55. 1340    IF S(I,3) THEN 1350 ELSE PRINT"You want to sort on all characters of ";
  56.  
  57.         :GOTO 1360
  58. 1350    PRINT"You want to sort on the first"S(I,3)"characters of ";
  59. 1360    PRINT LEFT$(N$(S(I,1)),4)"? (y/n) ";:
  60.  
  61.         A$=INPUT$(1):IF A$=CHR$(13) THEN A$="y"
  62. 1370    PRINT A$:IF A$="x" THEN 3400
  63. 1380    IF A$<>"y" THEN PRINT"Entry cancelled; ready for key"I"again.":GOTO 1280
  64. 1390    IF S(I,3) THEN KLEN=KLEN+S(I,3) ELSE KLEN=KLEN+10:KLENFLAG=1
  65. 1400    PRINT
  66. 1410 NEXT I
  67. 1420 NK=I-1
  68. 1430 IF S(1,1)=0 THEN 3400    'quit
  69. 1435 GOTO 1480            'skip this because of bug in desc. sort
  70. 1440 PRINT:PRINT"Ascending order? (y/n) ";
  71. 1450 A$=INPUT$(1): IF A$=CHR$(13) THEN A$="y"
  72. 1460 PRINT A$: IF A$="n" THEN S8=1
  73. 1470 IF A$="x" THEN 3400
  74. 1480 '
  75.  
  76.  
  77.         OUTPUT SWITCH (P7)
  78.  
  79.  
  80. 1490 P7=0
  81. 1500 PRINT:PRINT"Shall the product of the sort overlay the original file? (y/n) ";
  82. 1510 A$=INPUT$(1): IF A$=CHR$(13) THEN A$="y"
  83. 1520 PRINT A$:IF A$="x" THEN 3400
  84. 1530 IF A$="n" THEN P7=1:GOTO 1600
  85. 1540 IF A$<>"y" THEN 1500
  86. 1550 '
  87.  
  88.         YES, OVERLAY
  89.  
  90.  
  91. 1560 IF (T1=1 AND T2=N) OR S9=1 THEN 1630
  92. 1570 PRINT:PRINT"NOT ALLOWED - Overlaying part of file on file will erase records
  93. 1580 PRINT"outside of range.": PRINT:GOTO 1480
  94. 1590 '
  95.  
  96.  
  97.         NAME OUTPUT FILE
  98.  
  99.  
  100. 1600 PRINT:INPUT"Name of sort product file (no prefix or suffix) ";F2$
  101. 1610 IF F2$="" THEN 1480
  102. 1620 X$=F2$:GOSUB 3920:F2$=Y$ ' ucv
  103. 1630 '
  104.  
  105.  
  106.                 SHOW SORT SET-UP
  107.  
  108.  
  109. 1640 GOSUB 4010 'cs
  110. 1650 PRINT"SETUP FOR SORT
  111. 1660 PRINT: IF T1=1 AND T2=N THEN PRINT"Sort all records ("N")": GOTO 1710
  112. 1670 PRINT"Sorting range of records from"T1"to"T2"
  113. 1680 ON S9+1 GOTO 1690,1700
  114. 1690    PRINT"The output will be the range of records only.": GOTO 1710
  115. 1700    PRINT"The output will be the entire file with the selected range sorted.
  116. 1710 PRINT:PRINT"Records will be put in order by examining":
  117.  
  118.     PRINT"the contents of the sort key fields."
  119. 1720 PRINT:FOR I=1 TO NK
  120. 1730    PRINT TAB(29);:PRINT USING"##";I;:
  121.  
  122.     PRINT".  "LEFT$(N$(S(I,1)),4);
  123. 1740    PRINT TAB(40);:IF S(I,3) THEN PRINT S(I,3) ELSE PRINT" all"
  124. 1750 NEXT I
  125. 1760 PRINT:IF KLENFLAG THEN 1762 ELSE 1766
  126. 1762 PRINT"ESTIMATED string space needed for the key array is"KLEN*(T2-T1+1):
  127.  
  128.     GOTO 1768
  129. 1766 PRINT"String space needed for the key array is"KLEN*(T2-T1+1)
  130. 1768 PRINT"and the available space is"FRE(X$)".
  131. 1770 PRINT"This program can't tell whether there is enough space on disk "
  132.  
  133.     DD$(5)" for tempo-
  134. 1780 PRINT"rary storage of the key array.
  135. 1790 PRINT:PRINT"The records will be sorted in ";
  136. 1800 IF S8=0 THEN PRINT"ascending ";: GOTO 1820
  137. 1810 PRINT"descending ";
  138. 1820 IF S6=0 THEN PRINT"alphabetical ";: GOTO 1840
  139. 1830 PRINT"numerical ";
  140. 1840 PRINT"order."
  141. 1850 PRINT: PRINT"The output of the sort will ";
  142. 1860 IF P7=0 THEN PRINT"overlay the original file.":GOTO 1880
  143. 1870 PRINT"create a new DIMS file "F2$" on disk "DD$(4)"."
  144. 1880 PRINT:IF P7=0 AND (T1<>1 OR T2<>N) AND S9=0 THEN
  145.  
  146.     PRINT"You are aware that this process will erase records?
  147. 1885 IF P7 THEN 1890 ELSE 1900
  148. 1890 PRINT"The new file "F2$" will replace the safety copy of "F$".
  149. 1892 PRINT"You must then use PIP to move "F2$" to another disk,
  150. 1894 PRINT"and use the DEDIT 'backup' command on "F$" to re-create a
  151. 1896 PRINT"safety copy.
  152. 1900 '
  153.  
  154.  
  155.                 FINAL APPROVAL
  156.  
  157.  
  158. 1910 PRINT:PRINT"Is this exactly what you want? (y/n) ";
  159. 1920 A$=INPUT$(1): IF A$=CHR$(13) THEN A$="y"
  160. 1930 PRINT A$
  161. 1940 IF A$="x" THEN 3400
  162. 1950 IF A$="n" THEN PRINT"Try again.":GOTO 1090
  163. 1960 IF A$<>"y" THEN GOTO 1910
  164. 1970 GOTO 2110
  165. 1980 '
  166.  
  167.  
  168.                 SORT CONTROLS GUIDE
  169.  
  170.  
  171. 1990 ' S() array holds key orders (field#, num? (1=num), length, pad?)
  172. 2000 ' NK = number of keys specified
  173. 2010 ' S6 = 0 alpha sort
  174. 2020 '      1 numeric sort
  175. 2030 ' S7 = 0 don't rename dupe file
  176. 2040 '      1 rename dupe file as F2$.D
  177. 2050 ' S8 = 0 ascending order
  178. 2060 '      1 descending order
  179. 2070 ' S9 = 0 output only sorted range of records
  180. 2080 '      1 output records above and below sorted range
  181. 2090 ' P7 = 0 overlay main file
  182. 2100 '      1 output to named file
  183. 2110 '
  184.  
  185.  
  186.                 PUT KEYS IN TEMP FILE
  187.  
  188.  
  189. 2120 GOSUB 4010
  190. 2130 PRINT"SORTING '"F$"'
  191. 2140 PRINT:PRINT"Extracting keys.":PRINT
  192. 2150 OPEN"O",3,DD$(5)+"KEYS.$$$"
  193. 2160 FOR I=T1 TO T2
  194. 2170    GOSUB 4270:GOSUB 4110 ' get record
  195. 2180    IF ASC(T$)=0 THEN X$=CHR$(126)+"(del)":GOTO 2320 ' sorts deletes to end
  196. 2190    GOSUB 3540 ' parse
  197. 2200    X$=""
  198. 2210    FOR X=1 TO NK
  199. 2220        IF S(X,3) THEN 2230 ELSE X$=X$+B$(S(X,1))+CHR$(32):GOTO 2280
  200. 2230        Z$=LEFT$(B$(S(X,1)),S(X,3))
  201. 2240        Y=LEN(Z$)
  202. 2250        IF S(X,2)=1 THEN
  203.  
  204.             Y$=STRING$(S(X,3)-Y,CHR$(48)):
  205.  
  206.             X$=X$+Y$+Z$:GOTO 2280    'pad num field with left 0's
  207. 2252        IF S(X,4) THEN 2260 ELSE Y$="":GOTO 2270
  208. 2260        Y$=STRING$(S(X,3)-Y,CHR$(32))    'spaces to pad right
  209. 2270        X$=X$+Z$+Y$
  210. 2280    NEXT
  211. 2290    IF X$="" THEN X$=CHR$(126):GOTO 2320 ' makes empties go later
  212. 2300    IF S6 THEN 2320
  213. 2310    GOSUB 3920:X$=Y$    'ucv
  214. 2320    PRINT I,X$
  215. 2330    PRINT#3,X$
  216. 2340 NEXT
  217. 2350 CLOSE 3
  218. 2360 '
  219.  
  220.                 LOAD INDEX AND KEY ARRAYS
  221.  
  222.  
  223. 2370 PRINT:PRINT"Loading key array:":PRINT
  224. 2380 OPEN"I",3,DD$(5)+"KEYS.$$$"
  225. 2390 I=T1:J=1:D$(0)=CHR$(0)
  226. 2400 IF EOF(3) THEN 2450
  227. 2410    LINE INPUT#3,D$(J)
  228. 2420    D(J)=I
  229. 2430    I=I+1:J=J+1
  230. 2440 GOTO 2400
  231. 2450 CLOSE 3
  232. 2460 KILL DD$(5)+"KEYS.$$$"
  233. 2470 '
  234.  
  235.  
  236.                 READY TO SORT ARRAY
  237.  
  238.  
  239. 2480 PRINT:PRINT"Sorting array.":PRINT
  240. 2490 ' from QUICKSORT by Sylvan Rubin DDJ #33 p.42
  241. 2500 LND=1:HND=J-1:STP=0
  242. 2510 '
  243.  
  244.     PARTITION
  245.  
  246.  
  247. 2520 GOSUB 4270        'exit
  248. 2530 IF LND>=HND THEN 2910 ' pop stack
  249. 2540 PRINT CHR$(80);:CTR=INT((LND+HND+1)/2) ' use center for pivot
  250. 2550 SWAP D(CTR),D(HND):SWAP D$(CTR),D$(HND)
  251. 2560 LO=LND-1:HI=HND
  252. 2570 PIV$=D$(HND):GOTO 2600 ' scan-l
  253. 2580 '
  254.  
  255.     EXCHANGE
  256.  
  257.  
  258. 2590 SWAP D(LO),D(HI):SWAP D$(LO),D$(HI)
  259. 2600 '
  260.  
  261.     SCAN-L
  262.  
  263.  
  264. 2610 LO=LO+1:ON S6+1 GOTO 2620,2630 ' alph, num
  265. 2620 ON S8+1 GOTO 2640,2650 ' asc, desc
  266. 2630 ON S8+1 GOTO 2660,2670
  267. 2640 IF D$(LO)<PIV$ THEN 2610 ELSE 2680
  268. 2650 IF D$(LO)>PIV$ THEN 2610 ELSE 2680
  269. 2660 IF VAL(D$(LO))<VAL(PIV$) THEN 2610 ELSE 2680
  270. 2670 IF VAL(D$(LO))>VAL(PIV$) THEN 2610 ELSE 2680
  271. 2680 '
  272.  
  273.     SCAN-H
  274.  
  275.  
  276. 2690 HI=HI-1:ON S6+1 GOTO 2700,2710
  277. 2700 ON S8+1 GOTO 2720,2730
  278. 2710 ON S8+1 GOTO 2740,2750
  279. 2720 IF D$(HI)>PIV$ THEN 2690 ELSE 2760
  280. 2730 IF D$(HI)<PIV$ THEN 2690 ELSE 2760
  281. 2740 IF VAL(D$(HI))>VAL(PIV$) THEN 2690 ELSE 2760
  282. 2750 IF VAL(D$(HI))<VAL(PIV$) THEN 2690 ELSE 2760
  283. 2760 '
  284.  
  285.  
  286. 2765 IF LO<=HI THEN 2590
  287. 2770 '
  288.  
  289.     SWAP PIVOT
  290.  
  291.  
  292. 2780 SWAP D(LO),D(HND):SWAP D$(LO),D$(HND)
  293. 2790 '
  294.  
  295.     PUSH STACK
  296.  
  297.  
  298. 2800 IF (HI+1-LND)>(HND-LO) THEN 2860 ' stack low
  299. 2810 '
  300.  
  301.     STACK HIGH
  302.  
  303.  
  304. 2820 IF LO+2>HND THEN 2840
  305. 2830 STP=STP+1:LST(STP)=LO+1:HST(STP)=HND
  306. 2840 '
  307.  
  308.     SHIFT HIGHEND
  309.  
  310.  
  311. 2850 HND=HI:GOTO 2510 ' partition
  312. 2860 '
  313.  
  314.     STACK LOW
  315.  
  316.  
  317. 2870 IF LND+1>HI THEN 2900 ' shift lowend
  318. 2880 STP=STP+1:LST(STP)=LND:HST(STP)=HI
  319. 2890 '
  320.  
  321.     SHIFT LOWEND
  322.  
  323.  
  324. 2900 LND=LO+1:GOTO 2510 ' partition
  325. 2910 '
  326.  
  327.     POP STACK
  328.  
  329.  
  330. 2920 IF STP=0 THEN 2950 ' done
  331. 2930 LND=LST(STP):HND=HST(STP)
  332. 2940 STP=STP-1:GOTO 2510 ' partition
  333. 2950 PRINT:PRINT:PRINT"Array sorted.
  334. 2960 '
  335.  
  336.  
  337.                 OUTPUT
  338.  
  339.  
  340. 2970 NR=0 ' counts number of records in product file
  341. 2980 CLOSE 2:KILL DD$(4)+F$+".DD"+FT$:GOSUB 4080
  342. 2990 IF S9=0 GOTO 3060
  343. 3000 '
  344.  
  345.  
  346.                 COPY BLOCK BELOW T1
  347.  
  348.  
  349. 3010 IF T1=1 THEN 3060
  350. 3020 PRINT:PRINT"Outputting records below range.
  351. 3030 FOR I=1 TO T1-1
  352. 3040    GOSUB 3430 'output record
  353. 3050 NEXT
  354. 3060 '
  355.  
  356.  
  357.                 MOVE RECORDS PER INDEX ARRAY
  358.  
  359.  
  360. 3070 PRINT:PRINT"Now moving records from "
  361.  
  362.     DD$(3)" to "DD$(4)" in sorted order per index array.":PRINT
  363. 3080 ERASE D$ ' don't need strings
  364. 3090 FOR J=1 TO T2-T1+1
  365. 3100    I=D(J):GOSUB 3430
  366. 3110 NEXT
  367. 3120 '
  368.  
  369.  
  370.                 COPY BLOCK ABOVE
  371.  
  372.  
  373. 3130 IF S9=0 OR T2=N THEN 3180 ' skip block copy
  374. 3140 PRINT:PRINT"Outputting records above range
  375. 3150 FOR I=T2+1 TO N
  376. 3160    GOSUB 3430 ' output
  377. 3170 NEXT
  378. 3180 '
  379.  
  380.  
  381.  
  382.                 SAVE HEADER AND TIDY UP
  383.  
  384.  
  385. 3190 PRINT:PRINT"Saving header;"NR"records
  386. 3200 T$=""
  387. 3210 I=0
  388. 3220 I=I+1
  389. 3230    T$=T$+N$(I)+CHR$(126)
  390. 3240    IF LEFT$(N$(I),4)="stop" THEN 3260
  391. 3250 GOTO 3220
  392. 3260 T$=T$+STR$(NR)+CHR$(126) ' NR at end
  393. 3270 NR=0 ' for header
  394. 3280 GOSUB 3470 ' put it
  395. 3290 PRINT"!"
  396. 3300 IF P7 THEN 3330    'rename product
  397. 3310 GOSUB 3620 ' copy dupe to main
  398. 3320 GOTO 3380
  399. 3330 '
  400.  
  401.  
  402.         RENAME OUTPUT FILE
  403.  
  404.  
  405. 3340 CLOSE 2:NAME DD$(4)+F$+".DD"+FT$ AS DD$(4)+F2$+".D"+FT$:GOSUB 4080
  406. 3350 PRINT"Product file "F2$" is now on disk "DD$(4)" (backup erased).
  407. 3360 PRINT"After moving product to desired disk, use 'backup' command on "F$
  408. 3370 INPUT"to restore safety copy.  Hit RETURN to continue.    ";A$
  409. 3380 PRINT:PRINT:PRINT"Sort completed
  410. 3390 PRINT CHR$(7); 'beep
  411. 3400 '
  412.  
  413.  
  414.                 RETURN TO DEDIT
  415.  
  416.  
  417. 3410 PRINT:PRINT"Re-loading DEDIT.
  418. 3420 CHAIN DD$(1)+"DEDIT",1000
  419. 3430 '
  420.  
  421.  
  422.  
  423.  
  424.                 (SUB) OUTPUT RECORD "I"
  425.  
  426.  
  427. 3440 GOSUB 4110:PRINT T$ ' get rec I
  428. 3450 GOSUB 4270 ' exit
  429. 3460 NR=NR+1 ' # records in prod. file
  430. 3470 '
  431.  
  432.  
  433.         PUT RECORD NR
  434.  
  435.  
  436. 3480 ON FT GOTO 3510,3490
  437. 3490 LSET S$=MID$(T$,129)
  438. 3500 PUT #2,FT*NR+2
  439. 3510 LSET S$=LEFT$(T$,128)
  440. 3520 PUT #2,FT*NR+1
  441. 3530 RETURN
  442. 3540 '
  443.  
  444.  
  445.  
  446.  
  447.                 (SUB) PARSE STRING
  448.  
  449.  
  450. 3550 K=0
  451. 3560 J=INSTR(T$,CHR$(126)) ' delimiter
  452. 3570 IF J=0 THEN RETURN
  453. 3580 K=K+1
  454. 3590 B$(K)=MID$(T$,1,J-1)
  455. 3600 T$=MID$(T$,J+1)
  456. 3610 GOTO 3560
  457. 3620 '
  458.  
  459.  
  460.  
  461.                 (SUB) ERASE ORIGINAL FILE AND COPY DUP TO ORIG
  462.  
  463.  
  464. 3630 CLOSE
  465. 3640 PRINT
  466. 3650 KILL DD$(3)+F$+".D"+FT$
  467. 3660 PRINT"Copying dupe, overlaying original file.":PRINT
  468. 3670 GOSUB 4040 ' open both files
  469. 3680 FOR J=1 TO FT*(N+1)
  470. 3690    GET #2,J
  471. 3700    PRINT"&";
  472. 3710    LSET R$=S$
  473. 3720    PUT #1,J
  474. 3730    PRINT"*";
  475. 3740 NEXT J
  476. 3750 RETURN
  477. 3760 '
  478.  
  479.  
  480.  
  481.                 ERROR HANDLING
  482.  
  483.  
  484. 3770 IF ERR=61 THEN RESUME 3780 ELSE 3810
  485. 3780    PRINT CHR$(7)"Sorry - process halted because there isn't enough disk space
  486. 3790    PRINT"for the key file.
  487. 3800    INPUT"Hit return to recover.";A$:CLOSE:T=8:CHAIN DD$(1)+"DIMS",1000
  488. 3810 IF ERR=7 OR ERR=14 THEN RESUME 3820 ELSE 3850
  489. 3820    PRINT CHR$(7)"Sorry - process halted because key array needed more memory
  490. 3830    PRINT"than is available.  Try again with shorter key specifications.
  491. 3840    INPUT"Hit return to try again.";A$:CLOSE 3:GOTO 1090
  492. 3850 IF ERR=58 THEN RESUME 3860 ELSE 3910
  493. 3860    PRINT"Sorry - file named "F2$" already exists.
  494. 3870    INPUT"Enter another name for the output file here:  ";X$
  495. 3880    IF X$="" THEN 3870
  496. 3890    GOSUB 3920:F2$=Y$    'ucv
  497. 3900    GOTO 3330
  498. 3910 ON ERROR GOTO 0
  499. 3920 '
  500.  
  501.  
  502.  
  503.                 (SUB) UCV
  504.  
  505.  
  506. 3930 Y$=""
  507. 3940 FOR J=1 TO LEN(X$)
  508. 3950    Y$=Y$+" "
  509. 3960    X=ASC(MID$(X$,J,1))
  510. 3970    IF 96<X AND X<123 THEN MID$(Y$,J,1)=CHR$(X-32): GOTO 3990
  511. 3980    MID$(Y$,J,1)=MID$(X$,J,1)
  512. 3990 NEXT
  513. 4000 RETURN
  514. 4010 '
  515.  
  516.  
  517.  
  518.                 (SUB) CLEAR SCREEN(TERM DEP)
  519.  
  520.  
  521. 4020 PRINT CHR$(12)
  522. 4030 RETURN
  523. 4040 '
  524.  
  525.  
  526.                 (SUB) OPEN UP FILES
  527.  
  528.  
  529. 4050 CLOSE
  530. 4060 OPEN"R",1,DD$(3)+F$+".D"+FT$
  531. 4070 FIELD #1,128 AS R$
  532. 4080 OPEN"R",2,DD$(4)+F$+".DD"+FT$
  533. 4090 FIELD #2,128 AS S$
  534. 4100 RETURN
  535. 4110 '
  536.  
  537.  
  538.  
  539.                 (SUB) GET RECORD "I" IN T$
  540.  
  541.  
  542. 4120 T$=""
  543. 4130 ON FT GOTO 4160,4140
  544. 4140    GET#1,FT*I+2 ' latter half
  545. 4150    T$=LEFT$(R$,127)
  546. 4160    GET#1,FT*I+1
  547. 4170    T$=R$+T$
  548. 4180 RETURN
  549. 4190 '
  550.  
  551.  
  552.  
  553.                 (SUB) SHOW FIELDS
  554.  
  555.  
  556. 4200 FOR J=1 TO NC
  557. 4210    IF C(J)=0 THEN 4240
  558. 4220    PRINT TAB(29);
  559. 4230    PRINT USING"##";J;:PRINT".  "LEFT$(N$(J),4)"  "RIGHT$(N$(J),1)
  560. 4240 NEXT
  561. 4250 PRINT
  562. 4260 RETURN
  563. 4270 '
  564.  
  565.  
  566.                 (SUB) EXIT TEST
  567.  
  568.  
  569. 4280 X$=INKEY$
  570. 4282 IF X$<>CHR$(27) THEN RETURN
  571. 4290 PRINT:PRINT"Process paused by ESCAPE from keyboard.
  572. 4300 PRINT"Do you want to continue (y,n or x) ? ";
  573. 4310 A$=INPUT$(1):IF A$=CHR$(13) THEN A$="y"
  574. 4320 PRINT A$:IF A$="x" THEN CLOSE 3:GOTO 3400
  575. 4330 IF A$<>"y" THEN CLOSE 3:GOTO 1090
  576. 4340 RETURN
  577.  A$=CHR$(13) THEN A$="y"
  578. 4320 PRINT