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 / CPMUG044.ARK / G_L020.BAS < prev    next >
BASIC Source File  |  1985-02-10  |  6KB  |  151 lines
  1.     REMARK    *************************************************************
  2.     REMARK    *    GENERAL LEDGER UPDATE SORT    (GL020)            *
  3.     REMARK    *        VERS. OF 3.00 PM     8/14/79            *
  4.     REMARK    *  =======================================================  *
  5.     REMARK    *  THIS PROGRAM USES THE SHELL-METZNER SORTING ALGORITHM    *
  6.     REMARK    *  TO SORT A TRANSACTION FILE IN DECREASING INCREMENTS AND  *
  7.     REMARK    *  WRITE THE SORTED RECORDS OUT TO A WORKFILE.            *
  8.     REMARK    *  ONCE THE WORKFILE IS COMPLETELY WRITTEN, IT REPLACES THE *
  9.     REMARK    *  FILE USED AS INPUT.                        *
  10.     REMARK    *************************************************************
  11.  
  12.     WRITTEN=100000
  13.     DIM KEY.ARRAY(875)
  14. %INCLUDE CURSOR
  15.     GOTO 6000
  16. %INCLUDE POSTFILE
  17. %INCLUDE G/L-INFO
  18.  
  19.  
  20.  
  21.  
  22. 6000    CONSOLE
  23.     PRINT CLEAR.SCREEN$;"G/L POSTING SORT/UPDATE"
  24.     PRINT "KEY RETURN TO BEGIN; CTRL-C TO EXIT"            REMARK    WAIT FOR OPERATOR CUE BEFORE STARTING SORT
  25. 6010    IF CONSTAT%=0 THEN GOTO 6010
  26.     A%=CONCHAR%
  27.     IF A%=03H THEN \                        REMARK    IF CTRL-C ENTERED, EXIT PROGRAM
  28.         PRINT CLEAR.SCREEN$;"G/L POSTING SORT LOADING MENU":\
  29.         CHAIN "G/L000"
  30.     IF A%<>0DH THEN GOTO 6010
  31.     PRINT "WORKING...DO NOT INTERRUPT"
  32.     INPUT.FILE$="G/L0F020.DAT"
  33.     OUTPUT.FILE$="WORKFILE.DAT"
  34.     RECLENGTH=36
  35.     OPEN INPUT.FILE$ RECL RECLENGTH AS 1
  36.     OPEN "G/L0F130.DAT" AS 5
  37.     FILE.NO%=5:GOSUB .314
  38.     CLOSE 5
  39.     IF EXTERNAL.POSTING.EXTENT%=0 AND \
  40.         DIRECT.POSTING.EXTENT%=0 THEN\                REMARK    CHECK TO SEE IF ANY POSTINGS ARE ON FILE
  41.         PRINT CLEAR.SCREEN$;"NO RECORDS":\
  42.         CHAIN "G/L000"
  43.     PRINT "MAX NUMBER OF RECORDS:   ",EXTERNAL.POSTING.EXTENT%+DIRECT.POSTING.EXTENT%
  44.     PRINT "SORT EXTERNAL POSTINGS"
  45.     IF EXTERNAL.POSTING.EXTENT%=0 THEN DELETE 1:GOTO 7200        REMARK    IF NO EXTERNAL POSTINGS ON FILE, SKIP THIS PASS
  46. 6020    IF END #1 THEN 7000                        REMARK    SET END-OF-FILE BRANCH
  47.  
  48.  
  49.  
  50.                                     REMARK    READ KEY.ARRAY RECORDS, AND STRIP KEY ELEMENTS
  51. 6050    READ #1; VAR1,VAR2
  52.     RECORD.COUNT%=RECORD.COUNT% + 1
  53.     PRINT CURSOR.HOME$:PRINT:PRINT:PRINT:PRINT:PRINT
  54.     PRINT "RECORD NUMBER    ";RECORD.COUNT%
  55.     KEY.ARRAY(RECORD.COUNT%)=(VAR1*10000000)+(VAR2*10000)+RECORD.COUNT%
  56.     GOTO 6050                            REMARK    GET THE NEXT RECORD
  57.  
  58. 7000    CLOSE 1                                REMARK    SORT PHASE
  59.     OPEN INPUT.FILE$ RECL RECLENGTH AS 1
  60.     M%=RECORD.COUNT%
  61. 7010    M%=M%/2                                REMARK    DIVIDE THE SORT INTERVAL IN HALF
  62.     IF M%=0 THEN GOTO 7150                        REMARK    IF SORT IS THROUGH, RE-WRITE THE ORDERED FILE.
  63.     K%=RECORD.COUNT%-M%
  64.     J%=1
  65. 7040    I%=J%
  66. 7050    L%=I% + M%
  67.  
  68.     IF KEY.ARRAY(I%) <= KEY.ARRAY(L%) THEN GOTO 7120        REMARK    IF THE RECORDS ARE OUT OF ORDER, SWITCH THEM
  69.     TEMP=KEY.ARRAY(I%)
  70.     KEY.ARRAY(I%)=KEY.ARRAY(L%)
  71.     KEY.ARRAY(L%)=TEMP
  72.     I%=I% - M%
  73.     IF I% > 0 THEN GOTO 7050
  74. 7120    J%=J%+1
  75.     IF J% > K% THEN GOTO 7010 ELSE GOTO 7040
  76.  
  77.  
  78. 7150    CREATE OUTPUT.FILE$ RECL RECLENGTH AS 2                REMARK    WRITE SORTED RECORDS TO THE OUTPUT FILE
  79.     FOR OUTPUT.COUNT%=1 TO RECORD.COUNT%
  80.     POINTER%=KEY.ARRAY(OUTPUT.COUNT%) - \
  81.         (INT(KEY.ARRAY(OUTPUT.COUNT%)/10000)*10000)
  82.     FILE.NO%=1:RECORD.NO%=POINTER%:GOSUB 3600
  83.     FILE.NO%=2:RECORD.NO%=OUTPUT.COUNT%:GOSUB 3650
  84.     NEXT OUTPUT.COUNT%
  85.     DELETE 1
  86.     CLOSE 2
  87.     A%=RENAME(INPUT.FILE$,OUTPUT.FILE$)
  88.     IF FLAG%=1 THEN GOTO 7300                    REMARK    IF THIS WAS THE SECOND SORT PASS, BRANCH
  89. 7200    FLAG%=1                                REMARK    SET FLAG AFTER FIRST PASS
  90.     INPUT.FILE$="G/L0F030.DAT"
  91.     OPEN INPUT.FILE$ RECL RECLENGTH AS 1
  92.     RECORD.COUNT%=0
  93.     PRINT CURSOR.HOME$:PRINT:PRINT:PRINT:PRINT:PRINT"SORT DIRECT POSTINGS  "
  94.     IF DIRECT.POSTING.EXTENT%<>0 THEN GOTO 6020            REMARK    IF NO DIRECT POSTINGS ON FILE, SKIP THE SECOND PASS
  95.  
  96.                                     REMARK    MERGE PHASE
  97. 7300    PRINT CURSOR.HOME$:PRINT:PRINT:PRINT:PRINT:PRINT"MERGE SORTED FILES  "
  98.     IF DIRECT.POSTING.EXTENT%=0 THEN GOTO 8000            REMARK    IF NO DIRECT POSTINGS, SKIP MERGE
  99.     IF EXTERNAL.POSTING.EXTENT%=0 THEN \                REMARK    IF NO EXTERNAL POSTINGS,
  100.         A%=RENAME("G/L0F020.DAT","G/L0F030.DAT"):\        REMARK    SWITCH THE POSTING FILES...
  101.         CREATE "G/L0F030.DAT" RECL 36 AS 2:\
  102.         OPEN "G/L0F130.DAT" AS 5:\
  103.         EXTERNAL.POSTING.EXTENT%=DIRECT.POSTING.EXTENT%:\
  104.         DIRECT.POSTING.EXTENT%=0:\
  105.         FILE.NO%=5:GOSUB .315:\
  106.         GOTO 8000                        REMARK    AND SKIP THE MERGE
  107.  
  108.     OPEN "G/L0F020.DAT" RECL 36 AS 1,"G/L0F030.DAT" RECL 36 AS 2
  109.     CREATE "WORKFILE.DAT" RECL 36 AS 3
  110.     OUTPUT.COUNT%=0
  111.     GOSUB 7600                            REMARK    READ THE FIRST EXTERNAL RECORD
  112.     GOSUB 7700                            REMARK    READ THE FIRST DIRECT RECORD
  113. 7400    IF P1=WRITTEN AND P11=WRITTEN THEN GOTO 7900            REMARK    WHEN BOTH FILES ARE EXHAUSTED, BRANCH
  114.     IF P1=WRITTEN THEN GOTO 7500
  115.     IF P1<=P11 THEN \
  116.         OUTPUT.COUNT%=OUTPUT.COUNT%+1:\
  117.         PRINT #3,OUTPUT.COUNT%;P1,P2,P3,P4,P5:\            REMARK    WRITE THE RECORD FROM THE EXTERNAL POSTING FILE
  118.         GOSUB 7600
  119.     IF P11=WRITTEN THEN GOTO 7400
  120. 7500    IF P11<P1 THEN\
  121.         OUTPUT.COUNT%=OUTPUT.COUNT%+1:\
  122.         PRINT #3,OUTPUT.COUNT%;P11,P12,P13,P14,P15:\        REMARK    WRITE THE RECORD FROM THE DIRECT POSTING FILE
  123.         GOSUB 7700
  124.     GOTO 7400
  125.  
  126.  
  127. 7600    EXTERNAL.COUNT%=EXTERNAL.COUNT%+1                REMARK    READ THE RECORD FROM G/L0F020.DAT 
  128.     IF EXTERNAL.COUNT%>EXTERNAL.POSTING.EXTENT% THEN P1=WRITTEN:RETURN
  129.     READ #1,EXTERNAL.COUNT%;P1,P2,P3,P4,P5
  130.     RETURN
  131.  
  132. 7700    DIRECT.COUNT%=DIRECT.COUNT%+1                    REMARK    READ THE RECORD FROM G/L0F030.DAT
  133.     IF DIRECT.COUNT%>DIRECT.POSTING.EXTENT% THEN P11=WRITTEN:RETURN
  134.     READ #2,DIRECT.COUNT%;P11,P12,P13,P14,P15
  135.     RETURN
  136.  
  137. 7900    DELETE 1,2                            REMARK    DELETE THE OLD POSTING FILES
  138.     CLOSE 3                                REMARK    CLOSE THE WORKFILE BEFORE RENAMING
  139.     A%=RENAME("G/L0F020.DAT","WORKFILE.DAT")
  140.     CREATE "G/L0F030.DAT" RECL 36 AS 2
  141.     OPEN "G/L0F130.DAT" AS 5
  142.     EXTERNAL.POSTING.EXTENT%=OUTPUT.COUNT%
  143.     DIRECT.POSTING.EXTENT%=0
  144.     FILE.NO%=5:GOSUB .315                        REMARK    SAVE THE NEW FILE EXTENT INFORMATION
  145. 8000    CHAIN "G/L030"
  146. ;P11,P12,P13,P14,P15:\        REMARK    WRITE THE RECORD FROM THE DIRECT POSTING FILE
  147.         GOSUB 7700
  148.     GOTO 7400
  149.  
  150.  
  151. 7600    EXTERNAL.COUNT%