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