REMARK	*************************************************************\
	*  PR06A.BAS  TRANSACTION FILE SORT PROGRAM     5/10/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 P/R TRANSACTION 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$;"TRANSACTION ENTRY F/M (SORT)"
	PRINT "PROCESSING...DO NOT INTERRUPT"
	PRINT
	OUTPUT.FILE$="WORKFILE.DAT"
	INPUT.FILE$="P/R0F040.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 TRANSACTION 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(1)*10000000+T2(2)*100000+T2(3)*1000+RECORD.COUNT%



REM	*  THIS IS A GENERALIZED SORT, IDENTICAL IN ALMOST ALL      *
REM	*  CASES TO PR290.BAS.					    *
REM	*************************************************************
		PRINT CURSOR.HOME$:PRINT
		PRINT USING "RECORD NO : ###";RECORD.COUNT%
		GOTO 6055

6950		RECORD.COUNT%=RECORD.COUNT%-1
		IF RECORD.COUNT%=0 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 TRANSACTION FILE IN SORTED ORDER
	
	X0=TAG.ARRAY(X%)-INT(TAG.ARRAY(X%)/1000)*1000
		Y4=2
		IF X0=0 THEN 7200
		GOSUB 780						REMARK  READ THE TRANSACTION 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 TRANS. F/M (ALTER)"
	CHAIN "P/R06B"							REMARK  LOAD THE TRANSACTION F/M PROGRAM

8000	PRINT "EMPTY TRANSACTION FILE--PROGRAM ABORTED"
	CHAIN "P/R000"							REMARK  IF OPEN ERROR OCCURRED, LOAD THE MENU