IMD 1.16: 29/05/2007 18:56:08 FOGCPM.082 --FOGCPM082STKADD BAS8 STKBASE BAS0 STKBETA BAS:STKCHANGBASI !STKCREATBAS?"#$%&'()STKPRFM BAS(*+,-.STKTRANSBAS4/012345STKUPDATBASR6789:;<=>?@BUDGET BASNABCDEFGHIJCOMMSN BASKLMCOMMSN DOC NOFINANCE BAS+PQRSTUFINANGN1BASMVWXYZ[\]^_FINANGN1COM`abcdefghijklmnoFINANGN1COM*pqrstu-06-00 86 LOAN BASvwxPROJECT BAS7yz{|}~RATIOS BAS+RATIOS DOCSTATS1 BAS STKGRPH BAS-STKGRPH DOC7STOCGRPHBASSTOCGRPHDOCSTOCK DATSTOCKS BASSTCKEXMPBASSTOCKFL -CPM082 DOCThis is the disk name. REM *------------- Section 1.4 --------------------* REM * ADD TO STOCK FILE * REM * ----------------- * REM * UPDATED: February 5, 1983 * REM * BY: Edward A. Valenzuela * REM * VERSION: 1.31 * REM *----------------------------------------------* rem ----- requires following subroutines ----- rem stkbas.bas ... for jump vectors rem scrnin.bas rem stkcreat.bas ... for blank menu rem qksort$.bas ... alphabetical sort rem stkchang.bas ... for screen display 770 rem ... print screen ... print clear$; \ fn.down$(2); \ fn.right$(15); "STOCK ADD/DELETE PROGRAM" print fn.down$(2); fn.right$(4); "0 = return to main menu" print fn.right$(4); "1 = ADD to stock file" print fn.right$(4); "2 = DELETE stock from file" print down$; fn.right$(2); "INSTRUCTIONS: enter menu selection" print fn.right$(2); bell$; input " and hit return"; field% if field% = 0 then goto 900  on field% gosub 771,772 RETURN 771 rem ... ADD TO STOCK FILE ... morestock$ = "y" 775 while morestock$ = "y" rem ... open files, read in all data ... GOSUB 875 GOTO 872 rem ----- SUBROUTINE TO READ AND BACKUP FILE ----- 875 rem .. read in file .. if end #8 then 1791 if end #9 then 1792 OPEN "B:STKPRICE.DAT" AS 8 OPEN "B:STKFIL01.DAT" recl 80 as 9 goto 1793 1791 print "no such file: B:STKPRICE.DAT exists" print "check disk on DRIVE B" input "enter y to resume"; y$ INITIALIZE GOTO 871 1792 print "no such file: B:STKFIL01.DAT exists" print "check disk on DRIVE B" input "enter y to resume"; y$ INITIALIZE GOTO 871 1793 if end #8 then 1794 if end #9 then 1795 GOSUB 320 : rem ... read in stock price header GOSUB 330 : rem ... read in stock price file GOSUB 325 : rem ... read in S&P 500 price ... 1794 number.stock% = nstk% GOSUB 315 : rem ... read in stock data file 1795 CLOSE 8,9 CREATE "B:STKFIL01.BAK" recl 80 as 9 GOSUB 340 : rem ... write out stock data file CLOSE 9 871 RETURN rem ------ END OF READ AND BACKUP SUBROUTINE ----- 872 nstk%=nstk%+1 nitems% = nstk% + 1 oldprice(nitems%) = oldprice(nstk%) newprice(nitems%) = newprice(nstk%) GOSUB 710 : rem .. create input screen GOSUB 715 : rem .. enter new stock data rem ... read in current prices for new stocks ... print clear$ print fn.line$(13); fn.right$(2); "INSTRUCTIONS:" print fn.right$(2); bell$; "ENTER current stock price for :"; namstk$(nstk%) input NEWprice(nstk%) OLDprice(nstk%) = NEWprice(nstk%) GOSUB 1681 GOTO 1682 REM *** SUBROUTINE ALPHABETIZE STOCK FILE *** rem ... find the position of the new stock ... rem ... find the length of the smallest string ... 1681 small%=24 for i% = 1 to nstk% if len(namstk$(i%)) < small% then small% = len(namstk$(i%)) next i% rem ... pad the small names with z's ... for i%=1 to nstk% x$(i%) = UCASE$(namstk$(i%))  if len(x$(i%)) <= (small% + 3) then x$(i%) = x$(i%) + "zzzz" x$(i%) = left$(x$(i%),small% + 4) next i% nadd%=1 for i% = 1 to nstk%-1 if x$(nstk%) > x$(i%) then nadd% = nadd% + 1 next i% RETURN : rem *** END SUBROUTINE *** 1682 print namstk$(nstk%); " is to be added after "; namstk$(nadd%-1) print " in the "; nadd%; " position " rem ... write the newfile ... open "B:STKPRICE.DAT" RECL 30 AS 8 CREATE "B:STKFIL01.DAT" recl 80 as 9 rem ... write out the new number of stocks ... GOSUB 345 : rem .. write out header i% = 1 j% = 1 WHILE i% <= nadd%-1 key%(i%) = i% print #9, j%; nshrs%(i%), namstk$(i%), symbol$(i%), xchng$(i%), \ purdate$(i%), commission(i%), totpurprice(i%), key%(i%), dividend(i%) print #8, j%+1; newprice(i%), oldprice(i%) i% = i% + 1 j% = j% + 1 WEND key%(nstk%) = i% i% = nstk% : rem .. original position of added stock data print #9, j%; nshrs%(i%), namstk$(i%), symbol$(i%), xchng$(i%), \ purdate$(i%), commission(i%), totpurprice(i%), key%(i%), dividend(i%) print #8, j%+1; newprice(i%), oldprice(i%) i% = nadd% j% = j% + 1 WHILE i% <= nstk%-1 key%(i%) = i% print #9, j%; nshrs%(i%), namstk$(i%), symbol$(i%), xchng$(i%), \ purdate$(i%), commission(i%), totpurprice(i%), key%(i%), dividend(i%) print #8, j%+1; newprice(i%), oldprice(i%) i% = i% + 1 j% = j% + 1 WEND i% = nitems% print #8, j%+1; newprice(i%), oldprice(i%) CLOSE 8,9 rem ... UPDATE THE HISTORICAL PRICE FILES FOR STOCK ADDITION ... print clear$; fn.line$(4); bell$ print "UPDATING HISTORICAL PRICE FILES FOR LATEST" print " STOCK ADDITION ... you may wish to do something" print " else for the next few minutes ..." GOSUB 7900 rem ... ask if another stock to be added ... print clear$; fn.line$(13); fn.right$(2); "INSTRUCTIONS:" morestock$ = fn.entry$(0,44, \ "input another stock? y or n?",13,16) wend RETURN rem ------------END OF SUBROUTINE ADD TO FILE--------------- 772 rem ... DELETE STOCK FROM FILE SECTION ... rem ... open files, read in all data ... GOSUB 875 : rem .. form backup, read data 781 rem ... enter name of stock to be deleted ... TITLE1$ = "STOCK DELETION PROGRAM" TITLE2$ = "enter stock name to be deleted" delete$="T" GOSUB 7305 rem ... print title, ask for input, look for match if match(namstk$,namstk$(nrec%),1) > 0 then close 9 \ else RETURN rem ... ask if this is the correct stock to delete ... print fn.line$(13); fn.right$(16); \ "IS THIS THE CORRECT STOCK TO DELETE ?" print fn.right$(16); bell$; INPUT "y or n?"; y$ if y$ = "y" then goto 767 else goto 781 767 rem ... continue reading the file ... if end #8 then 768 if end #9 then 768 OPEN "B:STKPRICE.DAT" AS 8 OPEN "B:STKFIL01.DAT" RECL 80 AS 9 GOSUB 320 : rem .. read header i% = 1 WHILE i% <= nrec% GOSUB 325 : rem .. read stock price GOSUB 310 : rem .. read in stock data i% = i% + 1 key%(i%) = i% WEND i% = nrec% WHILE i% <= number.stock% - 1 GOSUB 325 : rem .. read in stock price GOSUB 310 : rem .. read in stock data rem .. for kth stock and store in ith place i% = i% + 1 key%(i%) = i% WEND i% = number.stock% GOSUB 325 : rem .. read S&P 500 price 768 CLOSE 8,9 rem ... re-write to STOCK.PRICE.DAT rem ... and to STOCK.FILE.DAT if end #8 then 769 if end #9 then 769 OPEN "B:STKPRICE.DAT" RECL 30 AS 8 OPEN "B:STKFIL01.DAT" RECL 80 AS 9 nstk% = number.stock% - 1 GOSUB 340 : rem .. write out stock file GOSUB 345 : rem .. write out header GOSUB 355 : rem .. write out price file GOSUB 350 : rem .. write S&P 500 price 769 CLOSE 8,9 rem ... UPDATE HISTORICAL PRICE FILES FOR STOCK DELETION ... print clear$; fn.line$(4); bell$ print "UPDATING HISTORICAL PRICE FILES FOR LATEST" print " STOCK DELETION ... you may wish to do something" print " else for the next few minutes ..." GOSUB 7950 RETURN rem ************************************************ rem * STOCK DATABASE PROGRAM * rem ************************************************ rem * * rem * WRITTEN: February 25, 1983 * rem * BY: Edward A. Valenzuela * rem * VERSION: 1.35 * rem ************************************************ rem * * rem * Copyright (C) 2/10/83 by Edward A. Valenzuela, * rem * 2001 Wyllys, Midland, Michigan, 48640. The author * rem * grants permission to FOG to copy this program on * rem * a not-for-profit basis. No copies of this program * rem * may be sold for profit except by the author. * rem * * rem ---------- functions used in program ------------------------------- %CHAIN 140, 15000, 40, 1600 COMMON option%,entry%, nstk%,morestock$ %include juldate% %include scrnin n%=50 dim nshrs%(n%),namstk$(n%),xchng$(n%),equiv(n%) dim purdate$(n%),totpurprice(n%),commission(n%) dim incvalue(n%),pcntinc(n%),anyield(n%),key%(n%) dim X$(N%),day%(n%),symbol$(n%) DIM NEWPRICE(N%),OLDPRICE(N%),NEWVALUE(N%) dim dividend(n%),YIELD(N%) rem ... stock beta calculation arrays ... m%=50 dim x(m%),y(m%),x0(m%),xr(m%),yr(m%),x%(m%),kode%(m%) rem -----print disk initialization instructions----- if entry% > 0 then goto 900 print clear$; fn.down$(2); \ fn.right$(10); "STOCK PORTFOLIO ANALYSIS" print down$; fn.line$(8); fn.right$(6); \ "CHANGE disks at this time" print fn.right$(6); \ "PROGRAMS disk should be on DRIVE A" print down$; fn.right$(6); \ "DATA files disk should be loaded on DRIVE B" space.remaining = FRE - 4000 print fn.line$(12); fn.right$(2); "Amount of FREE STORAGE area remaining "; \ space.remaining; " bytes" print fn.line$(14); fn.right$(6); bell$ ; PRINT "PRESS ANY KEY TO CONTINUE " while not constat% wend INITIALIZE disk.capacity% = 92 space.remaining% = disk.capacity% - size("B:*.*") print fn.line$(16); fn.right$(2); "Amount of FREE SPACE on DATA disk "; \ space.remaining%; " Kbytes" print "PLEASE TAKE NOTE OF DISK SPACE!";bell$ INPUT "enter y to continue "; yes$ 900 REM ...PRINT MAIN MENU... print clear$; fn.down$(2); \ fn.right$(10); "STOCK PORTFOLIO ANALYSIS" print down$; fn.right$(15); "option list" ; down$ print fn.right$(5); "0 = EXIT to CP/M" print fn.right$(5); "1 = CREATE stock file" print fn.right$(5); "2 = ADD/DELETE to stock file" print fn.right$(5); "3 = CHANGE entries in stock file" print fn.right$(5); "4 = HISTORICAL performance summary" print fn.right$(5); "5 = UPDATE weekly stock prices" print fn.right$(5); "6 = TIME-SERIES regressions" print fn.right$(5); "7 = BUY/SELL FILE entry" print fn.right$(5); "8 = STOCK SPLIT entry" print fn.right$(5); "9 = RISK/RETURN file sort" print down$; fn.line$(18); fn.right$(10); bell$ ; input "SELECT OPTION NUMBER: "; option% if option% <= 0 then goto 999 if option% > 9 then goto 999 on option% goto 910,920,930,940,950,960,970,980,989 rem -----end of screen option menu----- 910 rem ...... file creation menu ...... gosub 700 goto 900 920 rem ...... add to stock entries in file ...... gosub 770 goto 900 930 rem ...... modify entries in existing file ...... gosub 7300 goto 900 940 rem ...... performance summary ...... rem ...... versus original purchase ...... CHAIN "A:STKPRICE" goto 900 950 rem ...... update weekly stock prices ...... CHAIN "A:STKPRICE" goto 900 960 rem ...... time-series regression analysis ...... CHAIN "A:STKGRAPH" goto 900 970 rem ...... buy/sell data entry ...... GOSUB 3700 goto 900 980 rem ...... stock splits ...... GOSUB 7800 goto 900 989 rem ...... beta sorting routine ...... CHAIN "A:STKGRAPH" goto 900 rem ..... return to original menu ..... rem ************************************************ rem * SUBROUTINES * rem ************************************************ %include stkchang %include STKCREAT %include stkadd %include stktrans %include QKSORT$ %include STKUPDTE rem --------------------- end stkbas -------------- rem ...JUMP VECTORS FOR FILE READ AND PRINT... 310 GOTO 410 : rem ...READ IN SINGLE STOCK 315 GOTO 415 : rem ...READ IN STOCK FILE 320 GOTO 420 : rem ...READ IN STOCK PRICE HEADER RECORD 325 GOTO 425 : rem ...READ IN SINGLE STOCK PRICE 330 GOTO 430 : rem ...READ IN STOCK PRICE FILE 335 GOTO 435 : rem ...PRINT SINGLE STOCK 340 GOTO 440 : rem ...PRINT STOCK FILE 345 GOTO 445 : rem ...PRINT STOCK PRICE HEADER 350 GOTO 450 : rem ...PRINT SINGLE STOCK PRICE 355 GOTO 455 : rem ...PRINT STOCK PRICE FILE rem ----------------------------------------------- 410 rem ... unit number 9 READ #9; nshrs%(i%), namstk$(i%), symbol$(i%), xchng$(i%), purdate$(i%), \ commission(i%), totpurprice(i%), key%(i%), dividend(i%) RETURN 415 rem ... read nstk% records rem ... use i% for array element FOR i% = 1 to nstk% GOSUB 310 NEXT i% RETURN 420 rem ... unit number 8  READ #8; nstk%, newdate$, olddate$ RETURN 425 rem ... use i% for array element READ #8; newprice(i%),oldprice(i%) RETURN 430 rem ... read nstk% records FOR i% = 1 to nstk% GOSUB 325 NEXT i% RETURN 435 rem ... unit number 9 PRINT #9; nshrs%(i%), namstk$(i%), symbol$(i%), xchng$(i%), purdate$(i%), \ commission(i%), totpurprice(i%), key%(i%), dividend(i%) RETURN 440 rem ... print nstk% records rem ... use i% for array element FOR i% = 1 to nstk% GOSUB 335 NEXT i% RETURN 445 rem ... unit number 8 PRINT #8; nstk%, newdate$, olddate$ RETURN 450 rem ... use i% for array element PRINT #8; newprice(i%), oldprice(i%) RETURN 455 rem ... print nstk% records FOR i% = 1 to nstk% GOSUB 350 NEXT i% RETURN 999 end rem ************** MAIN PROGRAM END **************** REM *----------------------------------------------* REM * BETA REGRESSION ROUTINE * REM * ----------------------- * REM * UPDATED: February 5, 1983 * REM * COPYRIGHT: E. A. Valenzuela * REM * VERSION: 1.31 * REM *----------------------------------------------* rem ... requires following subprograms ... rem STKgraph.BAS ... MAIN program rem STKPLOT.BAS rem LINREG.BAS rem SCRNIN.BAS 9001 rem ...program to regress price history data to obtain alphas and rem ...betas for the portfolio... : rem ... read in # of stocks open "B:STKPRICE.DAT" as 8 read #8; nstk%, newdate$, olddate$ close 8 if end #4 then 9003 print clear$; fn.down$(2); \ fn.right$(4); "ALPHA AND BETA CALCULATION FOR PORTFOLIO" print down$; fn.right$(15); "option list" ; down$ print fn.right$(4); " 0 = RETURN to main menu" print print fn.right$(4); " 1 = DAILY PRICE FILE" print fn.right$(4); " 2 = WEEKLY PRICE FILE" print fn.right$(4); " 3 = MONTHLY PRICE FILE" print fn.right$(4); " 4 = QUARTERLY PRICE FILE" print fn.right$(4); " 5 = YEARLY PRICE FILE" print down$; fn.line$(17); fn.right$(10); bell$ ; input "SELECT FILE TO ANALYZE: "; option% print up$; fn.line$(17); fn.clear$(2,line%); bell$ input "FOR PRICE PLOTS ONLY, ENTER 'P': "; plot$ plot$ = ucase$( plot$ ) print up$; fn.line$(17); fn.clear$(2,line%); bell$ input "FOR AUTO-SCALING OF PLOTS, ENTER 'A': "; auto.scale$ auto.scale$ = ucase$( auto.scale$ ) if option% <= 0 or option% > 5 then RETURN ON option% goto 9011,9012,9013,9014,9015 9011 filename$ = "B:DAYHST.DAT" period = 260 : rem ... weekdays in a year goto 9016 9012 filename$ = "B:WEEKHST.DAT" period = 52 goto 9016 9013 filename$ = "B:MONTHST.DAT" period = 12 goto 9016 9014 filename$ = "B:QUARTHST.DAT" period = 4 goto 9016 9015 filename$ = "B:YEARHST.DAT" period = 1 rem ... set up, print report heading ... 9016 print$="F" title1$= " BETA ANALYIS OF PORTFOLIO on " title2$= " DATE: " if plot$="P" then goto 9017 else GOSUB 9023 9017 rem ... pick up the S&P 500 prices ... OPEN filename$ recl 8 as 4 if end #4 then 9003 namstk$ = "S&P 500" nitems% = nstk% + 3 j% = 0 i% = 1 n1% = 3 while -1 rem ... pointer points at record # 3 ... read #4, n1%; x0(i%) x(i%) = x0(i%) y(i%) = x0(i%) i% = i% + 1 j% = j% + 1 n1% = n1% + nitems% rem ... pointer points at record # 3 + number of stocks + 1 ... wend 9019 rem ... set up summation counters for the portfolio ... gx=0 gy=0 gx2=0 gy2=0 gxy=0 nport%=0 sump=1.0 open "B:STKFIL01.DAT" recl 80 as 9 rem ... pick up the prices of all the individual stocks ... for istock%=1 to nstk% n1%=3 j%=0 read #9; nshrs%,namstk$,SYMBOL$,XCHNG$,PURDATE$,COMMISSION, \ TOTPURPRICE,KEY%(ISTOCK%),DIVIDEND open FILENAME$ recl 8 as 4 if end #4 then 9003 i%=1 while -1 rem ... pointer points at record # 3 + stock number ...  read #4, n1% + istock%; price1 if price1 = 0 then goto 9004 j% = j% + 1 : \ x(j%) = x0(i%) : \ y(j%) = price1 9004 n1% = n1% + nitems% rem ... pointer points at record # 3 + number of stocks + 1 ... i%=i%+1 wend 9003 rem ...end-of-file on #4... nr% = j%-1 close 4 rem ... if less than 3 points, skip plots, analysis ... if nr% < 3 then goto 9031 rem ... PLOT STOCK PRICES ... console GOSUB 298 : rem ... SUBROUTINE STKPLOT.BAS if plot$="P" then goto 9031 rem ... if an "X" has been entered at the console, EXIT if CONSTAT% THEN ANS% = CONCHAR% IF CHR$( ANS% ) = "X" THEN RETURN rem ... calculate % price change ... sum5=1.0 j% = nr% + 1 for i%=2 to j% ij% = i%-1 xr(ij%) = (x(i%) - x(ij%)) / x(ij%) yr(ij%) = (y(i%) - y(ij%)) / y(ij%) sum5=sum5*(1.0+yr(ij%)) next i% rem ... calculate geometric annual return ... rem ... assume prices are weekly prices ... nperiods = float(nr%) nyear = nperiods / period yield = (sum5-1.0) / nyear if yield > 9.99 then yield = 9.99 if yield < -0.99 then yield = -0.99 ygavg=(sum5-1.0) / nperiods rem ... find maximum and minimum % increases ... min = yr(1) max = yr(1) for i%=2 to nr% if yr(i%) > max then max = yr(i%) if yr(i%) < min then min = yr(i%) next i% max=max min=min rem ... CALL LINEAR REGRESSION ROUTINE ... gosub 9100 : rem ... SUBROUTINE LINREG.BAS rem ... reward-risk ratio ... ratio = yield/YSD ab=(a/ABS(b))*100. REM ... PRINT STOCK STATISTICS ... gosub 9024 REM ... STORE PORTFOLIO SUMS ... gx=gx+sx gx2=gx2+sx2 gy=gy+sy gy2=gy2+sy2 gxy=gxy+sxy nport%=nport%+nr% sump=sump*sum5 9031 if istock% = 0 then goto 9019 next istock% CLOSE 9 if plot$="P" then RETURN rem ... calculate portfolio statistics ... namstk$ = "portfolio" sxy=gxy sx=gx sx2=gx2 sy=gy sy2=gy2 nr%=nport% nperiods = float(nr%) nyear = nperiods / period yield = (sump-1.0) / nyear ygavg = (sump-1.0) / nperiods print rem ... CALL LINEAR REGRESSION ROUTINE AT ENTRY POINT GOSUB 9110 : rem ... SUBROUTINE LINREG.BAS ratio=yield/YSD ab=(a/ABS(b))*100. gosub 9025 return rem ------ SUBROUTINES ----- 9023 rem ... SET UP PRINT FORMATS ... lprinter width 136 print small.print$ print newpage$ rem ... PRINT HEADING FOR REPORT ... print title1$; filename$ print title2$; newdate$ print " stand stand stand -correlation"\ +"- ------- RETURNS PER PERIOD-------------- reward" print " STOCK no.of alpha beta error error error r-square r"\ +" geometric arith. standard annual to-risk a/b" print " no. name points intrcpt slope estimate "\ +" average average deviatn min max yield ratio ratio" line$="--------- --------- --------- --------- --------- --------- " + \ "--------- --------- --------- --------- --------- --------- " + \ "---------" print line$ if print$="T" then return rem ... CREATE FILE FOR BETA STORAGE ... CREATE "B:BETA.DAT" as 10 return 9024 rem ... print statistics for each stock ... lprinter width 136 for9$=" ## /........../ ### ##.### ##.### #.### #.### #.### #.### #.##"\ +"# ##.### ##.### ##.### ##.### ##.### ##.### ###.## ###.##" print using for9$; istock%,namstk$,nr%,a,b, SA, SB, see, r2, r, \ ygavg, yavg, YSD, min, max, yield,ratio,ab if fn.mod%(istock%,5) eq 5 then print rem ... WRITE DATA TO BETA FILE ... print #10; istock%,namstk$,nr%,a,b, SA, SB, see, r2, r, \ ygavg, yavg, YSD, min, max, yield,ratio,ab return 9025 rem ... print portfolio statistics ... lprinter width 136 for8$=" ## /......../ ##### ##.### ##.### #.### #.### #.### #.### ##.##"\ +"# ##.### ##.### ##.### ##.### ###.## ###.##" print using for8$; istock%,namstk$,nr%,a,b,SA,SB,see,r2,r,ygavg,yavg,YSD, \ yield,ratio,AB rem ... FINISH WRITING DATA TO FILE... min=0 max=0 print #10; istock%,namstk$,nr%,a,b,SA,SB,see,r2,r,ygavg,yavg,YSD, \ min, max, yield, ratio, AB CLOSE 10 console return REM ---------------- END OF REGRESSION --------------------- ##.### ##.### ###.## ###.##" print using for9$; istock%,namstk$,nr%,a,b, SA, SB, see, r2, r, \ ygavg, yavg, YSD, min, max, yield,ratio,ab if fn.mod%(istock%,5) eq 5 then print rem ... WRITE DATA TO BETA FILE ... print #10; istock%,namstk$,nr%,a,b, SA, SB, see, r2, r, \ ygavg, yavg, YSD, min, max, yield,ratio,ab return 9025 rem ... print portfolio statistics ... lprinter width 136 for8$=" ## /......../ ##### ##.### ##.### #.### #.### #.### #.### ##.##"\ +"# ##.### ##.### ##.### ##.### ###.## ###.##" print using for8$; istock%,namstk$,nr%,a,b,SA,SB,see,r2,r,ygavg,yavg,YSD, \ yield,ratio,AB rem ... FINISH WRITING DATA TO FILE... min=0 max=0 prem *______________ Section 3.0 ___________________* rem * * rem * CHANGE ENTRIES IN STOCK FILE * rem * ---------------------------- * rem * UPDATED: February 5, 1983 * rem * BY: Edward A. Valenzuela * rem * REVISION: 1.31 * rem *______________________________________________* rem ----- requires following subroutines ----- rem scrnin.bas rem stkbas.bas ... for jump vectors rem stkcreat.bas ... for screen menu 7300 rem ...titles for screen display... TITLE1$ = "STOCK FILE CHANGE PROGRAM" TITLE2$ = "enter stock name for data changes" delete$="F" GOSUB 7305 RETURN rem ----------------- SUBROUTINES ------------------ 7305 rem ...... create screen display .............. MORECHANGE$ = "Y" WHILE MORECHANGE$ = "Y" 7310 print clear$; \ fn.down$(2); \ fn.right$(15); TITLE1$ print down$; fn.right$(4); "STOCK NAME:" print down$; fn.right$(2); "INSTRUCTIONS:" namstk$ = fn.entry$(2,16,\ TITLE2$,7,16) if end #9 then 7316 open "B:STKFIL01.DAT" RECL 80 AS 9 if end #9 then 7317 7311 i%=0 while -1 i%=i%+1 GOSUB 310 : rem .. read in stock name if match(namstk$,namstk$(i%),1) = 0 then goto 7331 \ else nrec%=i%: goto 7332 7331 wend 7317 print fn.line$(13); fn.right$(16); "match not found" input "continue...? y or n?";y$ y$ = UCASE$(y$) if y$ = "Y" then goto 7310 : close 9 else RETURN 7316 print "data file B:STKFIL01.DAT not found" print "check disk in drive B" input "enter y to continue"; y$ INITIALIZE goto 7310 7332 rem ... fill screen with selected data ... nstk% = nrec% gosub 710 rem ... add data to screen ... i%=nrec% print fn.line$(4); fn.clear$(16,line%); fn.right$(16); namstk$(i%) print fn.clear$(16,line%); fn.right$(16); xchng$(i%) print fn.right$(16); nshrs%(i%) print fn.right$(16); purdate$(i%) print fn.right$(16); totpurprice(i%) print fn.right$(16); commission(i%) print fn.right$(16); symbol$(i%) print fn.right$(16); dividend(i%) if delete$="T" then RETURN : rem ... if called from STKDELETE 7340 rem ... ask for field corrections ... gosub 720 rem ... valid data, store the record ... I% = NREC% print #9, nrec%; nshrs%(i%),namstk$(i%),symbol$(i%),xchng$(i%),purdate$(i%), \ commission(i%),totpurprice(i%),key%(i%),dividend(i%) CLOSE 9 rem ... ask if finished ... print fn.line$(13); : print fn.clear$(16,line%) for j%=1 to 8 : print fn.clear$(2,line%) : next j% MORECHANGE$ = fn.entry$(0,44, \ "input another stock? y or n?",13,16) MORECHANGE$ = ucase$(MORECHANGE$) wend rem ***** end of while morestock$ = "yes" ***** 7349 RETURN rem *____________ End of Section 3.0 ______________* rem * -------- STOCK SPLIT UPDATE PROGRAM -------- * 7800 rem ...titles for screen display... TITLE1$ = "STOCK SPLIT PROGRAM" TITLE2$ = "enter stock name that split" delete$="T" GOSUB 7305 if match(namstk$,namstk$(nrec%),1) <> 0 then close 9 print fn.line$(13); fn.right$(16); \ "IS THIS THE CORRECT STOCK TO UPDATE ?" print fn.right$(16); bell$ ; input "y or n?"; y$ if y$= "x" then goto 900 if y$= "y" then goto 7810 else goto 7800 7810 print print "enter the split factor as a fraction" print "for example, if the stock splits 2 for 1" print "your present holdings double, the factor" print "is 2.00" print "if the split is 3 for 2, factor = 1.50" print print "if a stock dividend is declared rather than" print "a split, enter the multiplicative factor" print "for example, for a 5% stock dividend," print "the factor is 1.05" print 7811 input "ENTER STOCK SPLIT FACTOR : "; split print print "you have entered "; split; " as the split factor" input "enter y/n if this is correct/incorrect "; yes$ yes$ = ucase$( yes$ ) if yes$ = "n" then goto 7811 OPEN "B:STKPRICE.DAT" RECL 30 AS 8 OPEN "B:STKFIL01.DAT" RECL 80 AS 9 NPRC%=NREC%+1 READ #8, NPRC%; newprice,oldprice newprice = newprice/split new$ = str$( newprice ) newprice$ = left$( new$, 6 ) newprice = val( newprice$ ) oldprice = oldprice/split old$ = str$( oldprice ) oldprice$ = left$( old$, 6 ) oldprice = val( oldprice$ ) PRINT #8, NPRC%; newprice,oldprice READ #9, NREC%; nshrs%,namstk$,symbol$,xchng$,purdate$, \ commission,totpurprice,key%,dividend nshrs% = int%( nshrs% * split ) PRINT #9, NREC%; nshrs%,namstk$,symbol$,xchng$,purdate$, \ commission,totpurprice,key%,dividend CLOSE 8,9 REM .. UPDATE HISTORICAL PRICE FILES .. GOSUB 7850 RETURN 7850 rem ----- UPDATE HISTORICAL PRICE FILE ----- REM ----- FOR STOCK SPLITS ----- file%=1 7870 on file% goto 7851,7852,7853,7854,7855,7856 7851 filename$ = "B:DAYHST.DAT" GOTO 7860 7852 filename$ = "B:WEEKHST.DAT" GOTO 7860 7853 filename$ = "B:MONTHST.DAT" GOTO 7860 7854 filename$ = "B:QUARTHST.DAT" GOTO 7860 7855 filename$ = "B:YEARHST.DAT" GOTO 7860 7860 if end #4 then 7859 OPEN FILENAME$ RECL 8 AS 4 if end #4 then 7863 rec%=2 WHILE -1 read #4, rec% ; nprices% newrec%=rec% + nrec% + 1 read #4, newrec% ; oldprice oldprice = oldprice/split old$ = str$( oldprice ) oldprice$ = left$( old$, 6 ) oldprice = val( oldprice$ ) print #4, newrec% ; oldprice REC% = rec% + nprices% + 2 WEND 7859 rem ... no file, continue to next file ... file% = file%+1 goto 7870 7863 rem ... end-of-file ... CLOSE 4 file% = file% + 1 goto 7870 7856 RETURN REM ------ END OF SUBROUTINE UPDATE FOR SPLIT ------ 7900 rem ... UPDATE HISTORICAL PRICE FILE FOR ADDED STOCKS ... file%=1 7920 on file% goto 7901,7902 ,7903,7904,7905,7906 7901 name.file$ = "DAYHST" GOTO 7910 7902 name.file$ = "WEEKHST" GOTO 7910 7903 name.file$ = "MONTHST" GOTO 7910 7904 name.file$ = "QUARTHST" GOTO 7910 7905 name.file$ = "YEARHST" GOTO 7910 7910 if end #4 then 7909 filename$ = "B:" + name.file$ + ".DAT" NEWFILE$ = "B:" + name.file$ + ".$$$" OLDFILE$ = "B:" + name.file$ + ".BAK" OPEN FILENAME$ RECL 8 AS 4 CREATE NEWFILE$ RECL 8 AS 1 FILE OLDFILE$ : rem ... as file #2 if end #4 then 7929 while -1 read #4 ; date print #1 ; date read #4 ; nprices% print #1 ; nprices%+1 read #4 ; market print #1 ; market i% = 1 WHILE i% <= nadd%-1 read #4 ; oldprice print #1 ; oldprice i% = i% + 1 WEND print #1 ; 0 i% = nadd% + 1 WHILE i% <= nprices% read #4 ; oldprice print #1 ; oldprice i% = i% + 1 WEND WEND 7909 rem ... no file, continue to next file ... file% = file%+1 goto 7920 7929 rem ... end-of-file ... CLOSE 1, 4 rem .. STEP 1 .. delete old BAK file DELETE 2 rem .. STEP 2 .. rename current DAT file to BACKUP if not rename( OLDFILE$, FILENAME$ ) \ then 7930 rem .. STEP 3 .. rename TEMP file to NEW DAT file if not rename( FILENAME$, NEWFILE$ ) \ then 7930 7930 FILE% = FILE%+1 goto 7920 7906 RETURN REM -------- END OF SUBROUTINE UPDATE FOR ADD ------ 7950 rem ... UPDATE HISTORICAL PRICE FILE FOR DELETIONS ... file%=1 7970 on file% goto 7951,7952,7953,7954,7955,7956 7951 name.file$ = "DAYHST" GOTO 7960 7952 name.file$ = "WEEKHST" GOTO 7960 7953 name.file$ = "MONTHST" GOTO 7960 7954 name.file$ = "QUARTHST" GOTO 7960 7955 name.file$ = "YEARHST" GOTO 7960 7960 if end #4 then 7959 filename$ = "B:" + name.file$ + ".DAT" NEWFILE$ = "B:" + name.file$ + ".$$$" OLDFILE$ = "B:" + name.file$ + ".BAK" OPEN FILENAME$ RECL 8 AS 4 CREATE NEWFILE$ RECL 8 AS 1 FILE OLDFILE$ : rem ... as file #2 if end #4 then 7969 while -1 read #4 ; date print #1 ; date read #4 ; nprices% print #1 ; nprices%-1 read #4 ; market print #1 ; market i% = 1 WHILE i% <= nrec%-1 read #4 ; oldprice print #1 ; oldprice i% = i% + 1 WEND read #4 ; oldprice i% = nrec%+1 WHILE i% <= nprices%-1 read #4 ; oldprice print #1 ; oldprice i% = i% + 1 WEND WEND 7959 rem ... no file, continue to next file ... file% = file%+1 goto 7970 7969 rem ... end-of-file ... CLOSE 1, 4 rem .. STEP 1 .. delete old BAK file DELETE 2 rem .. rename current DAT file to BACKUP if not rename( OLDFILE$ , FILENAME$ ) \ then 7980 rem .. rename TEMP file to NEW file if not rename( FILENAME$ , NEWFILE$ ) \ then 7980 7980 FILE% = FILE%+1 goto 7970 7956 RETURN rem *____________ End of Section 3.5 ______________* rem * * rem * END OF STOCK FILE CHANGE SUBROUTINE * rem * * rem *----------------------------------------------*  #1 ; nprices%-1 read #4 ; market print #1 ; market i% = 1 WHILE i% <= nrec%-1 read #4 ; oldprice print #1 ; oldprice i% = i% + 1 WEND read #4 ; oldprice i% = nrec%+1 WHILE i% <= nprices%-1 read #4 ; oldprice print #1 ; oldprice i% = i% + 1 WEND WEND 7959 rem ... no file, continue to next file ... file% = file%+1 goto 7970 7969 rem ... end-of-file ... CLOSE 1, 4 rem .. STEP 1 .. delete old BAK file DELETE 2 rem .. rename current DAT file to BACKUP if not rename( OLDFILE$ , FILENAME$ ) \ then 7980 rem .. rename TEMP file to NEW file if not rename( FILENAME$ , NEWFILE$ ) \ then 7980 7980 FILE% = FILE%+1 goto 7970 7956 RETURN rem *____________ End of Section 3.5 ______________* rem * * rem * END OF STOCK FILE CHANGE SUBROUTINE * rem * * rem *--------------rem *_______________ Section 1.0 __________________* rem * * rem * CREATE STOCK FILE FOR FIRST TIME * rem * -------------------------------- * rem * WRITTEN: February 5, 1983 * rem * UPDATED: April 20, 1983 * rem * COPYRIGHT: E. A. Valenzuela * rem * VERSION: 1.50 * rem *______________________________________________* rem ----- requires subroutines ----- rem stkupdat.bas rem scrnin.bas rem stkbas.bas ... for jump vectors 700 rem ...... original creation ...... nstk% = 0 morestock$ = "y" rem ... check to see if a stock file already exists ... if end #9 then 711 OPEN "B:STKFIL01.DAT" AS 9 print "FILE B:STKFIL01.DAT ALREADY EXISTS" input " do you want to continue? y or n? "; yes$ if yes$ = "n" then CLOSE 9: RETURN print "old file will be written to B:STKFIL01.BAK" IF RENAME("B:STKFIL01.BAK", "B:STKFIL01.DAT") = 1 THEN GOTO 711 print 713 print "UNABLE TO RENAME OLD DATA FILE TO BACKUP" input " enter name for old stock file: 5 characters "; name$ namefile$ = "B:" + UCASE$(name$) + "FIL.DAT" if rename(namefile$, "B:STKFIL01.dat") = 0 then goto 713 input "do you want to continue? y or n? "; yes$ if yes$ = "n" then return 711 CREATE "B:STKFIL01.DAT" recl 80 as 9 WHILE MORESTOCK$ = "y" nstk% = nstk% + 1 gosub 710 gosub 715 gosub 755 RETURN rem ...... create screen display ................... 710 print clear$; \ fn.down$(1); \ fn.right$(15); "STOCK PURCHASE DATA" : rem line 2 print down$; fn.right$(4); "STOCK NAME:" : rem line 4 print fn.right$(6); "EXCHANGE:" : rem line 5 print fn.right$(1); "NUMBER SHARES:" : rem line 6 print fn.right$(1); "PURCHASE DATE:" : rem line 7 print fn.right$(4); "TOTAL COST:" : rem line 8 print fn.right$(4); "COMMISSION:" : rem line 9 print fn.right$(8); "SYMBOL:" : rem line 10 print fn.right$(6); "DIVIDEND:" : rem line 11 print down$; fn.right$(2); "INSTRUCTIONS:" : rem line 13 rem ...... enter data return 715 gosub 800 gosub 810 gosub 820 gosub 830 gosub 840 gosub 850 gosub 860 gosub 870 rem ...........field corrections.................... rem ... instructions on line 13, column 16 720 print fn.line$(13); fn.clear$(16,60); fn.right$(16); \ "SELECT FIELD TO BE CORRECTED" print fn.right$(3); "0 = no changes" print fn.right$(3); "1 = stock name 5 = total purchase cost" print fn.right$(3); "2 = stock exchange 6 = commission charges" print fn.right$(3); "3 = number of shares 7 = stock symbol" print fn.right$(3); "4 = date purchased 8 = annual dividend" PRINT : rem line 19 730 print fn.right$(6);bell$; input "WHICH FIELD DO YOU WANT TO CHANGE?"; field% rem ... wait for valid field selection ... while (field% < 0) or (field% > 8) print up$; fn.clear$(6,line%); fn.right$(16); input "ENTER A FIELD BETWEEN 0 AND 8: "; field% wend rem ... make valid correction ... if field% eq 0 then goto 740 if field% ne 0 then \ print fn.line$(13); fn.clear$(16,line%) :\ for j% = 1 to 8 :\ print fn.clear$(2,line%) :\ next j% :\ on field% gosub 800, \ re-enter name 810, \ re-enter exchange 820, \ re-enter shares 830, \ re-enter purchase date 840, \ re-enter purchase cost 850, \ re-enter commission 860, \ re-enter symbol 870: \ re-enter dividend goto 720 740 rem ... 0 was entered, no changes selected ... rem ... ask for reverification ... print fn.right$(16);bell$; input "are you sure?"; y$ rem ... wait for yes or no while (y$ ne "y") and (y$ ne "n") print up$; fn.clear$(16,line%); fn.right$(16);bell$; input "enter y for yes or n for no"; y$ wend print up$; fn.clear$(16,line%) if y$ = "y" then RETURN if y$ = "n" then goto 720 750 RETURN rem ...........valid data entry, store the record....................... 755 rem key%(nstk%)=nstk% i% = nstk% GOSUB 335 print fn.line$(13); fn.clear$(16,line%) for j% = 1 to 7 : print fn.clear$(2,line%) : next j% : print fn.line$(13) : morestock$ = fn.entry$(0,44, \ "input another stock? y or n?",13,16) if morestock$ = "n" then goto 714 if fn.mod%(nstk%,10) <> 10 then goto 714 712 rem .. save every 10 records to disk file .. close 9 open "B:STKFIL01.DAT" recl 80 as 9 if end #9 then 714 while -1 read #9; dummy% wend rem .. chain program to itself to conserve memory .. drive$ = "A:" prog.name$ = "STKBASE" CHAIN DRIVE$ + PROG.NAME$ 714 rem .. continue adding stocks WEND : rem .. end of while morestock$ rem ***** end of while morestock$ = "yes" ***** close 9 rem ... alphabetize the data files just to be sure ... open "B:STKFIL01.DAT" as 9 FOR k%=1 to nstk% read #9; nshrs%(k%),namstk$(k%),symbol$(k%),xchng$(k%), \ purdate$(k%),commission(k%),totpurprice(k%), \ kode%(k%),dividend(k%) kode%(k%)=k% NEXT K% close 9 NEWFILE$ = "B:STKFIL01.BAK" OLDFILE$ = "B:STKFIL01.DAT" if not rename(NEWFILE$, OLDFILE$) then 1687 goto 1685 1687 print "unable to rename oldfile to BAK file" 1685 GOSUB 1681 N% = NSTK% GOSUB 1550 CREATE "B:STKFIL01.DAT" RECL 80 as 9 FOR J%=1 to nstk% k%=kode%(j%) PRINT #9; nshrs%(k%),namstk$(k%),symbol$(k%),xchng$(k%), \ purdate$(k%),commission(k%),totpurprice(k%),k%, \ dividend(k%) NEXT J% close 9 rem ... SET UP PRICE FILES FOR FIRST TIME ONLY ... CREATE "B:STKPRICE.DAT" RECL 30 AS 8 CREATE "B:STKPRICE.BAK" RECL 30 AS 7 GOSUB 5200 : rem ENTRY to STKUPDAT.BAS subroutine... GOSUB 34 5 : rem .. print stock price header print #7 ; nstk%, newdate$, newdate$ GOSUB 355 : rem .. print stock price file FOR I% = 1 TO NSTK% print #7; NEWprice(i%),NEWprice(i%) oldprice(i%) = newprice(i%) NEXT I% print #7; newprice(i%), newprice(i%) oldprice(i%) = newprice(i%) GOSUB 350 : rem .. print S&P 500 price CLOSE 7,8 799 return rem *_____________ end of section 1.0 _____________* rem * * rem * end of STOCK FILE CREATION SUBROUTINE * rem * * rem *----------------------------------------------* rem *********************************************** rem * SUBROUTINES * rem *********************************************** 800 temp$ = fn.entry$(9,17,\ "enter name of stock",13,16) rem ...... check name length ...... restrict to 24 characters namstk$(nstk%) = left$(temp$,24) return 810 xchng$ = fn.entry$(8,17,\ "enter exchange: NYSE, AMEX, OTC or OTHER",13,16) xchng$(nstk%) = ucase$(xchng$) return 820 nshrs$ = fn.entry$(7,17,\ "enter number of shares purchased",13,16) nshrs%(nstk%) = val(nshrs$) return 830 purdate$(nstk%) = fn.entry$(6,17,\ "enter date: month/day/year purchased",13,16) return 840 totpurprice$ = fn.entry$(5,17,\ "enter total purchase cost",13,16) totpurprice(nstk%) = val(totpurprice$) return 850 commission$ = fn.entry$(4,17,\ "enter total commission charges",13,16) commission(nstk%) = val(commission$) return 860 SYMBOL$ = FN.ENTRY$(3,17,\ "ENTER STOCK SYMBOL",13,16) SYMBOL$(NSTK%) = UCASE$(SYMBOL$) RETURN 870 dividend$ = fn.entry$(2,17,\ "enter stock dividend",13,16) dividend(nstk%) = val(dividend$) return 899 rem ... error code goes here ... rem -------- end subroutine stkcreat ---------------turn 810 xchng$ = fn.entry$(8,17,\ "enter exchange: NYSE, AMEX, OTC or OTHER",13,16) xchng$(nstk%) = ucase$(xchngrem *--------------- Section 4.0 ------------------* rem * * rem * HISTORICAL STOCK STATISTICAL SUMMARY * rem * ------------------------------------ * rem * COPYRIGHT: E. A. Valenzuela * rem * DATE: February 5, 1983 * rem * VERSION: 1.31 * rem *----------------------------------------------* rem --- requires subroutines --- rem scrnin.bas rem qksort%.bas ... for sorting integers rem qksort$.bas ... for sorting alphabetically rem stkfprnt.bas for printing rem stkprice.bas for jump vectors rem ...... check for end of file ...... 7000 if end # 9 then 7199 print clear$; fn.down$(3); fn.right$(10); \ "READING IN STOCK FILE" open "b:stkfil01.dat" recl 80 as 9 buff 8 recs 128 nstk% = 0 7050 nstk%=nstk%+1 i%=nstk% GOSUB 310 if nshrs%(i%)=0 then equiv(i%)=0 else \ equiv(i%)=totpurprice(i%)/nshrs%(i%) day%(i%) =fn.juldate%(purdate$(i%)) goto 7050 7199 REM "reached end-of-file on unit 9: # of stocks is ";i% close 9 nstk% = nstk%-1 if end # 8 then 7399 print fn.line$(6); fn.right$(10); "READING IN CURRENT PRICES" open "b:stkprice.dat" as 8 GOSUB 320 date1% = fn.juldate%(newdate$) GOSUB 330 for i%=1 to nstk% NEWvalue(i%) = float(nshrs%(i%)) * NEWprice(i%) INCVALUE(i%) = NEWvalue(i%) - totpurprice(i%) if totpurprice(i%)=0 then pcntinc(i%)=0 else \ pcntinc(i%) = INCVALUE(i%)/totpurprice(i%) * 100. if NEWprice(i%)=0 then yield(i%)=0 else \ YIELD(I%) = DIVIDEND(I%) / NEWPRICE(I%) * 100. if totpurprice(i%)=0 then anyield(i%)=0 else \ anyield(i%) = NEWvalue(i%) / totpurprice(i%) next i% print fn.line$(8); fn.right$(10); "CALCULATING ANNUAL YIELD" for i%=1 to nstk% date0% = day%(i%) years = float(date1% - date0%)*0.00274 rem ... 0.00274 is 1/365 ... anyield(i%) = ((anyield(i%))^(1./years) - 1.)*100. anyield(i%) = anyield(i%) + yield(i%) rem ... revise for extremes ... if anyield(i%) > 999 then anyield(i%) = 999. if anyield(i%) < -99 then anyield(i%) = -99. next i% goto 7400 7399 print "end-of-file on unit 8 reached" 7400 close 8 7600 print clear$; fn.down$(1); fn.right$(5); \ "HISTORICAL PERFORMANCE SUMMARY OPTION LIST" print fn.down$(2); fn.right$(10); "SORTING OPTIONS:"; down$ print tab(5);"0 = return to main menu" print tab(5);"1 = on date purchased" print tab(5);"2 = by number of shares" print tab(5);"3 = by stock exchange" print tab(5);"4 = by purchase cost" print tab(5);"5 = by current value" print tab(5);"6 = by percentage increase in value" print tab(5);"7 = by annual yield" print tab(5);"8 = by $ increase in value" print tab(5);"9 = alphabetical by stock name" print tab(4);"10 = by dividend yield" print down$; fn.right$(10); bell$; input "enter option number for sort:"; option% if option%=0 then goto 900 on option% goto 7610,7620,7630,7640,7650,7660,7670,7680,7690,7695 7610 sort$ = "date of purchase" for j%=1 to nstk% X%( j%) = day%(j%) next j% goto 7700 7620 sort$ = "number of shares" for j% = 1 to nstk% X%(j%) = nshrs%(j%) next j% goto 7700 7630 sort$ = "stock exchange" EXCH$ = "NYSE" kount% = 0 i% = 1 7631 kount% = kount% + 1 for j%=1 to nstk% if( xchng$(j%) = EXCH$ ) then kode%(i%) = j% : i%=i%+1 next j% if( kount% = 1 ) then EXCH$ = "AMEX" : goto 7631 if( kount% = 2 ) then EXCH$ = "OTC" : GOTO 7631 if( kount% = 3 ) then EXCH$ = "OTHER": goto 7631 n%=nstk% sortcheck$="yes" goto 7710 7640 sort$ = "total purchase price" for j%=1 to nstk% X%(j%) = int%( totpurprice(j%) ) next j% goto 7700 7650 sort$ = "current value" for j%=1 to nstk% X%(j%) = int%( NEWvalue(j%) ) next j% goto 7700 7660 sort$ = "percentage increase in value" for j%=1 to nstk% X%(j%) = int%( pcntinc(j%)*10. ) next j% goto 7700 7670 sort$ = "annual yield (including dividends)" for j%=1 to nstk% X%(j%) = int%( anyield(j%)*10. ) next j% goto 7700 7680 sort$ = "dollar increase in value" for j%=1 to nstk% X%(j%) = int%( incvalue(j%)*10. ) next j% goto 7700 7690 SORT$ = "ALPHABETICAL BY NAME" sortcheck$ = "no" GOTO 7710 7695 sort$ = "annual dividend yield" for j%=1 to nstk% X%(j%) = int%( yield(j%)*10. ) next j% goto 7700 rem ..... sort the percentage increases ..... 7700 sortcheck$ = "yes" N% = NSTK% FOR J%=1 TO N% KODE%(J%)=J% NEXT J% gosub 1500 goto 7710 7705 gosub 1550 7710 rem ...... print out statistical summary by calling print subroutine ... title$ = "OPTION 4 - HISTORICAL SUMMARY OF STOCK PORTFOLIO" TITLE2$ = "SORTED BY " + SORT$ gosub 6600 gosub 6620 goto 7600 7499 return rem ----------------end of statistical summary-------------------------- rem SUBROUTINErem *------------- Section 1.9 --------------------* rem * * rem * CREATE TRANSACTION FILE FOR FIRST TIME * rem * -------------------------------------- * rem * WRITTEN: February 25, 1983 * rem * BY: Edward A. Valenzuela * rem * VERSION: 1.35 * rem *----------------------------------------------* rem ----- requires following subroutines ----- rem rem ... scrnin.bas rem ... stkcreat.bas 3700 rem print clear$; \ fn.down$(2); \ fn.right$(10); "STOCK TRANSACTION FILE" print down$ print fn.right$(4); "0 = return to main menu" print fn.right$(4); "1 = ADD to transaction file" print fn.right$(4); "2 = ORIGINAL CREATION OF FILE" print down$; fn.right$(4); "INSTRUCTIONS: enter menu selection" print fn.right$(4); bell$; input " and hit return"; field% if field% = 0 then goto 900 on field% gosub 3811,3711 RETURN 3711 rem ...... original creation ...... ntrans% = 1 moretrans$ = "y" create "B:TRANSACT.DAT" recl 80 as 1 gosub 3705 RETURN REM * ----------- SUBROUTINES ---------- * 3811 rem ..... add to transaction file ...... ntrans% = 1 moretrans$ = "y" OPEN "B:TRANSACT.DAT" RECL 80 AS 1 rem ... read to EOF ... if end #1 then 3813 while moretrans$ = "y" read #1; nshrs%,namstk$,price,xchng$,purdate$,commission, \ totpurprice,symbol$ ntrans%=ntrans% + 1 wend nstk% = 1 3813 gosub 3705 RETURN 3705 while moretrans$ = "y" gosub 3710 gosub 3715 gosub 3755 RETURN rem ...... create screen display ................... 3710 print clear$; \ fn.down$(1); \ fn.right$(15); "STOCK PURCHASE DATA" print down$; fn.right$(5); "STOCK NAME:" print fn.right$(3); "BOUGHT/SOLD?:" print fn.right$(2); "NUMBER SHARES:" print fn.right$(5); "TRADE DATE:" print fn.right$(5); "TOTAL COST:" print fn.right$(5); "COMMISSION:" print fn.right$(9);  "SYMBOL:" print fn.right$(1); "BUY/SELL PRICE:" print down$; fn.right$(2); "INSTRUCTIONS:" rem ...... enter data RETURN 3715 gosub 8800 rem .. name stock gosub 8811 rem .. bought/sold gosub 8820 rem .. number shares gosub 8830 rem .. purchase date gosub 8840 rem .. total cost gosub 8850 rem .. commission gosub 8860 rem .. symbol gosub 8813 rem .. purchase price rem ...........field corrections.................... rem ... instructions on line 13, column 16 3720 print fn.line$(13); fn.clear$(16,line%); fn.right$(16); \ "SELECT FIELD TO BE CORRECTED" print fn.right$(2); "0 = no changes" print fn.right$(2); "1 = stock name ";"5 = total purchase cost" print fn.right$(2); "2 = bought/sold ";"6 = commission charges" print fn.right$(2); "3 = number of shares ";"7 = stock symbol" print fn.right$(2); "4 = date purchased/sold ";"8 = price per share"   print 3730 print fn.right$(6);bell$; input "WHICH FIELD DO YOU WANT TO CHANGE?"; field% rem ... wait for valid field selection ... while (field% < 0) or (field% > 8) print up$; fn.clear$(6,line%); fn.right$(16); input "ENTER A FIELD BETWEEN 0 AND 8: "; field% wend rem ... make valid correction ... if field% eq 0 then goto 3740 if field% ne 0 then \ print fn.line$(13); \ fn.clear$(16,line%) :\ for j% = 1 to 9 :\ print fn.clear$(2,line%) :\ next j% :\ print fn.clear$(2,line%) :\ on field% gosub 8800, \ re-enter name 8811, \ re-enter bought/sold 8820, \ re-enter shares 8830, \ re-enter date 8840, \ re-enter purchase cost 8850, \ re-enter commission 8860, \ RE-ENTER SYMBOL 8813: \ re-enter purchase price goto 3720 3740 rem ... 0 was entered, no changes selected ... rem ... ask for reverification ... print fn.right$(16);bell$; input "are you sure?"; y$ rem ... wait for yes or no while (y$ ne "y") and (y$ ne "n") print up$; fn.clear$(16,line%); fn.right$(16);bell$; input "enter y for yes or n for no"; y$ wend if y$ = "y" then goto 3750 if y$ = "n" then \ print up$; fn.clear$(2,line%): \ print fn.clear$(2,line%) goto 3730 3750 RETURN rem ...........valid data entry, store the record....................... 3755 rem k% = nstk% print #1; nshrs%(k%),namstk$(k%),NEWprice(k%),xchng$(k%),purdate$(k%), \ COMMISSION(K%),totpurprice(k%),symbol$(k%) print fn.line$(13); \ fn.clear$(16,line%) for j% = 1 to 8 : print fn.clear$(2,line%) : next j% : moretrans$ = fn.entry$(0,44, \ "input another purchase/sell? y or n?",13,16) wend rem ***** end of while moretrans$ = "yes" *****  close 1 3799 RETURN rem *********************************************** rem * SUBROUTINES * rem *********************************************** 8811 xchng$ = fn.entry$(8,17,\ "enter B for BUY, S for SELL, SPL for SPLIT",13,16) xchng$(nstk%) = ucase$(xchng$) if xchng$(nstk%) = "B" then sale$="bought" if xchng$(nstk%) = "S" then sale$="sold" return 8813 price$ = fn.entry$(2,17, \ "enter price per share " + sale$,13,16) NEWprice(nstk%) = val(price$) return 8800 temp$ = fn.entry$(9,17,\ "enter name of stock",13,16) rem ...... check name length ...... restrict to 24 characters namstk$(nstk%) = left$(temp$,24) return 8820 nshrs$ = fn.entry$(7,17,\ "enter number of shares " + sale$,13,16) nshrs%(nstk%) = val(nshrs$) return 8830 purdate$(nstk%) = fn.entry$(6,17,\ "enter date: month/day/year " + sale$,13,16) return 8840 totpurprice$ = fn.entry$(5,17,\ "enter total value of trade",13,16) totpurprice(nstk%) = val(totpurprice$) return 8850 commission$ = fn.entry$(4,17,\ "enter total commission charges",13,16) commission(nstk%) = val(commission$) return 8860 SYMBOL$ = FN.ENTRY$(3,17,\ "ENTER STOCK SYMBOL",13,16) SYMBOL$(NSTK%) = UCASE$(SYMBOL$) RETURN rem *-------- end subroutine stktrans -------------*EWprice(nstk%) = val(price$) return 8800 temp$ = fn.entry$(9,17,\ "enter name of stock",13,16) rem ...... check name length ...... restrict to 24 characters namstk$(nstk%) = left$(temp$,24) return 8820 nshrs$ = fn.entry$(7,17,\ "enter number of shares " + sale$,13,16) nshrs%(nstk%) = val(nshrs$) return 8830 purdate$(nstk%) = fn.entry$(6,17,\ "enter date: month/day/year " + sale$,13,16) return 8840 totpurprice$ = fn.entry$(5,17,\ "enterrem *_________________ section 5.0 ________________* rem * STOCK PRICE UPDATE ROUTINE * rem * -------------------------- * rem * UPDATED: February 5, 1983 * rem * BY: Edward A. Valenzuela * rem * REVISION: 1.31 * rem *----------------------------------------------* rem ----- requires subroutines ----- rem stkfprnt.bas ... for print initialization rem stkhist.bas to store prices rem stkprice.bas for jump vectors rem qksort%.bas to sort integers rem scrnin.bas ... for screen handling 5000 rem ... open files at beginning of section ... CREATE "b:stkprice.$$$" RECL 30 as 1 if end #8 then 5010 5040 OPEN "b:stkprice.dat" RECL 30 as 8 if end #3 then 5020 5050 OPEN "b:stkprice.bak" RECL 30 as 3 if end #9 then 5030 5060 OPEN "b:stkfil01.dat" recl 80 as 9 IF END #8 THEN 5011 rem ...... read in number of stocks ...... GOSUB 320 : rem .. read header GOSUB 330 : rem .. read price file GOSUB 325 : rem .. read S&P 500 price GOSUB 315 : rem .. read stock data file for i%=1 to nstk% oldprice(i%) = newprice(i%) next i% oldprice(i%) = newprice(i%) GOSUB 5200 : rem ...update each stock price GOSUB 5410 : rem ...write out new file RETURN rem ***************** SUBROUTINES ****************** 5200 rem ... update the current price of each stock ... print clear$; fn.line$(4) print " Enter date of current stock prices: mo/dy/yr" input newdate$ nbegin%=1 sum1 =0 sum2 =0 sum3 =0 print clear$ GOSUB 5250 rem ... if TEMPRICE.DAT file exists, continue, else begin... if end #4 then 5210 OPEN "B:TEMPRICE.DAT" RECL 30 as 4 if end #4 then 5212 read #4; ntemp%, newdate$, olddate$ for i%=1 to nbegin%-1 read #4; NEWprice(i%),OLDprice(i%) next i% 5212 CLOSE 4 5210 for i%=nbegin% to nstk% print fn.line$(14) for j%=1 to 4 print fn.clear$(2,line%)  next j% print fn.line$(16); \ "INSTRUCTIONS: ENTER stock price for "; namstk$(i%); BELL$ input NEWprice(i%) GOSUB 5250 : rem ...print heading GOSUB 5255 : rem ...print record rem ...to exit at any time, enter 0 for price ... rem ... the prices entered will be saved ... rem ... in the temporary price file ... if NEWprice(i%) = 0 then nstk%=i%-1: goto 5400 next i% FOR I%=1 to nstk% oldval = nshrs%(i%)*OLDprice(i%) sum2 = sum2 + oldval newval = nshrs%(i%)*NEWprice(i%) sum3 = sum3 + newval NEWvalue(i%) = newval incvalue(i%) = newval - oldval sum1 = sum1 + incvalue(i%) rem ... check for no oldvalue ... if oldval = 0 then pcntinc(i%) = 0 else \ pcntinc(i%) = ( incvalue(i%)/oldval * 100. ) NEXT I% if sum2 = 0 then sum9 = 0 else sum9 = sum1/sum2 * 100. if end #8 then 5213 read #8; OLDprice(i%),dummyprice 5213 namstk$(i%)="S&P 500" print fn.line$(15); fn.clear$(2,line%) : \  print fn.clear$(2,line%) : \ print fn.clear$(2,line%) print fn.line$(16); \ "INSTRUCTIONS: ENTER stock price for "; namstk$(i%); BELL$ input NEWprice(i%) incvalue(i%) = NEWprice(i%) - OLDprice(i%) if OLDprice(i%) = 0 then pcntinc(i%) = 0 else \ pcntinc(i%)=( incvalue(i%)/OLDprice(i%) * 100. ) rem ... ASK IF ANY MISTAKES ... PRINT print "You now have a chance to correct input errors" 5308 input "any price changes ? (y/n)?"; yes$ if yes$ = "n" or yes$ = "N" then goto 5310 input "enter number of stock for price change"; num% previous.value = nshrs%(num%)*newprice(num%) print "price for "; namstk$(num%); " is "; newprice(num%) input "enter correct price "; newprice(num%) oldval = nshrs%(num%)*oldprice(num%) newval = nshrs%(num%)*NEWprice(num%) sum3 = sum3 + newval - previous.value NEWvalue(num%) = newval incvalue(num%) = newval - oldval sum1 = sum1 + incvalue(num%) - (previous.value-oldval) rem ... check for no oldvalue ... if oldval = 0 then pcntinc(num%) = 0 else \ pcntinc(num%) = ( incvalue(num%)/oldval * 100. ) if sum2 = 0 then sum9 = 0 else sum9 = sum1/sum2 * 100. GOTO 5308 5310 rem ----- sort the percentage increases ----- N%=NSTK% FOR J%=1 TO N% X%(J%) = INT%(PCNTINC(J%)*10.) KODE%(J%)=J% NEXT J% GOSUB 1500 : rem ENTRY to qksort SUBROUTINE... 5315 rem ...... print the performance summary for the week ...... print clear$; tab(10); "DO YOU WANT TO PRINT TO :" print tab(14); " CONSOLE = 1 " print tab(14); " PRINTER = 2 " print tab(14); " BOTH = 3 " print fn.line$(10); bell$ input "INSTRUCTIONS: enter selection and hit return"; selection% if SELECTION% < 2 then goto 5316 title$ = "OPTION 5 - PRICES UPDATED FOR THE CURRENT WEEK - NEW VALUATION" TITLE2$ = "sorted by: percent increase for week" gosub 6600 : rem ENTRY to STKFPRNT.BAS SUBROUTINE... gosub 5350 CONSOLE 5316 if selection% = 2 then RETURN else GOSUB 5317 RETURN 5250 rem ... home cursor, print header ... print home$ for j%=1 to 4 print fn.clear$(2,line%) next j% print fn.line$(16); fn.clear$(37,line%) print fn.clear$(2,line%) print home$ print tab(6); " ***** STOCK PRICE UPDATE *****" print " price" print "number STOCK NAME OLD PRICE NEW PRICE change" print "---------------------------------------- ------" print RETURN 5255 rem ... display next record ... if i% < 6 then print fn.line$( 4 + fn.mod%(i%,5) ) else \ print fn.line$(24) : print fn.line$(9) pq = newprice(i%) - oldprice(i%) print using \ " ### / stock name / ##.### ##.### ###.###" ; \ i%,namstk$(i%),oldprice(i%),newprice(i%),pq RETURN 5350 rem ----- SUBROUTINE PRINT ----- for2$=" ## /................../ ##### ####.# ###.### ###.### ##.### #### #####.##" print " $ % current previous price number current" print " stock name increase increase price price increase of shares value" print for i%=1 to nstk% j%=kode%(i%) pq = NEWprice(j%) - OLDprice(j%) print using for2$;i%,namstk$(j%),incvalue(j%),pcntinc(j%),NEWprice(j%),\ OLDprice(j%),pq,nshrs%(j%),NEWvalue(j%) if fn.mod%(i%,5) eq 5 then print next i% print print using for2$;i%,namstk$(i%),incvalue(i%),pcntinc(i%),NEWprice(i%),OLDprice(i%) for3$=" TOTALS : ######.## ###.# ######.##" print print using for3$; sum1,sum9,sum3 RETURN 5317 rem ..... subroutine DISPLAY ..... print clear$; print tab(4); " ***** STOCK PRICE CHANGE ANALYSIS *****" print for5$ ="## /........../ ###.### ###.## ###.## ####.#" print " # STOCK NAME CURRENT PRICE % $" print " PRICE change inc inc" print "-------------------------------------------------" print for k%=1 to nstk% step 10 print fn.line$(7); fn.clear$(2,line%); : for i%=1 to 11 : print fn.clear$(2,line%) : next i% : print fn.line$(6) end% = k% + 9 if nstk% < end% then end% = nstk% for i%=k% to end% j%=kode%(i%) pq = NEWprice(j%) - OLDprice(j%) print using for5$;i%,namstk$(j%),NEWPRICE(j%),pq,pcntinc(j%), \ incvalue(j%) if fn.mod%(i%,5) eq 5 then print next i% for l%=1 to 2000: next l%: rem ... DELAY ... next k% pq = newprice(i%) - oldprice(i%) print print using for5$;i%,namstk$(i%),newprice(i%),pq,pcntinc(i%), \ incvalue(i%) print for6$ =" PORTFOLIO : ###.## #####.##" print using for6$; sum9,sum1 for l%=1 to 2000: next l%: rem ... DELAY ... RETURN 5400 rem ----- write out the new prices, update the price file ----- rem ...... write new records into temporary file ...... CREATE "B:TEMPRICE.DAT" RECL 30 as 4 print # 4 ; nstk%,newdate$,olddate$ for i%=1 to nstk% print #4; NEWprice(i%),OLDprice(i%) next i% CLOSE 4 5402 rem ...... close all open files ...... CLOSE 1,3,8,9 RETURN 5410 rem ----- SUBROUTINE WRITE TO FILE ----- print # 1 ; nstk%,newdate$,olddate$ for i%=1 to nstk% print #1; NEWprice(i%),OLDprice(i%) next i% print #1; NEWprice(i%),OLDprice(i%) : rem S&P 500 rem ...... close all open files except 3 ...... CLOSE 1,8,9 rem ......delete the backup file ......automatically closes 3 ..... DELETE 3 \ delete the old backup file rem ...... move the old data file into the backup spot if rename("B:stkprice.bak", "B:stkprice.dat") = 0 then goto 5490 rem ...... move the temporary file into the new data file if rename("B:stkprice.dat", "B:stkprice.$$$") = 0 then goto 5492 REM ... NORMAL EXIT FROM SUBROUTINE ... REM ... GO TO THE HISTORICAL FILE UPDATE ROUTINE ... print print tab(10);"UPDATING HISTORICAL PRICE FILE" GOSUB 5500 : rem ... ENTRY to STKHIST.BAS subroutine ... 5480 RETURN 5490 print "unable to rename old data file to backup" go to 5480 5492 print "unable to rename temporary file to new data file" go to 5480 5999 RETURN 5010 print "FILE B: STKPRICE.DAT NOT FOUND" print "check diskette loaded in drive B" print "does a stock price file exist?" input "do you want to continue the routine? y or n?"; y$ if y$ = "y" then close 8: initialize: goto 5040 RETURN 5011 print print "reached END-OF-FILE on B:STKPRICE.DAT" print " not enough stock prices in data file " input "to continue, enter yes"; y$ goto 5402 5020 print "FILE B: STKPRICE.BAK NOT FOUND" print "does a backup of the stock price file exist?" input "do you want to continue the routine? y or n?"; y$ if y$ = "y" then goto 5050 RETURN 5030 print "FILE B:STKFIL01.DAT NOT FOUND" print "check diskette loaded in drive B" print "or perhaps you have not run the CREATE STOCK FILE yet!" input "do you want to continue the routine? y or n?"; y$ if y$ = "y" then goto 5060 RETURN rem *------------ end of weekly update ------------*nt "check diskette loaded in drive B" print "does a stock price file exist?" input "do you want to continue the routine? y or n?"; y$ if y$ = "y" then close 8: initialize: goto 5040 RETURN 5011 print print "reached END-OF-FILE on B:STKPRICE.DAT" print " not enough stock prices in data file " input "to continue, enter yes"; y$ goto 5402 5020 print "FILE B: STKPRICE.BAK NOT FOUND" print "does a backup of the stock price file exist?" input "do you want to continue the routine? y or n?"; y$ if y$ = "y" then goto 5050 RETURN 5030 print "FILE B:STKFIL01.DAT NOT FOUND" print "check diskette loaded in drive B" print "or perhaps you have not run the CREATE STOCK FILE yet!" inpu110 REM ALL REM STATEMENTS CAN BE CHANGED TO ALLOW USE OF TWO TERMINALS 120 REM SEE ARTICLE IN PERSONAL COMPUTING MAY/JUNE 77 130 Q=27:V$="###.#":W$="$$#####,":U$="###" 140 DIM D(18),E$(Q),V(Q),F(Q) 150 PRINT TAB(19)"RECURSIVE BUDGETING MODEL":PRINT:PRINT TAB(28)"* * *" 160 DATA SALARY/WAGES,OTHER INCOME,FED INC TAX,STATE & LOCAL TAX 170 DATA SOCIAL SECURITY,UNEMPLOYMENT INS,HEALTH INS 180 DATA LIFE INS,CONTRIBUTIONS,OTHER DEDUCTIONS 190 DATA RENT/MORTGAGE,LIFE INS,HEALTH INS,HOUSE INS 200 DATA AUTO INS,CAR PAYMENTS,LOAN PAYMENTS,TRASH REMOVAL 210 DATA OTHER FIXED EXP 220 DATA FOOD/BEVERAGES,CLOTHING,DRY CLEANING,BARBER/BEAUTY 230 DATA HOME MAINT,HOME HEAT'G FUEL,WATER,ELECTRICITY, TELEPHONE 240 DATA GAS/OIL,AUTO MAINT,FARES/TOLLS/PARKING,DENTIST 250 DATA PHYSICIAN,DRUGS/SUNDRIES,SCHOOL EXPENSE,FAMILY ALLOWANCE 260 DATA CLUBS/LODGES,THEATER/SPORTS,RESTAURANTS 270 DATA OTHER ENT'MENT,MAG'S/BOOKS/PAPERS,SITTERS,CHILD CARE 280 DATA VACATION SAVING,OTHER SAVINGS,CONTRIBUTIONS,OTHER EXPENSES 290 PRINT:PRINT"SELECT YOUR BUDGETING PERIOD BY NUMBER. LATER ON IT WILL" 300 PRINT"BE EXTENDED TO ONE YEAR.":PRINT 310 PRINT TAB(3)"1-WEEKLY"TAB(15)"2-BIWEEKLY"TAB(30)"3-SEMIMONTHLY"; 320 PRINT TAB(45)"4-MONTHLY":PRINT 330 INPUT P:IF P>4 THEN PRINT"TRY AGAIN":GOTO 290 340 IF P=1 THEN P=52ELSE IF P=2 THEN P=26ELSE IF P=3 THEN P=24ELSE IF P=4 THEN P=12 350 PRINT:PRINT"ALRIGHT,FIRST LET'S LOOK AT INCOME FOR THE PERIOD.":PRINT 360 READ A$:PRINT A$;" $";:INPUT D(0):READ A$:PRINT A$;" $";:INPUT D(1) 370 TI=D(0)+D(1):PRINT 380 PRINT:PRINT"OK,NOW LET'S LOOK AT PAYCHECK DEDUCTIONS.":PRINT 390 FOR J=2 TO 9:READ A$:PRINT A$;:INPUT" $";D(J):TD=TD+D(J):NEXT J:PRINT 400 PRINT"OK,NOW LET'S LOOK AT FIXED EXPENSES.":PRINT 410 FOR J=10 TO 18:READ A$:PRINT A$;:INPUT" $";D(J):TF=TF+D(J):NEXT J 420 DF=TD+TF:SI=TI-DF:S=64 430 PRINT:PRINT"OK,AT THIS TIME OUR TABLE LOOKS LIKE THIS:":PRINT 440 REM 450 GOSUB 1900:PRINT:PRINT TAB(19); 460 PRINT"RECURSIVE BUDGETING MODEL":PRINT:PRINT TAB(27)"* * *":PRINT 470 GOSUB 1900 480 PRINT:PRINT TAB(20)"SPENDABLE INCOME SUMMARY":PRINT 490 GOSUB 1890:PRINT TAB(3)"ACCOUNT"TAB(42)"PERIOD"TAB(57)"ANNUAL" 500 GOSUB 1890:PRINT"TOTAL INCOME" TAB(40);:PRINT USING W$;TI;:PRINT TAB(55) 510 PRINT USING W$;TI*P:PRINT:PRINT TAB(3)"PAYCHECK DEDUCTIONS"TAB(25); 520 PRINT USING W$;TD*(-1):PRINT 530 PRINT TAB(3)"FIXED EXPENSES"TAB(25);:PRINT USING W$;TF*(-1); 540 PRINT TAB(40);:PRINT USING W$;DF*(-1);:PRINT TAB(55); 550 PRINT USING W$;DF*(-1)*P 560 PRINT TAB(41)"-------"TAB(55)"--------":PRINT"SPENDABLE INCOME"; 570 PRINT TAB(40);:PRINT USING W$;SI;:PRINT TAB(55);:PRINT USING W$;SI*P 580 PRINT TAB(41)"======="TAB(55)"========":PRINT: 590 GOSUB 1900:PRINT: PRINT 600 REM 610 GOSUB 1910:RO=0 620 PRINT:PRINT "OK,NOW FOR THE FIRST ROUND OF VARIABLE EXPENSE. DON'T" 630 PRINT"PINCH YOURSELF IN YOUR ESTIMATES (WITHIN REASON). LET THE" 640 PRINT"COMPUTER HELP YOU REFINE YOUR BUDGET LATER ON.":PRINT 650 FOR J=0 TO Q:READ E$(J) :PRINT E$(J);:INPUT" $";V(J):VT=VT+V(J):NEXT J 660 RESTORE:PRINT:PRINT 670 PRINT"YOUR BUDGET FOR THE FIRST ROUND TOTALLED $"VT". THIS" 680 PRINT"COMPARES TO SPENDABLE INCOME OF $"SI". WE HAVE" 690 PRINT"PRORATED THE DIFFERENCE, $"SI-VT",OVER ALL VARIABLE EXPENSE" 700 PRINT"ACCOUNTS.":PRINT 710 GOSUB 1910:FOR J=0 TO Q:V(J)=INT(V(J)/VT*SI):NEXT J:VT=SI:PRINT 720 PRINT"NOW WE BEGIN THE BUDGET REFINEMENT PHASE. MAKE AS MANY" 730 PRINT"PASSES AS YOU LIKE. AS YOU REVIEW EACH ACCOUNT,DECIDE" 740 PRINT"WHETHER TO FREEZE IT OR TO LEAVE IT FOR ANOTHER PASS.":PRINT 750 PRINT"HINT: DON'T BE IN A HURRY TO FREEZE AN ACCOUNT.":PRINT 760 PRINT"YOUR TASK IS FINISHED WHEN ALL ACCOUNTS ARE FROZEN.":PRINT 770 GOSUB 1910 780 FOR J=0 TO Q:PRINT:IF V(J)=0 THEN 980 790 PRINT E$(J);" $";V(J):INPUT"CHANGE ('Y' OR 'N')";A$ 800 IF A$="N"THEN 840ELSE IF A$="Y"THEN 820ELSE IF A$<>"Y"THEN 790 810 GOTO 790 820 INPUT"REVISED AMOUNT $";A:IF A=101 THEN GOTO 200 140 IF D <801 THEN C=8.43+(D*.02696): GOTO 180 145 IF D < 2501 THEN C=16.85+(N*.0315)+(D*.01685):GOTO 180 150 IF D< 5001 THEN C=29.21 +(N*.0315)+ (D*.01236):GOTO 170 155 IF D < 20001 THEN C=31.46 +(N*.0315) + (D*.01236): GOTO 175 160 IF D>=20001 THEN C=92 161 GOTO 180 170 IF C>87 THEN X=87 ELSE X=C 171 GOTO 300 175 IF C>92 THEN X=92 ELSE X=C 176 GOTO 300 180 X=C:GOTO 300 200 IF D <801 THEN C=8.43+(N*.0785)+(D*.02696): IF C>D*.1 THEN C=D*.1:GOTO 270 205 IF D < 2501 THEN C=18.95+(N*.0893)+(D*.01685): GOTO 270 210 IF D< 5001 THEN C=31.31 +(N*.0893)+ (D*.01236):GOTO 270 215 IF D < 20001 THEN C=33.56 +(N*.0945) + (D*.01236):GOTO 270 220 IF D< 30001 THEN C=114.45 +(N*.0945) + (D*.00843): GOTO 270 225 IF D < 300001! THEN C= 199.84 +(N*.0945) +(D*.00562): GOTO 270 230 IF D>= 300001! THEN C= 1209.86 + (N*.0945) +(D*.00225) 270 IF D<=5000 THEN X=N*.87 ELSE X=N*.92 300 IF D>300 THEN M=30 ELSE M=0 310 PRINT "****** MERRILL LYNCH ******" 320 IF CX THEN C=X 335 PRINT "COMMISSION = $";:PRINT USING "######.##";CDBL(C) 340 PRINT "AMOUNT = $";:PRINT USING "######.##";CDBL(D) 350 IF Q$="S" THEN T = D - C ELSE T=D + C 360 NETP=T/N 370 PRINT "NET AMOUNT = $";:PRINT USING "######.##";CDBL(T) 380 PRINT "NET PRICE PER SHARE = $";NETP 390 PRINT "COMMISSION PER SHARE = $";:PRINT USING "######.###";C/N 395 ML=C 400 REM SCHWAB COMMISSION 440 IF D <3001 THEN C=18+(D*.012): GOTO 470 450 IF D < 7001 THEN C=36+(D*.006): GOTO 470 460 IF D>= 7001 THEN C= 57 + (D*.003) 470 IF N<=600 THEN M=N*.08 ELSE M=48 + (N-600)*.04 480 IF N>=100 THEN X=N*.45 ELSE X=C 485 PRINT "****** SCHWAB ******": 490 IF CX THEN C=X 500 PRINT "COMMISSION = $";: PRINT USING "######.##";CDBL(C) 505 PRINT "AMOUNT = $";:PRINT USING "######.##";CDBL(D) 510 IF D>56000! THEN PRINT "AMOUNT OVER $56,000. CALL SCHWAB FOR QUOTE.":GOTO 5 520 IF Q$="S" THEN T=D-C ELSE T=D+C 525 NETP=T/N 530 PRINT "NET AMOUNT = $";:PRINT USING "######.##";CDBL(T) 535 PRINT "NET PRICE PER SHARE = $";NETP 538 PRINT "COMMISSION PER SHARE = $";:PRINT USING "######.###";C/N 539 IF ML>C THEN DIF=ML-C ELSE DIF=C-ML 540 PRINT "***********": PRINT "DIFFERENCE = $";DIF;,"PER SHARE = $";DIF/N 545 PRINT "***********" 547 IF ML>C THEN PRINT "SCHWAB WINS" ELSE PRINT "MERRILL LYNCH WINS" 548 IF ML>C THEN W=100*DIF/C:PRINT "MERRILL LYNCH COMMISSION IS GREATER BY";W;"PER CENT" ELSE W=100*DIF/ML: PRINT "SCHWAB COMMISSION IS GREATER BY";W;"PER CENT" 549 PRINT "***********" 550 GOTO 5 600 END  CENT" ELSE W=100*DIF/ML0 THEN M=N*.08 ELSE M=48 + (N-600)*.04 480 IF N>=100 THEN X=N*.45 ELSE X=C 485 PRINT "****** SCHWAB ******": 490 IF CN1 THEN 1590 1560 IF N2/N1>J1/N THEN 1590 1570 B0=B0+R 1580 N2=N2+1 1590 B2=B0*(1+I/N) 1600 I1=B2-B0 1610 I3=I3+I1 1620 I2=I2+I1 1630 IF P2/P1>J1/N THEN 1670 1640 I2=FNR(I2) 1650 B2=FNR(B2) 1660 P2=P2+1 1670 IF J0=Y THEN 1820 1770 NEXT J1 1780 IF J0N1 THEN 1590 1560 IF N2/N1>J1/N THEN 1590 1570 B0=B0+R 1580 N2=N2+1 1590 B2=B0*(1+I/N) 1600 I1=B2-B0 1610 I3=I3+I1 1620 I2=I2+I1 1630 IF P2/P1>J1/N THEN 1670 1640 I2=FNR(I2) 1650 B2=FNR(B2) 1660 P2=P2+1 1670 IF J0 TO EXIT PGM OR < P > TO PRINT ";: 251 INPUT A$:A$=LEFT$(A$,1) 252 IF A$="/" OR A$="\" THEN 280 ELSE IF A$="" THEN 260 ELSE IF A$="P" OR A$="p" THEN 30030 253 A=ASC(A$):IF A>=97 THEN A=A-(65+31) ELSE A=A-64 254 IF A<1 OR A>11 THEN 260 ELSE GOTO 270 260 GOTO 27 270 ON A GOTO 1000,2000,3000,4000,5000,6000,7000,8000,9000,10000,11000 275 GOTO 260 280 PRINT CHR$(26):PRINT"EXIT to System? (Y)es or ANY other key to CONTINUE "; 281 INPUT A$:IF LEFT$(A$,1)="Y" OR LEFT$(A$,1)="y" THEN GOTO 62000 ELSE GOTO 260 283 GOTO 260 290 END 1000 GOTO 16 2000 IF D1$=" DISCRETE " THEN D1$=" CONTINUOUS":R1$=" INPUT":COMP$=R1$:GOTO 27 2010 IF D1$=" CONTINUOUS" THEN D1$=" DISCRETE ":R1$="DEFAULT":COMP$=R1$:GOTO 27 3000 IF D2$="BEGIN" THEN D2$="END ":R1$="DEFAULT":PAYM$=R1$:GOTO 27 3010 IF D2$="END " THEN D2$="BEGIN":R1$=" INPUT":PAYM$=R1$:GOTO 27 3020 GOTO 250 4000 PRINT TAB(5)" OPTION D: INPUT PMT FREQUENCY OR FOR DEFAULT PF=1 ";:INPUT;D$ 4010 IF D$="" THEN PF=1 ELSE PF=VAL(D$) 4020 IF PF=1 THEN R1$="DEFAULT" ELSE R1$=" INPUT" 4022 PF$=R1$ 4025 GOTO 27 5000 PRINT TAB(5)" OPTION E: INPUT COMPOUNDING FREQ OR FOR DEFAULT CF=1 ";:INPUT ;D$ 5010 IF D$="" THEN CF=1 ELSE CF=VAL(D$) 5020 IF CF=1 THEN R1$="DEFAULT" ELSE R1$=" INPUT" 5022 CF$=R1$ 5025 GOTO 27 6000 PRINT TAB(5)" OPTION F: INPUT VALUE FOR N OR 'C' TO CALC N OR TO EXIT";:INPUT;D$ 6015 IF LEFT$(D$,1)="/" OR LEFT$(D$,1)="\" THEN 6028 6020 IF LEFT$(D$,1)="C" OR LEFT$(D$,1)="c" THEN 6200 6025 N$="INPUT" 6027 N=VAL(D$) 6028 N=INT((C1*N)+.5)/C1 6040 GOTO 27 6200 N$="CALC ":GOSUB 20000 6300 N=LOG((C-FV)/(C+PV))/LOG(1+IE) 6400 N1=INT((C1*N)+.5)/C1 6500 GOTO 27 7000 PRINT TAB(5)" OPTION G: INPUT VAL FOR I% OR 'C' TO CALC I% OR TO EXIT";:INPUT;D$ 7015 IF LEFT$(D$,1)="/" OR LEFT$(D$,1)="\" THEN 7028 7020 IF LEFT$(D$,1)="C" OR LEFT$(D$,1)="c" THEN 7300 7025 I$="INPUT" 7027 I=VAL(D$) 7028 I=INT((C1*I)+.5)/C1:J=I/100 7040 GOTO 27 7300 I$="CALC ":IF PMT=0 THEN J=ABS(FV/PV)^(1/N)-1:I0=J:GOTO 7650 7400 IF PMT*FV>=0 AND PV*PMT<0 THEN I0=ABS((N*PMT+PV+FV)/(N*PV)):GOTO 7500 7410 IF PMT*FV<0 AND PV<>0 THEN I0=ABS((FV-N*PMT)/(3*((N-1)^2*PMT+PV-FV))):GOTO 7500 7420 IF PMT*FV<0 AND PV=0 THEN I0=ABS((FV+N*PMT)/(3*((N-1)^2)*PMT+PV-FV)) 7500 A=(1+I0)^N-1:IF D2$="BEGIN" THEN X=1 ELSE X=0 7510 B=(1+I0*X)/I0 7520 C=PMT*B 7600 F1=A*(PV+C)+PV+FV 7610 F2=N*(A+1)/(1+I0)*(PV+C)-(A*C)/I0 7620 I0=I0-F1/F2 7630 IF ABS(F1/F2)<=1E-10 THEN 7650 7640 GOTO 7500 7650 IF D1$=" DISCRETE " THEN J=CF*((1+I0)^(PF/CF)-1) ELSE J=LOG((1+I0)^PF) 7660 I=J*100 7700 I1=INT((C1*I)+.5)/C1 7800 GOTO 27 8000 PRINT TAB(5)" OPTION H: INPUT VAL FOR PV 'C' TO CALC PV OR TO EXIT ";:INPUT;D$ 8015 IF LEFT$(D$,1)="/" OR LEFT$(D$,1)="\" THEN 8028 8020 IF LEFT$(D$,1)="C" OR LEFT$(D$,1)="c" THEN 8200 8025 PV$="INPUT" 8027 PV=VAL(D$) 8028 PV=INT((C1*PV)+.5)/C1 8040 GOTO 27 8200 PV$="CALC ":GOSUB 20000 8210 PV=-(FV+(A*C))/(A+1) 8300 PV1=INT((C1*PV)+.5)/C1 8400 GOTO 27 9000 PRINT TAB(5)" OPTION I: INPUT PAYMENT OR 'C' TO CALC PMT OR TO EXIT";:INPUT;D$ 9015 IF LEFT$(D$,1)="/" OR LEFT$(D$,1)="\" THEN 9028 9020 IF LEFT$(D$,1)="C" OR LEFT$(D$,1)="c" THEN 9200 9025 PMT$="INPUT" 9027 PMT=VAL(D$) 9028 PMT=INT((C1*PMT)+.5)/C1 9040 GOTO 27 9200 PMT$="CALC ":GOSUB 20000 9300 PMT=-(FV+PV*(A+1))/(A*B) 9400 PMT1=INT((C1*PMT)+.5)/C1 9500 GOTO 27 10000 PRINT TAB(5)" OPTION J: INPUT VAL FOR FV OR 'C' TO CALC FV OR TO EXIT";:INPUT;D$ 10015 IF LEFT$(D$,1)="/" OR LEFT$(D$,1)="\" THEN 10028 10020 IF LEFT$(D$,1)="C" OR LEFT$(D$,1)="c" THEN 10200 10025 FV$="INPUT" 10027 FV=VAL(D$) 10028 FV=INT((C1*FV)+.5)/C1 10040 GOTO 27 10200 FV$="CALC ":GOSUB 20000 10300 FV=-(PV+A*(PV+C)) 10400 FV1=INT((C1*FV)+.5)/C1 10500 GOTO 27 11000 PRINT TAB(5)" OPTION K: PMT DETAILS| Enter Payment # or to Exit ";:INPUT;D$ 11015 IF LEFT$(D$,1)="/" OR LEFT$(D$,1)="\" THEN 11050 11022 N2=VAL(D$) 11025 IF N2>N THEN N2=N ELSE IF N2<0 THEN N2=0 11040 N2=INT(N2+.5) 11050 IF N2=0 THEN 11140 11055 PRINT TAB(6);:PRINT"CALCULATING--THIS MAY TAKE A WHILE."; 11100 BAL=ABS(PV):ID=0:FOR Q=1 TO N2:IP=J/PF*BAL:ID=ID+IP:BAL=BAL-(ABS(PMT)-IP):NEXT Q 11110 SP=PV-BAL:SP1=ABS(N2*PMT):RP=N-N2 11120 BAL=INT((BAL*100)+.5)/100:ID=INT((ID*100)+.5)/100:IP=INT((IP*100)+.5)/100 11130 SP=INT((SP*100)+.5)/100:SP1=INT((SP1*100)+.5)/100:RP=INT((RP*100)+.5)/100 11140 GOTO 27 20000 J=I/100 20005 IF D1$=" DISCRETE " THEN IE=(1+J/CF)^(CF/PF)-1 ELSE IE=EXP(J/PF)-1 20020 A=(1+IE)^N-1 20030 IF D2$="BEGIN" THEN X=1 ELSE X=0 20040 B=(1+IE*X)/IE 20050 C=PMT*B 20060 RETURN 30030 LPRINT" ===========================================================================" 30040 LPRINT TAB(5)"| SIMPLE HEWLETT-PACKARD TYPE FINANCIAL CALCULATOR VERSION 1.10 |" 30050 LPRINT TAB(5)"| FREEWARE BY THOMAS S. COX MAY 17, 1986 (GENERIC VERSION) |" 30055 LPRINT TAB(5)"| Based on Formulas in PPC ROM USER'S MANUAL (C) 1981 by PPC ";TAB(79);"|" 30060 LPRINT TAB(5)"===========================================================================" 30070 LPRINT TAB(5)"| YOUR CHOICES ARE: ============================= |" 30080 LPRINT TAB(5)"| ----------------- ** VALUES CURRENTLY IN USE ** |" 30090 LPRINT TAB(5)"| A. Initialize to Standard Conditions ============================= |" 30100 LPRINT TAB(5)"| B. Toggle Compounding (Cont/Discrete)";TAB(51);"Cmpd =";D1$;TAB(71);COMP$;TAB(79);"|" 30110 LPRINT TAB(5)"| C. Toggle Payment (Beginning/End)";TAB(51);"Pmt = ";D2$;TAB(71);PAYM$;TAB(79);"|" 30120 LPRINT TAB(5)"| D. Payment Frequency";TAB(51);"PF = ";PF;TAB(71);PF$;TAB(79);"|" 30130 LPRINT TAB(5)"| E. Compounding Frequency";TAB(51);"CF = ";CF;TAB(71);CF$;TAB(79);"|" 30140 LPRINT TAB(5)"| F. Input or Calculate N";TAB(51);" N = ";N1;TAB(73);N$;TAB(79);"|" 30150 LPRINT TAB(5)"| G. Input or Calculate I%";TAB(51);"I% = ";I1;TAB(73);I$;TAB(79);"|" 30160 LPRINT TAB(5)"| H. Input or Calculate PV (Present Value)";TAB(51);"PV = ";PV1;TAB(73);PV$;TAB(79);"|" 30170 LPRINT TAB(5)"| I. Input or Calculate PMT (Payment)";TAB(51);"PMT= ";PMT1;TAB(73);PMT$;TAB(79);"|" 30180 LPRINT TAB(5)"| J. Input or Calculate FV (Future Value)";TAB(51);"FV = ";FV1;TAB(73);FV$;;TAB(79);"|" 30190 LPRINT TAB(5)"|-------------------------------------------------------------------------|" 30200 LPRINT TAB(5)"| K. PAYMENT DETAILS |Balance ";TAB(38);BAL;TAB(53);"Sum Prn ";SP;TAB(79);"|" 30210 LPRINT TAB(5)"| =============== |Int Pmt ";TAB(38);IP;TAB(53);"Sum Pmts ";SP1;TAB(79);"|" 30220 LPRINT TAB(5)"| PAYMENT #";TAB(23);N2;TAB(29);"|Sum Int ";TAB(38);ID;TAB(53);"Pmts Lft ";RP;TAB(79);"|" 30230 LPRINT TAB(5)"===========================================================================" 30250 GOTO 27 62000 PRINT CHR$(26):PRINT"Exiting to CP/M":SYSTEM ===================================================ulate I%";TAB(51);"I% = ";I1;TAB(73);I$;TAB(79);"|" 30160 LPRINT TAB(5)"| H. Input or Calculate PV (Present Value)";TAB(51);"PV = ";PV1;TAB(73);PV$;TAB(79);"|" 30170 LPRINT TAB(5)"| I. Input or Calculate PMT (Payment)";TAB(51);"PMT= ";PMT1;TAB(73);PMT$;TAB(79);"|" 30180 LPRINT TAB(5)"| J. Input or Calculate FV (Future Value)";TAB(51);"FV = ";FV1;TAB(73);FV$;;TAB(79);"|>k+ +yk+ (w!~#fo#~#w:j+,+6~+;+~ ;+6 H+~H+6ͤ/P+ɀ @ PPPPPP #ʌ+̏+~̏++(w#w+*R#~6+´+&6#s#r>6###s#r#6@"R=#w:G+!<,####~#+F#N#~#fo~#fo,CH!Rõ'$}'>110!6͑/111 !6$p5 !6$p5!6$p5!6$p510!6m/!($p5! $p5ͼ6$ͼ6$$1,!$p5/!$p52!$p55!$p58!$p5ͼ6;$1ͼ6C$ͼ6K$ͼ6S$ͼ6[$ͼ6S$ͼ6c$ͼ6k$ͼ6s$ͼ6{$ͼ6$ͼ6$ͩ6W$ͼ6$ͼ6$ͼ6$ͼ6$ͼ6$ͩ6W$1:4;C3$!Iͳ14;6k:4K;3$!Iͳ14;6s:4[;3$!Iͳ14;6{:4c;3$!Iͳ14;6:4S;3$!Iͳ14;61:4;3$!Iͳ14;6:4;3$!Iͳ14;6:4;3$!Iͳ14;6:4;3$!Iͳ14;6:4;3$!Iͳ14;6!7Q4;3$!Iͳ14;͍6610!6͑/0!#͑/10!6!q#͑/10!6!##͑/10!6!"m/!O6!@$m/!"͑/10!6!"͑/10!6!@"͑/10!6!!͑/10!6!!͑/10!6!x!m/!36!@$m/!o!m/!m/!G6!@$m/! m/!O6!@$m/!"͑/10!6!G!m/!36!@$m/!=!m/!m/!G6!@$m/! m/!O6!@$m/!"͑/10!6!"!m/!36!@$m/!!m/![/!G6!@$m/!m/!O6!@$m/!"͑/10!6! m/!36!@$m/! m/!$[/!G6!@$m/!m/!O6!@$m/!"͑/10!6! m/!36!@$m/! m/!k[/!I6!@$m/!,m/!O6!@$m/!"͑/10!6! m/!36!@$m/! m/!s[/!I6!@$m/!/m/!O6!@$m/!"͑/10!6!s m/!36!@$m/!j m/!{[/!I6!@$m/!2m/!O6!@$m/!"͑/10!6!@ m/!36!@$m/!7 m/![/!I6!@$m/!5m/!O6!@$m/!"͑/10!6! m/!36!@$m/! m/![/!I6!@$m/!8m/!@$m/!O6!@$m/!"͑/10!6!͑/10!6!m/!&6!@$m/![/!56!@$m/!m/![/!O6!@$m/!"͑/10!6!^m/!&6!@$m/![/!56!@$m/!Rm/![/!O6!@$m/!"͑/10!6!?m/!6!@$m/![/!6!@$m/!3m/!&6!@$m/![/!56!@$m/!'m/!R/!O6!@$m/!"͑/10!6!"͑/10!6!m/1!@$/͟-!.! 5p51!͆3!͆3|g}o|^ !ͪ3/ !͆3!͆3|g}o|t1!1662$ 3$6 3$61[2$^2$|g}o|/ 5 1x1!7͹5 % w Cb1/ 10!6͑/0!m/1!@$/͟-!.! 5!͆3! 5!͆3|g}o| / 1/ 1)1j1!($ͥ3 !|p5!rp5 !p5x1!|ͥ3% !($p5!6$p5 !p5x1!jͥ3Q ! $p5!6$p5 !p5x1! $ͥ3} !jp5!rp5 !p5x1W 10!6!/m/!@$/͟-!.1!,ͥ3 ͼ6$ !'2613$ !6$p5 !rp51!p51x10!6!m/!@$/͟-!.1!ͥ39 ͼ6$$D !'26$13$$\ !6$p5e !rp51!p51x10!6!m/!@$/͟-!.1! 5!͆3! 5!͆3|g}o| 1! 5!͆3! 5!͆3|g}o|: 1,!p51!'26C1:4;C3$!Iͳ14;6C1x1,!p5͍11c4c͗63[4!I2͗63$!I246C1:4;C3$!Iͳ14;6k1x10!6!Um/!@$/͟-!.1! 5!͆3! 5!͆3|g}o|G1! 5!͆3! 5!͆3|g}o|x1/!p51!'26K1:4;K3$!Iͳ14;6K:4K$61x1/!p5X3S4c[!Is1͗64$C͸43{$6ͼ61:4Scͣ2:4[S͚2|g}o| :4CS3[3c͗6:4[C4!Is161:4Sc͚2͇2[|g}o|n:4CS͌4c͗63C{$Ͳ4c$Q4Sz4c3[Q4k$4!Is161:4Sc͚2͊2[|g}o|:4CS3c͗63C{$Ͳ4c$Q4SQ4k$z4c3[4!Is1613$Ͳ4C3{$6!jͥ3ͩ6K$ͩ6G$1!7Q43$461:4S613[Q43[3c613$͗63[W4͗63$4Q4C͗6:44̀4614͌4614!Is1&3[$11!($ͥ33$͗64$͸43{$Q4$63$4!I261:4$6K1:4;K3$!Iͳ14;6s1x10!6!m/!@$/͟-!.1! 5!͆3! 5!͆3|g}o|1! 5!͆3! 5!͆3|g}o|12!p51!'26[1:4;[3$!Iͳ14;6[1x12!p5͍11:43c͒7͗63$46[1:4;[3$!Iͳ14;6{1x10!6!m/!@$/͟-!.1! 5!͆3! 5!͆3|g}o|1! 5!͆3! 5!͆3|g}o|%15!p51!'26S1:4;S3$!Iͳ14;6S1x15!p5͍113$Q4[3c͒7͗6:446S1:4;S3$!Iͳ14;61x10!6!m/!@$/͟-!.1! 5!͆3! 5!͆3|g}o|$1! 5!͆3! 5!͆3|g}o|I18!p51!'26c1:4;c3$!Iͳ14;6c1x18!p5͍113[Q43[͒76c1:4;c3$!Iͳ14;61x10!6!bm/!@$/͟-!.1! 5!͆3! 5!͆3|g}o|61!'2612Cͼ6C!S3!ͼ6s$13$!Iͳ161]310!6!@$m/0!<m/1![s16ͼ6s$!|666K$ü:44636!Ss1͌436Ϳ3K$621c4[6:4S!Is16c4C͍661:4$3$!Iͳ1Q4$6:4$3$!Iͳ1Q4$6:4$3$!Iͳ1Q4$61:4$3$!Iͳ1Q4$6:4$3$!Iͳ1Q4$64O$3S$!I1(4C$61x1:4K$61!($ͥ34$3$͗64$͸43{$6 4!Ì13{$613$Ͳ4C3{$61!jͥ3;ͩ6K$Bͩ6G$1!7Q43$461:4S61͠110!#͑/10!6!q#͑/10!6!##͑/10!6!"m/!O6!@$m/!"͑/10!6!"͑/10!6!@"͑/10!6!!͑/10!6!!͑/10!6!x!m/!36!@$m/!o!m/!m/!G6!@$m/! m/!O6!@$m/!"͑/10!6!G!m/!36!@$m/!=!m/!m/!G6!@$m/! m/!O6!@$m/!"͑/10!6!"!m/!36!@$m/!!m/![/!G6!@$m/!m/!O6!@$m/!"͑/10!6! m/!36!@$m/! m/!$[/!G6!@$m/!m/!O6!@$m/!"͑/10!6! m/!36!@$m/! m/!k[/!I6!@$m/!,m/!O6!@$m/!"͑/10!6! m/!36!@$m/! m/!s[/!I6!@$m/!/m/!O6!@$m/!"͑/10!6!s m/!36!@$m/!j m/!{[/!I6!@$m/!2m/!O6!@$m/!"͑/10!6!@ m/!36!@$m/!7 m/![/!I6!@$m/!5m/!O6!@$m/!"͑/10!6! m/!36!@$m/! m/![/!I6!@$m/!8m/!@$m/!O6!@$m/!"͑/10!6!͑/10!6!m/!&6!@$m/![/!56!@$m/!m/![/!O6!@$m/!"͑/10!6!^m/!&6!@$m/![/!56!@$m/!Rm/![/!O6!@$m/!"͑/10!6!?m/!6!@$m/![/!6!@$m/!3m/!&6!@$m/![/!56!@$m/!'m/!R/!O6!@$m/!"͑/10!6!"͑/1x10!6͑/0!*͑/))-Exiting to CP/M#?CALCULATING--THIS MAY TAKE A WHILE.7e OPTION K: PMT DETAILS| Enter Payment # or to Exit < OPTION J: INPUT VAL FOR FV OR 'C' TO CALC FV OR TO EXIT: OPTION I: INPUT PAYMENT OR 'C' TO CALC PMT OR TO EXIT: OPTION H: INPUT VAL FOR PV 'C' TO CALC PV OR TO EXIT TO EXITCALC INPUTcC< OPTION F: INPUT VALUE FOR N OR 'C' TO CALC N OR TO EXIT; OPTION E: INPUT COMPOUNDING FREQ OR FOR DEFAULT CF=1 /82 OPTION D: INPUT PMT FREQUENCY OR FOR DEFAULT PF=1 mBEGINu INPUT  CONTINUOUSyY5EXIT to System? (Y)es or ANY other key to CONTINUE pP\/G PLEASE ENTER YOUR CHOICE (A-K) OR < / > TO EXIT PGM OR < P > TO PRINT *Pmts Lft 6|Sum Int B| PAYMENT # USum Pmts !a| =============== |Int Pmt Sum Prn !| K. PAYMENT DETAILS |Balance K|-------------------------------------------------------------------------| FV = + | J. Input or Calculate FV (Future Value): PMT= 'C | I. Input or Calculate PMT (Payment)m PV = ,v | H. Input or Calculate PV (Present Value) I% =  | G. Input or Calculate I% N =  | F. Input or Calculate N CF =  | E. Compounding Frequency!PF = %!| D. Payment Frequency@!Pmt = %J!| C. Toggle Payment (Beginning/End)r!Cmpd =){!| B. Toggle Compounding (Cont/Discrete)K!| A. Initialize to Standard Conditions ============================= |K!| ----------------- ** VALUES CURRENTLY IN USE ** |KC"| YOUR CHOICES ARE: ============================= |K"==========================================================================="|@"| Based on Formulas in PPC ROM USER'S MANUAL (C) 1981 by PPC K&#| FREEWARE BY THOMAS S. COX MAY 17, 1986 (GENERIC VERSION) |Kt#| SIMPLE HEWLETT-PACKARD TYPE FINANCIAL CALCULATOR VERSION 1.10 |O# ===========================================================================$$$$ $#$END +$ DISCRETE 9$DEFAULTC$ #zH[_@ףp= #zH0B@RUdg jx(27<+F=POZadnxK5%7E W i ^ / tNu  5   %  w p XC@b(#'*X v  0  " Q }    ! D e q    : 8  4  NK   d gGt lx-q9srL nV`-K=xgO\T Y[h =l \ 7#D#<#%#A#C#P#6T$a$%'$,'$'I' )'+'C8'Z<(v()+6*+++! ++@/+[\+f+p+Qz+%N 4N#>NBHN_RNn\NXubuguluvuuuu^uuuHuuu2uuuu4v vv*v[[[[ BASLIB #980007 5.1 - OWNED BY MICROSOFT, 1979 <ÿ'ÿ'QͷQͷDM*"7*&;##"7Å(>2'2'*^#V"'##^#V"'!("|(6#6P>2(>2(>2(͹':(ͼ':(1(_=_P!P!"PxQ!5QJy2+"~q+=RuL+~%!9"I(*P*Jʝ(!6#}(|(6!O(6#z°(*N|(> !)6#s#r#=(>2C(>2F(>2E(2H("K(!>("V(':6; STO+)r,*V(.. . .........9*d(|):a(v)*_(|v)u+*J s#r*J {w#6"b(*I(*_(>2a(r,6;Error -!)~<ʜ)=ʜ)#~#)È)#<;(Syntax Error in DATRETURN without GOSU Type MismatcOut of DatIllegal Function CalFloating OverfloInteger OverfloOut of Memor Subscript Out of Rang Division By ZerOut of String SpacString Formula Too CompleRESUME without Erro2Field Overflo3Internal Erro4Bad File Numbe5File Not Foun6Bad File Mod7File Already Ope9Disk I/O Erro:File Already Exist=Disk Ful>Input Past En?Bad Record Numbe@Bad File NamCToo Many FileUnprintable Erro!9N#F*D~#~Ҧ+~+ʬ+~#~ڦ++^#V###Ä+###Ä+|ʸ+~#fo!+6; Internal Error - No Line Number >(*D~#T,6; at lineu+,r,>;,< ,4, ,;,< ,0͍G4,,}_|W!J,ͪH~#fo>6; at address|\1}\1r,> ͍G> ÍG!9"A(*A(KSKDEדEXjOULoAMŅpUaPE}CTPTIOqRINkOKbOӨU~EE˫EA]EmETUR_ESUMdESTOR^UΉENU͓ESEԌSEhNIGHTANDOMIZŃTOnPÚPACETRINGTRWAeGάIQTEМU—AVœYSTE͇ϘA™AHEΛROFxROySRSRSRSRSRSRSRSRSRSRSҮSINǞARPTҖN#",!9",",y2,*T(|-*l(!."d(A~#*,͞H~ʘ.S.-͐=-͗=",.!.ͻ;*I*I*I*I.. =*I..ͤ;*I*I*,͞HF.~#",,˜.-~˜.!"d(~,"^.#"~r.r.# a.Ø."x.#",x"ʍ. ʍ.+~ ʂ.yͶ9..6;?Redo from Start *,9!./*,:,O-*,+~+... +w ..++~#fos5",!,5*,~2/#~#^#V(;++9ͤE(|,͚/{0|,ͥ/{0|,Ͱ/{0|,p/{0|,͚/Ø0|,ͥ/Ø0|,Ͱ/Ø0|,0æ0|,͚/K0|,ͥ/K0|,Ͱ/K0|,0K0Iû/Iû/"I/H~# ¼/x2o;:w(r0B0/a?ͧ9<Ͳ0~/F#/a?~/ F#/>2o;:w(r0F#~#foxB0̲09000~#F$0909B0>"FG:{(xB0ʡG*|(+~ FB0>,FW*|(#^ 00+=0͡Gz{0{_0!("|(!"T(2w(1!("|(!"T(2w(1!z(~6#w~!51J1N,1͆,i&,) G~#Z1#L1++e10:p1ÍG|,I|,~J!O(4!9"I(^#V#!O(~w )!9"I( PTLU)S~!)#^#V++9o&(((:f(>[͍Gu+,>]͍G>2f(ɯ2f(|,K|,~!>!>!>!>!>^#V#^#V#G>!>!>!>!>!>^#V#!,G>!>!>!>!>!>g:I>2:Iƀ>2>!+>2>2>2>2>2>^#V#^#V#ùG> 3> 3> 3> 3> 3>^#V#^#V#G>73>73>73>73>73>^#V#!IG>_3>_3>_3>_3>_3>^#V#!,G>È3>È3>È3>È3>È3>͛7!+>ì3>ì3>ì3>ì3>ì3>͛7ʻ3~#fo##AH^#V#|,ͰQ3^#6H3NH^#V#|,;N3^#6H3AH^#V#|,ͱR4^#6H4NH^#V#|,CM@4^#6HF4NH^#V#|,+Ni4^#6HÕ4^#V#wHo4NH^#V#|,Iá4^#6H4^#V#wHç4NH^#V#|,K4^#6H5^#V#wH4||,!)BKE5PY|!)|,BK 65 o_5z!)|,zM5 S5_Y5o _ W}Ͷ99DM|,͐9ԭ5~##++G:>ͯH+V+^+ʠ5+r+s͑:|,s5~#^#Vö9ǯÿ5>25|5+})N#5~#fo :55!9"I(!O(4 ~ͪH#!)|!)|,!9>Ͷ9+f6*|({<-6͡G{<6=> F-6|!)}*|(<6<-6f6}-6|!)}-6|n6!*|(#n&M7!I[HOO^#6HI[H^#V#^#V#^H^#V#^#V#[HAH^#V#I^H^#V#I[H͸O!I^HO|,wH.7!I[H!,;NTLO^#V#|,Z7|,Z7|,zt7|t7|ͱSS^#VB7AH:I2I:I2IGN7y7#~#fo~#fo7#7 ¶7 y7y<.7)7)99a#77*7&778f8#8 8 8a8b828b8O8i_!74/85*7"7~#N#F#o8I8 ͪH28yxT8 28+++6@#yw#xw+++6###!7~6ڀ8͕8/88*7#~#~/8͆,)!*7"7~#^#V#88ͪHâ8|8â8++~_w#~Ww#â8͕8*7DM~#^#V#9988+z9+{9##{z~#q#p_8y.9x.9DM8~#.98YP+++"76@###{_zW+r+sɷʃ9*7|f9͆,)^#V+"78#s#r+++r+s##!99*";{z*$;?ҥ9}|~# «9yGS9xͯH͐9G:Ñ:*";*$;ͽH9:9G:͑:###9:6; during G.C. >(:6; >(6; Internal Error - String Space Corrup#N#F*7yxڌ:*7yxҌ:++`i+V+^ͽH:##6+6+~6  >@++*7"7s#r+8*7#~_#~WҺ:͆,')r+s##6"7###!7~#fo:ͽH:<*7"7*7}o|g6@#s#r#6"7*$;*";"7}w>#w##ͽH ;++6+678U~͍G#=*;<;~͍G#<;b##w++cs#reeeefff%f0f;f@fEfD;*I}/o|/g#"I|;͑S×;!I~wɯ2ID;O;*I;ÑSD;O>>m=~&(#;&(f;!I;>!II2;# ;!I;N!I<͗K>><>|}+!=CM͚̈́O2I!=%R!=CM!ICM~_#~W#~OGUóQ!EDðQcSm<ɇ<o&;ÑS*I*I͝<"I`i"I!I^#V#N#F#!=ñR5Ux{*U!I6 Twg>͒UNU<:o;Gw#<<2o;e2H;`hh=~&D-ʿ=+ʿ=+ͧDڢ>.L>e=E=ͧDl=L=q=Q=:o;>>>~%Y>#h>!i>d>D+>p>ͧDDͧD?+>_{_>>/>v;D!tp>ÿ=#t< =+>p>#+>̤;Ļ;D*I <>T])))O |>"Iÿ=yͲ;7>t$e<>ͦ< ?>;A<^?!ID>?:I??y^?:IZ?:I^?:I/^?ÞE?l?6+<~?6-v;#60:r;W:o;AA?C!L;F :r;_ ʷ?x*·?{·?AqͧD?E?D?0ʷ?,ʷ?.?+60{?+6${+p2r;!L;6 <*I*I2J;͞@E~?@:@0@ #~@>DG@"I`i"I#~+ʆ@-]@0OxG҆@#~D@`xE{@y /@>2J;Ë@|/@s@/@"I`i"I͏<#W͔B:J;@@@@3C60̤"w#6+@6-/</ @:#p#w#6!L;#z҉A&B+CzCC{<=C͚?>Ap#6!K;#:p;~ CA*CA+WAͧD-+$0A#ͧDҁA++wwADAʁA6%-BʥAID<Aa?+6%eA>A{_xBCCBCyJCOCGOZCB*p;=CP4AͲ;ѯ3B<7ĔByč>OzWO>SBaB/<ûB͏>BDBt#e<C9D FC/>;҃C>;p#=zC!I͌<öC_<>ͬ<͏<D?FC͚</{_#zW#yO++CM<#͏CD>FCN#F#*I/}o|g D"Ip#=CFCw1_cƤ~@zZrN vH Tʚ;@B''d #~: ʧD ʧD ʧD0?<=:o;D7-++ͧDdEODHD+DEh=H#.EE͆,)M!EE}0?)))صoEM!@E>E}dE0? VE? ))))صo@Ea{  =D:I:IY<:H;2I;2H;͆,)͆,)!"T(!,",ͺE:/E6;?EpFE:F>\2FEEF+E~F F+F FFF!,2FFFOE:F&F>\F2FyʐFF7 ʷF ʐF JFEÐFFEhFEF> F>ErF>#E‹F6F!,F F Fx<>ʛFyq#F F> FFʨF FF:/Fwr,ÍG>^F@FF~ F> FF#F(?*|( G#~+<G=ܡG xG{G !G4+~# F~=G*|(!("|(F"|(> F> F> -(> -(*FG GGG~#foG##G GGGH>H~+~?~H+#+H+ +H&)))^#V#!I^H^#V#!I[H^Hw#w#w#w#Oͭ!@$>IÆH>IoH ~#=ŠH!oH#~ ʝH ʝHɅo$ɧGw#³H{zɧ!5 !@$ !'% !!O !@$+ !"!7 !"C F I !O != X !@$!!j !!͗ |g}o|^ !/ !͡ ! |g}o|t͎ !͒$ $  $  $ PPLUOIL͸OL!IO!M PNU4JP!HLLL%JTL!I͔K=JL!HK!ICMÁJ:I11UpB.={`ԝ!Ms==Cz(/i1e:|\);8 P!vJCM:IJHJMTL2IM:IƁJͫPHO!MCMM!DJ͑L2M,M!]JͦL!9+NLM!I4K!M;N,M!MO."IM!M PNUUM PWK!I~6! NCM!M;NL!N PK!M;N![K͑L!N+N!HLog͸O!NCM!H;N1v޸-~Mοu9~5A`kc~2fI(L */OIKNUOK!VU!Iy#K+¶KNU?VULUOKL͸OL!IOPL:INU:I/̈́ON2I:INNUx/F+N+= M!IM!I>q#p#=!M!ICM"HMML*HOU:IU!IN#F SmOqʀMGܲNͰOx iM`MN!I͌OxMj0 TeB׳]h!I.k LUOML͸O!ICM1!Iq#~++w+qMNUDNn"~`35zr1{r1h!IONUyO2IANONU:ILSN/JP(P1GUXP5U!I6 Tg>͒U|S>"PakUP)SPNU?UʹPNUPTP,ScS|*UҕP!P̦PT%QͷRP>O!I~+>wNUQY'USNU:IPhPT)SƁPSR!QͅQJûRQY'UNUUT|Yt&wz^Pc|u~r1'U/Q1>2I!LQͅQTog͑SöQ }}{(qnz T5UͷRͅQ÷RT~#U=xʹR?UͶQÐQͣSóQ?UNU:I'UQ/OöQͣS(R?USNUȯG S"Iy2IFoSS!D*I:IOeRI4T}R͍Rg.*I:IOzfR͍Rg.*I:IsRx<=R{_zWxG)yOHGTͣSôR?U*UNU Sy+F+F+Fw`h|SgyR:IO|g}oxG-|R}R'TElaOR!I~Gx!SƀUwSw+ɷTU5Ux{*U!I6 TwgGSzFS >͒U|T{>2I'T/yU xU7>{_zW}o|g=oU|g}oڡUCZQÔU o-yOzW{_xGäUI*IDM^#V#N#F#xyVU:I:I7|/G}/O!>yU xU7>{_zW}W#~OS'TͣSR?UNU>OöQͣS(R?USNUȯG S"Iy2IFoSS!D*I:IOeRI4T}R͍Rg.*I:IOzfR͍Rg.*I:IsRx<=R{_zWxG)yOHGTͣSôR?U*UNU Sy+F+F+Fw`h|SgyR:IO|g}oxG-|R}R'TElaOR!I~Gx!SƀUwSw+ɷTU5Ux{*U!I6 TwgGSzFS >͒U|T{>2I'T/ * * * * CLEARS THE SCREEN * * * * 160 REM 170 DIM A$(25): REM * * SET UP INPUT DATA ARRAY FOR 25 ITEMS * * * * * 180 REM 190 REM * * * * * * * * * * * INPUT INFORMATION * * * * * * * * * * * 200 REM 210 INPUT "ENTER NUMBER OF PARTS ";Q 220 GOSUB 1230 230 FOR X=1 TO Q 240 PRINT"ENTER NAME OF PART NUMBER ";X;" (MAXIMUM 10 CHARACTERS.)" 250 INPUT Z$ 260 IF LEN(Z$)<1 THEN 240 270 IF LEN(Z$)<10 THEN Z$=Z$+" ":GOTO 270: REM * * PACK STRING * * 280 IF LEN(Z$)>10 THEN GOSUB 1240:GOTO 240 290 GOSUB 1230 300 PRINT"ENTER NUMBER OF PIECES OF ";Z$ 310 INPUT P$ 320 IF LEN(P$)<>1 THEN 290 330 GOSUB 1230 340 INPUT "ENTER TYPE OF MATERIAL (MAXIMUM 10 SPACES): ";K$ 350 IF LEN(K$)<1 THEN 330 360 IF LEN(K$)<10 THEN K$=K$+" ":GOTO 360: REM ** PACK STRING ** 370 IF LEN(K$)>10 THEN GOSUB 1240:GOTO 330 380 GOSUB 1230 390 PRINT"ENTER DIMENSIONS OF ";Z$ 400 INPUT "ENTER LENGTH IN INCHES (3 DIGITS MAXIMUM) ";L$ 410 IF LEN(L$)<1 THEN 400 420 IF LEN(L$)<3 THEN L$=L$+" ":GOTO 420 430 IF LEN(L$)>3 THEN GOSUB 1240:GOTO360 440 INPUT "ENTER WIDTH IN INCHES (3 DIGITS MAXIMUM) ";W$ 450 IF LEN(W$)<1 THEN 440 460 IF LEN(W$)<3 THEN W$=W$+" ":GOTO 460: REM * * PACK STRING * * 470 IF LEN(W$)>3 THEN GOSUB 1240:GOTO 440 480 INPUT "ENTER THICKNESS IN WHOLE INCHES.";T$ 490 IF LEN(T$)<>1 THEN 480 500 BF=VAL(L$)*VAL(W$)*VAL(T$): REM * * CALCULATE BOARD FEET * * 510 REM 520 BF=((BF/144)*VAL(P$)):B$=STR$(BF): REM CALCULATE TOTAL BD. FT. * 530 REM 540 IF LEN(B$)<10 THEN B$=B$+" ":GOTO 540: REM ** PACK STRING ** 550 GOSUB 1230 560 INPUT "ENTER UNIT COST OR COST PER BD.FT ";C$ 570 GOSUB 1230 580 IF LEN(C$)<5 THEN C$=C$+" ":GOTO 580: REM * * PACK STRING * * 590 REM 600 TC=VAL(C$)*VAL(B$): REM * * * * * CALCULATE TOTAL COST * * * * 610 R$=STR$(TC): REM * * CONVERT TOTAL COST TO STRING FOR STORAGE * * 620 IF LEN(R$)<10 THEN R$=R$+" ":GOTO 620: REM * * PACK STRING * * 630 REM 640 A$(X)=Z$+P$+L$+W$+T$+C$+B$+R$+K$: REM * TOTAL DATA STRING (53 SPACES) * 650 NEXT X 660 TC=0:FC=0:REM * * * SET FINAL COST TO ZERO PRIOR TO PRINTING * * * 670 GOSUB 1230 680 REM * * * * * * * * * * P R I N T T O T A L S * * * * * * * * * * * * 690 REM 700 INPUT "ENTER YOUR NAME :";N$ 710 GOSUB 1230 720 PRINT"ENTER YOUR CLASS AND SECTION (SUCH AS I.A. LAB 120-55)." 730 LINE INPUT; S$ 740 GOSUB 1230 750 PRINT"ENTER TODAY'S DATE :" 760 LINE INPUT; D$ 770 GOSUB 1230 780 INPUT "ENTER H FOR OR V FOR