home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / World_Of_Computer_Software-02-385-Vol-1of3.iso / g / getquo30.zip / STRIPPER.FOR < prev    next >
Text File  |  1992-10-12  |  11KB  |  388 lines
  1. OPTIONS X
  2. C  C:\AUTOSIG\STRIPPER.FOR
  3. C
  4. C  This UTAH FORTRAN program strips junk from AUTOSIG's .LOG file after
  5. C  accessing BASICQUOTE.  It assumes the default directory is C:\AUTOSIG
  6. C  and all files are located there.  Redirection can be controlled via
  7. C  the PROGRAM.CTL file.
  8. C
  9. C  Use this routine after MAKE_SCR.EXE, ATOSTART.BAT, and AUTOSIG.EXE
  10. C  have created the DYyymmdd.LOG file.  Your AUTOSIG must be setup prior
  11. C  to using those procedure.
  12. C
  13. C  Inputs:
  14. C     DYyymmdd.LOG - Session log of the quotes recieved (5 at a time).
  15. C     PROGRAM.CTL  - Path control file.
  16. C
  17. C  Outputs:
  18. C     DYyymmdd.PRN - Print file in flat ASCII format with names and header.
  19. C     DYyymmdd.DAT - Data file in flat ASCII format with symbols and
  20. C                    no header.
  21. C       where   yy - Year
  22. C               mm - Month
  23. C               dd - Day
  24. C        (SYMB).   - Stock symbol files.
  25. C
  26. C  Rev. 0    Clinton D. Huntemann    -   May 7, 1992
  27. C            (71247,2065)
  28. C
  29. C  Rev. 1    Clinton D. Huntemann    -   May 24, 1992
  30. C            (71247,2065)
  31. C            Added sorting capability to eliminate not found sysbols
  32. C            from DAT, PRN, and (SYMB) files and expanded CTL file
  33. C            options for path control.  Also added code to create an
  34. C            undated TICKER.UPD file.  (Speeds things up on next run.)
  35. C
  36. C  Rev. 2    Clinton D. Huntemann    -   June 5, 1992
  37. C            (71247,2065)
  38. C            Remove duplicate records from [SYMB.] files.
  39. C
  40. C  Rev. 3    Clinton D. Huntemann    -   OCT. 12, 1992
  41. C            (71247,2065)
  42. C            Added year to archived records.
  43. C
  44. C
  45.       DIMENSION FNAME1(3),FNAME2(3),FNAME3(3),LINE(13),SYMB(6),
  46.      1LINE2(9),LINE3(9),MPATH(10),PATH1(10),PATH2(10),PATH3(10),ATO(2),
  47.      2DRV(10),SYMFIL(2),TMPFIL(2),LINE4(13,6),LINE5(8)
  48.       REAL RYR,RMO,RDY
  49.       INTEGER MONTH,DAY,YEAR,WEEK
  50. C
  51. C Setup default paths
  52. C
  53.       DO 51 I=1,10
  54.       DRV(I) = 'C:'
  55.       MPATH(I)='      '
  56.       PATH1(I)='      '
  57.       PATH2(I)='      '
  58.    51 PATH3(I)='      '
  59.       ENCODE (MPATH,8,5013) '\5C\AUTOSIG'
  60.  5013 FORMAT (10A6)
  61.       ENCODE (PATH1,8,5013) '\5C\AUTOSIG'
  62.       ENCODE (PATH2,8,5013) '\5C\AUTOSIG'
  63.       ENCODE (PATH3,8,5013) '\5C\AUTOSIG'
  64.       ENCODE (ATO,8,5013) 'AUTOSIG '
  65. C
  66. C Retrieve the configuration file
  67. C
  68.       IERR=0
  69.       CALL OPEN (4,'PROGRAM.CTL',IERR)
  70.       IF (IERR .NE. 0) GOTO 59
  71. C
  72. C Read the available drives (record 1)
  73. C
  74.       READ (4,5015) DRV
  75.  5015 FORMAT (12X,10(A2,1X))
  76. C
  77. C Read the AUTOSIG.EXE name (record 2)
  78. C
  79.       READ (4,5014) ATO
  80.  5014 FORMAT (12X,A6,A2)
  81. C
  82. C Read the main file path (record 3)
  83. C
  84.       READ (4,5016) MPATH
  85.  5016 FORMAT (12X,10A6)
  86. C
  87. C Read the .LOG file path (record 4)
  88. C
  89.       READ (4,5016) PATH1
  90. C
  91. C Read the .PRN and .DAT files path (record 5)
  92. C
  93.       READ (4,5016) PATH2
  94. C
  95. C Read the .[SYMB.] file path (record 6)
  96. C
  97.       READ (4,5016) PATH3
  98.    59 CALL CLOSE (4)
  99. C
  100. C Update data file name
  101. C
  102.       CALL DATE(MONTH,DAY,YEAR,WEEK)
  103.       YEAR = YEAR-100*INT(YEAR/100)
  104.       ENCODE (RMO,2,4001) MONTH
  105.  4001 FORMAT (I2)
  106.       IF (MONTH .LT. 10) ENCODE (RMO,2,4002) MONTH
  107.  4002 FORMAT ('0',I1)
  108.       ENCODE (RDY,2,4001) DAY
  109.       IF (DAY .LT. 10) ENCODE (RDY,2,4002) DAY
  110.       ENCODE (RYR,2,4001) YEAR
  111.       IF (YEAR .LT. 10) ENCODE (RYR,2,4002) YEAR
  112.       ENCODE (FNAME1,14,4003) DRV(2),RYR,RMO,RDY
  113.  4003 FORMAT (A2,'DY',3A2,'.LOG')
  114.       ENCODE (FNAME2,14,4004) DRV(3),RYR,RMO,RDY
  115.  4004 FORMAT (A2,'DY',3A2,'.DAT')
  116.       ENCODE (FNAME3,14,4005) DRV(3),RYR,RMO,RDY
  117.  4005 FORMAT (A2,'DY',3A2,'.PRN')
  118. C
  119. C Open a new TICKER file for updated list
  120. C
  121.       CALL OPEN (2,'TICKER.UPD')
  122. C
  123. C Open the LOG File and skip to first data
  124. C
  125.       ICNT = 0
  126.       CALL OPEN (5,FNAME1)
  127.    10 READ (5,5000,END=100,ERR=199) LINE
  128.  5000 FORMAT (13A6)
  129.       IF ((LINE(1) .EQ. 'Issue:') .AND. (LINE(2) .NE. '      '))
  130.      1   CALL SYMBOL(LINE,SYMB,ISYM)
  131.       IF (LINE(7) .NE. ' Hi/As') GOTO 10
  132. C
  133. C Prep header and open PRN and DAT files
  134. C
  135.       CALL OPEN (3,FNAME2)
  136.       CALL OPEN (4,FNAME3)
  137.       WRITE (4,5000) LINE
  138.    20 READ (5,5000,END=100,ERR=199) LINE
  139.       IF ((LINE(1) .EQ. 'Issue:') .AND. (LINE(2) .NE. '      '))
  140.      1   CALL SYMBOL(LINE,SYMB,ISYM)
  141.       IF (LINE(7) .NE. ' -----') GOTO 20
  142.       IF (ICNT .EQ. 0) WRITE (4,5000) LINE
  143. C
  144. C Cycle through valid data
  145. C
  146.       ICTL=0
  147.       NSYM=0
  148.       DO 30 I=1,ISYM
  149.       LINE(7)='      '
  150.       READ (5,5000,END=100,ERR=199) LINE
  151.       IF (LINE(7) .EQ. '      ') THEN
  152.           CALL SYMERR(ISYM,SYMB,ICTL)
  153.           GOTO 40
  154.       ELSE
  155.           NSYM=NSYM+1
  156.           DO 22 J=1,13
  157.    22     LINE4(J,I)=LINE(J)
  158.       ENDIF
  159.    30 CONTINUE
  160. C
  161.    40 ICNT=ICNT+NSYM
  162.       K=0
  163.       DO 50 I=1,NSYM
  164.    41 K=K+1
  165.       IF (SYMB(K).EQ.'      ') GOTO 41
  166. C
  167. C Update the TICKER.UPD file
  168. C
  169.       WRITE (2,5001) SYMB(K)
  170.  5001 FORMAT (A6)
  171.       DO 42 J=1,13
  172.    42 LINE(J)=LINE4(J,I)
  173.       WRITE (4,5000) LINE
  174.       WRITE (0,5000) LINE
  175.       DECODE (LINE,78,5002) LINE2
  176.  5002 FORMAT (27X,8A6,A3)
  177.       WRITE (3,5003) SYMB(K),LINE2
  178.  5003 FORMAT (A6,2X,8A6,A3)
  179. C
  180. C Look for special [SYMB.] name which causes printer problems
  181. C
  182.       IF (SYMB(K) .EQ. 'PRN   ') SYMB(K)='PRN_  '
  183. C
  184. C  Remove internal blanks in issue symbol.
  185. C
  186.       CALL REMBLK(SYMB(K))
  187.       ENCODE (SYMFIL,8,5005) DRV(4),SYMB(K)
  188.  5005 FORMAT (A2,A6)
  189.       ENCODE (TMPFIL,8,5005) DRV(4),'TEMP  '
  190.       DUPE1='      '
  191.       CALL OPEN (7,TMPFIL)
  192.       CALL OPEN (6,SYMFIL,IERROR)
  193.       IF (IERROR .NE. 0) THEN
  194.            GOTO 49
  195.         ELSE
  196. C
  197. C Loop to copy old [SYMB.] file to TEMP.
  198. C
  199.    45      READ (6,5004,END=48) LINE3
  200.  5004      FORMAT (9A6)
  201.            DECODE (LINE3,54,5006) DUPE2,FSTAR
  202.  5006      FORMAT (45X,A5,A4)
  203. C
  204. C Check for duplicate date/time field in [SYMB.] record and skip
  205. C
  206.            IF (DUPE2 .NE. DUPE1) WRITE (7,5004) LINE3
  207.            DUPE1=DUPE2
  208.            GOTO 45
  209.    48      CALL CLOSE (6)
  210.            CALL DELETE (SYMFIL)
  211.         ENDIF
  212.    49 DECODE (LINE2,51,5007) LINE5,DUPE2,FSTAR
  213.  5007 FORMAT (7A6,A3,A5,A1)
  214. C
  215. C Check for duplicate date/time field in .LOG record and skip
  216. C
  217.       IF (DUPE2 .NE. DUPE1) WRITE (7,5008) LINE5,DUPE2,YEAR,FSTAR
  218.  5008 FORMAT (7A6,A3,A5,'/',I2,A1)
  219.       CALL CLOSE (7)
  220. C
  221. C Rename TEMP. to [SYMB.]
  222. C
  223.       CALL RENAME (TMPFIL,SYMFIL)
  224.    50 CONTINUE
  225.       GOTO 20
  226. C
  227. C Cleanup and exit
  228. C
  229.   100 CALL CLOSE (2)
  230.       CALL CLOSE (3)
  231.       CALL CLOSE (4)
  232.       CALL CLOSE (5)
  233.       WRITE (0,7000) FNAME3,FNAME2,FNAME1,ICNT,DRV(4)
  234.  7000 FORMAT (//'Files ',2A6,A2,' and ',2A6,A2,' created from ',2A6,A2,
  235.      1/,I4,' symbol archive files appended in ',A2//)
  236.       STOP 'Normal stop'
  237. C
  238.   199 CALL CLOSE (2)
  239.       CALL CLOSE (3)
  240.       CALL CLOSE (4)
  241.       CALL CLOSE (5)
  242.       WRITE (0,7099) FNAME2
  243.  7099 FORMAT ('Error creating file ',2A6,A2,'.'/'DO NOT USE.'//)
  244.       STOP 'Abnormal stop'
  245.       END
  246. C
  247.       SUBROUTINE SYMBOL(LINE,SYMB,ISYM)
  248. C
  249. C  This subroutine retrieves the Issue symbols list, counts the
  250. C  non-blank symbols in the list, and returns ISYM.
  251. C
  252. C  Rev. 0    Clinton D. Huntemann    -   May 24, 1992
  253. C            (71247,2065)
  254. C
  255.       DIMENSION LINE(13),SYMB(6)
  256. C
  257.       ISYM=0
  258.       WRITE (0,5000) LINE
  259.  5000 FORMAT (13A6)
  260.       DO 100 I=1,6
  261.   100 SYMB(I)='      '
  262.       DECODE (LINE,49,5001) SYMB
  263.  5001 FORMAT (7X,6(A6,1X))
  264.       DO 200 I=1,6
  265.   200 IF (SYMB(I) .NE. '      ') ISYM=ISYM+1
  266.       RETURN
  267.       END
  268. C
  269.       SUBROUTINE SYMERR(ISYM,SYMB,ICTL)
  270. C
  271. C  This subroutine finds the missing symbols in the log file and
  272. C  returns adjusted values of ICTL and SYMB.
  273. C
  274. C  Rev. 0    Clinton D. Huntemann    -   May 24, 1992
  275. C            (71247,2065)
  276. C
  277.       DIMENSION LINE(13),SYMB(6),CHAR(6),PARTS(72)
  278.       INTEGER ICNT(6,2)
  279. C
  280.       ICTL=0
  281. C
  282. C  Step through all SYMBols
  283. C
  284.       DO 30 I=1,ISYM
  285. C  Clear missing SYMB flag
  286.       ICNT(I,2)=0
  287. C  Clear the CHAR variable
  288.       DO 10 J=1,6
  289.    10 CHAR(J)='      '
  290. C
  291. C  Parse SYMB(I)
  292. C
  293.       CHECK=SYMB(I)
  294.       DECODE (CHECK,6,5001) CHAR
  295.  5001 FORMAT (6A1)
  296. C  Look for last non-blank character in SYMB(I)
  297.       DO 20 J=6,1,-1
  298.    20 IF (CHAR(J) .NE. '      ') GOTO 30
  299. C  Set ICNT(I,1) to length of SYMB(I)
  300.    30 ICNT(I,1)=J
  301. C
  302. C  Read next LOG file line
  303. C
  304.    35 READ (5,5000) LINE
  305.  5000 FORMAT (13A6)
  306. C  Parse LINE into characters
  307.       DECODE (LINE,72,5002) PARTS
  308.  5002 FORMAT (72A1)
  309.       K=0
  310. C
  311. C  Loop to check all SYMB(I)
  312. C
  313.       DO 50 I=1,ISYM
  314. C  Clear the CHAR variable
  315.       DO 40 J=1,6
  316.    40 CHAR(J)='      '
  317. C
  318. C  Parse SYMB(I)
  319. C
  320.       CHECK=SYMB(I)
  321.       DECODE (CHECK,6,5001) CHAR
  322. C  Retrieve length of SYMB(I)
  323.       MCNT=ICNT(I,1)
  324. C  Search LINE for SYMB(I)
  325.       DO 45 J=1,MCNT
  326.       M=K+J
  327. C  Match character by character
  328.    45 IF (CHAR(J) .NE. PARTS(M)) GOTO 50
  329. C  Set found flag & placeholder in LINE
  330.       ICNT(I,2)=1
  331.       K=K+MCNT+1
  332. C  Look for end off missing SYMB list
  333.       IF (PARTS(K) .EQ. '      ') GOTO 200
  334.    50 CONTINUE
  335. C  Recycle to read next line if no end found.
  336.       GOTO 35
  337. C
  338. C  Look for 'not found' string in log file LINE
  339. C
  340.   200 IF  ((PARTS(K+1).EQ.'n     ').AND.(PARTS(K+2).EQ.'o     ')
  341.      1.AND.(PARTS(K+3).EQ.'t     ').AND.(PARTS(K+4).EQ.'      ')
  342.      2.AND.(PARTS(K+5).EQ.'f     ').AND.(PARTS(K+6).EQ.'o     ')
  343.      3.AND.(PARTS(K+7).EQ.'u     ').AND.(PARTS(K+8).EQ.'n     ')
  344.      4.AND.(PARTS(K+9).EQ.'d     ')) THEN
  345. C  Set missing SYMB(I) to '      ' and increment missing counter
  346. C  to adjust ISYM back in MAIN program.
  347.            DO 210 I=1,ISYM
  348.            IF (ICNT(I,2).EQ.1) THEN
  349.                SYMB(I)='      '
  350.                ICTL=ICTL+1
  351.            ENDIF
  352.   210      CONTINUE
  353. C  Show 'not found' line on screen and return.
  354.            WRITE (0,5000) LINE
  355.            RETURN
  356. C  Recycle to read next line in LOG file if not lagit 'not found'
  357.       ELSE
  358.            GOTO 35
  359.       ENDIF
  360.       END
  361. C
  362.       SUBROUTINE REMBLK(CHECK)
  363. C
  364. C  This subroutine finds imbedded blanks in the symbol and replaces
  365. C  with underline.
  366. C
  367. C  Rev. 0    Clinton D. Huntemann    -   May 24, 1992
  368. C            (71247,2065)
  369. C
  370.       DIMENSION CHAR(6)
  371. C
  372. C  Clear the CHAR data area.
  373.       DO 10 J=1,6
  374.    10 CHAR(J)='      '
  375. C  Parse CHECK into characters
  376.       DECODE (CHECK,6,5001) CHAR
  377.  5001 FORMAT (6A1)
  378. C  Look for last non-blank character in CHECK
  379.       DO 20 J=6,1,-1
  380.    20 IF (CHAR(J) .NE. '      ') GOTO 30
  381. C  Change any blank characters to '_' within CHECK
  382.    30 DO 40 K=J,1,-1
  383.    40 IF (CHAR(K) .EQ. '      ') CHAR(K)='_     '
  384. C  Reassemble CHECK and return
  385.       ENCODE (CHECK,6,5001) CHAR
  386.       RETURN
  387.       END
  388.