home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / SIMTEL / CPMUG / CPMUG088.ARK / EPSORT.BAS < prev    next >
BASIC Source File  |  1984-04-29  |  4KB  |  154 lines
  1.     rem This is the Employee Information Entry Sort Program
  2.  
  3.  
  4.     rem This program creates a backup file and copies all undeleted
  5.     rem records to that file. Simultaneously it creates a RAM resident
  6.     rem list of either tag numbers, account numbers, or reference numbers
  7.     rem -  S(xxxx) - and Relative Record KEYS - T(xxxx).
  8.  
  9.     rem The tag, account, or reference numbers are then sorted via a Shell
  10.     rem Metzler algorithm and the Relative Record KEYS carried along.
  11.  
  12.     rem When the sort is complete, the Relative Record KEYS are used to
  13.     rem restore the backed up records to the original file in sorted order.
  14.  
  15.  
  16. %INCLUDE ALL.BAS
  17.  
  18.     dim s(z2),t(z2),n(2,20)
  19.  
  20.     z5$="b:ep":z6$="b:epback":z7$="b:epsize":RL=512
  21.  
  22.     false=0:true=-1
  23.  
  24. 2000    print clear$:print
  25.     print "Sorting the Employee Information file will make any old"
  26.     print "Time card files invalid and inaccessable. If you wish to"
  27.     print "use any of these old files, just type 'abort' and go to"
  28.     print "the time card entry operation to make a listing."
  29.     print:print "If you wish to continue, type 'C' "
  30.  
  31.     input line temp$
  32.  
  33.     if ucase$(temp$)="ABORT" then chain "epentry"
  34.  
  35.     if ucase$(temp$)<>"C" then 2000
  36.  
  37. 8000    INPUT "SORT ON TAG OR REFERENCE # (T OR A)";LINE SORT.KEY$
  38.     IF SORT.KEY$="t" OR SORT.KEY$="T" THEN A9=1:GOTO 8020
  39.     IF SORT.KEY$="a" OR SORT.KEY$="A" THEN A9=2:GOTO 8020
  40.     GOTO 8000
  41.  
  42. 8020    PRINT clear$:PRINT
  43.     PRINT "*** BACKING UP FILE ***"
  44.     PRINT:PRINT "*** NOTE - BACKUP IGNORES DELETED RECORDS ***"
  45.  
  46.     open z5$ recl RL as 1
  47.     create z6$ recl RL as 2
  48.  
  49.  
  50.     Z1=0
  51.  
  52.     FOR Z=1 TO Z2-1
  53.     read #1,z;N(2,1),N(2,2),N$,N(2,16),N(2,17),N(2,18),\
  54.           N(2,19),N(2,20),N(0,1),N(0,2),N(0,3),N(0,4),N(0,5),N(0,6),N(0,7),\
  55.           N(0,8),N(0,9),N(0,10),N(0,11),N(0,12),N(0,13),\
  56.           N(0,14),N(0,15),N(0,16),N(0,17),N(0,18)
  57.  
  58.     IF N(2,1)=0 THEN 8065
  59.     IF N(2,2)=0 THEN 8070
  60.     Z1=Z1+1
  61.     print #2,z1;N(2,1),N(2,2),N$,N(2,16),N(2,17),N(2,18),\
  62.           N(2,19),N(2,20),N(0,1),N(0,2),N(0,3),N(0,4),N(0,5),N(0,6),N(0,7),\
  63.           N(0,8),N(0,9),N(0,10),N(0,11),N(0,12),N(0,13),\
  64.           N(0,14),N(0,15),N(0,16),N(0,17),N(0,18)
  65.  
  66.     T(Z1)=Z1:S(Z1)=N(2,A9)
  67. 8065        NEXT Z
  68. 8070            close 1
  69.             close 2
  70.  
  71.     PRINT clear$:PRINT
  72.     PRINT "*** SORTING ON";
  73.     IF A9=1 THEN PRINT " TAG ***"
  74.     IF A9=2 THEN PRINT " REFERENCE NUMBER ***":PRINT
  75.     PRINT "THIS SORT TAKES FROM 30 SECONDS FOR 100 RECORDS"
  76.     PRINT "TO 10 MINUTES FOR 1000 RECORDS":PRINT
  77.     PRINT "*** PLEASE WAIT ***":PRINT
  78.  
  79.  
  80.     rem This is the actual sort routine
  81.  
  82.     N9=Z1
  83.     M9=N9
  84. 8515    M9=INT(M9/2)
  85.     IF M9=0 THEN 8580
  86.         J9=1:K9=N9-M9
  87.  
  88. 8530    I9=J9
  89. 8535    L9=I9+M9
  90.     IF S(I9)<S(L9) THEN 8565
  91.  
  92.         Z=S(I9):S(I9)=S(L9):S(L9)=Z
  93.         Z=T(I9):T(I9)=T(L9):T(L9)=Z
  94.         I9=I9-M9
  95.  
  96.     IF I9<1 THEN 8565
  97.  
  98.     GOTO 8535
  99.  
  100. 8565    J9=J9+1
  101.     IF J9>K9 THEN 8515
  102.     GOTO 8530
  103.  
  104.  
  105. 8580    PRINT clear$:PRINT
  106.     PRINT "SORT COMPLETED - YOU MAY STILL ABORT":PRINT
  107.     PRINT "IF YOU WISH TO ABORT - JUST TYPE ABORT":PRINT
  108.     PRINT "OTHERWISE TYPE A CARRIAGE RETURN TO CONTINUE !"
  109.     PRINT
  110.         INPUT LINE TEMP$
  111.         IF TEMP$="abort" OR TEMP$="ABORT" THEN 10000
  112.  
  113.             if T(1)=0 then 10000
  114.  
  115.     open z5$ recl RL as 1
  116.     open z6$ recl RL as 2
  117.         open z7$ as 3:read #3;z2,z3:close 3
  118.  
  119.  
  120.     Z2=Z1+1
  121.  
  122.     FOR Z=1 TO Z2-1
  123.     READ #2,T(Z);N(2,1),N(2,2),N$,N(2,16),N(2,17),N(2,18),\
  124.           N(2,19),N(2,20),N(0,1),N(0,2),N(0,3),N(0,4),N(0,5),N(0,6),N(0,7),\
  125.           N(0,8),N(0,9),N(0,10),N(0,11),N(0,12),N(0,13),\
  126.           N(0,14),N(0,15),N(0,16),N(0,17),N(0,18)
  127.  
  128.     PRINT #1,Z;N(2,1),N(2,2),N$,N(2,16),N(2,17),N(2,18),\
  129.           N(2,19),N(2,20),N(0,1),N(0,2),N(0,3),N(0,4),N(0,5),N(0,6),N(0,7),\
  130.           N(0,8),N(0,9),N(0,10),N(0,11),N(0,12),N(0,13),\
  131.           N(0,14),N(0,15),N(0,16),N(0,17),N(0,18)
  132.  
  133.     NEXT Z
  134.  
  135.         for z=1 to 20:n(0,z)=0:n(2,z)=0:next z:n$="":flag=true
  136.  
  137.     FOR Z=Z2 TO Z3+2
  138.     print #1,z;N(2,1),N(2,2),N$,N(2,16),N(2,17),N(2,18),\
  139.           N(2,19),N(2,20),N(0,1),N(0,2),N(0,3),N(0,4),N(0,5),N(0,6),N(0,7),\
  140.           N(0,8),N(0,9),N(0,10),N(0,11),N(0,12),N(0,13),\
  141.           N(0,14),N(0,15),N(0,16),N(0,17),N(0,18)
  142.  
  143.     NEXT Z
  144.         close 1
  145.         delete 2
  146.         open z7$ as 3:print #3;z2,z3,flag:close 3
  147.  
  148. chain "epentry"
  149.  
  150.  
  151. 10000 open z6$ recl RL as 1
  152.     delete 1
  153.     chain "epentry"
  154.