home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / cpmug / cpmug043.ark / A_P02A.BAS < prev    next >
BASIC Source File  |  1984-04-29  |  3KB  |  103 lines
  1.     REMARK    *************************************************************
  2.     REMARK    *    ACCOUNTS PAYABLE TRANSACTION SORT    (A/P02A)    *
  3.     REMARK    *        VERS. OF 2.00 PM     6/12/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.     ZERO$="000000"
  13.     DIM DATA$(1000),C(27),D(27),P(5)
  14. %INCLUDE CURSOR
  15.     GOTO 6000
  16. %INCLUDE READINV
  17. %INCLUDE WRITEINV
  18. %INCLUDE A/P-INFO
  19.  
  20.  
  21.  
  22.  
  23. 6000    CONSOLE
  24.     PRINT CLEAR.SCREEN$;"A/P TRANSACTION SORT/PRINT"
  25.     PRINT "KEY RETURN TO BEGIN; ENTER 'END' TO EXIT"
  26.     INPUT LINE A$
  27.     IF A$="END" THEN \
  28.         PRINT CLEAR.SCREEN$;"A/P SORT/PRINT LOADING MENU":\
  29.         CHAIN "A/P000"
  30.     PRINT CLEAR.SCREEN$;"SORT PHASE"
  31.     PRINT "WORKING...DO NOT INTERRUPT"
  32.     PRINT
  33.     INPUT.FILE$="A/P0F020.DAT"
  34.     OUTPUT.FILE$="WORKFILE.DAT"
  35.     RECLENGTH=580
  36.     OPEN INPUT.FILE$ RECL RECLENGTH AS 1
  37.     OPEN "A/P0F130.DAT" AS 5
  38.     X0=5:GOSUB 3310
  39.     IF TRANSACTION.RCD.COUNT%=0 THEN 8000
  40.     IF END #1 THEN 7000                        REMARK    SET END-OF-FILE BRANCH
  41.  
  42.     REMARK        **********     READ DATA RECORDS AND STRIP OFF KEY ELEMENTS FOR USE IN THE SORT     **********
  43.  
  44.  
  45. 6050    READ #1; VAR$,VAR1
  46.     RECORD.COUNT%=RECORD.COUNT% + 1
  47.     DATA$(RECORD.COUNT%)=VAR$
  48.     PRINT CURSOR.HOME$:PRINT:PRINT "RECORD #";RECORD.COUNT%
  49.  
  50.     X0$=ZERO$+STR$(VAR1)
  51.     X0$=RIGHT$(X0$,6)                        REMARK    CONVERT INVOICE # TO ALPHANUMERIC
  52.     FOR I%=1 TO 6 STEP 2
  53.     DATA$(RECORD.COUNT%)=DATA$(RECORD.COUNT%)+CHR$(VAL(MID$(X0$,I%,2)))
  54.     NEXT I%                                REMARK    ROUTINE TO PACK INVOICE NUMBER
  55.     X0$=ZERO$+STR$(RECORD.COUNT%)
  56.     X0$=RIGHT$(X0$,4)
  57.     X0%=VAL(LEFT$(X0$,2))
  58.     X1%=VAL(RIGHT$(X0$,2))
  59.     DATA$(RECORD.COUNT%)=DATA$(RECORD.COUNT%)+CHR$(X0%)+CHR$(X1%)
  60.     GOTO 6050                            REMARK    GET THE NEXT RECORD
  61. 7000    CLOSE 1
  62.     OPEN INPUT.FILE$ RECL RECLENGTH AS 1
  63.     PRINT "NUMBER OF RECORDS IN FILE =";RECORD.COUNT%
  64.     M%=RECORD.COUNT%
  65. 7010    M%=M%/2                                REMARK    DIVIDE THE SORT INTERVAL IN HALF
  66.     IF M%=0 THEN GOTO 7150                        REMARK    IF SORT INTERVAL IS EXHAUSTED,\
  67.                                         RE-WRITE THE ORDERED FILE.
  68.     K%=RECORD.COUNT%-M%
  69.     J%=1
  70. 7040    I%=J%
  71. 7050    L%=I% + M%
  72.  
  73.     IF DATA$(I%) <= DATA$(L%) THEN GOTO 7120
  74.     TEMP$=DATA$(I%)
  75.     DATA$(I%)=DATA$(L%)
  76.     DATA$(L%)=TEMP$
  77.     I%=I% - M%
  78.     IF I% > 0 THEN GOTO 7050
  79. 7120    J%=J%+1
  80.     IF J% > K% THEN GOTO 7010 ELSE GOTO 7040
  81. 7150    PRINT CLEAR.SCREEN$;
  82.     PRINT "SORT PHASE ENDED"
  83.     PRINT "WRITING SORTED RECORDS TO WORKFILE"
  84.     PRINT "WORKING... DO NOT INTERRUPT"
  85.     CREATE OUTPUT.FILE$ RECL RECLENGTH AS 2
  86.     FOR OUTPUT.COUNT%=1 TO RECORD.COUNT%
  87.     X0$=RIGHT$(DATA$(OUTPUT.COUNT%),2)
  88.     X0%=ASC(LEFT$(X0$,1))
  89.     POINTER%=X0% * 100
  90.     X0%=ASC(RIGHT$(X0$,1))
  91.     POINTER%=POINTER% + X0%
  92.     FILE.NO=1:X0%=POINTER%:GOSUB 3000
  93.     FILE.NO=2:X0%=OUTPUT.COUNT%:GOSUB 3050
  94.     NEXT OUTPUT.COUNT%
  95.     DELETE 1
  96.     CLOSE 2
  97.     A%=RENAME(INPUT.FILE$,OUTPUT.FILE$)
  98.     CLOSE 5
  99.     OPEN "A/P0F130.DAT" AS 5
  100.     SORT%=1
  101.     X0=5:GOSUB 3350
  102. 8000    CHAIN "A/P02B"
  103.