home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / cpmug / cpmug045.ark / P_R320.BAS < prev    next >
Encoding:
BASIC Source File  |  1984-04-29  |  2.7 KB  |  81 lines
  1. REMARK    *************************************************************\
  2.     *  P/R320.BAS   EMPLOYEE ACTIVITY SORT PROGRAM    4/23/79   *\
  3.     *  =======================================================  *\
  4.     *  THIS PROGRAM USES THE SHELL-METZNER SORTING ALGORITHM    *\
  5.     *  TO SORT A TRANSACTION FILE IN DECREASING INCREMENTS AND  *\
  6.     *  WRITE THE SORTED RECORDS OUT TO A WORKFILE.            *\
  7.     *************************************************************
  8.  
  9.     DIM TAG.ARRAY(875),T2(8)
  10. %INCLUDE CURSOR
  11. 6000    CONSOLE:PRINT CLEAR.SCREEN$;"EMPLOYEE ACTIVITY REPORT SORT"
  12.     PRINT "KEY RETURN TO BEGIN; CTRL-C TO EXIT"
  13. 6000.1    IF CONSTAT%=0 THEN GOTO 6000.1                    REMARK  WAIT FOR OPERATOR RESPONSE
  14.     A%=CONCHAR%
  15.     IF A%=03H THEN CHAIN "P/R000"                    REMARK  IF CTRL-C WAS HIT, LOAD MENU PROGRAM
  16.     IF A% <> 0DH THEN GOTO 6000.1
  17.     PRINT "PROCESSING...DO NOT INTERRUPT"
  18.     PRINT
  19.     OUTPUT.FILE$="WORKFILE.DAT"
  20.     INPUT.FILE$="JOB0F100.DAT":RECLENGTH=160
  21.  
  22.         REMARK*** OPEN FILES ***
  23.  
  24.     CREATE OUTPUT.FILE$ AS 1
  25.     IF END #2 THEN 8000                        REMARK  IF NULL FILE, ABORT PROGRAM
  26.     OPEN INPUT.FILE$ RECL RECLENGTH AS 2
  27.     IF END #2 THEN 6950                        REMARK  SET END-OF-FILE BRANCH CONDITION
  28. 6055        READ #2;VAR1, VAR2
  29.         RECORD.COUNT%=RECORD.COUNT%+1
  30.         IF VAR2=0 THEN GOTO 6055                REMARK  REJECT JOB HEADER RECORDS
  31. REM    *************************************************************
  32. REM    *  THE SORT KEY IS CALCULATED ON THE NEXT LINE FOR AN        *
  33. REM    *  ALGEBRAIC-RESULT SORT.  BINARY SORTS MUST USE CHARACTERS *
  34. REM    *  WHICH ARE PROPERLY JUSTIFIED FOR COMPARISON.             *
  35.  
  36.  
  37.     TAG.ARRAY(RECORD.COUNT%)=\
  38.     VAR2 * 10000000000 + VAR1 * 10000 + RECORD.COUNT%
  39.  
  40.  
  41.  
  42. REM    *  THIS IS A GENERALIZED SORT, IDENTICAL IN ALMOST ALL      *
  43. REM    *  CASES TO PR290.BAS.                        *
  44. REM    *************************************************************
  45.         PRINT CURSOR.HOME$:PRINT:PRINT:PRINT
  46.         PRINT USING "RECORD NO :####";RECORD.COUNT%
  47.         GOTO 6055
  48. 6950        CLOSE 2
  49.         PRINT "NUMBER OF RECORDS READ = ";RECORD.COUNT%
  50.         PRINT "SORTING..."
  51.         M%=RECORD.COUNT%
  52. 7000        M%=M% / 2
  53.         IF M%=0 THEN GOTO 7150                    REMARK  IF SORT INTERVAL (M) IS EXHAUSTED,\
  54.                                             THEN TERMINATE THE SORT.
  55.  
  56.         K%=RECORD.COUNT%-M%
  57.         J%=1
  58. 7040        I%=J%
  59. 7050        L%=I% + M%
  60.         IF TAG.ARRAY(I%) <= TAG.ARRAY(L%) THEN GOTO 7120
  61.         TEMP=TAG.ARRAY(I%)
  62.         TAG.ARRAY(I%)=TAG.ARRAY(L%)
  63.         TAG.ARRAY(L%)=TEMP
  64.         I%=I% - M%
  65.         IF I% >= 1 THEN 7050
  66. 7120        J%=J% + 1
  67.         IF J% > K% THEN GOTO 7000 ELSE GOTO 7040
  68.  
  69.  
  70.  
  71. 7150    FOR X%=1 TO RECORD.COUNT%                    REMARK  WRITE WORK FILE
  72.         IF TAG.ARRAY(X%) > 0 THEN PRINT #1;TAG.ARRAY(X%)
  73. 7200    NEXT X%
  74.     
  75.     PRINT CLEAR.SCREEN$
  76.     PRINT "SORT COMPLETE "
  77.     CHAIN "P/R321"                            REMARK  LOAD THE EMPLOYEE ACTIVITY REPORT PROGRAM
  78.  
  79. 8000    PRINT "NO RECORDS"
  80.     CHAIN "P/R000"                            REMARK  IF OPEN ERROR OCCURRED, LOAD THE MENU
  81.