OPTIONS X
C  C:\AUTOSIG\STRIPPER.FOR
C
C  This UTAH FORTRAN program strips junk from AUTOSIG's .LOG file after
C  accessing BASICQUOTE.  It assumes the default directory is C:\AUTOSIG
C  and all files are located there.  Redirection can be controlled via
C  the PROGRAM.CTL file.
C
C  Use this routine after MAKE_SCR.EXE, ATOSTART.BAT, and AUTOSIG.EXE
C  have created the DYyymmdd.LOG file.  Your AUTOSIG must be setup prior
C  to using those procedure.
C
C  Inputs:
C     DYyymmdd.LOG - Session log of the quotes recieved (5 at a time).
C     PROGRAM.CTL  - Path control file.
C
C  Outputs:
C     DYyymmdd.PRN - Print file in flat ASCII format with names and header.
C     DYyymmdd.DAT - Data file in flat ASCII format with symbols and
C                    no header.
C       where   yy - Year
C               mm - Month
C               dd - Day
C        (SYMB).   - Stock symbol files.
C
C  Rev. 0    Clinton D. Huntemann    -   May 7, 1992
C            (71247,2065)
C
C  Rev. 1    Clinton D. Huntemann    -   May 24, 1992
C            (71247,2065)
C            Added sorting capability to eliminate not found sysbols
C            from DAT, PRN, and (SYMB) files and expanded CTL file
C            options for path control.  Also added code to create an
C            undated TICKER.UPD file.  (Speeds things up on next run.)
C
C  Rev. 2    Clinton D. Huntemann    -   June 5, 1992
C            (71247,2065)
C            Remove duplicate records from [SYMB.] files.
C
C  Rev. 3    Clinton D. Huntemann    -   OCT. 12, 1992
C            (71247,2065)
C            Added year to archived records.
C
C
      DIMENSION FNAME1(3),FNAME2(3),FNAME3(3),LINE(13),SYMB(6),
     1LINE2(9),LINE3(9),MPATH(10),PATH1(10),PATH2(10),PATH3(10),ATO(2),
     2DRV(10),SYMFIL(2),TMPFIL(2),LINE4(13,6),LINE5(8)
      REAL RYR,RMO,RDY
      INTEGER MONTH,DAY,YEAR,WEEK
C
C Setup default paths
C
      DO 51 I=1,10
      DRV(I) = 'C:'
      MPATH(I)='      '
      PATH1(I)='      '
      PATH2(I)='      '
   51 PATH3(I)='      '
      ENCODE (MPATH,8,5013) '\5C\AUTOSIG'
 5013 FORMAT (10A6)
      ENCODE (PATH1,8,5013) '\5C\AUTOSIG'
      ENCODE (PATH2,8,5013) '\5C\AUTOSIG'
      ENCODE (PATH3,8,5013) '\5C\AUTOSIG'
      ENCODE (ATO,8,5013) 'AUTOSIG '
C
C Retrieve the configuration file
C
      IERR=0
      CALL OPEN (4,'PROGRAM.CTL',IERR)
      IF (IERR .NE. 0) GOTO 59
C
C Read the available drives (record 1)
C
      READ (4,5015) DRV
 5015 FORMAT (12X,10(A2,1X))
C
C Read the AUTOSIG.EXE name (record 2)
C
      READ (4,5014) ATO
 5014 FORMAT (12X,A6,A2)
C
C Read the main file path (record 3)
C
      READ (4,5016) MPATH
 5016 FORMAT (12X,10A6)
C
C Read the .LOG file path (record 4)
C
      READ (4,5016) PATH1
C
C Read the .PRN and .DAT files path (record 5)
C
      READ (4,5016) PATH2
C
C Read the .[SYMB.] file path (record 6)
C
      READ (4,5016) PATH3
   59 CALL CLOSE (4)
C
C Update data file name
C
      CALL DATE(MONTH,DAY,YEAR,WEEK)
      YEAR = YEAR-100*INT(YEAR/100)
      ENCODE (RMO,2,4001) MONTH
 4001 FORMAT (I2)
      IF (MONTH .LT. 10) ENCODE (RMO,2,4002) MONTH
 4002 FORMAT ('0',I1)
      ENCODE (RDY,2,4001) DAY
      IF (DAY .LT. 10) ENCODE (RDY,2,4002) DAY
      ENCODE (RYR,2,4001) YEAR
      IF (YEAR .LT. 10) ENCODE (RYR,2,4002) YEAR
      ENCODE (FNAME1,14,4003) DRV(2),RYR,RMO,RDY
 4003 FORMAT (A2,'DY',3A2,'.LOG')
      ENCODE (FNAME2,14,4004) DRV(3),RYR,RMO,RDY
 4004 FORMAT (A2,'DY',3A2,'.DAT')
      ENCODE (FNAME3,14,4005) DRV(3),RYR,RMO,RDY
 4005 FORMAT (A2,'DY',3A2,'.PRN')
C
C Open a new TICKER file for updated list
C
      CALL OPEN (2,'TICKER.UPD')
C
C Open the LOG File and skip to first data
C
      ICNT = 0
      CALL OPEN (5,FNAME1)
   10 READ (5,5000,END=100,ERR=199) LINE
 5000 FORMAT (13A6)
      IF ((LINE(1) .EQ. 'Issue:') .AND. (LINE(2) .NE. '      '))
     1   CALL SYMBOL(LINE,SYMB,ISYM)
      IF (LINE(7) .NE. ' Hi/As') GOTO 10
C
C Prep header and open PRN and DAT files
C
      CALL OPEN (3,FNAME2)
      CALL OPEN (4,FNAME3)
      WRITE (4,5000) LINE
   20 READ (5,5000,END=100,ERR=199) LINE
      IF ((LINE(1) .EQ. 'Issue:') .AND. (LINE(2) .NE. '      '))
     1   CALL SYMBOL(LINE,SYMB,ISYM)
      IF (LINE(7) .NE. ' -----') GOTO 20
      IF (ICNT .EQ. 0) WRITE (4,5000) LINE
C
C Cycle through valid data
C
      ICTL=0
      NSYM=0
      DO 30 I=1,ISYM
      LINE(7)='      '
      READ (5,5000,END=100,ERR=199) LINE
      IF (LINE(7) .EQ. '      ') THEN
          CALL SYMERR(ISYM,SYMB,ICTL)
          GOTO 40
      ELSE
          NSYM=NSYM+1
          DO 22 J=1,13
   22     LINE4(J,I)=LINE(J)
      ENDIF
   30 CONTINUE
C
   40 ICNT=ICNT+NSYM
      K=0
      DO 50 I=1,NSYM
   41 K=K+1
      IF (SYMB(K).EQ.'      ') GOTO 41
C
C Update the TICKER.UPD file
C
      WRITE (2,5001) SYMB(K)
 5001 FORMAT (A6)
      DO 42 J=1,13
   42 LINE(J)=LINE4(J,I)
      WRITE (4,5000) LINE
      WRITE (0,5000) LINE
      DECODE (LINE,78,5002) LINE2
 5002 FORMAT (27X,8A6,A3)
      WRITE (3,5003) SYMB(K),LINE2
 5003 FORMAT (A6,2X,8A6,A3)
C
C Look for special [SYMB.] name which causes printer problems
C
      IF (SYMB(K) .EQ. 'PRN   ') SYMB(K)='PRN_  '
C
C  Remove internal blanks in issue symbol.
C
      CALL REMBLK(SYMB(K))
      ENCODE (SYMFIL,8,5005) DRV(4),SYMB(K)
 5005 FORMAT (A2,A6)
      ENCODE (TMPFIL,8,5005) DRV(4),'TEMP  '
      DUPE1='      '
      CALL OPEN (7,TMPFIL)
      CALL OPEN (6,SYMFIL,IERROR)
      IF (IERROR .NE. 0) THEN
           GOTO 49
        ELSE
C
C Loop to copy old [SYMB.] file to TEMP.
C
   45      READ (6,5004,END=48) LINE3
 5004      FORMAT (9A6)
           DECODE (LINE3,54,5006) DUPE2,FSTAR
 5006      FORMAT (45X,A5,A4)
C
C Check for duplicate date/time field in [SYMB.] record and skip
C
           IF (DUPE2 .NE. DUPE1) WRITE (7,5004) LINE3
           DUPE1=DUPE2
           GOTO 45
   48      CALL CLOSE (6)
           CALL DELETE (SYMFIL)
        ENDIF
   49 DECODE (LINE2,51,5007) LINE5,DUPE2,FSTAR
 5007 FORMAT (7A6,A3,A5,A1)
C
C Check for duplicate date/time field in .LOG record and skip
C
      IF (DUPE2 .NE. DUPE1) WRITE (7,5008) LINE5,DUPE2,YEAR,FSTAR
 5008 FORMAT (7A6,A3,A5,'/',I2,A1)
      CALL CLOSE (7)
C
C Rename TEMP. to [SYMB.]
C
      CALL RENAME (TMPFIL,SYMFIL)
   50 CONTINUE
      GOTO 20
C
C Cleanup and exit
C
  100 CALL CLOSE (2)
      CALL CLOSE (3)
      CALL CLOSE (4)
      CALL CLOSE (5)
      WRITE (0,7000) FNAME3,FNAME2,FNAME1,ICNT,DRV(4)
 7000 FORMAT (//'Files ',2A6,A2,' and ',2A6,A2,' created from ',2A6,A2,
     1/,I4,' symbol archive files appended in ',A2//)
      STOP 'Normal stop'
C
  199 CALL CLOSE (2)
      CALL CLOSE (3)
      CALL CLOSE (4)
      CALL CLOSE (5)
      WRITE (0,7099) FNAME2
 7099 FORMAT ('Error creating file ',2A6,A2,'.'/'DO NOT USE.'//)
      STOP 'Abnormal stop'
      END
C
      SUBROUTINE SYMBOL(LINE,SYMB,ISYM)
C
C  This subroutine retrieves the Issue symbols list, counts the
C  non-blank symbols in the list, and returns ISYM.
C
C  Rev. 0    Clinton D. Huntemann    -   May 24, 1992
C            (71247,2065)
C
      DIMENSION LINE(13),SYMB(6)
C
      ISYM=0
      WRITE (0,5000) LINE
 5000 FORMAT (13A6)
      DO 100 I=1,6
  100 SYMB(I)='      '
      DECODE (LINE,49,5001) SYMB
 5001 FORMAT (7X,6(A6,1X))
      DO 200 I=1,6
  200 IF (SYMB(I) .NE. '      ') ISYM=ISYM+1
      RETURN
      END
C
      SUBROUTINE SYMERR(ISYM,SYMB,ICTL)
C
C  This subroutine finds the missing symbols in the log file and
C  returns adjusted values of ICTL and SYMB.
C
C  Rev. 0    Clinton D. Huntemann    -   May 24, 1992
C            (71247,2065)
C
      DIMENSION LINE(13),SYMB(6),CHAR(6),PARTS(72)
      INTEGER ICNT(6,2)
C
      ICTL=0
C
C  Step through all SYMBols
C
      DO 30 I=1,ISYM
C  Clear missing SYMB flag
      ICNT(I,2)=0
C  Clear the CHAR variable
      DO 10 J=1,6
   10 CHAR(J)='      '
C
C  Parse SYMB(I)
C
      CHECK=SYMB(I)
      DECODE (CHECK,6,5001) CHAR
 5001 FORMAT (6A1)
C  Look for last non-blank character in SYMB(I)
      DO 20 J=6,1,-1
   20 IF (CHAR(J) .NE. '      ') GOTO 30
C  Set ICNT(I,1) to length of SYMB(I)
   30 ICNT(I,1)=J
C
C  Read next LOG file line
C
   35 READ (5,5000) LINE
 5000 FORMAT (13A6)
C  Parse LINE into characters
      DECODE (LINE,72,5002) PARTS
 5002 FORMAT (72A1)
      K=0
C
C  Loop to check all SYMB(I)
C
      DO 50 I=1,ISYM
C  Clear the CHAR variable
      DO 40 J=1,6
   40 CHAR(J)='      '
C
C  Parse SYMB(I)
C
      CHECK=SYMB(I)
      DECODE (CHECK,6,5001) CHAR
C  Retrieve length of SYMB(I)
      MCNT=ICNT(I,1)
C  Search LINE for SYMB(I)
      DO 45 J=1,MCNT
      M=K+J
C  Match character by character
   45 IF (CHAR(J) .NE. PARTS(M)) GOTO 50
C  Set found flag & placeholder in LINE
      ICNT(I,2)=1
      K=K+MCNT+1
C  Look for end off missing SYMB list
      IF (PARTS(K) .EQ. '      ') GOTO 200
   50 CONTINUE
C  Recycle to read next line if no end found.
      GOTO 35
C
C  Look for 'not found' string in log file LINE
C
  200 IF  ((PARTS(K+1).EQ.'n     ').AND.(PARTS(K+2).EQ.'o     ')
     1.AND.(PARTS(K+3).EQ.'t     ').AND.(PARTS(K+4).EQ.'      ')
     2.AND.(PARTS(K+5).EQ.'f     ').AND.(PARTS(K+6).EQ.'o     ')
     3.AND.(PARTS(K+7).EQ.'u     ').AND.(PARTS(K+8).EQ.'n     ')
     4.AND.(PARTS(K+9).EQ.'d     ')) THEN
C  Set missing SYMB(I) to '      ' and increment missing counter
C  to adjust ISYM back in MAIN program.
           DO 210 I=1,ISYM
           IF (ICNT(I,2).EQ.1) THEN
               SYMB(I)='      '
               ICTL=ICTL+1
           ENDIF
  210      CONTINUE
C  Show 'not found' line on screen and return.
           WRITE (0,5000) LINE
           RETURN
C  Recycle to read next line in LOG file if not lagit 'not found'
      ELSE
           GOTO 35
      ENDIF
      END
C
      SUBROUTINE REMBLK(CHECK)
C
C  This subroutine finds imbedded blanks in the symbol and replaces
C  with underline.
C
C  Rev. 0    Clinton D. Huntemann    -   May 24, 1992
C            (71247,2065)
C
      DIMENSION CHAR(6)
C
C  Clear the CHAR data area.
      DO 10 J=1,6
   10 CHAR(J)='      '
C  Parse CHECK into characters
      DECODE (CHECK,6,5001) CHAR
 5001 FORMAT (6A1)
C  Look for last non-blank character in CHECK
      DO 20 J=6,1,-1
   20 IF (CHAR(J) .NE. '      ') GOTO 30
C  Change any blank characters to '_' within CHECK
   30 DO 40 K=J,1,-1
   40 IF (CHAR(K) .EQ. '      ') CHAR(K)='_     '
C  Reassemble CHECK and return
      ENCODE (CHECK,6,5001) CHAR
      RETURN
      END
