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
/
CPMUG045.ARK
/
P_R320.BAS
< prev
next >
Wrap
BASIC Source File
|
1984-04-29
|
3KB
|
81 lines
REMARK *************************************************************\
* P/R320.BAS EMPLOYEE ACTIVITY SORT PROGRAM 4/23/79 *\
* ======================================================= *\
* THIS PROGRAM USES THE SHELL-METZNER SORTING ALGORITHM *\
* TO SORT A TRANSACTION FILE IN DECREASING INCREMENTS AND *\
* WRITE THE SORTED RECORDS OUT TO A WORKFILE. *\
*************************************************************
DIM TAG.ARRAY(875),T2(8)
%INCLUDE CURSOR
6000 CONSOLE:PRINT CLEAR.SCREEN$;"EMPLOYEE ACTIVITY REPORT SORT"
PRINT "KEY RETURN TO BEGIN; CTRL-C TO EXIT"
6000.1 IF CONSTAT%=0 THEN GOTO 6000.1 REMARK WAIT FOR OPERATOR RESPONSE
A%=CONCHAR%
IF A%=03H THEN CHAIN "P/R000" REMARK IF CTRL-C WAS HIT, LOAD MENU PROGRAM
IF A% <> 0DH THEN GOTO 6000.1
PRINT "PROCESSING...DO NOT INTERRUPT"
PRINT
OUTPUT.FILE$="WORKFILE.DAT"
INPUT.FILE$="JOB0F100.DAT":RECLENGTH=160
REMARK*** OPEN FILES ***
CREATE OUTPUT.FILE$ AS 1
IF END #2 THEN 8000 REMARK IF NULL FILE, ABORT PROGRAM
OPEN INPUT.FILE$ RECL RECLENGTH AS 2
IF END #2 THEN 6950 REMARK SET END-OF-FILE BRANCH CONDITION
6055 READ #2;VAR1, VAR2
RECORD.COUNT%=RECORD.COUNT%+1
IF VAR2=0 THEN GOTO 6055 REMARK REJECT JOB HEADER RECORDS
REM *************************************************************
REM * THE SORT KEY IS CALCULATED ON THE NEXT LINE FOR AN *
REM * ALGEBRAIC-RESULT SORT. BINARY SORTS MUST USE CHARACTERS *
REM * WHICH ARE PROPERLY JUSTIFIED FOR COMPARISON. *
TAG.ARRAY(RECORD.COUNT%)=\
VAR2 * 10000000000 + VAR1 * 10000 + RECORD.COUNT%
REM * THIS IS A GENERALIZED SORT, IDENTICAL IN ALMOST ALL *
REM * CASES TO PR290.BAS. *
REM *************************************************************
PRINT CURSOR.HOME$:PRINT:PRINT:PRINT
PRINT USING "RECORD NO :####";RECORD.COUNT%
GOTO 6055
6950 CLOSE 2
PRINT "NUMBER OF RECORDS READ = ";RECORD.COUNT%
PRINT "SORTING..."
M%=RECORD.COUNT%
7000 M%=M% / 2
IF M%=0 THEN GOTO 7150 REMARK IF SORT INTERVAL (M) IS EXHAUSTED,\
THEN TERMINATE THE SORT.
K%=RECORD.COUNT%-M%
J%=1
7040 I%=J%
7050 L%=I% + M%
IF TAG.ARRAY(I%) <= TAG.ARRAY(L%) THEN GOTO 7120
TEMP=TAG.ARRAY(I%)
TAG.ARRAY(I%)=TAG.ARRAY(L%)
TAG.ARRAY(L%)=TEMP
I%=I% - M%
IF I% >= 1 THEN 7050
7120 J%=J% + 1
IF J% > K% THEN GOTO 7000 ELSE GOTO 7040
7150 FOR X%=1 TO RECORD.COUNT% REMARK WRITE WORK FILE
IF TAG.ARRAY(X%) > 0 THEN PRINT #1;TAG.ARRAY(X%)
7200 NEXT X%
PRINT CLEAR.SCREEN$
PRINT "SORT COMPLETE "
CHAIN "P/R321" REMARK LOAD THE EMPLOYEE ACTIVITY REPORT PROGRAM
8000 PRINT "NO RECORDS"
CHAIN "P/R000" REMARK IF OPEN ERROR OCCURRED, LOAD THE MENU