home *** CD-ROM | disk | FTP | other *** search
/ Hall of Fame / HallofFameCDROM.cdr / data / pdsdb40a.lzh / DBSORT.SRC < prev    next >
Text File  |  1989-02-15  |  4KB  |  50 lines
  1. 2010 CLS:PRINT TAB(20)"  PDS*BASE Data Base Sort Program For":PRINT:PRINT TAB(INT((80-LEN(ZB$))/2));ZB$:PRINT:PRINT
  2. |2015 DIM YA$(|12),YA%(|12,3),YF%(|07),ZS9(|13,1)
  3. 2020 PRINT:PRINT "Enter the name of the program this sort will be used with ";:INPUT YF$:IF YF$="" THEN 400
  4. 2025 IF RIGHT$(YF$,4)=".BAS" OR RIGHT$(YF$,4)=".bas" THEN YF$=LEFT$(YF$,LEN(YF$)-4)+".SRT" ELSE YF$=YF$+".SRT" 'append .SRT to the program name
  5. |2030 PRINT:PRINT "Choose one of the Master files to sort:":PRINT:FOR ZJ=1 TO |02:IF ZS%(ZJ,1)=1 THEN PRINT:PRINT ZJ;" - ";TAB(8);ZS$(ZJ,1)
  6. 2035 NEXT 'ZJ
  7. 2036 PRINT:PRINT "Enter File Number ";:INPUT ZA:IF ZS%(ZA,1)<>1 THEN PRINT:BEEP:PRINT "Bad code - Try again":PRINT:GOTO 2036
  8. *12 2037 ZF$=MID$("ABCDE",ZT%(ZA,1,1),1)+":"+LEFT$(ZS$(ZA,1),(LEN(ZS$(ZA,1))-4))+".SRT" 'figure out the sort key file name for this master file
  9. *13 2037 ZF$=LEFT$(ZS$(ZA,1),(LEN(ZS$(ZA,1))-4))+".SRT" 'figure out the sort key file name for this master file
  10. 2040 PRINT:PRINT "Enter major to minor sort field numbers":PRINT:FOR ZJ=1 TO ZS%(ZA,7):PRINT ZJ;" - ";TAB(8);ZN$(ZA,ZJ,1):NEXT ZJ:PRINT
  11. 2045 FOR ZJ=1 TO ZS%(ZA,7):INPUT "Enter field number ";ZQ$:YF%(ZJ)=VAL(ZQ$):IF YF%(ZJ)=0 THEN ZL=ZJ-1:ZJ=ZS%(ZA,7)
  12. 2050 NEXT ZJ:IF ZL=0 GOTO 400
  13. 2055 Z5=0:ZZ5=0:PRINT:PRINT "The sort keys are being loaded from the '";ZS$(ZA,1);"' file."
  14. 2060 PRINT:PRINT "There may be times when the disc drive stops - Not to worry":PRINT
  15. 2062 ON ERROR GOTO 2400:OPEN ZF$ FOR INPUT AS #ZQ+1 'open the sort key file to read the active record numbers
  16. 2065 IF EOF(ZQ+1) THEN 2070 ELSE ZZ5=ZZ5+1:INPUT #ZQ+1, YA%(ZZ5,3):GOTO 2065  'read the Master sort key file
  17. 2070 CLOSE #ZQ+1:ZFLAG=0:IF ZZ5=ZS%(ZA,6) THEN ZK=ZZ5 ELSE ZK=ZS%(ZA,2):ZFLAG=1
  18. 2075 FOR ZJJ=1 TO ZK 'ZK=# records in Master sort file if # RE. in sort file = # active rec in data base else it = the capacity of the data base
  19. 2080 IF ZFLAG=0 THEN ZR=YA%(ZJJ,3) ELSE ZR=ZJJ
  20. 2090 ZZ=1:GOSUB 610
  21. 2100 IF ZL$<>STRING$(ZSIZE%(ZA,1),32) THEN Z5=Z5+1:FOR ZJ=1 TO ZL:YA$(Z5)=YA$(Z5)+Y$(YF%(ZJ),ZA):NEXT ZJ:YA%(Z5,1)=Z5:YA%(Z5,2)=ZR
  22. 2120 NEXT 'ZJJ
  23. 2125 IF ZFLAG=1 THEN ZS%(ZA,6)=Z5 ' correct records assigned
  24. 2130 PRINT:BEEP:PRINT "There will be a file sort delay.":PRINT:PRINT
  25. 2140 ZZT$=TIME$:ZT1=(VAL(LEFT$(ZZT$,2))*3600) + (VAL(MID$(ZZT$,4,2))*60) + (VAL(RIGHT$(ZZT$,2)))
  26. 2150 ZI1=1:ZJ1=Z5:ZP=0
  27. 2160 ZI=ZI1:ZJ=ZJ1
  28. 2170 IF YA$(YA%(ZI,1))>YA$(YA%(ZJ,1)) THEN SWAP YA%(ZI,1),YA%(ZJ,1):SWAP YA%(ZI,2),YA%(ZJ,2):ZZS%=ABS(ZZS%-1)
  29. 2180 ZI=ZI+ZZS%:ZJ=ZJ-(1-ZZS%):IF ZI<ZJ THEN 2170
  30. 2190 IF ZI+1<ZJ1 THEN ZP=ZP+1:ZS9(ZP,0)=ZI+1:ZS9(ZP,1)=ZJ1
  31. 2200 ZJ1=ZI-1:IF ZI1<ZJ1 THEN 2160
  32. 2210 IF ZJ>0 THEN LOCATE ,1,1:PRINT YA$(YA%(ZJ,1));
  33. 2220 IF ZP THEN ZI1=ZS9(ZP,0):ZJ1=ZS9(ZP,1):ZP=ZP-1:GOTO 2160
  34. 2230 PRINT:PRINT:PRINT:ZZT$=TIME$:ZT2=(VAL(LEFT$(ZZT$,2))*3600)+(VAL(MID$(ZZT$,4,2))*60)+(VAL(RIGHT$(ZZT$,2)))
  35. 2240 BEEP:ZT3=ZT2-ZT1:IF ZT3 < 120 THEN PRINT "Elapsed time=";ZT3;" seconds" ELSE PRINT "Elapsed time =";INT(ZT3/60);" minutes ";INT( ( (ZT3/60)-INT(ZT3/60) ) * 60 );" seconds"
  36. 2245 BEEP:PRINT:PRINT "The sort is finished!!!!"
  37. 2250 PRINT:PRINT "The report sort file is being saved."
  38. 2270 OPEN YF$ FOR OUTPUT AS ZQ+1
  39. 2275 WRITE #ZQ+1,ZDATE$(ZA);ZTIME$(ZA) 'date & time the file with the date & time from the data base master file
  40. 2280 PRINT #ZQ+1, Z5:FOR ZI=1 TO Z5:PRINT #ZQ+1, YA%(ZI,2):NEXT
  41. 2290 CLOSE #ZQ+1:PRINT:PRINT "Report sort key file '";YF$;"' is created."
  42. 2300 PRINT:PRINT "The master sort file is being saved."
  43. 2310 OPEN ZF$ FOR OUTPUT AS ZQ+1
  44. 2320 FOR ZI=1 TO Z5:PRINT #ZQ+1, YA%(ZI,2):NEXT
  45. 2330 CLOSE #ZQ+1:PRINT:PRINT "Master sort key file '";ZF$;"' is created."
  46. 2340 GOTO 400
  47. 2400 '****** ERROR HANDLING
  48. 2410 IF ERR=53 THEN RESUME 2070 'master sort key file not on disc
  49. *31 Copyright 1987 by PRO DEV Software
  50.