home *** CD-ROM | disk | FTP | other *** search
/ PCDisk Magazine Disks / PCDisk Magazine - Disk 2.img / SBDAT.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1984-11-12  |  15.2 KB  |  457 lines
  1. 10  ' STOCK/BOND DATA FILE  BY EVELYN LEON. COPYRIGHT (C) 1984.
  2. 20  GOSUB 110                                            'TITLE
  3. 30  GOSUB 3330                                           'INIT
  4. 40  GOSUB 210                                            'MAIN SELECT
  5. 50  IF ESC.FLAG% THEN 2710                               'END
  6. 60  GOSUB 560                                            'MAIN ACTION
  7. 70  IF ESC.FLAG% THEN ESC.FLAG%=0:GOTO 40                'BACK TO MAIN SELECT
  8. 80  GOSUB 1860                                           'OUTPUT
  9. 90  GOTO 60
  10. 100  '
  11. 101  'INITIALIZATION
  12. 102  '
  13. 110  ON ERROR GOTO 3260
  14. 111  DEF FNEXTRACT$(X$,N%) = MID$(X$,((N%-1)*4)+1,4)
  15. 112  DEF FNSTRIP$(X!)= RIGHT$(STR$(X!),LEN(STR$(X!))-1)
  16. 114  KEY OFF:FOR X = 1 TO 10:KEY X, "" :NEXT
  17. 116  SCREEN 0,0,0:WIDTH 80:COLOR 7,0,0
  18. 118  ESC$ = CHR$(27) : LASTPG$ =CHR$(75) : NEXTPG$ = CHR$(77)
  19. 120  N = 1:OPTION BASE 1
  20. 122  DIM BOND.IND$(15), BOND.FORM$(15), STOCK.IND$(15), STOCK.FORM$(15), IND$(15), IFORM$(15), VAL1(220), VAL2(220), DAY$(220)
  21. 126  LN = 0: COL = 0: TOTCH = 0: PRT = 0: F$ = "": P$ = "": PRTSW = 0
  22. 130  BR = 0: RC = 0: VERT$ = CHR$(179): HORI$ = CHR$(205)
  23. 132  ULC$ = CHR$(213) : URC$ = CHR$(184) : LRC$ = CHR$(190) : LLC$ = CHR$(212)
  24. 134  START.WIPE = 0 : END.WIPE = 0
  25. 140  STOCK.IND$(1)= "DJ INDUSTRIAL AVERAGE"
  26. 141  STOCK.IND$(2)= "S & P 500"
  27. 142  STOCK.IND$(3)= "S & P 500 FUTURE"
  28. 143  STOCK.IND$(4)= "NYSE COMPOSITE"
  29. 144  STOCK.IND$(5)= "NYSE COMPOSITE FUTURE"
  30. 145  STOCK.IND$(6)= "VALUE LINE"
  31. 146  STOCK.IND$(7)= "VALUE LINE FUTURE"
  32. 147  STOCK.IND$(8)= "NYSE ISSUES ADVANCING" 
  33. 148  STOCK.IND$(9)= "NYSE ISSUES DECLINING"
  34. 149  STOCK.IND$(10)="NYSE ISSUES UNCHANGED"
  35. 150  STOCK.IND$(11)="TOTAL NYSE VOLUME"
  36. 151  STOCK.IND$(12)="ADVANCING NYSE VOLUME"
  37. 152  STOCK.IND$(13)="DECLINING NYSE VOLUME"
  38. 153  STOCK.IND$(14)="CBOE CALL VOLUME"
  39. 154  STOCK.IND$(15)="CBOE PUT VOLUME"
  40. 155  BOND.IND$(1)=  "DISCOUNT RATE"
  41. 156  BOND.IND$(2)=  "FED FUNDS RATE"
  42. 157  BOND.IND$(3)=  "COMMERCIAL PAPER"
  43. 158  BOND.IND$(4)=  "3 MONTH T-BILL"
  44. 159  BOND.IND$(5)=  "6 MONTH T-BILL"
  45. 160  BOND.IND$(6)=  "12 MONTH T-BILL"
  46. 161  BOND.IND$(7)=  "3 YEAR T-NOTE"
  47. 162  BOND.IND$(8)=  "5 YEAR T-NOTE" 
  48. 163  BOND.IND$(9)=  "7 YEAR T-NOTE" 
  49. 164  BOND.IND$(10)= "10 YEAR T-NOTE" 
  50. 165  BOND.IND$(11)= "20 YEAR T-NOTE" 
  51. 166  BOND.IND$(12)= "30 YEAR T-NOTE" 
  52. 167  BOND.IND$(13)= "LONG MUNI BOND RATE"
  53. 168  BOND.IND$(14)= "M-1 MONEY SUPPLY "
  54. 169  BOND.IND$(15)= "NET FREE RESERVES"
  55. 170  STOCK.FORM$(1)= "####.##"
  56. 171  STOCK.FORM$(2)= "###.##"
  57. 172  STOCK.FORM$(3)= "###.##"
  58. 173  STOCK.FORM$(4)= "###.##"
  59. 174  STOCK.FORM$(5)= "###.##"
  60. 175  STOCK.FORM$(6)= "###.##"
  61. 176  STOCK.FORM$(7)= "###.##"
  62. 177  STOCK.FORM$(8)= "####,."
  63. 178  STOCK.FORM$(9)= "####,."
  64. 179  STOCK.FORM$(10)="####,."
  65. 180  STOCK.FORM$(11)="######,."
  66. 181  STOCK.FORM$(12)="######,."
  67. 182  STOCK.FORM$(13)="######,."
  68. 183  STOCK.FORM$(14)="####,."
  69. 184  STOCK.FORM$(15)="####,."
  70. 185  BOND.FORM$(1)=  "##.##"
  71. 186  BOND.FORM$(2)=  "##.##"
  72. 187  BOND.FORM$(3)=  "##.##"
  73. 188  BOND.FORM$(4)=  "##.##"
  74. 189  BOND.FORM$(5)=  "##.##"
  75. 190  BOND.FORM$(6)=  "##.##"
  76. 191  BOND.FORM$(7)=  "##.##"
  77. 192  BOND.FORM$(8)=  "##.##"
  78. 193  BOND.FORM$(9)=  "##.##"
  79. 194  BOND.FORM$(10)= "##.##"
  80. 195  BOND.FORM$(11)= "##.##"
  81. 196  BOND.FORM$(12)= "##.##"
  82. 197  BOND.FORM$(13)= "##.##"
  83. 198  BOND.FORM$(14)= "###.#"
  84. 199  BOND.FORM$(15)= "+####,."
  85. 200  RETURN
  86. 201  '
  87. 202  ' MAIN MENU
  88. 203  '
  89. 210  IF BOX.DONE%=0 THEN CLS:GOSUB 42000:GOTO 260
  90. 220  LOCATE 11,35:PRINT SPACE$(15):LOCATE 14,29:PRINT SPACE$(30)
  91. 260  LOCATE 10,30:PRINT "VIEW:"
  92. 270  LOCATE 12,35:PRINT "(S)TOCK DATA"
  93. 280  LOCATE 13,35:PRINT "(B)OND DATA"
  94. 290  LOCATE 15,25:PRINT "ENTER CHOICE (<ESC> TO EXIT):"
  95. 300  LN = 15 : COL = 55 : TOTCH = 1 : PRT = 1 : GOSUB 3070 : A$ = P$'INKEY
  96. 310  IF ESC.FLAG% THEN GOTO 2710
  97. 320  IF A$ = "S" OR A$ = "s" THEN BDAT = 0: GOTO 350
  98. 330  IF A$ = "B" OR A$ = "b" THEN BDAT = 1: GOTO 350
  99. 340  BEEP:LOCATE 7,33: PRINT " " :GOTO 300
  100. 350  CLOSE #1:IF A$="S" OR A$="s" THEN GOSUB 410 ELSE GOSUB 460
  101. 360  RETURN
  102. 400  '
  103. 401  ' DATA FILE OPEN
  104. 402  '
  105. 410  REC.LEN% = 60 : OPEN "R",1,"STOCK.DAT",REC.LEN%
  106. 420  FIELD #1, 4 AS START.DAT$, 4 AS LAST.DAT$, 4 AS LAST.REC$, REC.LEN%-12 AS REST$ : GOSUB 510
  107. 430  FIELD #1, REC.LEN% AS RECORD$
  108. 440  RETURN
  109. 460  REC.LEN% = 64 : OPEN "R",1,"BOND.DAT",REC.LEN%
  110. 470  FIELD #1, 4 AS START.DAT$, 4 AS LAST.DAT$, 4 AS LAST.REC$, REC.LEN% - 12 AS REST$ : GOSUB 510
  111. 480  FIELD #1, 4 AS DAT.REC$, REC.LEN%-4 AS RECORD$
  112. 490  RETURN
  113. 500  '
  114. 501  ' READ DATA FILE CONTROL RECORD
  115. 502  '
  116. 510  GET #1,1 : START.DAT% = CVS(START.DAT$) : LAST.DAT% = CVS(LAST.DAT$): LAST.REC% = CVS(LAST.REC$)
  117. 520  DT = START.DAT%: GOSUB 51490: START.PRN$ = DT.PRN$
  118. 530  IF LAST.DAT% <> 0 THEN DT = LAST.DAT%:GOSUB 51490: LAST.PRN$ = DT.PRN$
  119. 540  SCRATCH! = FRE("")
  120. 545  RETURN
  121. 550  '
  122. 551  ' MAIN ACTION
  123. 552  '
  124. 560  CLS:BOX.DONE%=0
  125. 580  COLOR 0,7
  126. 590  LN = 1: COL = 2 : BR = 12 : RC = 79
  127. 600  GOSUB 41000                                           'DRAW BOX
  128. 610  GOSUB 990                                             'DISPLAY
  129. 620  GOSUB 1150                                            'GET SPEC
  130. 630  IF ESC.FLAG% THEN RETURN
  131. 640  GOSUB 1610                                            'GET DATA
  132. 650  IF OKDAT THEN RETURN ELSE GOTO 620
  133. 900  '
  134. 901  ' DISPLAY INDICATORS
  135. 902  '
  136. 990  FIRST.COL=5:SECOND.COL=46
  137. 1010  FOR X=1 TO 15
  138. 1020  IF BDAT=1 THEN IND$(X)=BOND.IND$(X):IFORM$(X)=BOND.FORM$(X) ELSE IND$(X)=STOCK.IND$(X):IFORM$(X)=STOCK.FORM$(X)
  139. 1030  NEXT
  140. 1050  COLOR 7,0:FOR X=3 TO 9
  141. 1060  LOCATE X,FIRST.COL:PRINT "V"+RIGHT$(STR$(X-2),1)+".  "+IND$(X-2)
  142. 1080  NEXT
  143. 1090  FOR X=3 TO 10
  144. 1100  LOCATE X,SECOND.COL:IF X+5<10 THEN PRINT "V"+RIGHT$(STR$(X+5),1)+".  "+IND$(X+5) ELSE PRINT "V"+RIGHT$(STR$(X+5),2)+". "+IND$(X+5)
  145. 1110  NEXT
  146. 1130  RETURN
  147. 1140  '
  148. 1141  ' GET SELECTION SPECS
  149. 1142  '
  150. 1150  LOCATE 13,30: PRINT "Selection Expressions:"
  151. 1155  LOCATE 14,33: PRINT "Vx"
  152. 1160  LOCATE 15,33: PRINT "Vx  <,>,=  VALUE"
  153. 1170  LOCATE 16,33: PRINT "Vx  <,>,=  Vy"
  154. 1180  LOCATE 18,5: PRINT "ENTER SELECTION EXPRESSION (<ESC> TO EXIT): ";
  155. 1190  LOCATE 18,49: PRINT SPACE$(10);:LN = 18 : COL = 49 : TOTCH = 12 : PRT = 1 : GOSUB 3070 : IF ESC.FLAG% THEN RETURN
  156. 1200  LEXPR$ = P$: IF LEXPR$="" THEN GOTO 1190 ELSE GOSUB 1410
  157. 1205  IF EXTYPE = 0 THEN LOCATE 18,60,0:PRINT "Invalid Expression";:GOSUB 3040:LOCATE 18,60:PRINT SPACE$(18);:GOTO 1190
  158. 1210  LOCATE 20,5: PRINT "START DATE (";START.PRN$;" or later):";
  159. 1220  LOCATE 20,37: PRINT SPACE$(10);:LN = 20 : COL = 37 : TOTCH = 9 : PRT = 1 : GOSUB 3070 : IF ESC.FLAG% THEN LOCATE 20,1:PRINT SPACE$(60);:GOTO 1190
  160. 1230  DAT$ = P$: IF DAT$="" THEN GOTO 1220 ELSE GOSUB 1510
  161. 1240  IF DT.FLAG% THEN LOCATE 20,50,0:PRINT "Invalid Date";:IF DT.FLAG%=1 THEN PRINT " - Out of Range";
  162. 1245  IF DT.FLAG% THEN GOSUB 3040:LOCATE 20,50:PRINT SPACE$(28);:GOTO 1220
  163. 1250  SDATE=DT.INT%
  164. 1260  LOCATE 21,5: PRINT "END DATE (";LAST.PRN$;" or earlier):";
  165. 1270  LOCATE 21,37: PRINT SPACE$(10);:LN = 21 : COL = 37 : TOTCH = 9 : PRT = 1 : GOSUB 3070 : IF ESC.FLAG% THEN LOCATE 21,1:PRINT SPACE$(60);:GOTO 1220
  166. 1280  DAT$ = P$: IF DAT$="" THEN GOTO 1270 ELSE GOSUB 1510
  167. 1290  IF DT.FLAG% THEN LOCATE 21,50,0:PRINT "Invalid Date";:IF DT.FLAG%=1 THEN PRINT " - Out of Range";
  168. 1295  IF DT.FLAG% THEN GOSUB 3040:LOCATE 21,50:PRINT SPACE$(28);:GOTO 1270
  169. 1300  EDATE=DT.INT%
  170. 1305  IF SDATE>EDATE THEN LOCATE 22,30,0:PRINT "End Date preceeds Start Date";:GOSUB 3040:LOCATE 22,30:PRINT SPACE$(40);:LOCATE 21,2:PRINT SPACE$(70);:GOTO 1220
  171. 1310  LOCATE 23,5: PRINT "OUTPUT TO SCREEN OR PRINTER (S/P): ";
  172. 1320  LOCATE 23,40: PRINT SPACE$(5);:LN = 23 : COL = 40 : TOTCH = 1 : PRT = 1 : GOSUB 3070 : IF ESC.FLAG% THEN LOCATE 23,10:PRINT SPACE$(60);:GOTO 1270
  173. 1330  IF P$ = "P" OR P$ = "p" THEN PRTSW = -1: GOTO 1360
  174. 1340  IF P$ = "S" OR P$ = "s" THEN PRTSW = 0: GOTO 1360
  175. 1350  BEEP:GOTO 1320
  176. 1360  LOCATE 24,20:PRINT "OK TO PROCEED (Y/N)? ";
  177. 1370  LOCATE 24,41:PRINT SPACE$(1);:LN = 24 : COL = 41 : TOTCH = 1 : PRT = 1 : GOSUB 3070 : IF ESC.FLAG% THEN LOCATE 24,20:PRINT SPACE$(21);:GOTO 1320
  178. 1380  IF P$ = "Y" OR P$ = "y" THEN GOTO 1410
  179. 1385  IF P$ = "N" OR P$ = "n" THEN GOTO 1190
  180. 1390  BEEP:GOTO 1320
  181. 1395  RETURN
  182. 1400  '
  183. 1401  ' EXPRESSION VALIDATION
  184. 1402  '
  185. 1410  EXTYPE = 0:OPER$ = ""
  186. 1415  PB$=LEFT$(LEXPR$,1):IF PB$<>"V" AND PB$<>"v" THEN RETURN
  187. 1420  FOR I%=0 TO 2:K%=INSTR(LEXPR$,CHR$(60+I%)):IF K%<>0 THEN I%=2
  188. 1425  NEXT I%:IF K%=0 THEN ARG1$=LEXPR$:GOTO 1435
  189. 1430  ARG1$=LEFT$(LEXPR$,K%-1):OPER$=MID$(LEXPR$,K%,1):ARG2$=RIGHT$(LEXPR$,LEN(LEXPR$)-K%)
  190. 1435  EXTYPE=1:EXBUF$=RIGHT$(ARG1$,LEN(ARG1$)-1):GOSUB 1492:IF EXTYPE=0 THEN RETURN
  191. 1440  IND1=VAL(EXBUF$):IF OPER$="" THEN RETURN
  192. 1445  EXTYPE=3:PB$=LEFT$(ARG2$,1)
  193. 1450  IF PB$="V" OR PB$="v" THEN EXBUF$=RIGHT$(ARG2$,LEN(ARG2$)-1):GOSUB 1492:IF EXTYPE=0 THEN RETURN ELSE IND2=VAL(EXBUF$):RETURN
  194. 1455  EXTYPE=2:PT.FLAG%=0:PB$=LEFT$(ARG2$,1):EXBUF$=""
  195. 1460  IF PB$="+" OR PB$="-" THEN EXBUF$=PB$:ARG2$=RIGHT$(ARG2$,LEN(ARG2$)-1)
  196. 1465  FOR I%=1 TO LEN(ARG2$):PB$=MID$(ARG2$,I%,1)
  197. 1470  IF PB$="." THEN IF PT.FLAG%=1 THEN EXTYPE=0:RETURN ELSE PT.FLAG%=1:GOTO 1480
  198. 1475  IF PB$<"0" OR PB$>"9" THEN EXTYPE=0:RETURN
  199. 1480  EXBUF$=EXBUF$+PB$:NEXT I%
  200. 1490  VALUE=VAL(EXBUF$):RETURN
  201. 1491  '
  202. 1492  L%=LEN(EXBUF$):IF L%<1 OR L%>2 THEN EXTYPE=0:RETURN
  203. 1494  IF L%=1 THEN IF EXBUF$>="1" AND EXBUF$<="9" THEN RETURN ELSE EXTYPE=0:RETURN
  204. 1496  IF L%=2 THEN IF LEFT$(EXBUF$,1)<>"1" OR RIGHT$(EXBUF$,1)<"0" OR RIGHT$(EXBUF$,1)>"5" THEN EXTYPE=0
  205. 1498  RETURN
  206. 1500  '
  207. 1501  ' DATE VALIDATION
  208. 1502  '
  209. 1510  GOSUB 51050
  210. 1520  IF DT.INT%<START.DAT% OR DT.INT%>LAST.DAT% THEN DT.FLAG%=1
  211. 1530  RETURN
  212. 1600  '
  213. 1601  ' DATA RETRIEVAL
  214. 1602  '
  215. 1610  OKDAT = 0:CNT=0:START.WIPE=13:END.WIPE=24:GOSUB 3010:LOCATE 18,35:COLOR 31:PRINT "WORKING":COLOR 7,0
  216. 1615  IF BDAT THEN GOSUB 1660 ELSE SREC = SDATE-START.DAT%+2:EREC = EDATE-START.DAT%+2
  217. 1620  FOR I%=SREC TO EREC:GET #1,I%
  218. 1625  IF EXTYPE = 1 THEN GOSUB 1710
  219. 1630  IF EXTYPE = 2 THEN VAL2 = VALUE:GOSUB 1740
  220. 1635  IF EXTYPE = 3 THEN GOSUB 1770
  221. 1640  IF CNT = 221 THEN I%=EREC
  222. 1645  NEXT I%
  223. 1650  IF CNT>220 THEN LOCATE 21,20:PRINT "Too many days requested.":LOCATE 22,20:PRINT "Break your request into shorter timeframes.":GOSUB 3040:RETURN
  224. 1655  OKDAT = 1:RETURN
  225. 1657  '
  226. 1660  TST.DAT%=SDATE:REC.NUM%=1
  227. 1662  GOSUB 1680:SREC=REC.NUM%
  228. 1664  TST.DAT%=EDATE:REC.NUM%=REC.NUM%-1
  229. 1666  GOSUB 1680:EREC=REC.NUM%:RETURN
  230. 1668  '
  231. 1680  MATCH.FLAG%=0
  232. 1682  WHILE NOT MATCH.FLAG%
  233. 1684  REC.NUM%=REC.NUM%+1:GET #1,REC.NUM%:TDATE%=CVS(DAT.REC$)
  234. 1686  IF TDATE%>=TST.DAT% THEN MATCH.FLAG%=-1
  235. 1688  WEND
  236. 1690  RETURN
  237. 1700  '
  238. 1701  ' RETRIEVAL BY EXPRESSION TYPE
  239. 1702  '
  240. 1710  TVAL=CVS(MID$(RECORD$,(IND1*4)-3,4)):IF TVAL=0 THEN RETURN
  241. 1715  CNT=CNT+1:IF CNT>220 THEN RETURN
  242. 1720  VAL1(CNT)=TVAL:GOSUB 1800:RETURN
  243. 1730  '
  244. 1740  TVAL=CVS(MID$(RECORD$,(IND1*4)-3,4)):IF TVAL=0 THEN RETURN
  245. 1745  VAL1=TVAL:GOSUB 1810:IF NOGO.FLAG% THEN RETURN
  246. 1750  CNT=CNT+1:IF CNT>220 THEN RETURN
  247. 1755  VAL1(CNT)=VAL1:GOSUB 1800:RETURN
  248. 1760  '
  249. 1770  TVAL=CVS(MID$(RECORD$,(IND1*4)-3,4)):IF TVAL=0 THEN RETURN
  250. 1775  VAL1=TVAL
  251. 1780  TVAL=CVS(MID$(RECORD$,(IND2*4)-3,4)):IF TVAL=0 THEN RETURN
  252. 1785  VAL2=TVAL:GOSUB 1810:IF NOGO.FLAG% THEN RETURN
  253. 1790  CNT=CNT+1:IF CNT>220 THEN RETURN
  254. 1795  VAL1(CNT)=VAL1:VAL2(CNT)=VAL2:GOSUB 1800:RETURN
  255. 1797  '
  256. 1800  IF BDAT THEN DT=CVS(DAT.REC$) ELSE DT=I%+START.DAT%-2
  257. 1805  GOSUB 51490:DAY$(CNT)=DT.PRN$:RETURN
  258. 1807  '
  259. 1810  NOGO.FLAG%=1
  260. 1812  IF OPER$="<" AND VAL1 < VAL2 THEN NOGO.FLAG%=0:RETURN
  261. 1814  IF OPER$=">" AND VAL1 > VAL2 THEN NOGO.FLAG%=0:RETURN
  262. 1816  IF OPER$="=" AND ABS(VAL1-VAL2)<0.01 THEN NOGO.FLAG%=0
  263. 1818  RETURN
  264. 1850  '
  265. 1851  ' DATA OUTPUT
  266. 1852  '
  267. 1860  EXEXPR$=IND$(IND1)
  268. 1870  IF EXTYPE=2 THEN EXEXPR$=EXEXPR$+" "+OPER$+STR$(VALUE)
  269. 1880  IF EXTYPE=3 THEN EXEXPR$=EXEXPR$+" "+OPER$+" "+IND$(IND2)
  270. 1890  IF PRTSW THEN DISPLEN=56 ELSE DISPLEN=17
  271. 1900  NPGS=INT(CNT/DISPLEN)
  272. 1910  DT=SDATE:GOSUB 51490:SDATE$=DT.PRN$
  273. 1920  DT=EDATE:GOSUB 51490:EDATE$=DT.PRN$
  274. 1930  TSPAN$=SDATE$+"-"+EDATE$
  275. 1940  RJUST=79-LEN(EXEXPR$)-LEN(TSPAN$)-12
  276. 1943  P1=13+CINT(LEN(IND$(IND1))/3)
  277. 1945  IF EXTYPE=3 THEN P2=18+LEN(IND$(IND1))+CINT(LEN(IND$(IND2))/3)
  278. 1947  IF PRTSW THEN CLS:LOCATE 18,25,0:PRINT "PRESS <ESC> TO HALT PRINTING."
  279. 1950  IF PRTSW THEN OPEN "O",2,"LPT1:" ELSE OPEN "O",2,"SCRN:"
  280. 1960  PGCNT=1
  281. 1970  SLINE=((PGCNT-1)*DISPLEN)+1
  282. 1980  ELINE=PGCNT*DISPLEN:IF ELINE>CNT THEN ELINE=CNT
  283. 1990  IF NOT(PRTSW) THEN CLS
  284. 2000  GOSUB 2310
  285. 2010  IF ESC.FLAG% THEN ESC.FLAG%=0:CLOSE #2:RETURN
  286. 2020  IF PRTSW THEN PRINT #2,CHR$(12):PGCNT=PGCNT+1:IF PGCNT>NPGS+1 THEN CLOSE #2:RETURN ELSE GOTO 1970
  287. 2030  P$=INKEY$:IF P$="" THEN 2030
  288. 2040  P$=RIGHT$(P$,1):IF ASC(P$)=27 THEN CLOSE #2:RETURN
  289. 2050  IF ASC(P$)=75 THEN TPGCNT=PGCNT-1:IF TPGCNT>0 THEN PGCNT=TPGCNT:GOTO 1970 ELSE BEEP:GOTO 2030
  290. 2060  IF ASC(P$)=77 THEN TPGCNT=PGCNT+1:IF TPGCNT<NPGS+2 THEN PGCNT=TPGCNT:GOTO 1970 ELSE BEEP:GOTO 2030
  291. 2080  BEEP:GOTO 2030
  292. 2300  '
  293. 2301  ' OUTPUT A PAGE
  294. 2302  '
  295. 2310  ESC.FLAG%=0
  296. 2315  PRINT #2,EXEXPR$+SPACE$(5)+TSPAN$+SPACE$(RJUST)+"Page"+STR$(PGCNT)
  297. 2320  PRINT #2," "
  298. 2330  PRINT #2," DATE   "+SPACE$(5)+IND$(IND1);
  299. 2340  IF EXTYPE=3 THEN PRINT #2,SPACE$(5)+IND$(IND2);
  300. 2350  PRINT #2," "
  301. 2360  PRINT #2,STRING$(8,"-")+SPACE$(5)+STRING$(LEN(IND$(IND1)),"-");
  302. 2370  IF EXTYPE=3 THEN PRINT #2,SPACE$(5)+STRING$(LEN(IND$(IND2)),"-");
  303. 2380  PRINT #2," "
  304. 2390  FOR I%=SLINE TO ELINE
  305. 2400  PRINT #2,DAY$(I%);TAB(P1);
  306. 2410  PRINT #2,USING IFORM$(IND1);VAL1(I%);
  307. 2420  IF EXTYPE=3 THEN PRINT #2,TAB(P2);:PRINT #2,USING IFORM$(IND2);VAL2(I%);
  308. 2430  PRINT #2," "
  309. 2440  P$=INKEY$:IF P$<>"" THEN IF ASC(P$)=27 THEN ESC.FLAG%=1:RETURN
  310. 2450  NEXT I%
  311. 2460  IF NOT(PRTSW) THEN PRINT #2," ":PRINT #2,"TYPE "+CHR$(26)+" FOR NEXT PAGE, "+CHR$(27)+" FOR PREVIOUS PAGE, OR <ESC> TO EXIT"
  312. 2470  RETURN
  313. 2700  '
  314. 2701  ' EXIT
  315. 2702  '
  316. 2710  CLS:ON ERROR GOTO 0
  317. 2720  KEY 1,"LIST" :KEY 2,"RUN" + CHR$(13) :KEY 3,"LOAD" + CHR$(34) :KEY 4,"SAVE"+ CHR$(34)
  318. 2730  KEY 5,"CONT" + CHR$(13) :KEY 6, CHR$(34) + "LPT1" + CHR$(34) + CHR$(13)
  319. 2740  KEY 7,"TRON" + CHR$(13) :KEY 8,"TROFF" + CHR$(13) :KEY 9,"KEY":
  320. 2750  KEY 10,"SCREEN 0,0,0"
  321. 2760  KEY ON
  322. 2770  END
  323. 3010  LOCATE ,,0: FOR X = START.WIPE TO END.WIPE                        'WIPE
  324. 3015  LOCATE X,1: PRINT SPC(77);
  325. 3020  NEXT
  326. 3030  RETURN
  327. 3040  FOR X = 1 TO 1500:NEXT X:RETURN                                   'DELAY
  328. 3050  '
  329. 3051  ' INKEY ROUTINE
  330. 3052  '
  331. 3070  P$ = ""
  332. 3075  ESC.FLAG% = 0
  333. 3080  O = COL : N = COL : Z = 0
  334. 3090  IF Z = TOTCH THEN RETURN
  335. 3100  LOCATE LN,COL,1
  336. 3110  J$ = INKEY$:IF J$ = "" THEN GOTO 3110 ELSE J = ASC(RIGHT$(J$,1))
  337. 3120  IF J = 27 THEN ESC.FLAG% = 1: RETURN
  338. 3122  IF J = 13 THEN LOCATE ,,0:RETURN
  339. 3130  IF J = 8 THEN GOSUB 3190 : GOTO 3090
  340. 3135  IF INSTR("1234567890SsPpBbVvYyNn+-./><=",J$)=0 THEN BEEP:GOTO 3090
  341. 3140  IF PRT = 1 THEN LOCATE LN,COL,0 : PRINT J$;: P$ = P$ + J$ : COL = COL + 1
  342. 3150  Z = Z + 1 : GOTO 3090
  343. 3180  RETURN
  344. 3190  N = COL : N = N - 1  : J$ = ""                              'BACKSPACE
  345. 3200  IF N <= 0 THEN BEEP: COL = 0 : RETURN ELSE LOCATE LN,N,1: PRINT " ";
  346. 3210  IF P$ = "" THEN RETURN ELSE N$ = LEFT$(P$, LEN(P$) - 1 ):P$ = N$:Z=Z-1
  347. 3220  COL = N
  348. 3230  RETURN
  349. 3250  '
  350. 3251  ' GENERAL ERROR HANDLER
  351. 3252  '
  352. 3260  LOCATE 23,1,0:PRINT SPACE$(60):LOCATE 23,10,0
  353. 3270  IF ERR = 53 THEN PRINT "FILE NOT FOUND. PLEASE COPY THE DATA FILES TO THIS DISK AND RE-START":GOSUB 3040:GOTO 2710
  354. 3280  IF ERR = 71 THEN PRINT "DISK IS NOT READY. CHECK DISK DRIVE DOOR.";:GOTO 3300
  355. 3290  IF ERR = 27 THEN PRINT "YOUR PRINTER IS NOT READY.";:GOTO 3300
  356. 3295  PRINT "GENERAL ERROR: ERROR # - ";ERR;", LINE - ";ERL;" PLEASE CALL PC DISK.":GOSUB 3040:GOSUB 3040:GOTO 2710
  357. 3300  LOCATE 24,10:PRINT "PLEASE CORRECT AND PRESS ANY KEY TO CONTINUE."
  358. 3310  P$=INKEY$:IF P$="" THEN 3310 ELSE RESUME
  359. 3320  '
  360. 3321  ' TITLE SCREEN
  361. 3322  '
  362. 3330  GOSUB 42000
  363. 3390  C = 65
  364. 3400  SP$ = STRING$(13,32)
  365. 3410  X$ = "STOCK / BOND DATA FILE
  366. 3420  TITLE$ = X$+SP$
  367. 3430  FOR Y = 1 TO 10
  368. 3440  FOR Z = 1 TO 10
  369. 3450  FOR E = 1 TO 19 :NEXT E
  370. 3460  FOR A = 1 TO 5
  371. 3470   FOR X = 1 TO LEN(TITLE$)
  372. 3480  L = L + 1
  373. 3490  T$ = MID$(TITLE$,L,1)
  374. 3500  H$ = H$ + T$
  375. 3510  LOCATE 8,C:PRINT H$
  376. 3520  C = C-1: IF C < 30 THEN 3570
  377. 3530  SOUND 1700,0.25
  378. 3540  NEXT X
  379. 3550  NEXT A:NEXT Z: NEXT Y
  380. 3570  LOCATE 11,35:PRINT ">>>>>><<<<<<": LOCATE 14,29:PRINT "Copyright (1984). PC-DISK."
  381. 3580  GOSUB 3040:RETURN
  382. 40000  '
  383. 40001  ' BOX-DRAW ROUTINES
  384. 40002  '
  385. 41000  LOCATE LN,COL,0: PRINT ULC$
  386. 41010  FOR X = COL +1 TO RC - 1
  387. 41020  LOCATE LN,X: PRINT HORI$;
  388. 41030  NEXT
  389. 41040  PRINT URC$
  390. 41050  FOR X = LN +1 TO BR -1
  391. 41060  LOCATE X,RC : PRINT VERT$
  392. 41070  NEXT
  393. 41080  LOCATE BR,RC : PRINT LRC$
  394. 41090  FOR X = RC - 1 TO COL +1 STEP -1
  395. 41100  LOCATE BR,X : PRINT HORI$
  396. 41110  NEXT X
  397. 41120  LOCATE BR,COL: PRINT LLC$
  398. 41130  FOR X = BR - 1 TO LN + 1 STEP -1
  399. 41140  LOCATE X,COL : PRINT VERT$
  400. 41150  NEXT X
  401. 41160  COLOR 7,0: RETURN
  402. 41170  '
  403. 42000  CLS: COLOR 0,7: X$ = CHR$(179) :Y$ = CHR$(205)
  404. 42010  LOCATE 5,15,0: PRINT CHR$(213): FOR X = 16 TO 66:LOCATE 5,X:PRINT Y$;:NEXT X:PRINT  CHR$(184)
  405. 42020  FOR X = 6 TO 18 : LOCATE X,67 :PRINT X$:NEXT X
  406. 42030  LOCATE 19,67:PRINT CHR$(190):FOR X = 66 TO 16 STEP -1 :LOCATE 19,X :PRINT Y$:NEXT X:LOCATE 19,15:PRINT CHR$(212)
  407. 42040  FOR X = 18 TO 6 STEP -1: LOCATE X,15:PRINT CHR$(179): NEXT X:COLOR 7,0
  408. 42050  BOX.DONE%=1:RETURN
  409. 50000  '
  410. 50010  ' DATE ROUTINES
  411. 50020  '
  412. 51050  '<DT_INT_CONT>
  413. 51110  GOSUB 51180:IF NO.SLASH% THEN DT.FLAG%=-1:RETURN
  414. 51120  GOSUB 51360:GOSUB 51490
  415. 51140  IF MON.ORIG%<>MON.OUT OR DAY.ORIG%<>DAY.OUT OR YR.ORIG%<>YR.OUT THEN DT.FLAG%=-1 ELSE DT.FLAG%=0
  416. 51150  DT.INT%=DT:SCRATCH!=FRE("")
  417. 51160  RETURN
  418. 51170  '
  419. 51180  '<DT_PARSE>
  420. 51240  BRK.1%=0:BRK.2%=0:NO.SLASH%=0
  421. 51250  FOR N%=1 TO LEN(DAT$)
  422. 51260    ELEM$=MID$(DAT$,N%,1)
  423. 51270    IF ASC(ELEM$)>=48 AND ASC(ELEM$)<=57 THEN 51290
  424. 51280    IF BRK.1%=0 THEN BRK.1%=N% ELSE BRK.2%=N%
  425. 51290  NEXT
  426. 51295  IF BRK.1%=0 OR BRK.2%=0 THEN NO.SLASH%=-1:RETURN
  427. 51300  MON.ORIG%=VAL(LEFT$(DAT$,BRK.1%-1))
  428. 51310  DAY.ORIG%=VAL(MID$(DAT$,BRK.1%+1,BRK.2%-BRK.1%-1))
  429. 51320  YR.ORIG%=VAL(MID$(DAT$,BRK.2%+1,4))
  430. 51330  IF YR.ORIG%>1999 THEN YR.ORIG%=YR.ORIG%-1900
  431. 51340  RETURN
  432. 51350  '
  433. 51360  ' <DT_INT_COMP>
  434. 51420  DAY.INP=DAY.ORIG%:MON.INP=MON.ORIG%:YR.INP=YR.ORIG%
  435. 51430  YR.INP=YR.INP+1900
  436. 51440  IF MON.INP<3 THEN YR.INP=YR.INP-1:MON.INP=MON.INP+13:ELSE:MON.INP=MON.INP+1
  437. 51450  DT=INT(365.25*YR.INP)+INT(30.6001*MON.INP)+DAY.INP-722527
  438. 51460  YR.INP=YR.INP-1900
  439. 51470  RETURN
  440. 51480  '
  441. 51490  ' <INT_DT>
  442. 51550  DT1=DT+722527:YR.OUT=INT((DT1-122.1)/365.25)
  443. 51560  MON.OUT=INT((DT1-INT(365.25*YR.OUT))/30.6001)
  444. 51570  DAY.OUT=DT1-INT(365.25*YR.OUT)-INT(30.6001*MON.OUT)
  445. 51580  IF MON.OUT>13 THEN MON.OUT=MON.OUT-13 ELSE MON.OUT=MON.OUT-1
  446. 51590  YR.OUT=YR.OUT-1900:IF MON.OUT<3 THEN YR.OUT=YR.OUT+1 
  447. 51600  IF YR.OUT>99 THEN YR.PRN$=FNSTRIP$(YR.OUT+1900) ELSE YR.PRN$=FNSTRIP$(YR.OUT)
  448. 51610  DT.PRN$=FNSTRIP$(MON.OUT)+"/"+FNSTRIP$(DAY.OUT)+"/"+YR.PRN$
  449. 51620  RETURN
  450. 52000  ' <DBD>
  451. 52002  DAT$=DAT1$:GOSUB 51050:DT.1%=DT.INT%
  452. 52004  IF YR.ORIG% MOD 4=0 AND MON.ORIG%<3 THEN Y.1.LEN%=366 ELSE Y.1.LEN%=365
  453. 52006  DAT$=DAT2$:GOSUB 51050:DT.2%=DT.INT%
  454. 52008  IF YR.ORIG% MOD 4=0 AND MON.ORIG%<3 THEN Y.2.LEN%=366 ELSE Y.2.LEN%=365
  455. 52010  DBD%=DT.2%-DT.1%:RETURN
  456. 52019  '
  457.