REMARK *************************************************************\ * PR290.BAS JOB POSTING FILE SORT PROGRAM 5/17/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. *\ * ONCE THE WORKFILE IS COMPLETELY WRITTEN, IT REPLACES THE *\ * FILE USED AS INPUT. *\ ************************************************************* DIM TAG.ARRAY(875),T2(8) %INCLUDE CURSOR GOTO 6000 780 READ #Y4,X0;T2(1),T2(2),T2(3),T2(4),T2(5),T2(6),T2(7),T2(8) REMARK READ RECORD FROM JOB POSTING FILE RETURN 800 PRINT #Y4;T2(1),T2(2),T2(3),T2(4),T2(5),T2(6),T2(7),T2(8) REMARK RE-WRITE RECORD ONTO WORKFILE RETURN 6000 Y4=2 CONSOLE:PRINT CLEAR.SCREEN$;"JOB POSTING SORT/UPDATE" PRINT "KEY RETURN TO BEGIN; CTRL-C TO EXIT" 6000.1 IF CONSTAT%=0 THEN GOTO 6000.1 REMARK POLL KEYBOARD FOR CTRL-C OR RETURN A%=CONCHAR% IF A%=03H THEN GOTO 7300 REMARK ABORT PROGRAM ON CTRL-C IF A%<>0DH THEN GOTO 6000.1 REMARK WAIT FOR RETURN BEFORE EXECUTING PROGRAM PRINT "PROCESSING...DO NOT INTERRUPT" PRINT OUTPUT.FILE$="WORKFILE.DAT" INPUT.FILE$="JOB0F110.DAT":RECLENGTH=42 REMARK*** OPEN FILES *** CREATE OUTPUT.FILE$ RECL RECLENGTH 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 RECORD.COUNT%=RECORD.COUNT% + 1 REMARK INCREMENT NUMBER OF RECORDS X0=RECORD.COUNT% GOSUB 780 REMARK READ FROM JOB POSTING FILE 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%)=T2(6)*10000000+T2(1)*10000+RECORD.COUNT% REM * THIS IS A GENERALIZED SORT, IDENTICAL IN ALMOST ALL * REM * CASES TO PR06A.BAS. * REM ************************************************************* PRINT CURSOR.HOME$:PRINT:PRINT PRINT USING "RECORD NO : ###";RECORD.COUNT% GOTO 6055 6950 RECORD.COUNT%=RECORD.COUNT%-1 IF RECORD.COUNT%<1 THEN 8000 CLOSE 2 OPEN INPUT.FILE$ RECL RECLENGTH AS 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 RE-WRITE POSTING FILE IN SORTED ORDER X0=TAG.ARRAY(X%)-INT(TAG.ARRAY(X%)/10000)*10000 Y4=2 IF X0=0 THEN 7200 GOSUB 780 REMARK READ THE POSTING FILE AT POSITION X0 Y4=1 REMARK SWAP FILE ASSIGNMENTS GOSUB 800 REMARK WRITE THE ORDERED RECORD TO WORKFILE. 7200 NEXT X% DELETE 2 CLOSE 1 A=RENAME(INPUT.FILE$,OUTPUT.FILE$) REMARK ERASE INPUT FILE AND RENAME WORKFILE TO \ ORIGINAL FILENAME PRINT CLEAR.SCREEN$ PRINT "SORT COMPLETE " PRINT "LOADING UPDATE PROCESSOR" CHAIN "P/R291" REMARK LOAD THE JOB POSTING UPDATE PROGRAM 7300 PRINT CLEAR.SCREEN$;"JOB POSTING LOADING MENU" CHAIN "P/R000" 8000 PRINT "EMPTY TRANSACTION FILE--PROGRAM ABORTED" CHAIN "P/R000" REMARK IF OPEN ERROR OCCURRED, LOAD THE MENU