REMARK ************************************************************* REMARK * GENERAL LEDGER UPDATE SORT (GL020) * REMARK * VERS. OF 3.00 PM 8/14/79 * REMARK * ======================================================= * REMARK * THIS PROGRAM USES THE SHELL-METZNER SORTING ALGORITHM * REMARK * TO SORT A TRANSACTION FILE IN DECREASING INCREMENTS AND * REMARK * WRITE THE SORTED RECORDS OUT TO A WORKFILE. * REMARK * ONCE THE WORKFILE IS COMPLETELY WRITTEN, IT REPLACES THE * REMARK * FILE USED AS INPUT. * REMARK ************************************************************* WRITTEN=100000 DIM KEY.ARRAY(875) %INCLUDE CURSOR GOTO 6000 %INCLUDE POSTFILE %INCLUDE G/L-INFO 6000 CONSOLE PRINT CLEAR.SCREEN$;"G/L POSTING SORT/UPDATE" PRINT "KEY RETURN TO BEGIN; CTRL-C TO EXIT" REMARK WAIT FOR OPERATOR CUE BEFORE STARTING SORT 6010 IF CONSTAT%=0 THEN GOTO 6010 A%=CONCHAR% IF A%=03H THEN \ REMARK IF CTRL-C ENTERED, EXIT PROGRAM PRINT CLEAR.SCREEN$;"G/L POSTING SORT LOADING MENU":\ CHAIN "G/L000" IF A%<>0DH THEN GOTO 6010 PRINT "WORKING...DO NOT INTERRUPT" INPUT.FILE$="G/L0F020.DAT" OUTPUT.FILE$="WORKFILE.DAT" RECLENGTH=36 OPEN INPUT.FILE$ RECL RECLENGTH AS 1 OPEN "G/L0F130.DAT" AS 5 FILE.NO%=5:GOSUB .314 CLOSE 5 IF EXTERNAL.POSTING.EXTENT%=0 AND \ DIRECT.POSTING.EXTENT%=0 THEN\ REMARK CHECK TO SEE IF ANY POSTINGS ARE ON FILE PRINT CLEAR.SCREEN$;"NO RECORDS":\ CHAIN "G/L000" PRINT "MAX NUMBER OF RECORDS: ",EXTERNAL.POSTING.EXTENT%+DIRECT.POSTING.EXTENT% PRINT "SORT EXTERNAL POSTINGS" IF EXTERNAL.POSTING.EXTENT%=0 THEN DELETE 1:GOTO 7200 REMARK IF NO EXTERNAL POSTINGS ON FILE, SKIP THIS PASS 6020 IF END #1 THEN 7000 REMARK SET END-OF-FILE BRANCH REMARK READ KEY.ARRAY RECORDS, AND STRIP KEY ELEMENTS 6050 READ #1; VAR1,VAR2 RECORD.COUNT%=RECORD.COUNT% + 1 PRINT CURSOR.HOME$:PRINT:PRINT:PRINT:PRINT:PRINT PRINT "RECORD NUMBER ";RECORD.COUNT% KEY.ARRAY(RECORD.COUNT%)=(VAR1*10000000)+(VAR2*10000)+RECORD.COUNT% GOTO 6050 REMARK GET THE NEXT RECORD 7000 CLOSE 1 REMARK SORT PHASE OPEN INPUT.FILE$ RECL RECLENGTH AS 1 M%=RECORD.COUNT% 7010 M%=M%/2 REMARK DIVIDE THE SORT INTERVAL IN HALF IF M%=0 THEN GOTO 7150 REMARK IF SORT IS THROUGH, RE-WRITE THE ORDERED FILE. K%=RECORD.COUNT%-M% J%=1 7040 I%=J% 7050 L%=I% + M% IF KEY.ARRAY(I%) <= KEY.ARRAY(L%) THEN GOTO 7120 REMARK IF THE RECORDS ARE OUT OF ORDER, SWITCH THEM TEMP=KEY.ARRAY(I%) KEY.ARRAY(I%)=KEY.ARRAY(L%) KEY.ARRAY(L%)=TEMP I%=I% - M% IF I% > 0 THEN GOTO 7050 7120 J%=J%+1 IF J% > K% THEN GOTO 7010 ELSE GOTO 7040 7150 CREATE OUTPUT.FILE$ RECL RECLENGTH AS 2 REMARK WRITE SORTED RECORDS TO THE OUTPUT FILE FOR OUTPUT.COUNT%=1 TO RECORD.COUNT% POINTER%=KEY.ARRAY(OUTPUT.COUNT%) - \ (INT(KEY.ARRAY(OUTPUT.COUNT%)/10000)*10000) FILE.NO%=1:RECORD.NO%=POINTER%:GOSUB 3600 FILE.NO%=2:RECORD.NO%=OUTPUT.COUNT%:GOSUB 3650 NEXT OUTPUT.COUNT% DELETE 1 CLOSE 2 A%=RENAME(INPUT.FILE$,OUTPUT.FILE$) IF FLAG%=1 THEN GOTO 7300 REMARK IF THIS WAS THE SECOND SORT PASS, BRANCH 7200 FLAG%=1 REMARK SET FLAG AFTER FIRST PASS INPUT.FILE$="G/L0F030.DAT" OPEN INPUT.FILE$ RECL RECLENGTH AS 1 RECORD.COUNT%=0 PRINT CURSOR.HOME$:PRINT:PRINT:PRINT:PRINT:PRINT"SORT DIRECT POSTINGS " IF DIRECT.POSTING.EXTENT%<>0 THEN GOTO 6020 REMARK IF NO DIRECT POSTINGS ON FILE, SKIP THE SECOND PASS REMARK MERGE PHASE 7300 PRINT CURSOR.HOME$:PRINT:PRINT:PRINT:PRINT:PRINT"MERGE SORTED FILES " IF DIRECT.POSTING.EXTENT%=0 THEN GOTO 8000 REMARK IF NO DIRECT POSTINGS, SKIP MERGE IF EXTERNAL.POSTING.EXTENT%=0 THEN \ REMARK IF NO EXTERNAL POSTINGS, A%=RENAME("G/L0F020.DAT","G/L0F030.DAT"):\ REMARK SWITCH THE POSTING FILES... CREATE "G/L0F030.DAT" RECL 36 AS 2:\ OPEN "G/L0F130.DAT" AS 5:\ EXTERNAL.POSTING.EXTENT%=DIRECT.POSTING.EXTENT%:\ DIRECT.POSTING.EXTENT%=0:\ FILE.NO%=5:GOSUB .315:\ GOTO 8000 REMARK AND SKIP THE MERGE OPEN "G/L0F020.DAT" RECL 36 AS 1,"G/L0F030.DAT" RECL 36 AS 2 CREATE "WORKFILE.DAT" RECL 36 AS 3 OUTPUT.COUNT%=0 GOSUB 7600 REMARK READ THE FIRST EXTERNAL RECORD GOSUB 7700 REMARK READ THE FIRST DIRECT RECORD 7400 IF P1=WRITTEN AND P11=WRITTEN THEN GOTO 7900 REMARK WHEN BOTH FILES ARE EXHAUSTED, BRANCH IF P1=WRITTEN THEN GOTO 7500 IF P1<=P11 THEN \ OUTPUT.COUNT%=OUTPUT.COUNT%+1:\ PRINT #3,OUTPUT.COUNT%;P1,P2,P3,P4,P5:\ REMARK WRITE THE RECORD FROM THE EXTERNAL POSTING FILE GOSUB 7600 IF P11=WRITTEN THEN GOTO 7400 7500 IF P11EXTERNAL.POSTING.EXTENT% THEN P1=WRITTEN:RETURN READ #1,EXTERNAL.COUNT%;P1,P2,P3,P4,P5 RETURN 7700 DIRECT.COUNT%=DIRECT.COUNT%+1 REMARK READ THE RECORD FROM G/L0F030.DAT IF DIRECT.COUNT%>DIRECT.POSTING.EXTENT% THEN P11=WRITTEN:RETURN READ #2,DIRECT.COUNT%;P11,P12,P13,P14,P15 RETURN 7900 DELETE 1,2 REMARK DELETE THE OLD POSTING FILES CLOSE 3 REMARK CLOSE THE WORKFILE BEFORE RENAMING A%=RENAME("G/L0F020.DAT","WORKFILE.DAT") CREATE "G/L0F030.DAT" RECL 36 AS 2 OPEN "G/L0F130.DAT" AS 5 EXTERNAL.POSTING.EXTENT%=OUTPUT.COUNT% DIRECT.POSTING.EXTENT%=0 FILE.NO%=5:GOSUB .315 REMARK SAVE THE NEW FILE EXTENT INFORMATION 8000 CHAIN "G/L030"