home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / database / flix11.zip / FLIXLBL.BAS < prev    next >
BASIC Source File  |  1990-09-16  |  24KB  |  486 lines
  1.  19 WIDTH "LPT1:", 132
  2.  20 REM  
  3.  25 REM  
  4.  110  V1$= "C:FLIX.DAT": REM .. MASTER FILE NAME ...
  5.  112  V2$= "C:FLIX.ISI":REM .. KEY FILE NAME ...
  6.  117 KL% =  32 : REM .....  KEY LENGTH ....
  7.  118  T =  16 : REM ... TOTAL NUMBER OF FIELDS 
  8.  119 DIM F$(T), F#(T), CX(T), CY(T), FL(T), TY$(T), K(T), KL(T), FIELDBUFFER$(T), T#(T)
  9.  180  BLANK$= STRING$(79,32): HOME$ = CHR$( 11): BOTT$ = HOME$+STRING$(0, 28)+STRING$( 22, 31):PL= 6 : FF$ = CHR$(12)
  10.  181 CL$=CHR$( 11)+CHR$( 12)+CHR$( 11):RC= 28 :DC= 31 :RB$=CHR$(32)+CHR$(29):SB$=CHR$(219)+CHR$(29):BS$=CHR$(29)+CHR$(32)+CHR$(29):HE$=""
  11.  182 FF$=CHR$(12)
  12.  195 PN$ = "C:FLIXLBL"
  13.  120 fl( 1 )= 32 :cx( 1 )= 23 :cy( 1 )= 3 :ty$( 1 )="A"
  14.  121 fl( 2 )= 4 :cx( 2 )= 23 :cy( 2 )= 4 :ty$( 2 )="N"
  15.  122 fl( 3 )= 3 :cx( 3 )= 36 :cy( 3 )= 4 :ty$( 3 )="A"
  16.  123 fl( 4 )= 16 :cx( 4 )= 23 :cy( 4 )= 5 :ty$( 4 )="A"
  17.  124 fl( 5 )= 28 :cx( 5 )= 27 :cy( 5 )= 8 :ty$( 5 )="A"
  18.  125 fl( 6 )= 28 :cx( 6 )= 27 :cy( 6 )= 9 :ty$( 6 )="A"
  19.  126 fl( 7 )= 28 :cx( 7 )= 27 :cy( 7 )= 12 :ty$( 7 )="A"
  20.  127 fl( 8 )= 28 :cx( 8 )= 27 :cy( 8 )= 13 :ty$( 8 )="A"
  21.  128 fl( 9 )= 28 :cx( 9 )= 27 :cy( 9 )= 15 :ty$( 9 )="A"
  22.  129 fl( 10 )= 3 :cx( 10 )= 27 :cy( 10 )= 16 :ty$( 10 )="N"
  23.  130 fl( 11 )= 7 :cx( 11 )= 48 :cy( 11 )= 16 :ty$( 11 )="A"
  24.  131 fl( 12 )= 7 :cx( 12 )= 23 :cy( 12 )= 17 :ty$( 12 )="N"
  25.  132 fl( 13 )= 7 :cx( 13 )= 36 :cy( 13 )= 17 :ty$( 13 )="N"
  26.  133 fl( 14 )= 32 :cx( 14 )= 23 :cy( 14 )= 18 :ty$( 14 )="A"
  27.  134 fl( 15 )= 31 :cx( 15 )= 24 :cy( 15 )= 19 :ty$( 15 )="A"
  28.  135 fl( 16 )= 3 :cx( 16 )= 24 :cy( 16 )= 20 :ty$( 16 )="N"
  29.  701 PRINT CL$;
  30.  702 PRINT "                      FLIX VIDEO CATALOG DATA BASE"
  31.  703 PRINT "              ╔═════════════════════════════════════════╗"
  32.  704 PRINT "              ╠═════════════════════════════════════════╣"
  33.  705 PRINT "              ║ TITLE: ================================ ║"
  34.  706 PRINT "              ║ YEAR:  ==== RATING: ===                 ║"
  35.  707 PRINT "              ║ TYPE:  ================                 ║"
  36.  708 PRINT "              ║                                         ║"
  37.  709 PRINT "              ║ ACTORS  -                               ║"
  38.  710 PRINT "              ║ ACTOR 1:   ============================ ║"
  39.  711 PRINT "              ║ ACTOR 2:   ============================ ║"
  40.  712 PRINT "              ║                                         ║"
  41.  713 PRINT "              ║ ACTRESSES -                             ║"
  42.  714 PRINT "              ║ ACTRESS 1: ============================ ║"
  43.  715 PRINT "              ║ ACTRESS 2: ============================ ║"
  44.  716 PRINT "              ║                                         ║"
  45.  717 PRINT "              ║ DIRECTOR:  ============================ ║"
  46.  718 PRINT "              ║ MINUTES:   ===  CATALOG NUMBER: ======= ║"
  47.  719 PRINT "              ║ FROM:  =======  TO: =======             ║"
  48.  720 PRINT "              ║ MAKER: ================================ ║"
  49.  721 PRINT "              ║ AWARDS: =============================== ║"
  50.  722 PRINT "              ║ NUMBER: ===                             ║"
  51.  723 PRINT "              ╚═════════════════════════════════════════╝"
  52.  15060 FL =  32 
  53.  15065 PRINT BOTT$;BLANK$;BOTT$ "Enter the key to get...";:PRINT FN CRT$( 23 , 3 );STRING$(FL,46);FN CRT$( 23 , 3 );"";
  54.  15070 TY$ = "A"
  55.  15100 HELP = 6: GOSUB 21000
  56.  15110 IF LEN(T$)=0 THEN 4000:'RETURN TO MAINLINE IF NULL ENTRY 
  57.  15200 K$=T$+STRING$(KL-LEN(T$),32):'PAD ENTRY & SET TO SEARCH KEY
  58.  15211 ' Execute inquiry after reading map file
  59.  15220 GOSUB 62500:GOSUB 62000
  60.  15230 IF Found THEN GET 1,I ELSE GOTO 700
  61.  113  V3$= "C:FLIX.MAP": REM .. MAP FILE NAME ..
  62.  15390 REM . . . SUBDIVIDE & PRINT RECORD . . . 
  63.  17002  F#( 2 ) = VAL(F$( 2 )): rset F$(2)=RIGHT$(FNU$(2,0),LEN(FNU$(2,0))-1)
  64.  17010  F#( 10 ) = VAL(F$( 10 )): rset F$(10)=RIGHT$(FNU$(10,0),LEN(FNU$(10,0))-1)
  65.  17012  F#( 12 ) = VAL(F$( 12 )): rset F$(12)=RIGHT$(FNU$(12,0),LEN(FNU$(12,0))-1)
  66.  17013  F#( 13 ) = VAL(F$( 13 )): rset F$(13)=RIGHT$(FNU$(13,0),LEN(FNU$(13,0))-1)
  67.  17016  F#( 16 ) = VAL(F$( 16 )): rset F$(16)=RIGHT$(FNU$(16,0),LEN(FNU$(16,0))-1)
  68.  17500 'PRINT RECORD
  69.  17502  LPRINT ""F$(1)
  70.  17504  LPRINT "YEAR: "F$(2)" RATING: "F$(3)" "
  71.  17506  LPRINT "FROM: "F$(12)" TO: "F$(13)" MIN: "F$(10)
  72.  17508  LPRINT "CAT#: "F$(11)" TYPE:"F$(4)
  73.  17510  LPRINT STRING$(2,10);
  74.  28000 LPRINT FF$:PG=0:RETURN
  75.  25003 RETURN
  76.  50  REM . . . . --->  This program is  C:FLIXLBL.BAS <----- 
  77. 10 CLEAR 5000: DEFINT A-Z: DIM X, Y, Z: KEY OFF: KEY 1, CHR$(27)
  78. 11 STARTUP = 1
  79. 12 GOSUB 61000
  80. 13 DIM MEMLINK$(BUS)
  81. 15 ON ERROR GOTO 53000
  82. 30 CR$ = "\│/─": BK$ = " "
  83. 182 '........ CALCULATE RECORD & KEY LENGTHS
  84. 183 FOR X = 1 TO T: IF TY$(X) <> "Z" THEN RL% = RL% + FL(X)
  85. 184 IF K(X) = 1 THEN KL(X) = FL(X)
  86. 185 NEXT X
  87. 186 DEF FNCRT$ (E1, E2) = HOME$ + STRING$(E2, DC) + STRING$(E1, RC)
  88. 190 D$ = CHR$(94) + STRING$(KL%, 32)
  89. 210 CLOSE FILNUM: OPEN "R", FILNUM, V1$, RL%' Open and Field Master File
  90. 211 FOR X = 1 TO 8: BT(X) = 0: NEXT X: BUF = 0
  91. 212 BBT = 1: FOR X = 1 TO T: IF TY$(X) = "Z" THEN 216 ELSE BUF = BUF + 1
  92. 213 IF FL(X) + BT(BBT) > 255 THEN BBT = BBT + 1
  93. 214 FIELD #FILNUM, BT(1) AS D$(1), BT(2) AS D$(2), BT(3) AS D$(3), BT(4) AS D$(4), BT(5) AS D$(5), BT(6) AS D$(6), BT(7) AS D$(7), FL(X) AS F$(X)
  94. 215 BT(BBT) = BT(BBT) + FL(X)
  95. 216 NEXT X
  96. 217 FIELD #FILNUM, BT(1) AS D$(1), BT(2) AS D$(2), BT(3) AS D$(3), BT(4) AS D$(4), BT(5) AS D$(5), BT(6) AS D$(6), BT(7) AS D$(7), BT(8) AS D$(8)
  97. 218 '...................................
  98. 219 RETURN
  99. 298 GOSUB 61000:  'Init BTREE
  100. 299 GOSUB 61500:  'Open MAP & ISI
  101. 699 '
  102. 700 '             Screen Print
  103. 4000 '  Begin Main Line
  104. 4001 IF STARTUP THEN HELP = 1: GOSUB 41000: STARTUP = 0
  105. 4003 UPDTE$ = ""
  106. 4004 FOR X = 1 TO T: T#(X) = 0: NEXT X: '  Clear Field
  107. 4005 COLOR 15, 4: LOCATE 25, 1: PRINT "* indicates a field overflow.        Press F1 for help.          "; : LOCATE 25, 65: PRINT USING "##,###"; NKA; : PRINT " Records";
  108. 4009 PRINT BOTT$; BLANK$; BOTT$; "<G>et Record, <S>earch, Sort, Select, <E>nd ";
  109. 4010 TY$ = "A": FL = 1
  110. 4015 HELP = 2: GOSUB 21000
  111. 4025 IF T$ = "G" OR T$ = "g" THEN UPDTE$ = "YES": GOTO 15000
  112. 4030 IF T$ = "E" OR T$ = "e" THEN 40000
  113. 4035 IF T$ <> "S" AND T$ <> "s" THEN 4005
  114. 4036 IF NKA = 0 THEN PRINT BOTT$; BLANK$; BOTT$; "No Records In Data File."; : GOSUB 60000: GOTO 4000
  115. 4037 PRINT BOTT$; BLANK$; BOTT$; "Search in a <F>ield, <A>nywhere or <R>etrieve all records? -"; : Z2 = 1: HELP = 3
  116. 4038 GOSUB 21000: IF T$ = "F" OR T$ = "f" THEN GOTO 45000 ELSE IF T$ = "R" OR T$ = "r" THEN 14036 ELSE IF T$ <> "A" AND T$ <> "a" THEN 4005
  117. 14000 'String Search
  118. 14001 CP = 0
  119. 14002 X = 0: LC = 0: PG = 0
  120. 14005 UPDTE$ = "S"
  121. 14010 PRINT BOTT$; BLANK$; BOTT$; "Type search string - "; : ' Search
  122. 14020 FL = 30
  123. 14030 TY$ = "A"
  124. 14035 HELP = 4: GOSUB 21000: Q$ = T$: IF Q$ = "" THEN GOTO 700 ELSE 14037
  125. 14036 Q$ = "": CP = 5: UPDTE$ = "S": X = 0: LC = 0: PG = 0
  126. 14037 SS$ = Q$: GOTO 45205: 'Look for sort
  127. 14038 PRINT BOTT$; BLANK$; BOTT$; " <S>top - ";
  128. 14039 FO = 0
  129. 14040 FOR X = 1 TO INT(LOF(1) / RL%): IF INKEY$ <> "" THEN 700 ELSE GET 1, X: FO = 0
  130. 14042 IF CP > 0 AND CP < 6 THEN GOSUB 48150: GOTO 14065
  131. 14044 FOR ZT = 1 TO T: IF INSTR(F$(ZT), Q$) <> 0 AND FO = 0 THEN 14100
  132. 14045 IF INKEY$ <> "" THEN 700
  133. 14060 NEXT ZT
  134. 14065 NEXT X: GOSUB 28000: GOTO 700
  135. 14099 '
  136. 14100 GOSUB 15390: '           Print Record and RETURN
  137. 14101 FO = 1
  138. 14200 PRINT BOTT$; BLANK$; BOTT$; " <S>top - ";
  139. 14250 GOTO 14060
  140. 14300 ' ..... remember that you have a line at 18200 ...
  141. 14999 '
  142. 15000 '
  143. 15002 '        Get Record
  144. 15003 PG = 0: LC = 0: NUMFND = 0
  145. 15004 IF INKEY$ <> "" THEN 700
  146. 15395 IF LC <= 0 THEN GOSUB 25000
  147. 15400 '
  148. 18200 IF UPDTE$ = "S" THEN RETURN
  149. 18560 IF FOUND = 0 AND NUMFND = 0 THEN GOTO 700 ELSE IF FOUND <> 0 THEN NUMFND = NUMFND + 1: I = LR: GOSUB 62030: GOTO 15230 ELSE GOSUB 28000: GOTO 700
  150. 22999 '
  151. 23000 '       Number Check Routine
  152. 23001 '
  153. 23005 F1 = 0: F2 = 0: N = 0
  154. 23010 FOR X = 1 TO LEN(T$)
  155. 23020 A = ASC(MID$(T$, X, 1))
  156. 23030 IF A < 45 OR A > 57 THEN PRINT CHR$(7); : GOTO 23100
  157. 23050 IF A = 46 THEN F1 = F1 + 1: IF F1 > 1 THEN PRINT CHR$(7); : GOTO 23100
  158. 23060 IF A = 45 THEN F2 = F2 + 1: IF F2 > 1 THEN PRINT CHR$(7); : GOTO 23100
  159. 23070 NEXT X
  160. 23080 IF INSTR(T$, "-") > 1 THEN PRINT CHR$(7); : GOTO 23100
  161. 23090 N = 1
  162. 23100 RETURN
  163. 24999 '
  164. 25000 '      Print Header
  165. 25001 '
  166. 25005 PG = PG + 1
  167. 25006 LPRINT FF$
  168. 25007 LPRINT " "
  169. 25009 LPRINT " ": LPRINT " "
  170. 25200 '
  171. 25300 LC = PL: RETURN
  172. 40000 PRINT BOTT$; BLANK$; BOTT$; "Do you really want to end? "; : Z2 = 1: HELP = 999: GOSUB 21000: IF T$ = "N" OR T$ = "n" THEN GOTO 4001 ELSE IF T$ <> "Y" AND T$ <> "y" THEN GOTO 40000
  173. 40010 COLOR 7, 0, 0: CLS : PRINT "You have exited your report program"
  174. 40020 PRINT "and are now in MS-DOS at the system"
  175. 40030 PRINT "prompt."
  176. 40040 SYSTEM ' You may branch to another program from here
  177. 53000 '  Error Traps
  178. 53001 FOR ZX = 1 TO 3: SOUND 1000, 1: SOUND 25000, 1: NEXT ZX
  179. 53002 COLOR 14, 4: PRINT BOTT$; BLANK$; BOTT$;
  180. 53003 IF ERR = 7 OR ERR = 14 THEN LOCATE 25, 1: PRINT " OUT OF MEMORY  (BASIC may not have been started with /S:2048)": END
  181. 53004 IF ERR <> 27 AND ERR <> 24 AND ERR <> 25 AND ERR <> 57 AND ERR <> 68 THEN 53009
  182. 53006 PRINT "Printer I/O Error. Abort or Retry?"; : Z$ = INPUT$(1): PRINT BOTT$; BLANK$; BOTT$;
  183. 53007 IF Z$ = "A" OR Z$ = "a" THEN PRINT "Operation aborted."; : GOTO 53050
  184. 53008 IF Z$ <> "R" AND Z$ <> "r" THEN 53006 ELSE PRINT "Retrying..."; : GOTO 53040
  185. 53009 IF ERR = 53 THEN PRINT "Your data file or a support file was not found at line"; ERL; ".": END
  186. 53010 IF ERR = 61 THEN PRINT "Disk full. No recovery possible. Program aborting.": END
  187. 53011 IF ERR = 4 THEN PRINT "Out of DATA. Probably errors in help subroutines.": END
  188. 53012 IF ERR = 6 THEN PRINT "Overflow error in line"; ERL; ". No recovery possible. Program aborting.": END
  189. 53013 IF ERR = 11 THEN PRINT "There is a division by zero in your computation in line"; ERL; ".": END
  190. 53014 IF ERR = 51 THEN PRINT "BASIC Interpreter Error. No recovery possible. Program aborting.": END
  191. 53015 IF ERR = 64 THEN PRINT "Illegal filename used in line"; ERL; ". No recovery possible. Program aborting.": END
  192. 53016 IF ERR = 67 THEN PRINT "Too many files open. Modify FILES line in CONFIG.SYS.": END
  193. 53017 IF ERR = 71 THEN PRINT "Disk not ready. Check drive door. Press ENTER to continue..."; : Z$ = INPUT$(1): GOTO 53040
  194. 53018 IF ERR = 72 THEN PRINT "Disk damaged. No recovery possible. Program aborting.": END
  195. 53019 IF ERR = 75 OR ERR = 76 THEN PRINT "Path not found. No recovery possible. Program aborting.": END
  196. 53020 PRINT "Report program error"; ERR; "trapped at line"; ERL; ". Program aborting.": END
  197. 53040 RESUME
  198. 53050 ECODE = -1: RESUME NEXT
  199. 59999 '
  200. 60000 ' 4 Second Time Delay Loop
  201. 60001 '
  202. 60010 COUNT# = TIMER
  203. 60020 IF INKEY$ = "" AND TIMER - COUNT# < 4 THEN 60020
  204. 60030 RETURN
  205. 187 DEF FNM$ (F, R) = STR$(F#(F) + (SGN(F#(F)) * .5#) / (10# ^ R)) + "." + STRING$(R, "0")
  206. 188 DEF FNU$ (F, R) = MID$(FNM$(F, R), 1, INSTR(FNM$(F, R), ".") - 1 + (ABS(R <> 0) * (R + 1)))
  207. 202 FILNUM = 1: GOSUB 210: GOTO 298
  208. 44999 '
  209. 45000 ' Relational Record Selection Prompting
  210. 45005 UPDTE$ = "S"
  211. 45010 LC = 0
  212. 45015 FC = 0: CP = 0: BF = 0
  213. 45020 PRINT BOTT$; BLANK$; BOTT$; "Press RETURN to get to the Field you want to Search on ...";
  214. 45025 FL = 1: HELP = 7: GOSUB 21000
  215. 45030 PRINT BOTT$; BLANK$; BOTT$; "When you are at the Field you want, TYPE in what you want to Search for. ";
  216. 45035 FC = FC + 1: IF FC > T THEN 4000 ELSE IF TY$(FC) = "Z" THEN 45035
  217. 45040 FL = FL(FC): LOCATE CY(FC) + 1, CX(FC) + 1
  218. 45045 HELP = 8: GOSUB 21000: IF TY$(FC) = "N" THEN GOSUB 23000: IF N = 0 THEN PRINT FNCRT$(CX(FC), CY(FC)); STRING$(FL(FC), "."); : GOTO 45040
  219. 45050 IF T$ <> "" THEN 45070 ELSE 45035
  220. 45055 '
  221. 45060 '
  222. 45065 '
  223. 45070 SS$ = T$: Q$ = T$
  224. 45075 '
  225. 45080 IF TY$(FC) <> "N" THEN CP = 4: GOTO 45205'sort ?
  226. 45083 '
  227. 45084 ' Get Relation on Numeric field
  228. 45085 PRINT BOTT$; BLANK$; BOTT$; "The Field you are Searching is a Number Field..."; : GOSUB 60000
  229. 45090 PRINT BOTT$; BLANK$; BOTT$; "You may Select Records in your Report that are ... "; : GOSUB 60000
  230. 45095 PRINT BOTT$; BLANK$; BOTT$; "<E>qual, <L>ess or <G>reater than the number you entered (Pick E,L or G) - "; : FL = 1: HELP = 9: GOSUB 21000
  231. 45100 IF T$ = "" THEN 45095
  232. 45105 IF ASC(T$) > 90 THEN T$ = CHR$(ASC(T$) - 32)
  233. 45110 CP = INSTR(" ELGelg", T$) - 1: IF CP > 3 THEN CP = CP - 3
  234. 45115 IF CP < 1 OR CP > 3 THEN PRINT CHR$(7); : GOTO 45095
  235. 45199 '
  236. 45200 ' Look for Sort (QP3SORT.EXE)
  237. 45205 IF NKA = 0 THEN T$ = "N": GOTO 45235 ELSE ON ERROR GOTO 45215'look for Sort
  238. 45210 OPEN "I", 3, "QP3SORT.EXE": CLOSE 3: GOTO 45230'if found proceed
  239. 45215 CLOSE 3: IF ERR = 53 THEN T$ = "N": RESUME 45235'if not found return
  240. 45220 IF ERR = 54 THEN RESUME 45230'if BM error proceed
  241. 45225 GOTO 53000'error traps
  242. 45228 '
  243. 45229 ' Sort prompting if Sort is found
  244. 45230 ON ERROR GOTO 53000: SS = 0: PRINT BOTT$; BLANK$; BOTT$; "Do you want your Report in sorted order ? (Y/N)-"; : FL = 1: HELP = 10: GOSUB 21000: IF T$ = "" THEN 45230
  245. 45235 IF INSTR("Nn", T$) THEN GOTO 14038
  246. 45245 FOR X = 1 TO T: IF TY$(X) = "Z" THEN 45255 ELSE N$ = MID$(STR$(X), 2)
  247. 45250 PRINT FNCRT$(CX(X), CY(X)); N$; : IF FL(X) <> 1 THEN PRINT STRING$(FL(X) - LEN(N$), ".");
  248. 45260 '
  249. 45265 CLOSE : PRINT BOTT$; BLANK$; BOTT$; "What Field do you want to Sort on ? - ";
  250. 45270 FL = 2: HELP = 11: GOSUB 21000: IF T$ = "" OR VAL(T$) < 1 OR VAL(T$) > T THEN 45265
  251. 45275 IF TY$(VAL(T$)) = "Z" THEN PRINT BOTT$; BLANK$; BOTT$; "> Cannot Sort on Display Only Fields <"; : GOSUB 60000: GOTO 45230
  252. 45280 SO = VAL(T$): KYD = 0
  253. 45285 FOR X = 1 TO SO - 1: IF TY$(X) <> "Z" THEN KYD = KYD + FL(X)
  254. 45290 NEXT X
  255. 45295 KYL = FL(SO)
  256. 45300 IF CP THEN PRINT FNCRT$(CX(FC), CY(FC)); SS$
  257. 45304 '
  258. 45310 OPEN "O", #3, "QUIKSORT.CMD"
  259. 45314 '
  260. 45320 PRINT #3, V1$:    'Send master file's filename to the sort
  261. 45330 PRINT #3, RL%:    'with the record length
  262. 45340 PRINT #3, TY$(SO) 'and the field type
  263. 45350 PRINT #3, KYL:    'and the key length
  264. 45360 PRINT #3, KYD:    'and the key depth
  265. 45365 CLOSE 3:          'then close it.
  266. 45368 '
  267. 45378 '
  268. 45383 '
  269. 45384 ' RUN Quikpro+ Sort
  270. 45385 PRINT BOTT$; BLANK$; BOTT$; " Loading Quikpro Sort  ...  ";
  271. 45390 SHELL "QP3SORT": GOTO 47000
  272. 45499 '
  273. 45500 ' Read Record / Test Relation / Print
  274. 45501 '   ... if not Sorting
  275. 45505 ON ERROR GOTO 53000
  276. 45510 X = 1: GET 1, X
  277. 45520 PRINT BOTT$; BLANK$; BOTT$; "Press any key to STOP search - ";
  278. 45530 '
  279. 45531 GET 1, X: X = X + 1: IF INT(LOF(1) / RL%) < X - 1 THEN GOSUB 28000: GOTO 700
  280. 45540 IF F$(FC) = STRING$(FL(FC), 0) THEN 45530
  281. 45599 '
  282. 45600 GOSUB 48000
  283. 45601 '
  284. 45700 IF INKEY$ <> "" THEN 700
  285. 45710 GOTO 45530
  286. 46999 '
  287. 47000 'Do that sort thing
  288. 47010 '
  289. 47020 OPEN "R", #1, "SRTDLIST.QP3", 2
  290. 47030 FIELD #1, 2 AS PNTR$
  291. 47090 IF LOF(1) = 0 THEN CLOSE : KILL "SRTDLIST.QP3": GOTO 47510: 'NO RECORDS!
  292. 47110 FILNUM = 2 'Open Master File
  293. 47120 GOSUB 210: UPDTE$ = "S"
  294. 47130 PRINT BOTT$; BLANK$; BOTT$; "Print in <F>orward or <R>everse order? "; : FL = 1: HELP = 13: GOSUB 21000
  295. 47140 IF T$ = "R" OR T$ = "r" THEN INC = -1 ELSE IF T$ <> "F" AND T$ <> "f" THEN 47130 ELSE INC = 1
  296. 47148 '
  297. 47149 'Scan master file in sorted order & do that search on the sort thing
  298. 47150 MXKY = LOF(1) / 2: MFPTR = 0: IF INC = -1 THEN Y = MXKY + 1: MXKY = 0 ELSE Y = 0: MXKY = MXKY + 1
  299. 47170 PP$ = BOTT$ + BLANK$ + BOTT$ + "Scanning for matches & printing... <P>ause, <A>bort, <R>edo - ": PRINT PP$;
  300. 47180 Y = Y + INC: IF Y = MXKY THEN GOSUB 28000: GOTO 47260
  301. 47185 GET 1, Y: MFPTR = CVI(PNTR$)
  302. 47190 GET 2, MFPTR
  303. 47200 GOSUB 48000
  304. 47220 N$ = INKEY$: IF N$ <> "" THEN 47320' check for interrupt
  305. 47240 GOTO 47180
  306. 47249 '
  307. 47250 ' another copy / return to program
  308. 47260 '
  309. 47265 PRINT BOTT$; BLANK$; BOTT$; " Do you want to print another copy ? (Y/N) - ";
  310. 47270 FL = 1: HELP = 12: GOSUB 21000: IF T$ = "" THEN 47270
  311. 47280 IF INSTR("Nn", T$) THEN CLOSE : KILL "SRTDLIST.QP3": GOTO 47520
  312. 47290 IF INSTR("Yy", T$) THEN LC = 0: PG = 0: GOTO 47150
  313. 47300 GOTO 47260
  314. 47309 '
  315. 47310 ' Pause / Abort /Redo
  316. 47320 N = INSTR("PARpar", N$): IF N > 3 THEN N = N - 3
  317. 47330 ON N GOTO 47360, 47390, 47440
  318. 47340 GOTO 47220
  319. 47350 ' pause
  320. 47360 PRINT BOTT$; BLANK$; BOTT$; " PRINTING PAUSED * Press any key to continue - ";
  321. 47370 A$ = INKEY$: IF A$ = "" THEN 47370 ELSE N$ = "": PRINT PP$; : GOTO 47240
  322. 47380 ' abort
  323. 47390 CLOSE
  324. 47400 KILL "SRTDLIST.QP3"
  325. 47410 GOTO 47520
  326. 47420 ' redo
  327. 47440 PRINT BOTT$; BLANK$; BOTT$; " REDO REPORT * Press any key to continue - ";
  328. 47450 A$ = INKEY$: IF A$ = "" THEN 47450 ELSE LC = 0: PG = 0: GOTO 47150
  329. 47459 '
  330. 47460 ' if sort detected error
  331. 47470 PRINT BOTT$; BLANK$; BOTT$; "SORT DETECTED ERROR #"; EC!; ", <E>nter to continue -";
  332. 47480 A$ = INKEY$: IF A$ = CHR$(13) THEN 47510 ELSE 47480
  333. 47489 '
  334. 47490 'if no PRINTCMD file
  335. 47500 RESUME 47510
  336. 47510 ON ERROR GOTO 53000
  337. 47520 ST = 0: CP = 0: CLOSE : GOTO 202
  338. 47999 '
  339. 48000 'BUILD A RELATIONAL LINE ( test & select )
  340. 48011 '
  341. 48080 ON CP GOTO 48150, 48150, 48150, 48180, 48090
  342. 48089 GOTO 48110
  343. 48090 ' Print all Records
  344. 48100 IF F$(1) <> STRING$(FL(1), 0) THEN GOSUB 15390
  345. 48109 RETURN
  346. 48110 ' Test for String Anywhere in file
  347. 48120 MFOUND = 0: FOR ZZ = 1 TO T: IF INSTR(F$(ZZ), SS$) THEN MFOUND = 1
  348. 48125 NEXT ZZ: IF MFOUND THEN GOSUB 15390
  349. 48130 RETURN
  350. 48139  '
  351. 48140 ' Test for Numeric < = >
  352. 48150 ON CP GOTO 48151, 48153, 48155, 48180, 48090
  353. 48151 IF VAL(F$(FC)) = VAL(SS$) THEN GOSUB 15390
  354. 48152 RETURN
  355. 48153 IF VAL(F$(FC)) < VAL(SS$) THEN GOSUB 15390
  356. 48154 RETURN
  357. 48155 IF VAL(F$(FC)) > VAL(SS$) THEN GOSUB 15390
  358. 48156 RETURN
  359. 48169 '
  360. 48170 ' Test for String in a Field
  361. 48180 IF INSTR(F$(FC), SS$) THEN GOSUB 15390
  362. 48190 RETURN
  363. 48200 '
  364. 15211 '   *** Execute binary tree inquiry after reading map file
  365. 15220 GOSUB 62500: GOSUB 62000
  366. 15230 IF FOUND THEN GET 1, I ELSE GOTO 700
  367. 60999 'Initialize BTree variables
  368. 61000 I = 0: ZR = 0: LR = 0: LL = 0: NKT = 0: NKA = 0: W = 0: ROOT = 0
  369. 61010 TKL = KL + 5: BUS = 400
  370. 61030 RETURN
  371. 61500 'Open MAP and ISI files & initialize in-memory link list
  372. 61510 OPEN "R", 2, V2$, TKL
  373. 61520 FIELD 2, 2 AS LJ$, 2 AS LK$, KL AS KS$, 1 AS DF$
  374. 61530 FIELD 2, TKL AS AM$
  375. 61540 IF LOF(2) / TKL > BUS THEN BUI = BUS ELSE BUI = LOF(2) / TKL
  376. 61550 FOR X = 1 TO BUI: GET 2, X: MEMLINK$(X) = AM$: NEXT X
  377. 61560 IF LOF(2) = 0 THEN KE = 1 ELSE GOSUB 62500
  378. 61570 RETURN
  379. 62000 'Binary Tree inquiry
  380. 62010 I = ROOT
  381. 62020 IF I = ZR THEN FOUND = 0: GOTO 62090
  382. 62030 IF I <= BUS THEN LSET AM$ = MEMLINK$(I) ELSE GET 2, I
  383. 62040 LL = CVI(LJ$): LR = CVI(LK$): KX$ = KS$: DEL$ = DF$
  384. 62050 IF K$ > KX$ THEN GOTO 62080
  385. 62060 IF K$ = KX$ AND DEL$ = "A" THEN FOUND = 1: GOTO 62090
  386. 62065 IF K$ = KX$ AND DEL$ = "D" AND LR <> 0 THEN I = LR: GOTO 62030 ELSE IF K$ = KX$ AND DEL$ = "D" THEN FOUND = 0: GOTO 62090
  387. 62070 IF LL <> ZR THEN I = LL: GOTO 62030 ELSE FOUND = 0: GOTO 62090
  388. 62080 IF LR <> ZR THEN I = LR: GOTO 62030 ELSE FOUND = 0
  389. 62090 RETURN
  390. 62499 'Open map file & get information, then close
  391. 62500 OPEN "R", 3, V3$, 56
  392. 62510 FIELD 3, 2 AS RT$, 2 AS NKT$, 2 AS NKA$, 50 AS FD$
  393. 62580 GET 3, 1: ROOT = CVI(RT$): NKT = CVI(NKT$): NKA = CVI(NKA$): KE = NKT + 1
  394. 62590 CLOSE 3: RETURN
  395. 41000 'HELP SECTION *******************************************
  396. 41010 BSV = &HB800: DEF SEG = &H40: ZZZ = PEEK(&H87): PCX = POS(0): PCY = CSRLIN
  397. 41020 IF ZZZ <> 0 THEN GOTO 41040
  398. 41030 ZZZ = PEEK(&H10): YYY = ZZZ AND 48: IF YYY = 48 THEN BSV = &HB000
  399. 41040 DEF SEG = BSV: BSAVE "$$$$$$$$.$$$", 960, 1440: RESTORE: GOTO 41800
  400. 41050 DATA 1,2,"x"
  401. 41060 DATA "       Flix Video Catalog Data Base Labels  "
  402. 41070 DATA "                                 "
  403. 41080 DATA 2,6,"G/S/E"
  404. 41090 DATA "* GET"
  405. 41100 DATA " Print record(s) read in using key field."
  406. 41110 DATA "* SEARCH/SORT/SELECT"
  407. 41120 DATA " Print one or more records based on search criteria."
  408. 41130 DATA "* END
  409. 41140 DATA " Exit the report program."
  410. 41150 DATA 3,6,"Search Type"
  411. 41160 DATA "* Search in a FIELD"
  412. 41170 DATA " Print record if string appears in specified field."
  413. 41180 DATA "* Search ANYWHERE"
  414. 41190 DATA " Print a record if string appears in record."
  415. 41191 DATA "* RETRIEVE All Records"
  416. 41192 DATA " Prints every record in the data file."
  417. 41200 DATA 4,3,"Search String"
  418. 41210 DATA "Type in the string you wish to search for. If this"
  419. 41220 DATA "string is found anywhere in the file, the record"
  420. 41230 DATA "will be printed."
  421. 41270 DATA 6,2,"Get Record"
  422. 41280 DATA "The Get command operates on the key field. Enter"
  423. 41290 DATA "the key to search for."
  424. 41300 DATA 7,3,"Select Field"
  425. 41310 DATA "By continually pressing Return you can move the"
  426. 41320 DATA "cursor through the fields one by one. Press Return"
  427. 41330 DATA "now to move the cursor into the first field."
  428. 41340 DATA 8,5,"Selecting Field"
  429. 41350 DATA "You are selecting the field to search in. Press"
  430. 41360 DATA "Return to move the cursor to the next field up to"
  431. 41370 DATA "and through the last one. When it is on the field"
  432. 41380 DATA "you want to search, type the data you want searched"
  433. 41390 DATA "for and press Return again to begin the search."
  434. 41400 DATA 9,4,"E/L/G"
  435. 41410 DATA "Since the field you chose to search was a numeric"
  436. 41420 DATA "field, during the search, comparisons may be made."
  437. 41430 DATA "You can print records that are Equal to, Less than,"
  438. 41440 DATA "or Greater than the search string you entered."
  439. 41450 DATA 10,3,"Sort Data?"
  440. 41460 DATA "You have the option of sorting the data before it"
  441. 41470 DATA "is printed. Sorting takes place on the field of"
  442. 41480 DATA "your choice."
  443. 41490 DATA 11,3,"Sort Field"
  444. 41500 DATA "Sorting on numeric fields is in ascending order. On"
  445. 41510 DATA "non-numeric fields, the sort is in alphabetical"
  446. 41520 DATA "order based on the IBM's internal ASCII code table."
  447. 41530 DATA 12,1,"Another Copy?"
  448. 41540 DATA "You may print the entire report over if necessary."
  449. 41541 DATA 13,2,"Reverse Order"
  450. 41542 DATA "You may print the records in reverse order (i.e."
  451. 41543 DATA "Z-A, 9-0, etc) or ascending order (i.e. A-Z, etc)."
  452. 41550 DATA 999,0,"x"
  453. 41800 READ HLPNUM, NUMLIN, HLPLBL$
  454. 41810 IF NUMLIN = 0 THEN RESTORE: HELP = 1: GOTO 41800
  455. 41820 IF HLPNUM <> HELP THEN FOR TT = 1 TO NUMLIN: READ XX$: NEXT TT: GOTO 41800
  456. 41825 IF STARTUP AND HELP THEN HLPLBL$ = PN$ ELSE IF NOT STARTUP AND HELP = 1 THEN HLPLBL$ = "NO HELP FOUND"
  457. 41830 COLOR 14, 1: YYY = 12 - INT(NUMLIN / 2) - 1: XXX = 52 - LEN(HLPLBL$)
  458. 41840 LOCATE YYY - 1, 13: PRINT CHR$(201); "["; HLPLBL$; "]"; STRING$(XXX, 205); CHR$(187);
  459. 41850 FOR TT = 1 TO NUMLIN: READ XX$: IF LEN(XX$) < 52 THEN XX$ = XX$ + SPACE$(52 - LEN(XX$))
  460. 41860 LOCATE YYY + TT - 1, 13: PRINT CHR$(186); " "; XX$; " "; CHR$(186): NEXT TT
  461. 41865 LOCATE YYY + NUMLIN, 13: PRINT CHR$(186); : COLOR 15, 1
  462. 41866 PRINT "           (press any key to continue...)             "; : COLOR 14, 1: PRINT CHR$(186);
  463. 41870 LOCATE YYY + NUMLIN + 1, 13: PRINT CHR$(200); STRING$(54, 205); CHR$(188);
  464. 41880 WHILE INKEY$ = "": WEND
  465. 41890 BLOAD "$$$$$$$$.$$$", 960: KILL "$$$$$$$$.$$$"
  466. 21000 'Keyboard Scan Routine
  467. 21001 '
  468. 21010 LOCATE , , 0: T$ = "": PY = CSRLIN: PX = POS(0): CSP = 0
  469. 21020 A$ = INKEY$: IF A$ <> "" THEN 21050
  470. 21030 CSP = CSP + 1: IF CSP = 6 THEN CSP = 1
  471. 21040 PRINT MID$(CR$, CSP, 1); : LOCATE PY, PX: GOTO 21020
  472. 21050 IF A$ = CHR$(27) THEN GOSUB 41000: GOTO 21020
  473. 21060 IF A$ = CHR$(8) AND LEN(T$) > 0 THEN PRINT BK$; : PX = PX - 1: LOCATE PY, PX: T$ = LEFT$(T$, LEN(T$) - 1): GOTO 21020 ELSE IF A$ = CHR$(8) THEN T$ = A$: GOTO 21100
  474. 21070 IF A$ = CHR$(13) THEN PRINT " "; : GOTO 21100
  475. 21080 IF A$ < " " OR A$ > "~" THEN 21020
  476. 21090 IF LEN(T$) = FL THEN SOUND 1500, 1: GOTO 21020 ELSE T$ = T$ + A$: PRINT A$; : PX = PX + 1: GOTO 21020
  477. 21100 RETURN
  478.  9 COLOR  14 , 1 , 1 : 'Colors in lines 45240, 45255, and 41900
  479.  45240 IF INSTR(" Yy",T$)=0 THEN 45230 ELSE SS=1:COLOR  14 , 1 
  480.  45255 NEXT : COLOR 14 , 1 
  481.  41900 LOCATE PCY, PCX: COLOR  14 , 1 : RETURN
  482.  53030 COLOR 14 , 1 : RESUME NEXT
  483.  53040 COLOR 14 , 1 : RESUME
  484.  53050 COLOR 14 , 1 : RESUME 4000
  485.  4006 LOCATE 1,1:COLOR 14 , 1 
  486.