PCjs Machines
Home of the original IBM PC emulator for browsers.
PC-SIG Diskette Library (Disk #460)
[PCjs Machine "ibm5170"]
Waiting for machine "ibm5170" to load....
Information about “ALBERT AGRICULTURE”
Another useful collection of decision aids for Farm Management. This
one is from Alberta College's Department of Agriculture, and each
one analyzes a specific farming related situation. If you are
involved in any aspect of farming, or are a student of analysis
methods, this disk holds a lot of information.
System Requirements: Monochrome display, 64K and one disk drive.
How to Start: To run BASIC programs consult the directions in GETTING
STARTED for your configuration. Consult README.DOC for additional
program information.
File Descriptions:
AUTOEXEC BAT Batch file BASICA HELLO
DIET BAS Diet Detective Jr. - March 1983
CRCROP BAS Concensus research crops model - July 1984
COWCRAB BAS Cow calf risk analysis budget - July 1983
CFP BAS Comparative feed pricing - June 1984
CARCOST BAS Car or truck costing program - January 1984
BFP BAS Breakeven feeder prices - July 1984
BESTCROP BAS Breakeven prices & yields - March 1982
HAYCRAB BAS Hay cost returns and analysis - March 1982
DOLLAR BAS Dollar Detective - personal budgeting - March 1983
LOAN BAS Loan calculator - August 1984
LANDPUR BAS Land purchase decisions - February 1983
INSTALL BAT Batch file to add system and BASICA to disk
HELLO BAS Alberta Agricluture menu program - August 1984
README DOC Author supplied documentation file
RATION BAS Ration balancing - May 1984
BESTCROP.BAS
1 REM BESTCROP-AN ANALYSIS OF EQUAL RETURN PRICES & YIELDS FOR TWO CROPS
3 REM ORIGINATED FROM AGNET PROGRAM
4 REM REWRITTEN IN APPLESOFT BASIC FOR APPLE II & III BY EL MCCARLEY MARCH/82
5 REM CONTACT: E.L. MCCARLEY, C.S.B.
6 REM LAST REVISION: MARCH 30, 1982 BY ELM ( CHANGE LINE 9075 ALSO)
8 GOTO 5000
9 S$="":REM THIS IS THE INPUT SUBROUTINE
10 GOSUB 24:PRINT SPACE$(LEN(S$));
11 S8=0:GOSUB 24
12 GOSUB 31
13 GOSUB 35
14 GOSUB 53
15 IF S$="" THEN S$=S6$:GOTO 22
16 IF S3=1 THEN GOSUB 56
17 IF S8=1 GOTO 10
18 IF S3=1 THEN GOSUB 68
19 IF S8=1 GOTO 10
20 IF S3=3 THEN GOSUB 73
21 IF S8=1 GOTO 10
22 IF S3=1 THEN S=VAL(S$)
23 RETURN
24 REM POSITION CURSOR
25 LOCATE S1,S2,1
30 RETURN
31 REM PRINT DEFAULT
32 PRINT S6$
33 GOSUB 24
34 RETURN
35 REM TRANSPARENT CURSOR ROUTINE
36 S$=""
37 S1$=INPUT$(1)
41 S=ASC(S1$):IF S<>13 GOTO 46
42 IF S$="" THEN GOSUB 24:PRINT " ";:GOSUB 24:GOSUB 31:PRINT:RETURN
43 IF LEN(S$)>=LEN(S6$) GOTO 45
44 PRINT SPACE$(LEN(S6$)-LEN(S$));
45 PRINT S1$;:RETURN
46 IF S<32 GOTO 50
47 IF S=34 THEN S1$="'"
48 S$=S$+S1$:IF S9>0 THEN IF LEN(S$)>S9 THEN PRINT S1$;:GOTO 52
49 PRINT S1$;:GOTO 37
50 IF LEN(S$)<1 GOTO 36
51 IF LEN(S$)=1 THEN PRINT CHR$(29);:PRINT" ";:PRINT CHR$(29);:GOTO 36
52 S$=LEFT$(S$,LEN(S$)-1):PRINT CHR$(29);:PRINT" ";:PRINT CHR$(29);:GOTO 37
53 REM THIS CHECKS FOR EXIT
54 IF S$="<" THEN CLS:PRINT" LOADING MENU...":RUN"HELLO.BAS"
55 RETURN
56 S1$=S$:S7=0:REM CHECK FOR NUMERIC INPUT
57 IF LEFT$(S1$,1)=" " THEN S1$=RIGHT$(S1$,LEN(S1$)-1):GOTO 57
58 IF RIGHT$(S1$,1)=" " THEN S1$=LEFT$(S1$,LEN(S1$)-1):GOTO 58
59 IF LEN(S1$)<1 GOTO 64
60 FOR S=1 TO LEN(S1$):S6=ASC(MID$(S1$,S,1))
61 IF S6>=48 AND S6<=57 GOTO 66
62 IF (S6=43 OR S6=45) AND S=1 GOTO 66
63 IF S6=46 AND S7=0 THEN S7=1:GOTO 66
64 S2$="NON NUMERIC INPUT":S1$="":GOSUB 78
65 RETURN
66 NEXT S
67 RETURN
68 REM CHECK FOR PROPER LIMITS
69 S6=VAL(S$)
70 IF S6<S4 THEN S2$="INPUT BELOW":S1$=STR$(S4):GOSUB 78:RETURN
71 IF S6>S5 THEN S2$="INPUT ABOVE":S1$=STR$(S5):GOSUB 78:RETURN
72 RETURN
73 REM CHECK FOR YES OR NO
74 IF LEFT$(S$,1)="Y" OR LEFT$(S$,1)="N" GOTO 76
75 S2$="MUST BE YES/NO ANSWER":S1$="":GOSUB 78:RETURN
76 S$=LEFT$(S$,1)
77 RETURN
78 REM ERROR FOR ALL CONDITIONS
79 COLOR 31,0,0:BEEP
80 GOSUB 90
81 PRINT" ";S2$;S1$;
82 FOR S7=1 TO 3000:NEXT S7
83 COLOR 7,0,0
87 GOSUB 93
88 S8=1
89 RETURN
90 REM POSTITION TO LAST LINE
91 LOCATE 25,1,0
92 RETURN
93 REM BLANK LAST LINE
94 LOCATE 25,1,1
95 PRINT SPACE$(39);
96 RETURN
200 REM ****DOLLAR FORMAT SUBROUTINE****
201 S3=INT(S3*100+0.5)/100
202 S3$=SPACE$(30)
203 IF S3=0 THEN S3$=RIGHT$(S3$,S4-4)+"0.00":GOTO 209
204 S4$=STR$(S3)
205 IF ASC(MID$(RIGHT$(S4$,2),1,1))=46 THEN S3$=S3$+S4$+"0":GOTO 208
206 IF ASC(MID$(RIGHT$(S4$,3),1,1))=46 THEN S3$=S3$+S4$:GOTO 208
207 S3$=S3$+S4$+".00"
208 S3$=RIGHT$(S3$,S4)
209 RETURN
300 REM HOLD SCREEN
301 S$="PRESS RETURN TO CONTINUE "
302 COLOR 31,0,0
303 GOSUB 90
304 PRINT" ";S$;
305 POKE 106,0
306 IF INKEY$=CHR$(13) GOTO 307 ELSE GOTO 305
307 COLOR 7,0,0
308 GOSUB 93
314 S$="":S1$=""
315 RETURN
5000 REM *** MAINLINE: BESTCROP ***
5005 DIM F(5),G(5),L(5),R(5),E(5),D(5),P(5)
5006 B=1:B1=1:C=1:C1=1
5010 GOSUB 60000
5020 GOSUB 9000
5030 GOSUB 6000: REM PAINT SCREEN
5040 GOSUB 6500: REM ENTER CROP DATA
5050 S1=23:S2=1: GOSUB 24: PRINT "ANY CHANGES (Y/N)?":S1=23:S2=22:S3=3:S6$="Y":S9=1: GOSUB 9
5060 IF S$="Y" THEN 5040
5070 GOSUB 7000: REM RESULTS TO SCREEN
5080 S1=23:S2=1: GOSUB 24: PRINT "DO YOU WANT TO PRINT RESULTS (Y/N)?":S1=23:S2=37:S3=3:S6$="Y":S9=1: GOSUB 9
5090 IF S$="Y" THEN GOSUB 8000: REM RESULTS TO PRINTER
5100 S1=23:S2=1: GOSUB 24: PRINT "DO YOU WANT TO RUN AGAIN (Y/N)? ":S2=37: GOSUB 9
5110 IF S$="Y" THEN 5030
5120 CLS : PRINT : PRINT : PRINT : PRINT "THANK YOU AND GOOD FARMING!"
5130 LOCATE 10,1: COLOR 0,7 : PRINT "PLEASE WAIT ... LOADING PROGRAM MENU": COLOR 7,0 : RUN "HELLO"
6000 REM *** SUBR: PAINT SCREEN
6010 CLS
6020 PRINT "NAME OF BASE CROP ?"
6030 PRINT " ---- ----"
6040 PRINT "UNIT OF YIELD ?"
6050 PRINT "EXPECTED YIELD/ACRE ?"
6060 PRINT "EXPECTED PRICE/UNIT ($) ?"
6070 PRINT : PRINT "DIRECT CASHFLOW EXPENSE/ACRE TO GROW"
6080 PRINT " LESS SECONDARY CROP VALUE ($) ?"
6100 PRINT : PRINT "======================================="
6120 PRINT : PRINT : PRINT "NAME OF COMPETING CROP ?"
6130 PRINT " --------- ----"
6140 PRINT "UNIT OF YIELD ?"
6150 PRINT "EXPECTED YIELD/ACRE ?"
6160 PRINT "EXPECTED PRICE/UNIT ($) ?"
6170 PRINT : PRINT "DIRECT CASHFLOW EXPENSE/ACRE TO GROW"
6180 PRINT " LESS SECONDARY CROP VALUE ($) ?"
6190 RETURN
6500 REM *** SUBR: ENTER BASE & COMPETING CROP DATA
6510 S1=1:S2=21:S3=2:S9=15:S6$=B$: GOSUB 9:B$=S$
6515 S1=3:S2=27:S9=7:S6$=U$: GOSUB 9:U$=S$
6520 S1=4:S3=1:S4=0.1:S5=999:S6$= MID$(STR$(B),2): GOSUB 9:B=S
6525 S1=5:S6$= MID$(STR$(B1),2): GOSUB 9:B1=S
6530 S1=8:S2=36:S4=0:S5=500:S6$= MID$(STR$(E1),2): GOSUB 9:E1=S
6535 S1=13:S2=26:S3=2:S9=15:S6$=C$: GOSUB 9:C$=S$
6540 S1=15:S2=27:S9=7:S6$=W$: GOSUB 9:W$=S$
6545 S1=16:S3=1:S4=0.1:S5=999:S6$= MID$(STR$(C),2): GOSUB 9:C=S
6550 S1=17:S6$= MID$(STR$(C1),2): GOSUB 9:C1=S
6555 S1=20:S2=34:S4=0:S5=500:S6$= MID$(STR$(E2),2): GOSUB 9:E2=S
6580 RETURN
7000 REM *** SUBR: DISPLAY RESULTS ON SCREEN
7010 CLS
7020 PRINT "BREAKEVEN PRICES & YIELDS FOR TWO CROPS"
7025 PRINT "======================================="
7030 PRINT : PRINT LEFT$(B$+" ",9)+"*"+ LEFT$(C$+" ",9)+"-------"+"PRICE ($)/"+ LEFT$(W$,4)
7040 M=0!
7050 FOR J=1 TO 5
7060 F(J)=C1+C1*(M-0.2)
7070 F(J)= INT(F(J)*100!)/100!
7080 M=M+0.1
7090 NEXT J
7100 S3$=STR$(B)+" ":S3$=MID$(S3$,2,3):A$=S3$+"*"
7101 S4=6:S5=2
7102 FOR J=1 TO 5
7104 S3=F(J): GOSUB 200:A$=A$+S3$
7106 NEXT J
7108 PRINT "YIELD=";A$
7110 PRINT " PRICE($)*"
7120 PRINT " /"; LEFT$(U$+" ",7);"*'=RETURN' "; LEFT$(C$+" ",9);"YIELD/ACRE": PRINT " *"
7130 M=0
7140 FOR I=1 TO 5
7150 D(I)=B1+B1*(M-0.2)
7160 M=M+0.1
7170 FOR J=1 TO 5
7180 G(J)=(B*D(I)-E1+E2)/F(J)
7190 G(J)= INT(G(J)*100!)/100!
7200 NEXT J
7210 S3=D(I):S4=6:S5=2: GOSUB 200:A$=S3$+" *"
7214 S5=0: FOR K=1 TO 5:S3=G(K): GOSUB 200:A$=A$+S3$: NEXT K
7218 PRINT A$
7220 NEXT I
7230 GOSUB 300: CLS
7235 REM ********* TABLE #2 *********
7240 PRINT " ": PRINT LEFT$(B$+" ",9)+"*"+ LEFT$(C$+" ",9)+"----"+"YIELD/ACRE------"
7250 M=0
7260 FOR J=1 TO 5
7270 L(J)=C+C*(M-0.2)
7280 L(J)= INT(L(J)*100!)/100!
7290 M=M+0.1
7300 NEXT J
7410 S3=B1:S4=6:S5=2: GOSUB 200:A$="$"+S3$+" *"
7414 S5=1: FOR J=1 TO 5:S3=L(J): GOSUB 200:A$=A$+S3$: NEXT J
7418 PRINT A$;
7420 PRINT : PRINT " YIELD *"
7430 PRINT "PER ACRE *'=RETURN' "; LEFT$(C$+" ",9)+"--PRICE($)":PRINT " *"
7440 M=0
7450 FOR I=1 TO 5
7460 E(I)=B+B*(M-0.2)
7470 M=M+0.1
7480 FOR J=1 TO 5
7490 G(J)=(E(I)*B1-E1+E2)/L(J)
7500 G(J)= INT(G(J)*100!)/100!
7510 NEXT J
7520 S3=E(I):S4=5:S5=1: GOSUB 200:A$=S3$+" *"
7524 S4=6:S5=2: FOR K=1 TO 5:S3=G(K): GOSUB 200:A$=A$+S3$: NEXT K
7528 PRINT A$
7530 NEXT I
7550 GOSUB 300: CLS
7555 REM ********* TABLE #3 *********
7560 S3=B1:S4=5:S5=2: GOSUB 200
7562 PRINT : PRINT LEFT$(B$+" ",9)+": YIELD="+ RIGHT$ (" "+ STR$(B),3)+" "+ LEFT$(U$+" ",6)+";PRICE=$"+S3$
7570 PRINT : PRINT "PRICE RETURN YIELD RETURN"
7580 PRINT
7590 FOR J=1 TO 5
7600 P(J)=B*D(J)-E1
7610 R(J)=B1*E(J)-E1
7620 R(J)= INT(R(J)*100!)/100!:P(J)= INT(P(J)*100!)/100!
7630 S4=6:S5=2:S3=D(J): GOSUB 200:A$="$"+S3$
7634 S3=P(J): GOSUB 200:A$=A$+" $"+S3$
7636 S3=E(J): GOSUB 200:A$=A$+" "+S3$
7638 S3=R(J): GOSUB 200:A$=A$+" $"+S3$
7639 PRINT A$
7640 NEXT J
7650 PRINT
7660 RETURN
8000 REM *** SUBR: DISPLAY RESULTS ON PRINTER
8040 LPRINT " ":LPRINT " ":LPRINT " "
8050 LPRINT " BREAKEVEN PRICES AND YIELDS FOR TWO CROPS"
8055 LPRINT " ========================================="
8060 LPRINT " ":LPRINT " ":LPRINT B$,C$,"PRICE($)/ ";W$
8070 LPRINT "YIELD=";B,F(1);" ";F(2);" ";F(3);" ";F(4);" ";F(5)
8080 LPRINT " PRICE($)"
8090 LPRINT " PER ";U$,"EQUAL-RETURN ";C$;" YIELD/ACRE"
8100 FOR I=1 TO 5
8110 FOR J=1 TO 5
8120 G(J)=(B*D(I)-E1+E2)/F(J)
8130 G(J)= INT(G(J)*100!)/100!
8140 NEXT J
8150 S3=D(I):S4=8:S5=2: GOSUB 200:A$=S3$+" "
8152 S4=11:S5=1: FOR K=1 TO 5:S3=G(K): GOSUB 200:A$=A$+S3$: NEXT K
8154 LPRINT A$
8160 NEXT I
8165 LPRINT " ":LPRINT "------------------------------------------------------------"
8170 LPRINT " ":LPRINT B$,C$,"YIELD PER ACRE"
8180 LPRINT "PRICE=$ ";B1,L(1);" ";L(2);" ";L(3);" ";L(4);" ";L(5)
8190 LPRINT " YIELD"
8200 LPRINT " PER ACRE EQUAL-RETURN ";C$,"PRICE ($)"
8210 FOR I=1 TO 5
8220 FOR J=1 TO 5
8230 G(J)=(E(I)*B1-E1+E2)/L(J)
8240 G(J)= INT(G(J)*100!)/100
8250 NEXT J
8260 S3=E(I):S4=8:S5=1: GOSUB 200:A$=S3$+" "
8262 S4=11:S5=2: FOR K=1 TO 5:S3=G(K): GOSUB 200:A$=A$+S3$: NEXT K
8264 LPRINT A$
8270 NEXT I
8280 LPRINT " ":LPRINT " -----------------------------------------------------------"
8290 LPRINT " ":LPRINT " ":LPRINT B$;" YIELD=";B;" ";U$;,B$;" PRICE=$";B1
8300 LPRINT "PRICE","RETURN","YIELD","RETURN"
8310 LPRINT " "
8320 FOR J=1 TO 5
8330 S4=6:S5=2:S3=D(J): GOSUB 200:A$="$"+S3$+" "
8332 S4=14:S3=P(J): GOSUB 200:A$=A$+S3$+" "
8334 S5=1:S3=E(J): GOSUB 200:A$=A$+S3$+" "
8336 S5=2:S3=R(J): GOSUB 200:A$=A$+S3$
8338 LPRINT A$
8340 NEXT J
8350 LPRINT
8355 REM END PRINT
8360 RETURN
9000 REM *** SUBR: DESCRIPTION SCREEN ***
9020 CLS
9030 PRINT : PRINT : COLOR 0,7 : PRINT " B E S T C R O P ": COLOR 7,0
9040 PRINT : PRINT : PRINT " AN ANALYSIS OF EQUAL RETURN"
9050 PRINT : PRINT " PRICES AND YIELDS"
9055 PRINT : PRINT : PRINT : PRINT "THIS ANALYSIS ASSUMES ENOUGH MACHINERY"
9060 PRINT "AND TIME TO GROW EITHER CROP WITHOUT"
9065 PRINT "ADVERSE EFFECTS DUE TO MONO-CULTURE,"
9070 PRINT "ROTATION, PESTS, ETC."
9075 PRINT : PRINT : PRINT : PRINT : PRINT " MARCH 30, 1982"
9080 GOSUB 300: REM SCRNHOLD
9090 RETURN
10000 REM **** VARIABLES ****
10002 REM B$=BASE CROP *C$=COMPETING CROP
10004 REM B =YIELD/ACRE *C =YIELD/ACRE
10006 REM B1=PRICE/UNIT *C1=PRICE/UNIT
10008 REM E1=CASHFLOW EXPENSES *E2=CASHFLOW EXPENSES
10010 REM D()= RANGE OF PRICES/UNIT YIELD OF BASE CROP
10012 REM E()= RANGE OF YIELDS/ACRE OF BASE CROP
10014 REM F()= RANGE OF PRICES/UNIT YIELD OF COMPETING CROP
10016 REM L()= RANGE OF YIELDS/ACRE OF COMPETING CROP
10018 REM P()=EXPECTED RETURNS FOR BASE CROP (YIELD B & PRICES D())
10020 REM R()=EXPECTED RETURNS FOR BASE CROP (PRICE B1 & YIELDS E())
10022 REM G()= WORK ARRAY
10024 REM I,J,K=COUNTERS (1-5) : M =COUNTER (BY .1)
60000 REM this is the logo routine
60010 DEF SEG=0:IF (PEEK(&H410) AND &H30)=&H30 GOTO 60550
60020 S=3.141593
60030 KEY OFF
60040 SCREEN 1
60050 COLOR 0,1
60060 CLS
60070 LINE(0,0)-(319,199),3,B
60080 LINE(5,5)-(314,194),3,B
60090 PAINT(1,1),1,3
60100 DRAW"c3;bm40,100;e60;d60;l5;h15;e4;f10;u40;g50;l5;"
60110 PAINT(43,99),1,3
60120 DRAW"C3;bm110,30;d70;L5;U70;R5;"
60130 PAINT(109,99),1,3
60140 DRAW"C3;bm120,40;d60;L5;U60;R5;"
60150 PAINT(119,99),1,3
60160 CIRCLE(135,83),20,3,1.25*S,0.75*S
60170 CIRCLE(135,83),15,3,1.25*S,0.9*S
60180 DRAW"bm119,96;e5;"
60190 PAINT(135,98),1,3
60200 CIRCLE(170,83),20,3,0.2*S,1.85*S
60210 CIRCLE(170,83),15,3,0.25*S,1.8*S
60220 DRAW"C3;BM182,90;R5;"
60230 DRAW"C3;BM187,75;G10;H3;E7;"
60240 PAINT(170,99),1,3
60250 PAINT(170,67),1,3
60260 DRAW"c3;bm195,100;l5;u34;r5;d34;"
60270 CIRCLE(210,83),20,3,0.55*S,0.76*S
60280 CIRCLE(210,83),15,3,0.59*S,0.8799999*S
60290 DRAW"bm207,66;d5;"
60300 PAINT(194,99),1,3
60310 PAINT(206,69),1,3
60320 DRAW"c3;bm217,100;l5;u40;r5;d5;r7;d5;l7;d30;"
60330 PAINT(216,97),1,3
60340 DRAW"C3;bm265,65;d35;L5;U35;R5;"
60350 CIRCLE(245,83),20,3,0.25*S,1.75*S
60360 CIRCLE(245,83),15,3,0.09999999*S,1.7*S
60370 DRAW"bm261,99;h6;"
60380 PAINT(245,98),1,3
60390 PAINT(264,69),1,3
60400 LOCATE 14,22
60410 PRINT"AGRICULTURE"
60420 LOCATE 17,4
60430 PRINT"FIELD SERVICES DIVISION"
60440 LOCATE 18,4
60450 PRINT" & ECONOMIC SERVICES DIVISION"
60460 LOCATE 23,5
60470 PRINT"PROVIDED BY ALBERTA AGRICULTURE"
60480 LOCATE 24,3
60490 PRINT"RESPONSIBILITY RESTS WITH THE USER";
60500 FOR S=1 TO 4100
60510 POKE 106,0
60520 IF INKEY$<>"" GOTO 60540
60530 NEXT S
60540 ON ERROR GOTO 0 :SCREEN 0,0,0:RETURN
60550 REM **MONOCHROME LOGO**
60560 KEY OFF:WIDTH 80:CLS:S$=CHR$(219)
60570 PRINT STRING$(75,S$);
60580 FOR S=2 TO 23:LOCATE S,75:PRINT S$;:NEXT
60590 LOCATE 24,1:PRINT STRING$(75,S$);
60600 FOR S=23 TO 2 STEP -1:LOCATE S,1:PRINT S$;:NEXT
60610 '
60620 '
60630 LOCATE 5,28:PRINT "▌"
60640 LOCATE 6,24:PRINT"/▌ ▌ ▌"
60650 LOCATE 7,23:PRINT"/ ▌ ▌ ▌"
60660 LOCATE 8,22:PRINT"/ ▌ ▌ ▌ ▐"
60670 LOCATE 9,21:PRINT"/ ▌ ▌ ▌ __ __ ▐_ __"
60680 LOCATE 10,20:PRINT"/ ▌ ▌ ▌/ \ / \ ▐/ ▐ / \▌"
60690 LOCATE 11,19:PRINT"/ ▌ ▌ █ ▐ ▌ / ▐ ▐ ▌ ▌"
60700 LOCATE 12,18:PRINT"/ \ ▌ ▌ █ ▐ ▌ ▐ ▐ ▌ ▌"
60710 LOCATE 13,17:PRINT"/ \▌ ▌ ▌\__/ \__/ ▐ ▐ \__/▌"
60720 LOCATE 15,36:PRINT"A G R I C U L T U R E"
60730 LOCATE 18,14:PRINT"FIELD SERVICES & ECONOMIC SERVICES DIVISION"
60740 LOCATE 21,22:PRINT"PROVIDED BY ALBERTA AGRICULTURE."
60750 LOCATE 22,19:PRINT"RESPONSIBILITY RESTS SOLELY WITH USER"
60760 FOR S=1 TO 1500
60770 S$=INKEY$
60780 IF S$=CHR$(13) GOTO 60800
60790 NEXT S
60800 S$=""
60810 ON ERROR GOTO 0
60820 RETURN
BFP.BAS
1 REM *** BREAK-EVEN FEEDER PRICES****
2 REM ***THIS PROGRAM CALCULATES THE BREAK-EVEN PURCHASE PRICE, SALE PRICE AND
3 REM *** EXPECTED NET REVENUE FOR FEEDING LIVESTOCK.
4 REM ****JULY/84****
5 REM G.MONNER
6 REM R.E.B.S. BRANCH
7 REM FAIRVIEW,ALTA.
8 GOTO 5000
9 S$="":REM THIS IS THE INPUT SUBROUTINE
10 GOSUB 24:PRINT SPACE$(LEN(S$));
11 S8=0:GOSUB 24
12 GOSUB 31
13 GOSUB 35
14 GOSUB 53
15 IF S$="" THEN S$=S6$:GOSUB 9090:GOTO 22
16 IF S3=1 THEN GOSUB 56:IF T=1 OR T=2 THEN 20
17 IF S8=1 GOTO 10
18 IF S3=1 THEN GOSUB 68
19 IF S8=1 GOTO 10
20 IF S3=3 THEN GOSUB 73
21 IF S8=1 GOTO 10
22 IF S3=1 THEN S=VAL(S$)
23 RETURN
24 REM POSITION CURSOR
25 LOCATE S1,S2,1
30 RETURN
31 REM PRINT DEFAULT
32 PRINT S6$
33 GOSUB 24
34 RETURN
35 REM TRANSPARENT CURSOR ROUTINE
36 S$=""
37 S1$=INPUT$(1)
41 S=ASC(S1$):IF S<>13 GOTO 46
42 IF S$="" THEN GOSUB 24:PRINT " ";:GOSUB 24:GOSUB 31:PRINT:RETURN
43 IF LEN(S$)>=LEN(S6$) GOTO 45
44 PRINT SPACE$(LEN(S6$)-LEN(S$));
45 PRINT S1$;:RETURN
46 IF S<32 GOTO 50
47 IF S=34 THEN S1$="'"
48 S$=S$+S1$:IF S9>0 THEN IF LEN(S$)>S9 THEN PRINT S1$;:GOTO 52
49 PRINT S1$;:GOTO 37
50 IF LEN(S$)<1 GOTO 36
51 IF LEN(S$)=1 THEN PRINT CHR$(29);:PRINT" ";:PRINT CHR$(29);:GOTO 36
52 S$=LEFT$(S$,LEN(S$)-1):PRINT CHR$(29);:PRINT" ";:PRINT CHR$(29);:GOTO 37
53 REM THIS CHECKS FOR EXIT
54 IF S$="<" THEN CLS:PRINT" LOADING MENU...":RUN "HELLO.BAS"
55 RETURN
56 GOSUB 9090:S1$=S$:S7=0:REM CHECK FOR NUMERIC INPUT
57 IF LEFT$(S1$,1)=" " THEN S1$=RIGHT$(S1$,LEN(S1$)-1):GOTO 57
58 IF RIGHT$(S1$,1)=" " THEN S1$=LEFT$(S1$,LEN(S1$)-1):GOTO 58
59 IF LEN(S1$)<1 GOTO 64
60 FOR S=1 TO LEN(S1$):S6=ASC(MID$(S1$,S,1))
61 IF S6>=48 AND S6<=57 GOTO 66
62 IF (S6=43 OR S6=45) AND S=1 GOTO 66
63 IF S6=46 AND S7=0 THEN S7=1:GOTO 66
64 S2$="NON NUMERIC INPUT":S1$="":GOSUB 78
65 RETURN
66 NEXT S
67 RETURN
68 REM CHECK FOR PROPER LIMITS
69 S6=VAL(S$)
70 IF S6<S4 THEN S2$="INPUT BELOW":S1$=STR$(S4):GOSUB 78:RETURN
71 IF S6>S5 THEN S2$="INPUT ABOVE":S1$=STR$(S5):GOSUB 78:RETURN
72 RETURN
73 REM CHECK FOR YES OR NO
74 IF LEFT$(S$,1)="Y" OR LEFT$(S$,1)="N" GOTO 76
75 S2$="MUST BE YES/NO ANSWER":S1$="":GOSUB 78:RETURN
76 S$=LEFT$(S$,1)
77 RETURN
78 REM ERROR FOR ALL CONDITIONS
79 COLOR 31,0,0:BEEP
80 GOSUB 90
81 PRINT" ";S2$;S1$;
82 FOR S7=1 TO 3000:NEXT S7
83 COLOR 7,0,0
87 GOSUB 93
88 S8=1
89 RETURN
90 REM POSTITION TO LAST LINE
91 LOCATE 25,1,0
92 RETURN
93 REM BLANK LAST LINE
94 LOCATE 25,1,1
95 PRINT SPACE$(39);
96 RETURN
200 REM ****DOLLAR FORMAT SUBROUTINE****
201 S3=INT(S3*100+0.5)/100
202 S3$=SPACE$(30)
203 IF S3=0 THEN S3$=RIGHT$(S3$,S4-4)+"0.00":GOTO 209
204 S4$=STR$(S3)
205 IF ASC(MID$(RIGHT$(S4$,2),1,1))=46 THEN S3$=S3$+S4$+"0":GOTO 208
206 IF ASC(MID$(RIGHT$(S4$,3),1,1))=46 THEN S3$=S3$+S4$:GOTO 208
207 S3$=S3$+S4$+".00"
208 S3$=RIGHT$(S3$,S4)
209 RETURN
300 REM HOLD SCREEN
301 S$="PRESS RETURN TO CONTINUE "
302 COLOR 31,0,0
303 GOSUB 90
304 PRINT" ";S$;
305 POKE 106,0
306 IF INKEY$=CHR$(13) GOTO 307 ELSE GOTO 305
307 COLOR 7,0,0
308 GOSUB 93
314 S$="":S1$=""
315 RETURN
5000 GOSUB 62000: GOSUB 60000: REM LOGO SCRNPRT LOADER
5010 REM ****************************
5020 REM *****T I T L E *************
5030 REM ****************************
5040 CLS
5050 PRINT : PRINT : PRINT " BREAK-EVEN FEEDER PRICES"
5060 PRINT
5070 PRINT " REVISED JULY/84"
5080 PRINT : PRINT : PRINT : PRINT : PRINT : PRINT
5090 PRINT " ENTER VALUES AS REQUESTED. IF YOU"
5100 PRINT " NEED ASSISTANCE ENTER 'H' FOR HELP."
5110 PRINT " THE FOLLOWING SECTIONS HAVE THE"
5115 PRINT " 'HELP' FUNCTION:"
5120 PRINT " -AVERAGE WEIGHTS & PRICES"
5130 PRINT " -AVERAGE DAYS ON FEED "
5140 PRINT " -FEED COSTS"
5150 PRINT " -YARDAGE "
5160 PRINT " NOTE: CHECK MANUAL FOR MORE FEATURES."
5220 GOSUB 300
5230 REM *******************************
5240 REM ****MAIN TABLE DATA ENTRY******
5250 REM *******************************
5260 DIM Y(12):S9=8:V=1:A1=2:A2=1:B1=1:B2=1:DF=1:DR=1
5270 FOR I=1 TO 12:Y(I)=1: NEXT I
5280 GOSUB 7900: REM PRINT MAIN TABLE
5290 GOSUB 9260:V=2: GOSUB 9260
5300 S6$= STR$(A1):S1=5:S2=6:S3=1:S4=1:S5=3000:V=2: GOSUB 9:V=1: IF T=1 THEN T=0:I=1: GOSUB 6260: GOTO 5370
5310 A1=S
5320 GOSUB 9260:V=3: GOSUB 9260
5330 S6$= STR$(B1):S2=16:S4=1:S5=3000:V=3: GOSUB 9:V=1: IF T=1 THEN T=0:I=1: GOSUB 6260: GOTO 5370
5340 IF T=2 THEN T=0: GOSUB 8490: GOTO 5380
5350 B1=S
5360 S2=28: GOSUB 24: PRINT INT(((A1*B1)/100)*100+0.5)/100
5370 GOSUB 9260:V=2: GOSUB 9260
5380 S6$= STR$(A2):S1=6:S2=6:S3=1:S4=1:S5=3000:V=2: GOSUB 9:V=1: IF T=1 THEN T=0:I=2: GOSUB 6260: GOTO 5440
5390 A2=S
5400 GOSUB 9260
5410 S6$= STR$(B2):S2=16:S4=1:S5=3000: GOSUB 9:V=1: IF T=1 THEN T=0:I=2: GOSUB 6260: GOTO 5440
5420 B2=S
5430 S2=28: GOSUB 24: PRINT INT(((A2*B2)/100)*100+0.5)/100
5440 GOSUB 9260:V=2: GOSUB 9260
5450 S6$= STR$(DF):S1=8:S2=29:S3=1:S4=1:S5=500:V=2: GOSUB 9:V=1: IF T=1 THEN T=0: GOSUB 6660: GOTO 5470
5460 DF=S
5470 GOSUB 9260:V=4: GOSUB 9260
5480 S6$= STR$(FC):S1=10:S2=29:S3=1:S4=0.01:S5=500:V=4: GOSUB 9:V=1: IF T=1 THEN T=0: GOSUB 7020: GOTO 5510
5490 IF T=3 THEN T=0:FC= INT(S*DF*1000+0.5)/1000: GOSUB 24: PRINT FC;: GOTO 5510
5500 FC=S
5510 GOSUB 9260:V=5: GOSUB 9260
5520 S6$= STR$(VM):S1=11:S2=29:S3=1:S4=0.01:S5=500:V=5: GOSUB 9:V=1
5530 IF T=3 THEN T=0:VM= INT(S*DF*1000+0.5)/1000: GOSUB 24: PRINT VM;: GOTO 5550
5540 VM=S
5550 GOSUB 9260
5560 S6$= STR$(DR):S1=12:S2=29:S3=1:S4=1:S5=100: GOSUB 9:V=1
5570 IF T=3 THEN T=0:DR= INT(S*DF*1000+0.5)/1000: GOTO 5590
5580 DR=S
5590 GOSUB 9260:V=6: GOSUB 9260
5600 S6$=I8$
5640 S1=13:S2=14: GOSUB 24: PRINT " ";
5650 S3=1:S4=0.01:S5=500:V=6: GOSUB 9:V=1
5660 IF T=3 THEN T=0:IR= INT(S*DF*100+0.5)/100:I7=1: GOTO 5760
5670 IF T=4 THEN T=0:IR=S:I7=2: GOTO 5760
5680 IF T=5 THEN T=0:V1=((FC/2)*(S/100)*(DF/2)/365):I7=3: GOTO 5750
5690 IF I8$=S$ AND VAL(S6$) > 0 THEN 5700
5695 GOTO 5720
5700 IF I7=1 THEN T=3: GOTO 5660
5705 IF I7=2 THEN T=4: GOTO 5670
5710 IF I7=3 THEN T=5: GOTO 5680
5720 S1$="":S2$="ADD '*','%' OR '$' TO THE #'S END"
5730 GOSUB 78
5740 GOTO 5600
5750 CA=A2*B2/100
5755 IR= INT(((CA*S*DF/36500!)+V1-(V1*DR/200))*100+0.5)/100
5760 CA=A2*B2/100
5770 S2=29: GOSUB 24: PRINT " ": GOSUB 24: PRINT IR;
5780 GOSUB 9260:V=4: GOSUB 9260
5790 S6$= STR$(YA):S1=14:S2=29:S3=1:S4=0.01:S5=500:V=4: GOSUB 9:V=1
5800 IF T=3 THEN T=0:YA= INT(S*DF*100+0.5)/100: GOSUB 24: PRINT YA;: GOTO 5830
5810 IF T=1 THEN T=0: GOSUB 7450: GOTO 5830
5820 YA=S
5830 GOSUB 9260
5840 GOSUB 8130
5850 S1=18:S2=1: GOSUB 24
5860 LOCATE 18,29: PRINT INT(BS*10000+0.5)/100
5870 LOCATE 19,29: PRINT INT(BP*10000+0.5)/100
5880 LOCATE 20,29: PRINT INT(NR*100+0.5)/100
5890 IF Q1 > 0 OR Q2 > 0 THEN V4=1: GOSUB 8670
5900 S1=23:S2=1: GOSUB 24: PRINT "CHANGE DATA (Y/N)? ";
5910 S6$=" ":S1=23:S2=22:S3=3: GOSUB 9
5920 IF LEFT$(S$,1)="Y" THEN 5280
5930 IF S$=" " THEN 5910
5940 IF V4=1 THEN S2=1: GOSUB 24: PRINT "PROBABILITY ANALYSIS (Y/N)?";: GOTO 5960
5950 GOTO 5980
5960 S6$="Y":S1=23:S2=29:S3=3: GOSUB 9
5970 IF LEFT$(S$,1)="Y" THEN 8720
5980 S2=1: GOSUB 24: PRINT "SUPPLEMENTAL INFORMATION (Y/N)? ";
5990 S6$="Y":S1=23:S2=35:S3=3: GOSUB 9
6000 IF LEFT$(S$,1)="Y" THEN 6100
6010 GOSUB 9040
6020 S2=1: GOSUB 24: PRINT "EXIT PROGRAM (Y/N)? ";
6030 S6$="N":S1=23:S2=21:S3=3: GOSUB 9
6040 IF LEFT$(S$,1)="Y" THEN CLS : PRINT "GOOD BYE": LOCATE 10,1: COLOR 0,7 : PRINT " PLEASE WAIT ... LOADING PROGRAM MENU ": COLOR 7,0 :RUN "HELLO"
6060 GOTO 5900
6070 REM *******************************
6080 REM ****SUPPLIMENTAL INFORMATION***
6090 REM *******************************
6100 CLS : PRINT : PRINT "****SUPPLEMENTAL INFORMATION****"
6110 PRINT "================================"
6120 PRINT : PRINT "A D G ...................=" INT(P0*100+0.5)/100
6130 PRINT : PRINT "* TOTAL COST/LB OF GAIN..=$" INT(P1*100+0.5)/100
6140 PRINT : PRINT " FEED COST/LB OF GAIN...=$" INT((P2)*100+0.5)/100
6150 PRINT : PRINT " FEED COST/ANIMAL/DAY...=$" INT(P3*100+0.5)/100
6160 PRINT : PRINT "* TOTAL COST/ANIMAL/DAY..=$" INT(P4*100+0.5)/100
6170 PRINT : PRINT " FEED COST/ANIMAL.......=$" INT(P5*100+0.5)/100
6180 PRINT : PRINT "* TOTAL COST/ANIMAL......=$" INT(P6*100+0.5)/100
6190 PRINT "================================"
6200 PRINT "* NOTE:DOES NOT INCLUDE PURCHASE PRICE.*"
6210 GOSUB 300: GOSUB 9040
6220 GOSUB 7900: GOTO 5850
6230 REM *******************************
6240 REM ***H E L P ! FOR WT. & PRICE***
6250 REM *******************************
6260 CLS : PRINT "AVERAGE WT = LBS.
6270 PRINT "AVERAGE PRICE= $/CWT
6280 PRINT : PRINT "===================================="
6290 PRINT " NO. OF WEIGHT PRICE"
6300 PRINT " ANIMALS <LBS> <$/CWT>"
6310 PRINT " -------- -------- --------"
6320 A(1)=A1:A(2)=A2:B(1)=B1:B(2)=B2
6330 J=1
6340 S1=7+J:S2=1: GOSUB 24: PRINT J;:S6$= STR$(N(J,I)):S2=4:S3=1:S4=1:S5=1000
6350 GOSUB 9
6360 IF S=0 THEN GOTO 6440
6370 N(J,I)= VAL(S$)
6380 S6$= STR$(AA(J,I)):S2=15:S5=2000: GOSUB 9
6390 AA(J,I)= VAL(S$)
6400 S6$= STR$(BB(J,I)):S2=29:S5=200: GOSUB 9
6410 BB(J,I)= VAL(S$)
6420 IF JK=1 THEN JK=0: GOTO 6570
6430 PRINT :J=J+1:KJ=J: GOTO 6340
6440 CC=0:N1=0:A3=0
6450 FOR JJ=1 TO KJ-1
6460 CC=CC+(N(JJ,I)*AA(JJ,I)*BB(JJ,I)/100)
6470 N1=N1+N(JJ,I):A3=A3+(N(JJ,I)*AA(JJ,I))
6480 NEXT JJ
6490 LOCATE 1,1:A(I)= INT((A3/N1)*100+0.5)/100:B(I)= INT((CC/A3)*10000+0.5)/100
6500 LOCATE 1,15: PRINT A(I):A1=A(1):A2=A(2)
6510 LOCATE 2,15: PRINT B(I):B1=B(1):B2=B(2)
6520 PRINT
6530 S6$=" ":S1=23:S2=1: GOSUB 24:
6540 PRINT " CHANGE DATA? ";:S2=23:S3=3: GOSUB 9: IF LEFT$(S$,1)="Y" THEN 6570
6550 IF LEFT$(S$,1)="N" THEN GOTO 6620
6560 GOTO 6530
6570 S6$="":S1=23:S2=1: GOSUB 24
6580 PRINT " ENTER LINE #: ";:S2=23:S3=1:S4=1:S5=KJ: GOSUB 9: IF S$="" THEN 6440
6590 J= VAL(S$):JK=1: LOCATE 1,1: IF J=KJ THEN JK=0
6600 FOR K=1 TO (4+J): PRINT : NEXT K
6610 GOTO 6340
6620 GOSUB 9040: GOSUB 7900: RETURN
6630 REM *****************************
6640 REM ***H E L P ! DAYS ON FEED****
6650 REM *****************************
6660 CLS : LOCATE 2,1: IF BS > 0 THEN Y$="Y"
6670 PRINT "AVERAGE DAYS ON FEED= "
6680 PRINT : PRINT "ENTER DATE AS 8-DIGIT NUMBER:"
6690 PRINT " EG.<APRIL 1,1980> IS <04011980>"
6700 PRINT : PRINT "==================================="
6710 PRINT "NO. OF DATE DATE"
6720 PRINT "ANIMALS PURCHASED SOLD DAYS"
6730 PRINT "-------- --------- ------- -----"
6740 S1=11:S2=1: GOSUB 24:DE=0:NA=0:I=0
6750 I=I+1: PRINT I;:S6$= STR$(E1(I)):S1=10+I:S2=4:S3=1:S4=1:S5=1000: GOSUB 9
6760 IF S$="" THEN 6910
6770 E1(I)= VAL(S$)
6780 IF E1(I)=0 THEN 6910
6790 S6$=E2$(I):S2=11:S4=1011979!:S5=12312000#: GOSUB 9:E2$(I)=S$:ER$=S$
6800 GOSUB 8420: IF ER=1 THEN 6790
6810 S6$=E3$(I):S2=24:S4=1011979!:S5=12312000#: GOSUB 9:E3$(I)=S$:ER$=S$
6820 GOSUB 8420: IF ER=1 THEN 6810
6830 L4= VAL( RIGHT$(E2$(I),4)+ LEFT$(E2$(I),2)+ MID$(E2$(I),3,2))
6840 L5= VAL( RIGHT$(E3$(I),4)+ LEFT$(E3$(I),2)+ MID$(E3$(I),3,2))
6850 IF L4 > L5 THEN I=I-1: GOTO 6750
6860 GOSUB 90: PRINT "PLEASE BE PATIENT! I'M THINKING.";
6870 GOSUB 8250:S1=10+I:S2=33: GOSUB 24: PRINT A
6880 GOSUB 93:S1=11+I:S2=1: GOSUB 24
6890 AD=E1(I)*A:DE=DE+AD:NA=NA+E1(I)
6900 GOTO 6750
6910 DF= INT((DE/NA)+0.5)
6920 S1=2:S2=23: GOSUB 24: PRINT DF
6930 S1=23:S2=1:S3=3: GOSUB 24
6940 PRINT " CHANGE DATA? ";:S6$=" ":S2=23: GOSUB 9:Y$= LEFT$(S$,1)
6950 IF Y$="Y" THEN 6740
6960 IF Y$="N" THEN 6980
6970 GOTO 6930
6980 GOSUB 9040: GOSUB 7900: RETURN
6990 REM *****************************
7000 REM ***H E L P ! FEED COSTS *****
7010 REM *****************************
7020 CLS : LOCATE 2,1: PRINT "AVERAGE FEED COST/HD=$ "
7030 PRINT " ---------"
7040 PRINT : PRINT "====================================="
7050 PRINT : PRINT " FEED- LBS DAYS $/ LBS/"
7060 PRINT " STUFF FED FED UNIT UNIT"
7070 PRINT " /DAY"
7080 PRINT " ----- --- --- ---- ----"
7090 J=0
7100 JJ=0
7110 J=J+1:S1=10+J:S2=1:GOSUB 24:PRINT "FEED#"J;
7115 S6$=FS$(J):S1=10+J:S2=8:S3=2: GOSUB 9: IF S$="" THEN 7250
7120 FS$(J)=S$
7130 S6$= STR$(PF(J)):S2=16:S3=1:S4=0.1:S5=100: GOSUB 9
7140 PF(J)= VAL(S$)
7150 IF DG(J)=0 OR DG(J)=DF THEN S6$= STR$(DF): GOTO 7170
7160 S6$= STR$(DG(J))
7170 S2=21:S4=1:S5=500: GOSUB 9
7180 DG(J)= VAL(S$)
7190 S6$= STR$(DU(J)):S2=27:S4=0.1:S5=5000: GOSUB 9
7200 DU(J)= VAL(S$)
7210 S6$= STR$(PU(J)):S2=33:S4=0.1:S5=25000: GOSUB 9
7220 PU(J)= VAL(S$)
7230 IF XX=1 THEN XX=0: RETURN
7240 PRINT :JJ=JJ+1: GOTO 7110
7250 GOSUB 7360
7260 S1=23:S2=1: GOSUB 24: PRINT " CHANGE DATA?(Y OR N) ";:S6$=" ":S2=29:S3=3: GOSUB 9
7270 IF S$="Y" THEN GOTO 7300
7280 IF S$="N" THEN GOSUB 9040: GOSUB 7900: RETURN
7290 GOTO 7260
7300 S2=1: GOSUB 24: PRINT " ENTER FEED #: ";
7310 S6$="1":S2=25:S3=1:S4=1:S5=JJ: GOSUB 9:Z= VAL(S$)
7320 LOCATE 1,1
7330 FOR K=1 TO (8+Z): PRINT : NEXT
7340 IF Z > JJ THEN XX=0:J=Z-1: GOTO 7110
7350 J=Z-1:XX=1: GOSUB 7110: GOTO 7250
7360 FC=0
7370 FOR I=1 TO JJ
7380 FC=FC+(PF(I)*DG(I)*DU(I)/PU(I))
7390 NEXT I
7400 FC= INT(FC*100+0.5)/100
7410 LOCATE 2,23:PRINT FC: RETURN
7420 REM ******************************
7430 REM *** H E L P ! YARDAGE ******
7440 REM ******************************
7450 CLS : LOCATE 2,1: PRINT " YARDAGE COST/HD=$"YA
7460 PRINT " -------"
7470 PRINT : PRINT "1-ANIMALS THROUGH FEEDLOT/YR= "Y(1)
7480 PRINT : PRINT "2-OPERATING & MAINTENANCE/YR=$"Y(2)
7490 PRINT : PRINT "3-LABOUR/YR.................=$"Y(3)
7500 PRINT : PRINT "4-FACILITIES:-INVESTMENT....=$"Y(4)
7510 PRINT "5- -SALVAGE VALUE.=$"Y(5)
7520 PRINT "6- -YEARS OF USE..= "Y(6)
7530 PRINT "7- -RATE OF RETURN= "Y(7)" %"
7540 PRINT : PRINT "8-MACHINERY:-INVESTMENT.....=$"Y(8)
7550 PRINT "9- -SALVAGE VALUE..=$"Y(9)
7560 PRINT "10- -YEARS OF USE...= "Y(10)
7570 PRINT "11- -RATE OF RETURN.= "Y(11)" %"
7580 PRINT : PRINT : PRINT
7590 PRINT " CHANGE DATA <Y OR N>"
7600 FOR L=1 TO 11:S6$= STR$(Y(L)):S2=31:S3=1:S4=1
7610 IF L=1 THEN S1=5:S5=10000: GOTO 7720
7620 IF L=2 THEN S1=7:S5=50000!: GOTO 7720
7630 IF L=3 THEN S1=9:S5=50000!: GOTO 7720
7640 IF L=4 THEN S1=11:S5=500000!: GOTO 7720
7650 IF L=5 THEN S1=12:S5=500000!: GOTO 7720
7660 IF L=6 THEN S1=13:S5=100: GOTO 7720
7670 IF L=7 THEN S1=14:S5=50: GOTO 7720
7680 IF L=8 THEN S1=16:S5=500000!: GOTO 7720
7690 IF L=9 THEN S1=17:S5=500000!: GOTO 7720
7700 IF L=10 THEN S1=18:S5=100: GOTO 7720
7710 IF L=11 THEN S1=19:S5=50: GOTO 7720
7720 GOSUB 9:Y(L)= VAL(S$)
7730 NEXT L
7740 GOSUB 7800
7750 S1=2:S2=20: GOSUB 24: PRINT YA;
7760 S6$=" ":S1=23:S2=27:S3=3: GOSUB 9
7770 IF S$="Y" THEN GOTO 7600
7780 IF S$="N" THEN GOSUB 9040: GOSUB 7900: RETURN
7790 GOTO 7740
7800 Y1=((Y(4)+Y(5))/2)*Y(7)/100
7810 Y2=((Y(8)+Y(9))/2)*Y(11)/100
7820 IF Y(6)=0 OR Y(10)=0 THEN Y3=0:Y4=0: GOTO 7850
7830 Y3=(Y(4)-Y(5))/Y(6)
7840 Y4=(Y(8)-Y(9))/Y(10)
7850 YA= INT(((Y(2)+Y(3)+Y1+Y2+Y3+Y4)/Y(1))*100+0.5)/100
7860 RETURN
7870 REM ******************************
7880 REM ****** PRINT MAIN TABLE ******
7890 REM ******************************
7900 CLS : LOCATE 2,1
7910 PRINT " WEIGHT * PRICE ="
7920 PRINT " <LBS.> <$/CWT>"
7930 PRINT " ------- ------- "
7940 PRINT "SALE:";A1; TAB( 14);"* ";B1; TAB( 26);"=$"; INT(A1*B1+0.5)/100
7950 PRINT "PUR.:";A2; TAB( 14);"* ";B2; TAB( 26);"=$"; INT(A2*B2+0.5)/100
7960 PRINT
7970 PRINT " DAYS ON FEED...........= "DF
7980 PRINT
7990 PRINT "FEED COST/HD..............=$"FC
8000 PRINT "VET. & MED./HD............=$"VM
8010 PRINT "DEATH LOSS................= "DR; TAB( 35)"%"
8020 PRINT "INTEREST/HD [ %,$,* ].....=$"IR
8030 PRINT "YARDAGE/HD................=$"YA
8040 PRINT "======================================"
8050 PRINT : PRINT
8060 PRINT "BREAK-EVEN SELLING PRICE..=$"
8070 PRINT "BREAK-EVEN PURCHASE PRICE.=$"
8080 PRINT "NET RETURN(/HD)...........=$"
8090 RETURN
8100 REM ******************************
8110 REM **** CALCULATE ANSWERS********
8120 REM ******************************
8130 OC=IR
8140 DL=A2*B2*DR/10000:SR=A1*B1/100
8150 CC=DL+FC+VM+YA+OC
8160 BS=(CA+CC)/A1
8170 BP=(SR-CC)/A2
8180 NR=SR-CA-CC
8190 P0=(A1-A2)/DF:P1=CC/(A1-A2):P2=FC/(A1-A2)
8200 P3=FC/DF:P4=CC/DF:P5=FC:P6=CC
8210 RETURN
8220 REM ******************************
8230 REM **** DAY CALCULATION ********
8240 REM ******************************
8250 L=0:DX=0:K=0
8260 M= VAL( LEFT$(E2$(I),2)):D= VAL( MID$(E2$(I),3,2))
8270 Y= VAL( RIGHT$(E2$(I),4))
8280 M1= VAL( LEFT$(E3$(I),2)):D1= VAL( MID$(E3$(I),3,2))
8290 Y1= VAL( RIGHT$(E3$(I),4))
8300 IF M=M1 AND Y=Y1 THEN 8380
8310 FOR J=1 TO M: READ D2: NEXT J
8320 RESTORE
8330 IF K=0 AND L <> 2 THEN DX=DX+D2-D:D=0: GOTO 8350
8340 DX=DX+D2
8350 IF INT(Y/4)=Y/4 AND M=2 THEN DX=DX+1
8360 M=M+1: IF M > 12 THEN M=1:Y=Y+1:L=2
8370 K=K+1: GOTO 8300
8380 IF K=0 AND L <> 2 THEN A=DX+D1-D: RETURN
8390 A=DX+D1: RETURN
8400 GOTO 8300
8410 DATA 31,28,31,30,31,30,31,31,30,31,30,31
8420 IF VAL( LEFT$(ER$,2)) > 12 THEN ER=1: RETURN
8430 IF VAL( MID$(ER$,3,2)) > 31 THEN ER=1: RETURN
8440 IF LEN (ER$) <> 8 THEN ER=1: RETURN
8450 ER=0: RETURN
8460 REM ***************************************
8470 REM ****** PROB. INPUT ***********
8480 REM ******************************
8490 CLS : LOCATE 2,1: PRINT : PRINT " IN $/CWT:"
8500 PRINT " ----------------------------"
8510 PRINT:PRINT"WHAT IS YOUR ESTIMATE OF THE ";:COLOR 0,7:PRINT"LOWEST":COLOR 7,0:PRINT"PRICE THAT YOU ";
8520 PRINT "COULD REASONABLY EXPECT":PRINT"TO SELL YOUR ANIMALS FOR?"
8530 PRINT:PRINT"WHAT IS YOUR ESTIMATE OF THE ";:COLOR 0,7:PRINT"HIGHEST":COLOR 7,0:PRINT"PRICE?"
8540 PRINT:PRINT"WHAT IS YOUR ESTIMATE OF THE ";:COLOR 0,7:PRINT"MOST LIKELY";:COLOR 7,0:PRINT"PRICE?"
8550 S1=23:S2=1: GOSUB 24: PRINT " CHANGE DATA?[Y OR N]"
8560 S6$= STR$(Q1):S1=8:S2=27:S3=1:S4=1:S5=200: GOSUB 9
8570 Q1= VAL(S$)
8580 S6$= STR$(Q2):S1=11:S2=8:S3=1:S4=1:S5=200: GOSUB 9
8590 Q2= VAL(S$)
8600 S6$= STR$(Q3):S1=14:S2=8:S3=1:S4=1:S5=200: GOSUB 9
8610 Q3= VAL(S$)
8620 S6$=" ":S1=23:S2=26:S3=3: GOSUB 9: IF S$="Y" THEN 8560
8630 IF S$=" " THEN 8620
8640 B1=Q3: GOSUB 9040: GOSUB 7900: RETURN
8650 REM ******************************
8660 REM ****** PROBABILITY CALC.******
8670 REM ******************************
8680 IF BS*100 > =Q3 THEN Q5=1-((Q2-BS*100)^2)/((Q2-Q3)*(Q2-Q1)): GOTO 8700
8690 IF BS*100 < Q3 THEN Q5=((BS*100-Q1)^2)/((Q3-Q1)*(Q2-Q1)): GOTO 8700
8700 Q4= INT(((Q3-Q1)/(Q2-Q1))*100+0.5)/100
8710 Q5=1-Q5: RETURN
8720 CLS : PRINT " GIVEN YOUR ESTIMATES:"
8730 PRINT " ======================="
8740 PRINT
8750 PRINT "PROB. $/CWT T"
8760 PRINT "----- ----- T 1. YOU HAVE A %CHANCE"
8770 PRINT " T OF GETTING MORE THAN "
8780 PRINT " T YOUR BREAK EVEN SALE"
8790 PRINT " T PRICE OF $ /CWT"
8800 PRINT " T"
8810 PRINT " T "
8820 PRINT " T 2. YOU HAVE A %CHANCE"
8830 PRINT " T OF GETTING MORE THAN "
8840 PRINT " T YOUR MOST LIKELY PRICE"
8850 PRINT " T OF $ /CWT"
8860 PRINT " T"
8870 PRINT " T"
8880 PRINT " T "
8890 PRINT " T "
8900 PRINT " T"
8910 S1=6:S2=1: GOSUB 24
8920 FOR I=10 TO 90 STEP 10
8930 IF I/100 < Q4 THEN Q8=Q1+((1-I/100)*(Q3-Q1)*(Q2-Q1))^0.5
8940 IF I/100 > =Q4 THEN Q8=Q2-(I/100*(Q2-Q3)*(Q2-Q1))^0.5
8950 PRINT I; TAB( 5) INT(Q8*100+0.5)/100: PRINT
8960 NEXT I
8970 IF Q5 < 0 THEN Q5=0
8972 IF(BS*100)<Q1 THEN Q5=1!
8974 IF(BS*100)>Q2 THEN Q5=0!
8980 S1=5:S2=29: GOSUB 24: COLOR 0,7 : PRINT INT(Q5*100+0.5)
8990 S1=8:S2=27: GOSUB 24: PRINT INT(BS*10000+0.5)/100
9000 S1=11:S2=29: GOSUB 24: PRINT INT((1-Q4)*100+0.5)
9010 S1=14:S2=21: GOSUB 24: PRINT Q3;: COLOR 7,0
9020 GOSUB 300: GOSUB 9040
9030 GOSUB 7900: GOTO 5850
9040 S1=23:S2=1: GOSUB 24: PRINT "PRINTOUT OF THIS SCREEN?(Y/N) ";
9050 S6$="N":S2=31:S3=3: GOSUB 9
9060 IF S$="Y" THEN S2=1: GOSUB 24: PRINT " ";:CALL PRTSCR:RETURN
9070 IF S$="N" THEN RETURN
9080 GOTO 9040
9090 ON V GOTO 9250,9100,9110,9120,9130,9140,9250
9100 GOSUB 9150: RETURN
9110 GOSUB 9170: RETURN
9120 GOSUB 9150: GOSUB 9190: RETURN
9130 GOSUB 9190: RETURN
9140 GOSUB 9190: GOSUB 9210: GOSUB 9230: RETURN
9150 IF LEFT$(S$,1)="H" THEN T=1:S$= STR$( VAL(S$))
9160 RETURN
9170 IF LEFT$(S$,1)="P" THEN T=2:S$= STR$( VAL(S$))
9180 RETURN
9190 IF RIGHT$(S$,1)="*" AND LEN(S$)>1 THEN T=3:I8$=S$:S$= LEFT$(S$, LEN (S$)-1)
9200 RETURN
9210 IF RIGHT$(S$,1)="$" AND LEN(S$)>1 THEN T=4:I8$=S$:S$= LEFT$(S$, LEN (S$)-1)
9220 RETURN
9230 IF RIGHT$(S$,1)="%" AND LEN(S$)>1 THEN T=5:I8$=S$:S$= LEFT$(S$, LEN (S$)-1)
9240 RETURN
9250 T=0: RETURN
9260 IF V=1 THEN GOSUB 93: RETURN
9270 GOSUB 93: GOSUB 90: COLOR 0,7
9280 IF V=2 THEN PRINT "ENTER 'H' FOR HELP SUBROUTINE";: COLOR 7,0 : RETURN
9290 IF V=3 THEN PRINT "ENTER 'P' FOR PROBABILITY INPUT.";: COLOR 7,0 : RETURN
9300 IF V=4 THEN PRINT "'H'=HELP:'*' MULT. VALUE BY DAYS FED";: COLOR 7,0 : RETURN
9310 IF V=5 THEN PRINT "ENTER'*'AFTER VALUE MULT. BY DAYS FED";: COLOR 7,0 : RETURN
9320 IF V=6 THEN PRINT " '*'=MULT:'%'=PERCENT:'$'=DOLLAR";: COLOR 7,0 : RETURN
9330 RETURN
9340 REM A1,A2,A(I)=SALE & PURCHASE WEIGHTS
9350 REM B1,B2,B(I)=SALE & PURCHASE PRICES
9360 REM DF= DAYS ON FEED
9370 REM FC= FEED COST
9380 REM VM= VET. & MED. COSTS
9390 REM DR= DEATH RATE
9400 REM IR,OC=INTEREST COST
9410 REM YA=YARDAGE COST
9420 REM P0=AVERAGE DAILY GAIN
9430 REM P1= TOTAL COST /LB OF GAIN
9440 REM P2= FEED COST /LB OF GAIN
9450 REM P3=FEED COST/ANIMAL /DAY
9460 REM P4=TOTAL COST/ANIMAL/DAY
9470 REM P5=FEED COST/ANIMAL
9480 REM P6= TOTAL COST/ANIMAL
9490 REM CA=COST OF ANIMALS
9500 REM N(J,I)= NUMBER OF ANIMALS
9510 REM AA()=WEIGHT OF ANIMALS
9520 REM BB()=PRICE OF ANIMALS
9530 REM CC=GROSS REV.(COST) ALL ANIMALS SOLD(PURCHASED)
9540 REM N1=TOTAL NO. OF ANIMALS PURCHSED(SOLD)
9550 REM A3= TOTAL GROSS WEIGHT OF ALL ANIMALS PURCHASED
9560 REM E1()=# OF ANIMALS
9570 REM E2$()=PURCHASE DATE
9580 REM E3$()=SALE DATE
9590 REM DE= TOTAL # OF ANIMAL DAYS
9600 REM NA= TOTAL # OF ANIMALS
9610 REM FS$()=FEED DESCRIPTION
9620 REM PF()= LBS FED/DAY
9630 REM DG()= DAYS FED
9640 REM DU()= LBS/UNIT
9650 REM PU()= $/UNIT
9660 REM Y()= YARDAGE INPUT SEE 7190-7290
9670 REM Y1,Y2=INTEREST ON FACILITIES & MACHINES
9680 REM Y3,Y4=DEPRECIATION ON FAC.& MACH.
9690 REM M,M1=MONTH
9700 REM D,D1=DAY
9710 REM Y,Y1=YEAR
9720 REM Q1...Q3 =PROBABILITY INPUT
9730 REM Q5=% CHANCE OF GETING MORE THAN BS
9740 REM 1-Q4= % CHANCE OF GETTING > THAN Q3
9750 REM DL= DEATH LOSS COST
9760 REM SR=REVENUE SALE OF LIVESTOCK
9770 REM CC= CASH COSTS
9780 REM BS= BREAKEVEN SELLING PRICE
9790 REM BP= BREAKEVEN PURCHASE PRICE
9800 REM NR= EXPECTED NET REVENUE
9810 REM I7= FLAG FOR KIND OF INTEREST COST INPUT 1=%,2=*,3=$
9820 REM I8= INTEREST RATE
60000 REM this is the logo routine
60010 DEF SEG=0:IF (PEEK(&H410) AND &H30)=&H30 GOTO 60550
60020 S=3.141593
60030 KEY OFF
60040 SCREEN 1
60050 COLOR 0,1
60060 CLS
60070 LINE(0,0)-(319,199),3,B
60080 LINE(5,5)-(314,194),3,B
60090 PAINT(1,1),1,3
60100 DRAW"c3;bm40,100;e60;d60;l5;h15;e4;f10;u40;g50;l5;"
60110 PAINT(43,99),1,3
60120 DRAW"C3;bm110,30;d70;L5;U70;R5;"
60130 PAINT(109,99),1,3
60140 DRAW"C3;bm120,40;d60;L5;U60;R5;"
60150 PAINT(119,99),1,3
60160 CIRCLE(135,83),20,3,1.25*S,0.75*S
60170 CIRCLE(135,83),15,3,1.25*S,0.9*S
60180 DRAW"bm119,96;e5;"
60190 PAINT(135,98),1,3
60200 CIRCLE(170,83),20,3,0.2*S,1.85*S
60210 CIRCLE(170,83),15,3,0.25*S,1.8*S
60220 DRAW"C3;BM182,90;R5;"
60230 DRAW"C3;BM187,75;G10;H3;E7;"
60240 PAINT(170,99),1,3
60250 PAINT(170,67),1,3
60260 DRAW"c3;bm195,100;l5;u34;r5;d34;"
60270 CIRCLE(210,83),20,3,0.55*S,0.76*S
60280 CIRCLE(210,83),15,3,0.59*S,0.8799999*S
60290 DRAW"bm207,66;d5;"
60300 PAINT(194,99),1,3
60310 PAINT(206,69),1,3
60320 DRAW"c3;bm217,100;l5;u40;r5;d5;r7;d5;l7;d30;"
60330 PAINT(216,97),1,3
60340 DRAW"C3;bm265,65;d35;L5;U35;R5;"
60350 CIRCLE(245,83),20,3,0.25*S,1.75*S
60360 CIRCLE(245,83),15,3,0.09999999*S,1.7*S
60370 DRAW"bm261,99;h6;"
60380 PAINT(245,98),1,3
60390 PAINT(264,69),1,3
60400 LOCATE 14,22
60410 PRINT"AGRICULTURE"
60420 LOCATE 17,4
60430 PRINT"FIELD SERVICES DIVISION"
60440 LOCATE 18,4
60450 PRINT" & ECONOMIC SERVICES DIVISION"
60460 LOCATE 23,5
60470 PRINT"PROVIDED BY ALBERTA AGRICULTURE"
60480 LOCATE 24,3
60490 PRINT"RESPONSIBILITY RESTS WITH THE USER";
60500 FOR S=1 TO 4100
60510 POKE 106,0
60520 IF INKEY$<>"" GOTO 60540
60530 NEXT S
60540 ON ERROR GOTO 0 :SCREEN 0,0,0:RETURN
60550 REM **MONOCHROME LOGO**
60560 KEY OFF:WIDTH 80:CLS:S$=CHR$(219)
60570 PRINT STRING$(75,S$);
60580 FOR S=2 TO 23:LOCATE S,75:PRINT S$;:NEXT
60590 LOCATE 24,1:PRINT STRING$(75,S$);
60600 FOR S=23 TO 2 STEP -1:LOCATE S,1:PRINT S$;:NEXT
60610 '
60620 '
60630 LOCATE 5,28:PRINT "▌"
60640 LOCATE 6,24:PRINT"/▌ ▌ ▌"
60650 LOCATE 7,23:PRINT"/ ▌ ▌ ▌"
60660 LOCATE 8,22:PRINT"/ ▌ ▌ ▌ ▐"
60670 LOCATE 9,21:PRINT"/ ▌ ▌ ▌ __ __ ▐_ __"
60680 LOCATE 10,20:PRINT"/ ▌ ▌ ▌/ \ / \ ▐/ ▐ / \▌"
60690 LOCATE 11,19:PRINT"/ ▌ ▌ █ ▐ ▌ / ▐ ▐ ▌ ▌"
60700 LOCATE 12,18:PRINT"/ \ ▌ ▌ █ ▐ ▌ ▐ ▐ ▌ ▌"
60710 LOCATE 13,17:PRINT"/ \▌ ▌ ▌\__/ \__/ ▐ ▐ \__/▌"
60720 LOCATE 15,36:PRINT"A G R I C U L T U R E"
60730 LOCATE 18,14:PRINT"FIELD SERVICES & ECONOMIC SERVICES DIVISION"
60740 LOCATE 21,22:PRINT"PROVIDED BY ALBERTA AGRICULTURE."
60750 LOCATE 22,19:PRINT"RESPONSIBILITY RESTS SOLELY WITH USER"
60760 FOR S=1 TO 1500
60770 S$=INKEY$
60780 IF S$=CHR$(13) GOTO 60800
60790 NEXT S
60800 S$=""
60810 ON ERROR GOTO 0
60820 RETURN
62000 REM THIS IS THE SCREEN PRINT LOADER ACTIVATE WITH 'CALL PRTSCR'
62010 DEF SEG=&H0
62020 POKE &HF1, &HCD
62030 POKE &HF2, &H5
62040 POKE &HF3, &HCB
62050 PRTSCR=&HF1
62060 RETURN
CARCOST.BAS
1 REM CARCOST-CAR & TRUCK COSTS CALCULATOR
2 REM PROGRAMMER: G.MONNER
3 REM LAST REVISION: FIXED METRIC CONVERSION: G.FISHER JAN 1984
4 REM CONTACT: G.MONNER, REBS BRANCH
5 REM APPLE II VERSION
8 GOTO 5000
9 S$="":REM THIS IS THE INPUT SUBROUTINE
10 GOSUB 24:PRINT SPACE$(LEN(S$));
11 S8=0:GOSUB 24
12 GOSUB 31
13 GOSUB 35
14 GOSUB 53
15 IF S$="" THEN S$=S6$:GOTO 22
16 IF S3=1 THEN GOSUB 56
17 IF S8=1 GOTO 10
18 IF S3=1 THEN GOSUB 68
19 IF S8=1 GOTO 10
20 IF S3=3 THEN GOSUB 73
21 IF S8=1 GOTO 10
22 IF S3=1 THEN S=VAL(S$)
23 RETURN
24 REM POSITION CURSOR
25 LOCATE S1,S2,1
30 RETURN
31 REM PRINT DEFAULT
32 PRINT S6$
33 GOSUB 24
34 RETURN
35 REM TRANSPARENT CURSOR ROUTINE
36 S$=""
37 S1$=INPUT$(1)
41 S=ASC(S1$):IF S<>13 GOTO 46
42 IF S$="" THEN GOSUB 24:PRINT " ";:GOSUB 24:GOSUB 31:PRINT:RETURN
43 IF LEN(S$)>=LEN(S6$) GOTO 45
44 PRINT SPACE$(LEN(S6$)-LEN(S$));
45 PRINT S1$;:RETURN
46 IF S<32 GOTO 50
47 IF S=34 THEN S1$="'"
48 S$=S$+S1$:IF S9>0 THEN IF LEN(S$)>S9 THEN PRINT S1$;:GOTO 52
49 PRINT S1$;:GOTO 37
50 IF LEN(S$)<1 GOTO 36
51 IF LEN(S$)=1 THEN PRINT CHR$(29);:PRINT" ";:PRINT CHR$(29);:GOTO 36
52 S$=LEFT$(S$,LEN(S$)-1):PRINT CHR$(29);:PRINT" ";:PRINT CHR$(29);:GOTO 37
53 REM THIS CHECKS FOR EXIT
54 IF S$="<" THEN CLS:PRINT" LOADING MENU...":RUN"HELLO.BAS"
55 RETURN
56 GOSUB 6000:S1$=S$:S7=0:REM CHECK FOR NUMERIC INPUT
57 IF LEFT$(S1$,1)=" " THEN S1$=RIGHT$(S1$,LEN(S1$)-1):GOTO 57
58 IF RIGHT$(S1$,1)=" " THEN S1$=LEFT$(S1$,LEN(S1$)-1):GOTO 58
59 IF LEN(S1$)<1 GOTO 64
60 FOR S=1 TO LEN(S1$):S6=ASC(MID$(S1$,S,1))
61 IF S6>=48 AND S6<=57 GOTO 66
62 IF (S6=43 OR S6=45) AND S=1 GOTO 66
63 IF S6=46 AND S7=0 THEN S7=1:GOTO 66
64 S2$="NON NUMERIC INPUT":S1$="":GOSUB 78
65 RETURN
66 NEXT S
67 RETURN
68 REM CHECK FOR PROPER LIMITS
69 S6=VAL(S$)
70 IF S6<S4 THEN S2$="INPUT BELOW":S1$=STR$(S4):GOSUB 78:RETURN
71 IF S6>S5 THEN S2$="INPUT ABOVE":S1$=STR$(S5):GOSUB 78:RETURN
72 RETURN
73 REM CHECK FOR YES OR NO
74 IF LEFT$(S$,1)="Y" OR LEFT$(S$,1)="N" GOTO 76
75 S2$="MUST BE YES/NO ANSWER":S1$="":GOSUB 78:RETURN
76 S$=LEFT$(S$,1)
77 RETURN
78 REM ERROR FOR ALL CONDITIONS
79 COLOR 31,0,0:BEEP
80 GOSUB 90
81 PRINT" ";S2$;S1$;
82 FOR S7=1 TO 3000:NEXT S7
83 COLOR 7,0,0
87 GOSUB 93
88 S8=1
89 RETURN
90 REM POSTITION TO LAST LINE
91 LOCATE 25,1,0
92 RETURN
93 REM BLANK LAST LINE
94 LOCATE 25,1,1
95 PRINT SPACE$(39);
96 RETURN
200 REM ****DOLLAR FORMAT SUBROUTINE****
201 S3=INT(S3*100+0.5)/100
202 S3$=SPACE$(30)
203 IF S3=0 THEN S3$=RIGHT$(S3$,S4-4)+"0.00":GOTO 209
204 S4$=STR$(S3)
205 IF ASC(MID$(RIGHT$(S4$,2),1,1))=46 THEN S3$=S3$+S4$+"0":GOTO 208
206 IF ASC(MID$(RIGHT$(S4$,3),1,1))=46 THEN S3$=S3$+S4$:GOTO 208
207 S3$=S3$+S4$+".00"
208 S3$=RIGHT$(S3$,S4)
209 RETURN
300 REM HOLD SCREEN
301 S$="PRESS RETURN TO CONTINUE "
302 COLOR 31,0,0
303 GOSUB 90
304 PRINT" ";S$;
305 POKE 106,0
306 IF INKEY$=CHR$(13) GOTO 307 ELSE GOTO 305
307 COLOR 7,0,0
308 GOSUB 93
314 S$="":S1$=""
315 RETURN
5000 GOSUB 62000: GOSUB 60000: REM MAIN LINE
5001 REM PRINT LOGO
5009 REM MAINLINE PROGRAM
5010 CLS : PRINT
5020 PRINT : PRINT : PRINT " CAR & TRUCK COSTING MODEL"
5030 PRINT " ------------------------"
5035 PRINT " REVISED JAN/84"
5040 PRINT : PRINT
5050 DIM A$(15),B$(15),M$(15),A(15)
5055 FOR I=1 TO 14:A(I)=1: NEXT I
5060 FOR I=1 TO 14: READ B$(I): NEXT I
5070 FOR I=1 TO 14: READ M$(I): NEXT I
5080 PRINT " BRITISH(B) OR METRIC(M) UNITS? ";
5090 S6$=" ":S1=9:S2=33:S3=2:S9=1: GOSUB 9:U$=S$
5100 IF U$="B" OR U$="M" THEN GOTO 5120
5110 GOTO 5090
5120 CLS : FOR I=1 TO 14
5130 IF U$="B" THEN A$(I)=B$(I)
5140 IF U$="M" THEN A$(I)=M$(I)
5150 PRINT A$(I);
5160 FOR I1=1 TO (31- LEN(A$(I))): PRINT ".";: NEXT I1: PRINT ">";A(I);
5170 IF I=2 OR I=4 OR I=7 OR I=9 OR I=11 OR I=12 THEN 5190
5180 PRINT
5190 PRINT
5200 NEXT I
5202 IF U <> 1 GOTO 5210
5206 CALL PRTSCR:U=0: RETURN
5210 IF U$="B" THEN S1$="TYPE 'M' AFTER ENTRY TO CONVERT"
5220 IF U$="M" THEN S1$="TYPE 'B' AFTER ENTRY TO CONVERT"
5230 S2$=" ": GOSUB 78: GOSUB 90: PRINT S1$;
5240 I=1:S9=7:S6$= STR$(A(I))
5250 S1=1:S2=33:S3=1:S4=0:S4=1:S5=300000!: GOSUB 9:A(I)= VAL(S$)
5260 I=I+1:S6$= STR$(A(I)):S1=3:S4=1:S5=150:GOSUB 9:A(I)= VAL(S$)
5270 I=I+1:S6$= STR$(A(I)):S1=4:S4=0.1:S5=3: GOSUB 9:A(I)= VAL(S$)
5280 I=I+1:S6$= STR$(A(I)):S1=6:S4=1:S5=500: GOSUB 9:A(I)= VAL(S$)
5290 I=I+1:S6$= STR$(A(I)):S1=7:S4=1:S5=50000!: GOSUB 9:A(I)= VAL(S$)
5300 I=I+1:S6$= STR$(A(I)):S1=9:S4=1:S5=5000: GOSUB 9:A(I)= VAL(S$)
5310 I=I+1:S6$= STR$(A(I)):S1=11:S4=1:S5=2000: GOSUB 9:A(I)= VAL(S$)
5320 I=I+1:S6$= STR$(A(I)):S1=12:S4=1:S5=300000!: GOSUB 9:A(I)= VAL(S$)
5330 I=I+1:S6$= STR$(A(I)):S1=14:S4=1:S5=9000:GOSUB 9:A(I)= VAL(S$)
5340 I=I+1:S6$= STR$(A(I)):S1=15:S4=1:S5=9000: GOSUB 9:A(I)= VAL(S$)
5350 I=I+1:S6$= STR$(A(I)):S1=17:S4=1:S5=300000!: GOSUB 9:A(I)= VAL(S$)
5360 I=I+1:S6$= STR$(A(I)):S1=18:S4=1:S5=300000!: GOSUB 9:A(I)= VAL(S$)
5370 I=I+1:S6$= STR$(A(I)):S1=19:S4=0.1:S5=50: GOSUB 9:A(I)= VAL(S$)
5380 I=I+1:S6$= STR$(A(I)):S1=21:S4=1:S5=100: GOSUB 9:A(I)= VAL(S$)
5390 S1=23:S2=1: GOSUB 24: PRINT "CHANGE DATA? (Y/N)";:S6$=" ":S2=20:S3=3: GOSUB 9
5400 IF S$="Y" THEN 5240
5405 IF S$="N" THEN 5410
5406 GOTO 5390
5410 IF U$="B" THEN A2=A(2)
5420 IF U$="M" THEN A2=100/A(2)
5430 FC= INT((A(3)/A2)*10000+0.5)/10000
5440 OL= INT((A(4)/A(5))*10000+0.5)/10000
5450 RT= INT((A(6)/A(1))*10000+0.5)/10000
5460 TR= INT((A(7)/A(8))*10000+0.5)/10000
5470 LI= INT((A(9)/A(1))*10000+0.5)/10000
5480 IS= INT((A(10)/A(1))*10000+0.5)/10000
5490 DE= INT((((A(11)-A(12))/A(13))/A(1))*10000+0.5)/10000
5500 IN= INT(((((A(11)+A(12))/2)*A(14)/100)/A(1))*1000+0.5)/1000
5510 X=FC+OL+RT+TR+LI+IS
5520 CF=DE+IN
5540 TC=DE+IN+FC+OL+RT+TR+LI+IS
5550 CLS
5560 PRINT " CAR & TRUCK COSTS "
5570 PRINT " ----------------- "
5580 PRINT
5590 PRINT " FUEL COST....=";:S3=100*FC:S4=6:S5=1: GOSUB 200: PRINT S3$
5600 PRINT " OIL & LUBE...=";:S3=100*OL: GOSUB 200: PRINT S3$
5610 PRINT " REPAIRS & ...=";:S3=100*RT: GOSUB 200: PRINT S3$
5620 PRINT " TIRES........=";:S3=100*TR: GOSUB 200: PRINT S3$
5630 PRINT : PRINT " LICENCE &"
5640 PRINT " INSURANCE....=";:S3=100*IS+LI: GOSUB 200: PRINT S3$
5650 PRINT " ------------------"
5660 PRINT " TOTAL CASH COSTS....=";:S3=100*X: GOSUB 200: PRINT S3$
5670 PRINT " DEPRECIATION.=";:S3=100*DE: GOSUB 200: PRINT S3$
5680 PRINT " INTEREST.....=";:S3=100*IN: GOSUB 200: PRINT S3$
5690 PRINT " ------------------"
5700 PRINT " TOTAL FIXED COSTS...=";:S3=100*CF: GOSUB 200: PRINT S3$
5710 PRINT " ------"
5720 IF U$="B" THEN GOSUB 5810: REM PRINT BRITISH TOTAL
5730 IF U$="M" THEN GOSUB 5840: REM PRINT METRIC TOTAL
5740 GOSUB 5800: PRINT "PRINTOUT OF RESULTS (Y/N)";
5750 S6$="N":S1=23:S2=26:S3=3: GOSUB 9
5760 IF S$="Y" THEN GOSUB 5800: PRINT " ";: GOSUB 6150
5770 GOSUB 5800: PRINT "CHANGE INPUT DATA (Y/N) ";:S2=25: GOSUB 9
5780 IF S$="Y" THEN 5120
5785 GOSUB 5800: PRINT "EXIT PROGRAM? (Y/N) ";:S2=21: GOSUB 9
5790 IF S$="N" THEN RUN 5010
5795 CLS : PRINT "THANK YOU":LOCATE 10,1: COLOR 0,7: PRINT "PLEASE WAIT ... LOADING PROGRAM MENU":COLOR 7,0: RUN "HELLO"
5800 S1=23:S2=1: GOSUB 24: RETURN
5810 PRINT " TOTAL COST (CENTS)..=";:S3=100*TC: GOSUB 200: PRINT S3$;"/MILE"
5820 PRINT " =";:S3=100*TC/1.6093: GOSUB 200: PRINT S3$;"/KM"
5830 RETURN
5840 PRINT " TOTAL COST (CENTS)..=";:S3=100*TC: GOSUB 200: PRINT S3$;"/KM"
5850 PRINT " =";:S3=100*TC*1.6093: GOSUB 200: PRINT S3$;"/MILE"
5860 RETURN
5870 END
5999 REM CONVERSION SUBROUTINE
6000 IF RIGHT$ (S$,1)="M" OR RIGHT$ (S$,1)="B" THEN 6040
6010 RETURN
6040 IF U$="B" AND RIGHT$ (S$,1)="M" THEN 6070
6050 IF U$="M" AND RIGHT$ (S$,1)="B" THEN 6120
6060 RETURN
6070 ON I GOSUB 6080,6090,6100,6110,6080,6110,6110,6080,6110,6110,6110
6075 GOSUB 24: PRINT " ";: GOSUB 24: PRINT S$;: RETURN
6080 S$=STR$(INT(VAL(S$)*0.621371+0.5)):RETURN
6090 S$= STR$( INT((282.102/ VAL(S$))*10+0.5)/10): RETURN
6100 S$= STR$( INT( VAL(S$)*454+0.5)/100): RETURN
6110 RETURN
6120 ON I GOSUB 6130,6090,6140,6110,6130,6110,6110,6130,6110,6110,6110
6125 GOSUB 24: PRINT " ";: GOSUB 24: PRINT S$;: RETURN
6130 S$=STR$(INT(VAL(S$)/0.621371+0.5)):RETURN
6140 S$= STR$( INT(( VAL(S$)/4.54)*100+0.5)/100): RETURN
6149 REM PRINT TABLE
6150 REM SCREEN PRINT
6152 CALL PRTSCR
6154 U=1: GOSUB 5100: RETURN
10000 DATA "MILES TRAVELLED /YR "
10010 DATA "AVERAGE # OF MPG ","COST/GAL OF FUEL($/GAL)"
10020 DATA "OIL & LUBE COST/OIL CHANGE"
10030 DATA "MILES BETWEEN O&L","REPAIR & TUNE-UP COST/YR "
10040 DATA "COST OF SET OF TIRES","MILES/SET OF TIRES"
10050 DATA "LICENCE FEE ($/YR)","INSURANCE ($/YR)","PURCHASE PRICE"
10060 DATA "TRADE-IN OR SALE VALUE"
10070 DATA "NUMBER OF YEARS OWNED","INTEREST RATE ON INVESTMENT(%)"
10080 DATA "KILOMETERS TRAVELLED/YR "
10090 DATA "AVERAGE # OF L/100KM ","COST/LITRE OF FUEL ($/LITRE)"
10100 DATA "OIL & LUBE COST/OIL CHANGE"
10110 DATA "KILOMETERS BETWEEN O&L","REPAIR & TUNE-UP COST/YR"
10120 DATA "COST OF SET OF TIRES","KILOMETERS/SET OF TIRES"
10130 DATA "LICENCE FEE($/YR)","INSURANCE ($/YR)","PURCHASE PRICE"
10140 DATA "TRADE-IN OR SALE VALUE"
10150 DATA "NUMBER OF YEARS OWNED","INTEREST RATE ON INVESTMENT(%)"
12000 REM A(I) WHERE I=1TO24 IS THE INPUT DATA
12010 REM U$ IS THE DESIGNATION OF BRITISH OR METRIC UNITS
12020 REM FC=FUEL COSTS
12030 REM OL=OIL & LUBE COS TS
12040 REM RT=REPAIR & MAINTANENCE COSTS
12050 REM TR=COST OF TIRES
12060 REM LI=LICENCE COSTS
12070 REM IS=INSURANCE COSTS
12080 REM DE=DEPRICIATION COST
12090 REM IN=INTEREST COST
12100 REM X=TOTAL CASH COSTS
12110 REM CF=TOYAL FIXED COSTS
12120 REM TC=TOTAL COSTS
12130 END
60000 REM this is the logo routine
60010 DEF SEG=0:IF (PEEK(&H410) AND &H30)=&H30 GOTO 60550
60020 S=3.141593
60030 KEY OFF
60040 SCREEN 1
60050 COLOR 0,1
60060 CLS
60070 LINE(0,0)-(319,199),3,B
60080 LINE(5,5)-(314,194),3,B
60090 PAINT(1,1),1,3
60100 DRAW"c3;bm40,100;e60;d60;l5;h15;e4;f10;u40;g50;l5;"
60110 PAINT(43,99),1,3
60120 DRAW"C3;bm110,30;d70;L5;U70;R5;"
60130 PAINT(109,99),1,3
60140 DRAW"C3;bm120,40;d60;L5;U60;R5;"
60150 PAINT(119,99),1,3
60160 CIRCLE(135,83),20,3,1.25*S,0.75*S
60170 CIRCLE(135,83),15,3,1.25*S,0.9*S
60180 DRAW"bm119,96;e5;"
60190 PAINT(135,98),1,3
60200 CIRCLE(170,83),20,3,0.2*S,1.85*S
60210 CIRCLE(170,83),15,3,0.25*S,1.8*S
60220 DRAW"C3;BM182,90;R5;"
60230 DRAW"C3;BM187,75;G10;H3;E7;"
60240 PAINT(170,99),1,3
60250 PAINT(170,67),1,3
60260 DRAW"c3;bm195,100;l5;u34;r5;d34;"
60270 CIRCLE(210,83),20,3,0.55*S,0.76*S
60280 CIRCLE(210,83),15,3,0.59*S,0.8799999*S
60290 DRAW"bm207,66;d5;"
60300 PAINT(194,99),1,3
60310 PAINT(206,69),1,3
60320 DRAW"c3;bm217,100;l5;u40;r5;d5;r7;d5;l7;d30;"
60330 PAINT(216,97),1,3
60340 DRAW"C3;bm265,65;d35;L5;U35;R5;"
60350 CIRCLE(245,83),20,3,0.25*S,1.75*S
60360 CIRCLE(245,83),15,3,0.09999999*S,1.7*S
60370 DRAW"bm261,99;h6;"
60380 PAINT(245,98),1,3
60390 PAINT(264,69),1,3
60400 LOCATE 14,22
60410 PRINT"AGRICULTURE"
60420 LOCATE 17,4
60430 PRINT"FIELD SERVICES DIVISION"
60440 LOCATE 18,4
60450 PRINT" & ECONOMIC SERVICES DIVISION"
60460 LOCATE 23,5
60470 PRINT"PROVIDED BY ALBERTA AGRICULTURE"
60480 LOCATE 24,3
60490 PRINT"RESPONSIBILITY RESTS WITH THE USER";
60500 FOR S=1 TO 4100
60510 POKE 106,0
60520 IF INKEY$<>"" GOTO 60540
60530 NEXT S
60540 ON ERROR GOTO 0 :SCREEN 0,0,0:RETURN
60550 REM **MONOCHROME LOGO**
60560 KEY OFF:WIDTH 80:CLS:S$=CHR$(219)
60570 PRINT STRING$(75,S$);
60580 FOR S=2 TO 23:LOCATE S,75:PRINT S$;:NEXT
60590 LOCATE 24,1:PRINT STRING$(75,S$);
60600 FOR S=23 TO 2 STEP -1:LOCATE S,1:PRINT S$;:NEXT
60610 '
60620 '
60630 LOCATE 5,28:PRINT "▌"
60640 LOCATE 6,24:PRINT"/▌ ▌ ▌"
60650 LOCATE 7,23:PRINT"/ ▌ ▌ ▌"
60660 LOCATE 8,22:PRINT"/ ▌ ▌ ▌ ▐"
60670 LOCATE 9,21:PRINT"/ ▌ ▌ ▌ __ __ ▐_ __"
60680 LOCATE 10,20:PRINT"/ ▌ ▌ ▌/ \ / \ ▐/ ▐ / \▌"
60690 LOCATE 11,19:PRINT"/ ▌ ▌ █ ▐ ▌ / ▐ ▐ ▌ ▌"
60700 LOCATE 12,18:PRINT"/ \ ▌ ▌ █ ▐ ▌ ▐ ▐ ▌ ▌"
60710 LOCATE 13,17:PRINT"/ \▌ ▌ ▌\__/ \__/ ▐ ▐ \__/▌"
60720 LOCATE 15,36:PRINT"A G R I C U L T U R E"
60730 LOCATE 18,14:PRINT"FIELD SERVICES & ECONOMIC SERVICES DIVISION"
60740 LOCATE 21,22:PRINT"PROVIDED BY ALBERTA AGRICULTURE."
60750 LOCATE 22,19:PRINT"RESPONSIBILITY RESTS SOLELY WITH USER"
60760 FOR S=1 TO 1500
60770 S$=INKEY$
60780 IF S$=CHR$(13) GOTO 60800
60790 NEXT S
60800 S$=""
60810 ON ERROR GOTO 0
60820 RETURN
62000 REM THIS IS THE SCREEN PRINT LOADER ACTIVATE WITH 'CALL PRTSCR'
62010 DEF SEG=&H0
62020 POKE &HF1, &HCD
62030 POKE &HF2, &H5
62040 POKE &HF3, &HCB
62050 PRTSCR=&HF1
62060 RETURN
CFP.BAS
1 REM **COMPARATIVE FEED PRICING**
2 REM **-A PROGRAM FOR CALCULATING THE ENERGY & PROTEIN EQUIVALENT PRICES OF
3 REM **FEEDSTUFFS RELATIVE TO THE PRICES OF BARLEY & CANOLA MEAL.
4 REM **REVISION DATE= 06/84 (CHANGE STMT 5063 ALSO)
5 REM **CONTACT: GEORGE MONNER DON MILLIGAN,R.D.WIESENBERGER
6 REM ** R.E.B.S. BRANCH LIVESTOCK INDUSTRY DIVISION
7 REM *** IBM VERSION
8 GOTO 5000
9 S$="":REM THIS IS THE INPUT SUBROUTINE
10 GOSUB 24:PRINT SPACE$(LEN(S$));
11 S8=0:GOSUB 24
12 GOSUB 31
13 GOSUB 35
14 GOSUB 53
15 IF S$="" THEN S$=S6$:GOTO 22
16 IF S3=1 THEN GOSUB 56
17 IF S8=1 GOTO 10
18 IF S3=1 THEN GOSUB 68
19 IF S8=1 GOTO 10
20 IF S3=3 THEN GOSUB 73
21 IF S8=1 GOTO 10
22 IF S3=1 THEN S=VAL(S$)
23 RETURN
24 REM POSITION CURSOR
25 LOCATE S1,S2,1
30 RETURN
31 REM PRINT DEFAULT
32 PRINT S6$
33 GOSUB 24
34 RETURN
35 REM TRANSPARENT CURSOR ROUTINE
36 S$=""
37 S1$=INPUT$(1)
41 S=ASC(S1$):IF S<>13 GOTO 46
42 IF S$="" THEN GOSUB 24:PRINT " ";:GOSUB 24:GOSUB 31:PRINT:RETURN
43 IF LEN(S$)>=LEN(S6$) GOTO 45
44 PRINT SPACE$(LEN(S6$)-LEN(S$));
45 PRINT S1$;:RETURN
46 IF S<32 GOTO 50
47 IF S=34 THEN S1$="'"
48 S$=S$+S1$:IF S9>0 THEN IF LEN(S$)>S9 THEN PRINT S1$;:GOTO 52
49 PRINT S1$;:GOTO 37
50 IF LEN(S$)<1 GOTO 36
51 IF LEN(S$)=1 THEN PRINT CHR$(29);:PRINT" ";:PRINT CHR$(29);:GOTO 36
52 S$=LEFT$(S$,LEN(S$)-1):PRINT CHR$(29);:PRINT" ";:PRINT CHR$(29);:GOTO 37
53 REM THIS CHECKS FOR EXIT
54 IF S$="<" THEN CLS:PRINT" LOADING MENU...":RUN"HELLO.BAS"
55 RETURN
56 S1$=S$:S7=0:REM CHECK FOR NUMERIC INPUT
57 IF LEFT$(S1$,1)=" " THEN S1$=RIGHT$(S1$,LEN(S1$)-1):GOTO 57
58 IF RIGHT$(S1$,1)=" " THEN S1$=LEFT$(S1$,LEN(S1$)-1):GOTO 58
59 IF LEN(S1$)<1 GOTO 64
60 FOR S=1 TO LEN(S1$):S6=ASC(MID$(S1$,S,1))
61 IF S6>=48 AND S6<=57 GOTO 66
62 IF (S6=43 OR S6=45) AND S=1 GOTO 66
63 IF S6=46 AND S7=0 THEN S7=1:GOTO 66
64 S2$="NON NUMERIC INPUT":S1$="":GOSUB 78
65 RETURN
66 NEXT S
67 RETURN
68 REM CHECK FOR PROPER LIMITS
69 S6=VAL(S$)
70 IF S6<S4 THEN S2$="INPUT BELOW":S1$=STR$(S4):GOSUB 78:RETURN
71 IF S6>S5 THEN S2$="INPUT ABOVE":S1$=STR$(S5):GOSUB 78:RETURN
72 RETURN
73 REM CHECK FOR YES OR NO
74 IF LEFT$(S$,1)="Y" OR LEFT$(S$,1)="N" GOTO 76
75 S2$="MUST BE YES/NO ANSWER":S1$="":GOSUB 78:RETURN
76 S$=LEFT$(S$,1)
77 RETURN
78 REM ERROR FOR ALL CONDITIONS
79 COLOR 31,0,0:BEEP
80 GOSUB 90
81 PRINT" ";S2$;S1$;
82 FOR S7=1 TO 3000:NEXT S7
83 COLOR 7,0,0
87 GOSUB 93
88 S8=1
89 RETURN
90 REM POSTITION TO LAST LINE
91 LOCATE 25,1,0
92 RETURN
93 REM BLANK LAST LINE
94 LOCATE 25,1,1
95 PRINT SPACE$(39);
96 RETURN
200 REM ****DOLLAR FORMAT SUBROUTINE****
201 S3=INT(S3*100+0.5)/100
202 S3$=SPACE$(30)
203 IF S3=0 THEN S3$=RIGHT$(S3$,S4-4)+"0.00":GOTO 209
204 S4$=STR$(S3)
205 IF ASC(MID$(RIGHT$(S4$,2),1,1))=46 THEN S3$=S3$+S4$+"0":GOTO 208
206 IF ASC(MID$(RIGHT$(S4$,3),1,1))=46 THEN S3$=S3$+S4$:GOTO 208
207 S3$=S3$+S4$+".00"
208 S3$=RIGHT$(S3$,S4)
209 RETURN
300 REM HOLD SCREEN
301 S$="PRESS RETURN TO CONTINUE "
302 COLOR 31,0,0
303 GOSUB 90
304 PRINT" ";S$;
305 POKE 106,0
306 IF INKEY$=CHR$(13) GOTO 307 ELSE GOTO 305
307 COLOR 7,0,0
308 GOSUB 93
314 S$="":S1$=""
315 RETURN
1110 REM Z5,Z6=INTERNAL COUNTERS
1120 REM I,I1,J,K=LOOP COUNTERS
1130 REM V,V$,V1,V2,V3=TEMPOARY VALUES FOR READ STATEMENTS
1140 REM C$( , )=FEEDSTUFF DESCRIPTION
1150 REM W( )=TEMPORARY STORAGE VALUE FOR FEEDSTUFF NUMBER
1160 REM W1= COUNTER OF THE NUMBER OF FEEDS USED
1170 REM NI=NUMBER IDENTIFIER FOR NEW FEEDS ADDED
1180 REM A( , ),C1,C2 ,C3,R,X,Y,V=TEMPOARY VALUES USED FOR DOING CALCULATION
1190 REM V1=$ VALUE CALCULATED FOR FEEDSTUFFS
4999 REM MAINLINE OF PROGRAM
5000 GOSUB 62000: REM SCREEN DUMP
5005 GOSUB 60000: REM LOGO
5006 CLS: PRINT "PLEASE WAIT... LOADING DATA"
5007 CLS
5010 PRINT " COMPARATIVE FEED PRICING"
5020 PRINT " ========================"
5025 PRINT : PRINT
5030 PRINT : PRINT " THIS PROGRAM CALCULATES THE ENERGY AND"
5035 PRINT "PROTEIN EQUIVALENT PRICES OF FEEDSTUFFS"
5040 PRINT "RELATIVE TO THE PRICES OF BARLEY AND "
5045 PRINT "CANOLA MEAL."
5050 PRINT : PRINT " NOTE: THIS PROGRAM DOES NOT TAKE INTO"
5055 PRINT "ACCOUNT SUCH FACTORS AS PALATABILITY"
5060 PRINT "AND DIGESTIBILITY OF THE FEEDSTUFFS."
5063 PRINT : PRINT : PRINT " JUNE 1984"
5065 GOSUB 300
5070 CLS : PRINT " MENU"
5071 PRINT " ---- "
5072 PRINT : PRINT
5080 PRINT "1. CHOOSE/ADD FEEDSTUFFS FROM LIST"
5090 PRINT : PRINT "2. CHOOSE/ADD OWN FEEDSTUFFS"
5100 PRINT : PRINT "3. LIST/CHANGE NUTRIENT VALUES OF FEEDS"
5105 PRINT : PRINT "4. DELETE FEEDSTUFFS"
5110 PRINT : PRINT "5. PERFORM DOLLAR CALCULATIONS"
5120 PRINT : PRINT "6. EXIT PROGRAM"
5130 PRINT : PRINT : PRINT
5135 PRINT : PRINT : PRINT
5140 PRINT "ENTER THE NUMBER OF YOUR CHOICE:"
5150 S6$="":S1=22:S2=34:S3=1:S4=1:S5=6:S9=1: GOSUB 9
5160 IF S$="1" THEN RESTORE : GOSUB 7000: GOTO 5070: REM CHOOSE/ADDFEEDSTUFFS FROM LIST
5170 IF S$="2" THEN GOSUB 7500: GOTO 5070: REM ADD OWN FEEDSTUFFS
5180 IF S$="3" THEN GOSUB 7800: GOTO 5070: REM LIST/CHANGE NUTRIENT VALUES
5185 IF S$="4" THEN GOSUB 8200: GOTO 5070: REM DELETE A FEEDSTUFF
5190 IF S$="5" THEN GOSUB 8000: GOTO 5070: REM ENTER $ VALUES & DO CALCULATIONS
5200 IF S$="6" THEN CLS : PRINT "GOOD BYE!":LOCATE 10,1:COLOR 0,7: PRINT " LOADING PROGRAM MENU PLEASE WAIT ":COLOR 7,0:RUN "HELLO"
5210 GOTO 5150
6999 REM CHOOSE/ADD FEEDS FROM LIST
7000 IF W1 > =6 THEN S$="MAX. FEEDS ALREADY CHOSEN 'RETURN'": GOSUB 302: RETURN
7003 Z5=1:Z6=7: GOSUB 7170: PRINT "HAY**": GOSUB 7210:S4=Z5:S5=Z6: GOSUB 7280
7005 IF I5=1 THEN I5=0: RETURN
7010 Z5=11:Z6=14: GOSUB 7170: PRINT "GREENFEED": GOSUB 7210:S4=Z5:S5=Z6: GOSUB 7280
7015 IF I5=1 THEN I5=0: RETURN
7020 Z5=21:Z6=29: GOSUB 7170: PRINT "*SILAGE": GOSUB 7210:S4=Z5:S5=Z6: GOSUB 7280
7025 IF I5=1 THEN I5=0: RETURN
7030 Z5=31:Z6=33: GOSUB 7170: PRINT "*STRAW*** ": GOSUB 7210:S4=Z5:S5=Z6: GOSUB 7280
7035 IF I5=1 THEN I5=0: RETURN
7040 Z5=41:Z6=43: GOSUB 7170: PRINT "*GRAIN*": GOSUB 7210:S4=Z5:S5=Z6: GOSUB 7280
7045 IF I5=1 THEN I5=0: RETURN
7050 Z5=51:Z6=57: GOSUB 7170: PRINT "*SUPPLEMENT**": GOSUB 7210: S4=Z5:S5=Z6
7051 GOSUB 7280
7060 RESTORE : GOSUB 90: PRINT "PLEASE BE PATIENT. I'M THINKING!";
7070 FOR I=1 TO 33
7080 READ V,V$,V1,V2,V3
7090 IF V=41 THEN C$(1,2)=V$:C$(1,3)= STR$(V1):C$(1,4)= STR$(V2):C$(1,5)= STR$(V3)
7100 IF V=56 THEN C$(2,2)=V$:C$(2,3)= STR$(V1):C$(2,4)= STR$(V2):C$(2,5)= STR$(V3)
7110 FOR J=1 TO W1
7120 IF V=W(J) AND C$(J+2,2)="" THEN C$(J+2,1)= STR$(V):C$(J+2,2)=V$:C$(J+2,3)= STR$(V1)
7130 IF V=W(J) AND C$(J+2,4)="" THEN C$(J+2,4)= STR$(V2):C$(J+2,5)= STR$(V3)
7140 NEXT J
7150 NEXT I
7155 RETURN
7169 REM HEADING FOR FEED LISTS
7170 CLS
7180 PRINT TAB( 16);" DM DE CP "
7190 PRINT "-------------------------------------"
7200 RETURN
7209 REM ROUTINE FOR READING & PRINTING FEED LISTS
7210 FOR I=Z5 TO Z6
7220 READ V,V$,V1,V2,V3
7230 PRINT
7235 PRINT USING"## \ \###.## #.#### #.####";V;V$;V1;V2;V3
7240 NEXT I
7250 RETURN
7279 REM INPUT FEEDSTUFFS FROM LIST
7280 S1=22:S2=1: GOSUB 24: PRINT "ENTER THE # OF THE FEED & PRESS RETURN."
7285 PRINT " TO CONTINUE, JUST PRESS RETURN"
7290 FOR J=1 TO 4:S6$=" ":S1=23:S2=33:S3=1:S9=2: GOSUB 9
7291 IF S<1 THEN J=4: GOTO 7310
7300 W1=W1+1:W(W1)=S: IF W1=6 THEN GOSUB 7060: GOSUB 7400:I5=1: RETURN
7302 S1=5+(S-Z5)*2:S2=1:GOSUB 24
7304 IF W(W1)>9 THEN COLOR 0,7:PRINT MID$(STR$(W(W1)),2);:COLOR 7,0:GOTO 7310
7306 PRINT " ";:COLOR 0,7: PRINT MID$(STR$(W(W1)),2);: COLOR 7,0
7310 NEXT J
7320 RETURN
7399 REM REMINDER OF MAX NO. OF FEEDS
7400 I5=1: GOSUB 7800
7410 PRINT "YOU NOW HAVE MAX. NO. OF FEEDS."
7420 PRINT "DO YOU WISH TO DELETE A FEED?<Y/N>"
7430 S6$="N":S1=22:S2=35:S3=3: GOSUB 9
7440 IF S$="Y" THEN GOSUB 8200
7450 RETURN
7500 REM ROUTINE TO ADD NEW FEEDSTUFFS
7510 IF W1=6 THEN GOSUB 7400: RETURN
7520 CLS : PRINT
7530 PRINT : PRINT : PRINT "ENTER FEEDSTUFF NAME..........."
7540 PRINT : PRINT "ENTER % DRY MATTER OF FEEDSTUFF "
7550 PRINT : PRINT "ENTER DE OF FEEDSTUFF.......... "
7560 PRINT : PRINT "ENTER CP OF FEEDSTUFF.......... "
7590 PRINT : PRINT "======================================"
7600 PRINT : PRINT "CHANGE DATA?(Y/N)"
7610 PRINT : PRINT "ANOTHER FEEDSTUFF?(Y/N)"
7620 S6$=C$(W1+3,2):S1=4:S2=33:S3=2:S9=8: GOSUB 9:C$(W1+3,2)=S$
7630 S6$=C$(W1+3,3):S3=1:S1=6:S4=1:S5=100: GOSUB 9:C$(W1+3,3)=S$
7640 S6$=C$(W1+3,4):S1=8:S4=0:S5=3: GOSUB 9:C$(W1+3,4)=S$
7650 S6$=C$(W1+3,5):S1=10: GOSUB 9:C$(W1+3,5)=S$
7680 S6$="N":S1=14:S3=3: GOSUB 9: IF S$="Y" THEN 7620
7710 W1=W1+1:NI=NI+1
7720 S6$="N":S1=16: GOSUB 9: IF S$="Y" THEN 7510
7730 GOSUB 7060: RETURN
7799 REM LISTNG/CHANGING NUTRIENT VALUES OF FEEDS CHOSEN
7800 GOSUB 7170: REM HEADING FOR FEED LIST
7820 FOR I=1 TO W1+2
7830 PRINT USING"## \ \###.## #.#### #.####";I;C$(I,2);VAL(C$(I,3));VAL(C$(I,4));VAL(C$(I,5))
7840 PRINT
7850 NEXT I
7860 S1=20:S2=1: GOSUB 24: PRINT "======================================"
7865 IF I5=1 THEN I5=0: RETURN
7870 PRINT "ENTER NO. OF FEED TO BE CHANGED: "
7875 PRINT " <PRESS 'RETURN' TO CONTINUE>"
7880 S6$="":S1=21:S2=34:S3=1:S4=0:S5=W1+2: GOSUB 9:J=S
7885 IF J=0 THEN GOSUB 9400: RETURN
7890 S1=23:S2=1: GOSUB 24: PRINT "DRY MATTER < % >.= ";
7900 S6$=C$(J,3):S1=23:S2=25:S4=1:S5=100:S9=6: GOSUB 9:C$(J,3)=S$
7910 S1=23:S2=1: GOSUB 24: PRINT "ENERGY <MCAL>= ";
7920 S6$=C$(J,4):S2=25:S4=0:S5=3: GOSUB 9:C$(J,4)=S$
7930 S2=1: GOSUB 24: PRINT "CRUDE PROTEIN<LBS>= ";
7940 S6$=C$(J,5):S2=20:S5=3: GOSUB 9:C$(J,5)=S$:S9=0
7950 GOTO 7800
7999 REM DISPLAY FEED LIST/ ENTER $ VALUES
8000 CLS
8005 PRINT "NAME $/UNIT LBS/UNIT "
8010 PRINT "-------- ------ --------:YOU CAN:WHICH"
8020 PRINT " :PAY :IS A"
8025 PRINT " :UP TO: :PREM."
8030 PRINT " :$/UNIT :OF:"
8040 PRINT "======================== ------ ------"
8045 S1=20:S2=1: GOSUB 24: PRINT "*=BASIC COMPARISON FEEDSTUFFS"
8050 S1=3:S2=1: GOSUB 24:H$="*"
8060 FOR I=1 TO W1+2
8065 IF I < 3 THEN C$(I,2)=H$+C$(I,2)
8070 PRINT LEFT$ (C$(I,2),9)
8075 PRINT
8080 NEXT I
8085 S1=3
8090 FOR I1=1 TO W1+2
8100 S6$=C$(I1,6):S2=11:S3=1:S4=0:S5=10000:S9=6: GOSUB 9
8110 C$(I1,6)=S$
8120 S6$=C$(I1,7):S2=17:S4=1:S5=100000!: GOSUB 9
8125 IF S=0 THEN S6$="2000": GOSUB 9
8130 C$(I1,7)=S$
8140 IF I1 > 2 THEN GOSUB 9000
8145 S1=S1+2
8150 NEXT I1
8160 S1=23:S2=1: GOSUB 24: PRINT "CHANGE DATA='C':MENU='M':PRINT='P'";
8170 S6$=" ":S1=23:S2=36:S3=2:S9=1: GOSUB 9:S9=0: IF S$="M" THEN RETURN
8180 IF S$="C" THEN GOSUB 93: GOTO 8085
8182 IF S$ <> "P" GOTO 8190
8184 S2=1: GOSUB 24: PRINT " "
8186 CALL PRTSCR
8190 GOTO 8160
8200 REM DELETE A FEEDSTUFF
8210 I5=1: GOSUB 7800
8220 PRINT " ENTER # OF FEED TO BE DELETED:"
8225 PRINT " < PRESS 'RETURN' TO CONTINUE>"
8230 S6$=" ":S1=21:S2=33:S3=1:S4=0:S5=W1+2: GOSUB 9:S= INT(S)
8240 IF S=0 THEN RETURN
8245 IF S < =2 THEN BEEP:PRINT:PRINT "THIS FEED IS NECESSARY FOR CALCULATIONS"
8247 IF S < =2 THEN GOSUB 60470: GOTO 8210
8250 FOR I=S TO W1+2
8260 FOR I1=2 TO 7
8270 C$(I,I1)=C$(I+1,I1)
8280 NEXT I1
8290 NEXT I
8300 W1=W1-1
8305 FOR I=W1+3 TO W1+3:FOR I1=2 TO 7:C$(I,I1)="":NEXT I1:NEXT I
8310 GOTO 8200
8999 REM CALCULATION OF EQUIVALENT PRICE]
9000 FOR J = 1 TO 3
9005 K=J: IF J=3 THEN K=I1
9010 A(1,J)=( VAL(C$(K,4))/( VAL(C$(K,3))/100))
9020 A(2,J)=( VAL(C$(K,5))/( VAL(C$(K,3))/100))
9030 IF J=3 THEN 9060
9040 C1(J)= VAL(C$(J,6)):C2(J)= VAL(C$(J,7)):C3(J)=1000*C1(J)/C2(J)
9050 C3(J)=C3(J)/( VAL(C$(K,3))/100)
9060 NEXT J
9070 FOR J = 1 TO 3
9080 FOR I = 1 TO 2
9090 IF A(I,J)<=0 THEN PRINT "NO UNIQUE SOLUTION":RETURN
9100 NEXT I
9110 NEXT J
9150 CE=(A(2,1)*A(1,3)-A(1,1)*A(2,3))/(A(2,1)*A(1,2)-A(1,1)*A(2,2))
9160 DE=(A(1,3)-A(1,2)*CE)/A(1,1)
9330 V=DE*C3(1)+CE*C3(2)
9375 V1=V*VAL(C$(I1,7))/1000*(VAL(C$(I1,3))/100)
9380 S2=24: GOSUB 24:S3=V1:S4=8:S5=2: GOSUB 200: PRINT S3$;
9385 S3=V1- VAL(C$(I1,6)): GOSUB 200: PRINT S3$
9390 RETURN
9400 REM OPTION TO USE SCREEN PRINT ROUTINE
9410 S1=23:S2=1: GOSUB 24: PRINT "WANT A PRINTOUT OF THIS TABLE?<Y/N>"
9420 S6$="N":S1=23:S2=38:S3=3: GOSUB 9
9422 IF S$="Y" THEN S2=1: GOSUB 24: PRINT " ":S2=38
9424 IF S$="Y" THEN CALL PRTSCR
9430 RETURN
9999 REM DATA FOR FEEDSTUFF LISTING
10000 DATA 1,ALFLFA-H,89.3,1.05,.159
10010 DATA 2,CLOVER-H,87.1,1.00,.133
10020 DATA 3,AL-GRS-H,88.2,.99,.121
10030 DATA 4,LG-GRS-H,87.9,.97,.112
10040 DATA 5,BROME-H,89.2,.91,.088
10050 DATA 6,TIMTHY-H,88.8,.89,.081
10060 DATA 7,GRASS-H,88.8,.91,.092
10070 DATA 11,BRLY-GF,86.8,1.04,.087
10080 DATA 12,OATS-GF,88.5,1.02,.083
10090 DATA 13,RYE-GF,89.9,1.02,.075
10100 DATA 14,CERL-GF,86.1,1.01,.085
10110 DATA 21,BRLEY-SL,39.5,.47,.043
10120 DATA 22,OATS-SL,36.4,.42,.036
10130 DATA 23,CORN-SL,32.8,.43,.029
10140 DATA 24,WHEAT-SL,38,.44,.037
10150 DATA 25,CREAL-SL,37.6,.44,.038
10160 DATA 26,ALFAL-SL,46.3,.55,.082
10170 DATA 27,AL-GR-SL,45.0,.50,.065
10180 DATA 28,GRASS-SL,38.2,.39,.045
10190 DATA 29,LEG-G-SL,44.2,.49,.062
10200 DATA 31,BRLEY-ST,88.9,.80,.042
10210 DATA 32,OATS-ST,88.7,.87,.040
10220 DATA 33,WHEAT-ST,91.1,.75,.036
10230 DATA 41,BRLEY-G,88.6,1.47,.109
10240 DATA 42,OATS-G,90.2,1.37,.105
10250 DATA 43,WHEAT-G,88.4,1.56,.140
10260 DATA 51,32% BSUP.,90,1.10,.32
10270 DATA 52,32% DSUP.,90,1.25,.32
10280 DATA 53,UREA,100,0,2.81
10290 DATA 54,BEET PULP,91,1.44,.1
10300 DATA 55,SOY ML,89,1.44,.475
10310 DATA 56,CANOLA MEAL,90,1.24,.37
10320 DATA 57,DEHY ALFA,92,1.12,.170
60000 REM this is the logo routine
60010 DEF SEG=0:IF (PEEK(&H410) AND &H30)=&H30 GOTO 60550
60020 S=3.141593
60030 KEY OFF
60040 SCREEN 1
60050 COLOR 0,1
60060 CLS
60070 LINE(0,0)-(319,199),3,B
60080 LINE(5,5)-(314,194),3,B
60090 PAINT(1,1),1,3
60100 DRAW"c3;bm40,100;e60;d60;l5;h15;e4;f10;u40;g50;l5;"
60110 PAINT(43,99),1,3
60120 DRAW"C3;bm110,30;d70;L5;U70;R5;"
60130 PAINT(109,99),1,3
60140 DRAW"C3;bm120,40;d60;L5;U60;R5;"
60150 PAINT(119,99),1,3
60160 CIRCLE(135,83),20,3,1.25*S,0.75*S
60170 CIRCLE(135,83),15,3,1.25*S,0.9*S
60180 DRAW"bm119,96;e5;"
60190 PAINT(135,98),1,3
60200 CIRCLE(170,83),20,3,0.2*S,1.85*S
60210 CIRCLE(170,83),15,3,0.25*S,1.8*S
60220 DRAW"C3;BM182,90;R5;"
60230 DRAW"C3;BM187,75;G10;H3;E7;"
60240 PAINT(170,99),1,3
60250 PAINT(170,67),1,3
60260 DRAW"c3;bm195,100;l5;u34;r5;d34;"
60270 CIRCLE(210,83),20,3,0.55*S,0.76*S
60280 CIRCLE(210,83),15,3,0.59*S,0.8799999*S
60290 DRAW"bm207,66;d5;"
60300 PAINT(194,99),1,3
60310 PAINT(206,69),1,3
60320 DRAW"c3;bm217,100;l5;u40;r5;d5;r7;d5;l7;d30;"
60330 PAINT(216,97),1,3
60340 DRAW"C3;bm265,65;d35;L5;U35;R5;"
60350 CIRCLE(245,83),20,3,0.25*S,1.75*S
60360 CIRCLE(245,83),15,3,0.09999999*S,1.7*S
60370 DRAW"bm261,99;h6;"
60380 PAINT(245,98),1,3
60390 PAINT(264,69),1,3
60400 LOCATE 14,22
60410 PRINT"AGRICULTURE"
60420 LOCATE 17,4
60430 PRINT"ECONOMIC SERVICES DIVISION"
60440 LOCATE 18,4
60450 PRINT"& LIVESTOCK INDUSTRY DIVISION"
60460 LOCATE 23,5
60470 PRINT"PROVIDED BY ALBERTA AGRICULTURE"
60480 LOCATE 24,3
60490 PRINT"RESPONSIBILITY RESTS WITH THE USER";
60500 FOR S=1 TO 4100
60510 POKE 106,0
60520 IF INKEY$<>"" GOTO 60540
60530 NEXT S
60540 ON ERROR GOTO 0 :SCREEN 0,0,0:RETURN
60550 REM **MONOCHROME LOGO**
60560 KEY OFF:WIDTH 80:CLS:S$=CHR$(219)
60570 PRINT STRING$(75,S$);
60580 FOR S=2 TO 23:LOCATE S,75:PRINT S$;:NEXT
60590 LOCATE 24,1:PRINT STRING$(75,S$);
60600 FOR S=23 TO 2 STEP -1:LOCATE S,1:PRINT S$;:NEXT
60610 '
60620 '
60630 LOCATE 5,28:PRINT "▌"
60640 LOCATE 6,24:PRINT"/▌ ▌ ▌"
60650 LOCATE 7,23:PRINT"/ ▌ ▌ ▌"
60660 LOCATE 8,22:PRINT"/ ▌ ▌ ▌ ▐"
60670 LOCATE 9,21:PRINT"/ ▌ ▌ ▌ __ __ ▐_ __"
60680 LOCATE 10,20:PRINT"/ ▌ ▌ ▌/ \ / \ ▐/ ▐ / \▌"
60690 LOCATE 11,19:PRINT"/ ▌ ▌ █ ▐ ▌ / ▐ ▐ ▌ ▌"
60700 LOCATE 12,18:PRINT"/ \ ▌ ▌ █ ▐ ▌ ▐ ▐ ▌ ▌"
60710 LOCATE 13,17:PRINT"/ \▌ ▌ ▌\__/ \__/ ▐ ▐ \__/▌"
60720 LOCATE 15,36:PRINT"A G R I C U L T U R E"
60730 LOCATE 18,10:PRINT"LIVESTOCK INDUSTRY DIVISION & ECONOMIC SERVICES DIVISION"
60740 LOCATE 21,22:PRINT"PROVIDED BY ALBERTA AGRICULTURE."
60750 LOCATE 22,19:PRINT"RESPONSIBILITY RESTS SOLELY WITH USER"
60760 FOR S=1 TO 1500
60770 S$=INKEY$
60780 IF S$=CHR$(13) GOTO 60800
60790 NEXT S
60800 S$=""
60810 ON ERROR GOTO 0
60820 RETURN
62000 REM THIS IS THE SCREEN PRINT LOADER ACTIVATE WITH 'CALL PRTSCR'
62010 DEF SEG=&H0
62020 POKE &HF1, &HCD
62030 POKE &HF2, &H5
62040 POKE &HF3, &HCB
62050 PRTSCR=&HF1
62060 RETURN
COWCRAB.BAS
1 REM COW COMPUTERIZED RISK ANALYSIS BUDGET
2 REM CALCULATES RISK LEVELS FOR COW/CALF PRODUCERS
3 REM ORIGINAL PROGRAM BY GEORGE MONNER, 1979
4 REM MODIFIED TO ADA STANDARDS BY GARY FISHER
5 REM FBMB OLDS, ALBERTA PH (403) 556-4240
6 REM LAST MODIFIED JULY 21, 1983
8 GOTO 5000
9 S$="":REM THIS IS THE INPUT SUBROUTINE
10 GOSUB 24:PRINT SPACE$(LEN(S$));
11 S8=0:GOSUB 24
12 GOSUB 31
13 GOSUB 35
14 GOSUB 53
15 IF S$="" THEN S$=S6$:GOTO 22
16 IF S3=1 THEN GOSUB 56
17 IF S8=1 GOTO 10
18 IF S3=1 THEN GOSUB 68
19 IF S8=1 GOTO 10
20 IF S3=3 THEN GOSUB 73
21 IF S8=1 GOTO 10
22 IF S3=1 THEN S=VAL(S$)
23 RETURN
24 REM POSITION CURSOR
25 LOCATE S1,S2,1
30 RETURN
31 REM PRINT DEFAULT
32 PRINT S6$;
33 GOSUB 24
34 RETURN
35 REM TRANSPARENT CURSOR ROUTINE
36 S$=""
37 S1$=INPUT$(1)
41 S=ASC(S1$):IF S<>13 GOTO 46
42 IF S$="" THEN GOSUB 24:PRINT " ";:GOSUB 24:GOSUB 31:RETURN
43 IF LEN(S$)>=LEN(S6$) GOTO 45
44 PRINT SPACE$(LEN(S6$)-LEN(S$));
45 RETURN
46 IF S<32 GOTO 50
47 IF S=34 THEN S1$="'"
48 S$=S$+S1$:IF S9>0 THEN IF LEN(S$)>S9 THEN PRINT S1$;:GOTO 52
49 PRINT S1$;:GOTO 37
50 IF LEN(S$)<1 GOTO 36
51 IF LEN(S$)=1 THEN PRINT CHR$(29);:PRINT" ";:PRINT CHR$(29);:GOTO 36
52 S$=LEFT$(S$,LEN(S$)-1):PRINT CHR$(29);:PRINT" ";:PRINT CHR$(29);:GOTO 37
53 REM THIS CHECKS FOR EXIT
54 IF S$="<" THEN CLS:PRINT" NORMAL EXIT, LOADING MENU....":RUN"HELLO.BAS"
55 RETURN
56 S1$=S$:S7=0:REM CHECK FOR NUMERIC INPUT
57 IF LEFT$(S1$,1)=" " THEN S1$=RIGHT$(S1$,LEN(S1$)-1):GOTO 57
58 IF RIGHT$(S1$,1)=" " THEN S1$=LEFT$(S1$,LEN(S1$)-1):GOTO 58
59 IF LEN(S1$)<1 GOTO 64
60 FOR S=1 TO LEN(S1$):S6=ASC(MID$(S1$,S,1))
61 IF S6>=48 AND S6<=57 GOTO 66
62 IF (S6=43 OR S6=45) AND S=1 GOTO 66
63 IF S6=46 AND S7=0 THEN S7=1:GOTO 66
64 S2$="NON NUMERIC INPUT":S1$="":GOSUB 78
65 RETURN
66 NEXT S
67 RETURN
68 REM CHECK FOR PROPER LIMITS
69 S6=VAL(S$)
70 IF S6<S4 THEN S2$="INPUT BELOW":S1$=STR$(S4):GOSUB 78:RETURN
71 IF S6>S5 THEN S2$="INPUT ABOVE":S1$=STR$(S5):GOSUB 78:RETURN
72 RETURN
73 REM CHECK FOR YES OR NO
74 IF LEFT$(S$,1)="Y" OR LEFT$(S$,1)="N" GOTO 76
75 S2$="MUST BE YES/NO ANSWER":S1$="":GOSUB 78:RETURN
76 S$=LEFT$(S$,1)
77 RETURN
78 REM ERROR FOR ALL CONDITIONS
79 COLOR 31,0,0:BEEP
80 GOSUB 90
81 PRINT" ";S2$;S1$;
82 FOR S7=1 TO 3000:NEXT S7
83 COLOR 7,0,0
87 GOSUB 93
88 S8=1
89 RETURN
90 REM POSTITION TO LAST LINE
91 LOCATE 25,1,0
92 RETURN
93 REM BLANK LAST LINE
94 LOCATE 25,1,1
95 PRINT SPACE$(39);
96 RETURN
200 REM ****DOLLAR FORMAT SUBROUTINE****
201 S3=INT(S3*100+0.5)/100
202 S3$=SPACE$(30)
203 IF S3=0 THEN S3$=RIGHT$(S3$,S4-4)+"0.00":GOTO 209
204 S4$=STR$(S3)
205 IF ASC(MID$(RIGHT$(S4$,2),1,1))=46 THEN S3$=S3$+S4$+"0":GOTO 208
206 IF ASC(MID$(RIGHT$(S4$,3),1,1))=46 THEN S3$=S3$+S4$:GOTO 208
207 S3$=S3$+S4$+".00"
208 S3$=RIGHT$(S3$,S4)
209 RETURN
220 REM **** GENERAL NUMBER FOR MATTER SUBROUTINE ****
221 S7=10^S5
222 IF S3=0 THEN S3$=RIGHT$(" 0",S4-S5-1)+LEFT$(".0000",S5+1):GOTO 229
223 S6=INT(S3*S7+0.5)/S7
224 S3$=STR$(S6+SGN(S6)*0.1/S7)
225 S6=LEN(S3$)
226 S3$=LEFT$(S3$,S6-1)
227 IF S6=S4+1 THEN 229
228 S3$=LEFT$(" ",S4+1-S6)+S3$
229 RETURN
300 REM HOLD SCREEN
301 S$="PRESS RETURN TO CONTINUE "
302 COLOR 31,0,0
303 GOSUB 90
304 PRINT" ";S$;
305 POKE 106,0
306 IF INKEY$=CHR$(13) GOTO 307 ELSE GOTO 305
307 COLOR 7,0,0
308 GOSUB 93
314 S$="":S1$=""
315 RETURN
5000 REM THIS IS THE START OF COWCRAB
5010 GOSUB 60000:GOSUB 62000:WIDTH 40:CLS
5020 REM ID SCREEN FOR ***COW/CALF BUDGET***
5030 GOSUB 7000
5040 GOSUB 300
5050 CLS:PRINT "PLEASE WAIT.... LOADING DATA"
5060 DIM B$(16),B(16),C(16),DS(22),P$(22),RN(22):A1=1
5070 DEF FNCHOP$(X)=MID$(STR$(X),2,255)
5080 DIM A$(16),A(16,16),U(16),V2(16)
5090 CLS:PRINT:PRINT:PRINT " NUMBER OF COWS IN HERD? ";
5100 S6$=FNCHOP$(A1):S1=3:S2=29:S3=1:S4=1:S5=99999!:S9=5:GOSUB 9:A1=S
5110 DATA STEERS,HEIFERS,YEARLINGS,COWS,BULLS
5120 DATA "NUMBER SOLD:","WEIGHT OF:(CWT)","PRICE OF:($/CWT)"
5130 FOR I=1 TO 8:READ A$(I):NEXT I
5140 S$=" (DATA INPUT)":GOSUB 6560
5150 GOSUB 6660
5160 S1=4
5170 FOR I=1 TO 15
5180 S1=S1+1:IF S1=10 OR S1=17 THEN S1=S1+2
5190 FOR J=1 TO 3
5200 S2=10+J*8:S3=1:S4=0:S5=999999!:S9=6
5210 IF I>5 THEN S5=500:S9=5
5220 S6$=FNCHOP$(A(I,J)):GOSUB 9:A(I,J)=S
5230 IF A(I,J-1)>A(I,J) THEN S2$="CANNOT BE LESS THAN":S1$=STR$(A(I,J-1)):GOSUB 78:GOTO 5200
5240 NEXT J
5250 NEXT I
5260 S1=4:S$=" (CHANGE DATA)":GOSUB 6560
5270 GOSUB 6660
5280 FOR J=1 TO 15
5290 S1=S1+1:IF S1=10 OR S1=17 THEN S1=S1+2
5300 FOR L=1 TO 3
5310 S2=10+L*8
5320 GOSUB 24:PRINT FNCHOP$(A(J,L));
5330 NEXT L
5340 U(J)=(A(J,1)+A(J,2)+A(J,3))/3
5350 V2(J)=(((A(J,3)-A(J,1))^2)-(A(J,2)-A(J,1))*(A(J,3)-A(J,2)))/18
5360 NEXT J
5370 S6$="N":S1=24:S2=4:GOSUB 24:PRINT"CHANGE DATA ? ";:S2=18:S3=3:S9=1:GOSUB 9
5380 IF S$="N" AND X4$="Y" GOTO 5710
5390 IF S$="N" GOTO 5540
5400 S1=24:S2=4:GOSUB 24
5410 PRINT "ENTER # OF ROW TO CHANGE ";
5420 S6$="0":S1=24:S2=29:S3=1:S4=1:S5=15:S9=2:GOSUB 9:X=S
5430 IF X=0 GOTO 5540
5440 IF X<6 THEN S1=X+4 ELSE S1=X+6
5450 IF X>10 THEN S1=X+8
5460 FOR L=1 TO 3
5470 S2=10+L*8
5480 S6$=FNCHOP$(A(X,L)):S3=1:S4=0:S5=999999!:S9=6
5490 IF X>5 THEN S5=500:S9=5
5500 GOSUB 9:A(X,L)=S
5510 IF A(X,L-1)>A(X,L) THEN S2$="CANNOT BE LESS THAN":S1$=STR$(A(X,L-1)):GOSUB 78:GOTO 5480
5520 NEXT L
5530 GOTO 5260
5540 S6$="N":S1=24:S2=4:GOSUB 24:PRINT"PRINT SCREEN? ";:S2=18:S3=3:S9=1:GOSUB 9
5550 IF S$="Y" THEN S2=4:GOSUB 24:PRINT SPACE$(34);:CALL PRTSCR
5560 FOR J=1 TO 15
5570 U(J)=(A(J,1)+A(J,2)+A(J,3))/3
5580 V2(J)=(((A(J,3)-A(J,1))^2)-(A(J,2)-A(J,1))*(A(J,3)-A(J,2)))/18
5590 NEXT J
5600 GOSUB 6620
5610 DATA " COWS"
5620 DATA " REP. HEIFERS"," BULLS"," PASTURE"," CREEP FEED"," SALT,MIN & VIT."
5630 DATA " BULLS PUR."," COWS PUR."," HIRED LABOUR",BEDDING,"VET.MED. A.I."
5640 DATA "MACH. & EQ. OPERATING","TAXES UTIL. & INS."
5650 DATA "MARKETING & TRANSPT.","INT ON OP. CAP.",MISCELLANEOUS
5660 IF X4$="Y" THEN 5680
5670 FOR I=1 TO 16:READ B$(I):PRINT I;TAB(5);B$(I):NEXT I
5680 FOR I=1 TO 16
5690 S6$=FNCHOP$(B(I)):S1=I+4:S2=28:S3=1:S4=0:S5=999999!:S9=6:GOSUB 9:B(I)=S
5700 NEXT I
5710 GOSUB 6620:TC=0
5720 FOR I=1 TO 16
5730 PRINT I;B$(I);TAB(27);B(I)
5740 TC=TC+B(I)
5750 NEXT I
5760 PRINT TAB(28);"═════════"
5770 PRINT "TOTAL COSTS=";TAB(27);TC
5780 S6$="N":S1=24:S2=4:GOSUB 24:PRINT"CHANGE DATA ? ";:S2=18:S3=3:S9=1:GOSUB 9
5790 IF S$="N" THEN 5860
5800 S1=24:S2=4:GOSUB 24
5810 PRINT "ENTER # OF ROW TO CHANGE ";
5820 S6$="0":S1=24:S2=29:S3=1:S4=1:S5=16:S9=2:GOSUB 9:X=S
5830 IF X=0 GOTO 5710
5840 S6$=FNCHOP$(B(X)):S1=X+4:S2=28:S3=1:S4=0:S5=999999!:S9=6:GOSUB 9:B(X)=S
5850 GOTO 5710
5860 S6$="N":S1=24:S2=4:GOSUB 24:PRINT"PRINT SCREEN? ";:S2=18:S3=3:S9=1:GOSUB 9
5870 IF S$="Y" THEN S2=4:GOSUB 24:PRINT SPACE$(34);:CALL PRTSCR
5880 RS=U(1)*U(6)*U(11)
5890 RH=U(2)*U(7)*U(12)
5900 RY=U(3)*U(8)*U(13)
5910 RC=U(4)*U(9)*U(14)
5920 RB=U(5)*U(10)*U(15)
5930 GR=RS+RH+RC+RB+RY
5940 NR=GR-TC
5950 FOR I=1 TO 5
5960 ON I GOSUB 6510,6520,6530,6540,6550
5970 VA=V2(X)*V2(Y)*V2(Z)+V2(X)*V2(Z)*U(Y)^2+V2(Y)*V2(Z)*U(X)^2
5980 VB=V2(X)*V2(Y)*U(Z)^2+V2(X)*U(Y)^2*U(Z)^2
5990 VC=V2(Y)*U(X)^2*U(Z)^2+V2(Z)*U(X)^2*U(Y)^2
6000 V(I)=SQR(VA+VB+VC)
6010 NEXT I
6020 CLS:PRINT " EXPECTED VALUES"
6030 PRINT " ══════════════════"
6040 PRINT "REVENUE:"
6050 PRINT " STEER CALVES......$"INT(RS)
6060 PRINT " HEIFER CALVES.....$"INT(RH)
6070 PRINT " YEARLINGS.........$"INT(RY)
6080 PRINT " CULL COWS.........$"INT(RC)
6090 PRINT " CULL BULLS........$"INT(RB)
6100 PRINT TAB(23);"═════════"
6110 PRINT "TOTAL REVENUE $"INT(GR)
6120 PRINT
6130 PRINT "TOTAL EXPENSES $"TC
6140 PRINT :PRINT
6150 PRINT "NET EXPECTED REVENUE $"INT(NR)
6160 GOSUB 300
6170 R1=0.974:R2=0.9490001:R3=0.9765:R4=0.8745:R5=0.9416:R6=0.918:R7=0.8060001
6180 R8=0.8594:R9=0.8850001:R0=0.92
6190 T3=V(1)^2+V(2)^2+V(3)^2+V(4)^2+V(5)^2+2*V(2)*V(1)*R1+V(1)*2*V(3)*R2
6200 T4=V(2)*V(3)*2*R3+2*V(1)*V(4)*R4+2*V(2)*V(4)*R5+2*V(3)*V(4)*R6
6210 T5=2*V(1)*V(5)*R7+2*V(2)*V(5)*R8+2*V(3)*V(5)*R9+2*V(4)*V(5)*R0
6220 T6=SQR(T3+T4+T5)
6230 DATA -2.325,-1.645,-1.285,-1.035,-.845,-.675,-.525,-.385,-.255,-.125,0
6240 DATA .125,.255,.385,.525,.675,.845,1.035,1.285,1.645,2.325
6250 IF X4$="Y" THEN 6320
6260 FOR L=1 TO 21
6270 READ DS(L)
6280 NEXT L
6290 DATA .01,.05,.1,.15,.2,.25,.3,.35,.4,.45,.5,.55,.6,.65,.7
6300 DATA .75,.8,.85,.9,.95,.99
6310 FOR I=1 TO 21:READ P$(I):NEXT I
6320 FOR K=1 TO 21
6330 RN(K)=NR+DS(K)*T6
6340 NEXT K
6350 CLS
6360 PRINT " PROBABILITY OF GETTING LESS THAN"
6370 PRINT " NET REVENUE `NR*'"
6380 PRINT
6390 PRINT "PROB. NR* NR*/COW "
6400 PRINT "═════ ═══════ ════════"
6410 FOR I=1 TO 21 STEP 2
6420 PRINT USING " \ \ ######.## ######.##";P$(I),RN(I),RN(I)/A1
6430 NEXT I
6440 S6$="N":S1=24:S2=4:GOSUB 24:PRINT"PRINT SCREEN ? ";:S2=19:S3=3:S9=1:GOSUB 9
6450 IF S$="Y" THEN S2=4:GOSUB 24:PRINT SPACE$(34);:CALL PRTSCR
6460 S6$="C":S1=24:S2=1:GOSUB 24:PRINT"CHANGE DATA<C>, RUN AGAIN<R>, EXIT<E>";:S2=38:S3=2:S9=1:GOSUB 9
6470 IF S$="C" THEN X4$="Y":GOTO 5260
6480 IF S$="R" THEN CLEAR:GOTO 5050
6490 IF S$="E" THEN CLS:PRINT "LOADING MENU....":RUN"HELLO.BAS":END
6500 GOTO 6460
6510 X=1:Y=6:Z=11:RETURN
6520 X=2:Y=7:Z=12:RETURN
6530 X=3:Y=8:Z=13:RETURN
6540 X=4:Y=9:Z=14:RETURN
6550 X=5:Y=10:Z=15:RETURN
6560 CLS
6570 PRINT S$;TAB(17);" LOW MOST HIGH"
6580 PRINT TAB(23);" LIKELY"
6590 PRINT TAB(17);"═══════════════════════"
6600 RETURN
6610 PRINT TAB(33);:RETURN
6620 CLS:PRINT:PRINT"C O S T S:";TAB(28);"TOTAL/YR"
6630 PRINT TAB(28);"════════"
6640 PRINT " WINTER FEED:"
6650 RETURN
6660 F=1:FOR K=1 TO 3
6670 PRINT A$(K+5)
6680 FOR I=1 TO 5
6690 PRINT F;:IF F<10 THEN PRINT" ";
6700 PRINT A$(I):F=F+1
6710 NEXT I
6720 IF K<3 THEN PRINT
6730 NEXT K
6740 RETURN
7000 REM FIRST SCREEN FOR COW/CALF CRAB
7010 CLS
7020 PRINT TAB(12);"*** COW/CALF ***"
7030 PRINT " COMPUTERIZED RISK ANALYSIS BUDGET"
7040 PRINT TAB(15);"JULY 1983":PRINT
7050 PRINT " THIS PROGRAM ALLOWS YOU TO ANALYSE"
7060 PRINT "VARIOUS COMBINATIONS OF NUMBERS SOLD"
7070 PRINT "WEIGHTS, AND PRICES FOR CATTLE.":PRINT
7080 PRINT " FOR EACH CATTLE TYPE, YOU ENTER THE"
7090 PRINT "LOWEST, MOST LIKELY AND HIGHEST VALUES."
7100 PRINT "THE COSTS ARE ALSO ENTERED INTO THE"
7110 PRINT "MODEL.":PRINT
7120 PRINT " THE PROGRAM WILL DISPLAY AVERAGE NET"
7130 PRINT "REVENUES AND A TABLE WHICH SHOWS THE"
7140 PRINT "PERCENTAGE CHANCE OF GETTING LESS THAN"
7150 PRINT "A CERTAIN LEVEL OF NET REVENUE ON A"
7160 PRINT "TOTAL AND PER COW BASIS."
7170 PRINT
7180 PRINT "JUST A WARNING: THE LOWEST VALUE MUST"
7190 PRINT "NOT BE GREATER THAN THE MOST LIKELY"
7200 PRINT "VALUE, WHICH IN TURN, CANNOT BE"
7210 PRINT "GREATER THAN THE HIGHEST VALUE."
7220 RETURN
60000 REM this is the logo routine
60010 DEF SEG=0:IF (PEEK(&H410) AND &H30)=&H30 GOTO 60530
60020 S=3.141593
60030 KEY OFF
60040 SCREEN 1
60050 COLOR 0,1
60060 CLS
60070 LINE(0,0)-(319,199),3,B
60080 LINE(5,5)-(314,194),3,B
60090 PAINT(1,1),1,3
60100 DRAW"c3;bm40,100;e60;d60;l5;h15;e4;f10;u40;g50;l5;"
60110 PAINT(43,99),1,3
60120 DRAW"C3;bm110,30;d70;L5;U70;R5;"
60130 PAINT(109,99),1,3
60140 DRAW"C3;bm120,40;d60;L5;U60;R5;"
60150 PAINT(119,99),1,3
60160 CIRCLE(135,83),20,3,1.25*S,0.75*S
60170 CIRCLE(135,83),15,3,1.25*S,0.9*S
60180 DRAW"bm119,96;e5;"
60190 PAINT(135,98),1,3
60200 CIRCLE(170,83),20,3,0.2*S,1.85*S
60210 CIRCLE(170,83),15,3,0.25*S,1.8*S
60220 DRAW"C3;BM182,90;R5;"
60230 DRAW"C3;BM187,75;G10;H3;E7;"
60240 PAINT(170,99),1,3
60250 PAINT(170,67),1,3
60260 DRAW"c3;bm195,100;l5;u34;r5;d34;"
60270 CIRCLE(210,83),20,3,0.55*S,0.76*S
60280 CIRCLE(210,83),15,3,0.59*S,0.8799999*S
60290 DRAW"bm207,66;d5;"
60300 PAINT(194,99),1,3
60310 PAINT(206,69),1,3
60320 DRAW"c3;bm217,100;l5;u40;r5;d5;r7;d5;l7;d30;"
60330 PAINT(216,97),1,3
60340 DRAW"C3;bm265,65;d35;L5;U35;R5;"
60350 CIRCLE(245,83),20,3,0.25*S,1.75*S
60360 CIRCLE(245,83),15,3,0.09999999*S,1.7*S
60370 DRAW"bm261,99;h6;"
60380 PAINT(245,98),1,3
60390 PAINT(264,69),1,3
60400 LOCATE 14,22
60410 PRINT"AGRICULTURE"
60420 LOCATE 18,5
60430 PRINT"FARM BUSINESS MANAGEMENT BRANCH"
60440 LOCATE 23,5
60450 PRINT"PROVIDED BY ALBERTA AGRICULTURE"
60460 LOCATE 24,3
60470 PRINT"RESPONSIBILITY RESTS WITH THE USER";
60480 FOR S=1 TO 4100
60490 POKE 106,0
60500 IF INKEY$<>"" GOTO 60520
60510 NEXT S
60520 ON ERROR GOTO 0 :SCREEN 0,0,0:RETURN
60530 REM **MONOCHROME LOGO**
60540 KEY OFF:WIDTH 80:CLS:S$=CHR$(219)
60550 REM **MONOCHROME LOGO**
60560 KEY OFF:WIDTH 80:CLS:S$=CHR$(219)
60570 PRINT STRING$(75,S$);
60580 FOR S=2 TO 23:LOCATE S,75:PRINT S$;:NEXT
60590 LOCATE 24,1:PRINT STRING$(75,S$);
60600 FOR S=23 TO 2 STEP -1:LOCATE S,1:PRINT S$;:NEXT
60610 '
60620 '
60630 LOCATE 7,23:PRINT"/ ▌ ▌ ▌"
60640 LOCATE 8,22:PRINT"/ ▌ ▌ ▌ ▐"
60650 LOCATE 9,21:PRINT"/ ▌ ▌ ▌ __ __ ▐_ __"
60660 LOCATE 10,20:PRINT"/ ▌ ▌ ▌/ \ / \ ▐/ ▐ / \▌"
60670 LOCATE 11,19:PRINT"/ ▌ ▌ █ ▐ ▌ / ▐ ▐ ▌ ▌"
60680 LOCATE 12,18:PRINT"/ \ ▌ ▌ █ ▐ ▌ ▐ ▐ ▌ ▌"
60690 LOCATE 13,17:PRINT"/ \▌ ▌ ▌\__/ \__/ ▐ ▐ \__/▌"
60700 LOCATE 15,36:PRINT"A G R I C U L T U R E"
60710 LOCATE 18,22:PRINT"FARM BUSINESS MANAGEMENT BRANCH"
60720 LOCATE 21,22:PRINT"PROVIDED BY ALBERTA AGRICULTURE."
60730 LOCATE 22,19:PRINT"RESPONSIBILITY RESTS SOLELY WITH USER"
60740 FOR S=1 TO 1500
60750 S$=INKEY$
60760 IF S$=CHR$(13) GOTO 60780
60770 NEXT S
60780 S$=""
60790 ON ERROR GOTO 0
60800 RETURN
62000 REM THIS IS THE SCREEN PRINT LOADER ACTIVATE WITH 'CALL PRTSCR'
62010 DEF SEG=&H0
62020 POKE &HF1, &HCD
62030 POKE &HF2, &H5
62040 POKE &HF3, &HCB
62050 PRTSCR=&HF1
62060 RETURN
CRCROP.BAS
1 REM CRCROP PROGRAM
2 REM CALCULATION OF CROP ENTERPRISE COSTS
3 REM LISTING MACHINERY, ENTERPRISE OPERATIONS, AND ASSOCIATED COSTS
4 REM LAST REVISED JULY,1984:IF CHANGED LINE 61085 ALSO
5 REM CONTACT KEN BUNNAGE
6 REM PHONE LETHBRIDGE 329-5118
8 GOTO 5000
9 S$="":REM THIS IS THE INPUT SUBROUTINE
10 GOSUB 24:PRINT SPACE$(LEN(S$));
11 S8=0:GOSUB 24
12 GOSUB 31
13 GOSUB 35
14 GOSUB 53
15 IF S$="" THEN S$=S6$:GOTO 22
16 IF S3=1 THEN GOSUB 56
17 IF S8=1 GOTO 10
18 IF S3=1 THEN GOSUB 68
19 IF S8=1 GOTO 10
20 IF S3=3 THEN GOSUB 73
21 IF S8=1 GOTO 10
22 IF S3=1 THEN S=VAL(S$)
23 RETURN
24 REM POSITION CURSOR
25 LOCATE S1,S2,1
30 RETURN
31 REM PRINT DEFAULT
32 PRINT S6$
33 GOSUB 24
34 RETURN
35 REM TRANSPARENT CURSOR ROUTINE
36 S$=""
37 S1$=INPUT$(1)
41 S=ASC(S1$):IF S<>13 GOTO 46
42 IF S$="" THEN GOSUB 24:PRINT " ";:GOSUB 24:GOSUB 31:PRINT:RETURN
43 IF LEN(S$)>=LEN(S6$) GOTO 45
44 PRINT SPACE$(LEN(S6$)-LEN(S$));
45 PRINT S1$;:RETURN
46 IF S<32 GOTO 50
47 IF S=34 THEN S1$="'"
48 S$=S$+S1$:IF S9>0 THEN IF LEN(S$)>S9 THEN PRINT S1$;:GOTO 52
49 PRINT S1$;:GOTO 37
50 IF LEN(S$)<1 GOTO 36
51 IF LEN(S$)=1 THEN PRINT CHR$(29);:PRINT" ";:PRINT CHR$(29);:GOTO 36
52 S$=LEFT$(S$,LEN(S$)-1):PRINT CHR$(29);:PRINT" ";:PRINT CHR$(29);:GOTO 37
53 REM THIS CHECKS FOR EXIT
54 IF S$="<" THEN CLS:PRINT" NORMAL EXIT":LOCATE 11,6:COLOR 0,7:PRINT" LOADING MENU ... PLEASE WAIT ":COLOR 7,0:RUN "HELLO"
55 RETURN
56 S1$=S$:S7=0:REM CHECK FOR NUMERIC INPUT
57 IF LEFT$(S1$,1)=" " THEN S1$=RIGHT$(S1$,LEN(S1$)-1):GOTO 57
58 IF RIGHT$(S1$,1)=" " THEN S1$=LEFT$(S1$,LEN(S1$)-1):GOTO 58
59 IF LEN(S1$)<1 GOTO 64
60 FOR S=1 TO LEN(S1$):S6=ASC(MID$(S1$,S,1))
61 IF S6>=48 AND S6<=57 GOTO 66
62 IF (S6=43 OR S6=45) AND S=1 GOTO 66
63 IF S6=46 AND S7=0 THEN S7=1:GOTO 66
64 S2$="NON NUMERIC INPUT":S1$="":GOSUB 78
65 RETURN
66 NEXT S
67 RETURN
68 REM CHECK FOR PROPER LIMITS
69 S6=VAL(S$)
70 IF S6<S4 THEN S2$="INPUT BELOW":S1$=STR$(S4):GOSUB 78:RETURN
71 IF S6>S5 THEN S2$="INPUT ABOVE":S1$=STR$(S5):GOSUB 78:RETURN
72 RETURN
73 REM CHECK FOR YES OR NO
74 IF LEFT$(S$,1)="Y" OR LEFT$(S$,1)="N" GOTO 76
75 S2$="MUST BE YES/NO ANSWER":S1$="":GOSUB 78:RETURN
76 S$=LEFT$(S$,1)
77 RETURN
78 REM ERROR FOR ALL CONDITIONS
79 COLOR 31,0,0:BEEP
80 GOSUB 90
81 PRINT" ";S2$;S1$;
82 FOR S7=1 TO 3000:NEXT S7
83 COLOR 7,0,0
87 GOSUB 93
88 S8=1
89 RETURN
90 REM POSTITION TO LAST LINE
91 LOCATE 25,1,0
92 RETURN
93 REM BLANK LAST LINE
94 LOCATE 25,1,1
95 PRINT SPACE$(39);
96 RETURN
200 REM ****DOLLAR FORMAT SUBROUTINE****
201 S3=INT(S3*100+0.5)/100
202 S3$=SPACE$(30)
203 IF S3=0 THEN S3$=RIGHT$(S3$,S4-4)+"0.00":GOTO 209
204 S4$=STR$(S3)
205 IF ASC(MID$(RIGHT$(S4$,2),1,1))=46 THEN S3$=S3$+S4$+"0":GOTO 208
206 IF ASC(MID$(RIGHT$(S4$,3),1,1))=46 THEN S3$=S3$+S4$:GOTO 208
207 S3$=S3$+S4$+".00"
208 S3$=RIGHT$(S3$,S4)
209 RETURN
300 REM HOLD SCREEN
301 S$="PRESS RETURN TO CONTINUE "
302 COLOR 31,0,0
303 GOSUB 90
304 PRINT" ";S$;
305 POKE 106,0
306 IF INKEY$=CHR$(13) GOTO 307 ELSE GOTO 305
307 COLOR 7,0,0
308 GOSUB 93
314 S$="":S1$=""
315 RETURN
900 REM *** CHANGES TO INPUT ***
901 S1$="DO YOU WISH TO MAKE CHANGES (Y/N)"
902 S1=22:S2=1:GOSUB 24:PRINT S1$
903 S6$="Y":S1=22:S2=35:S3=3:GOSUB 9
904 S1$="":S1=22:S2=1:GOSUB 24
905 RETURN
910 REM *** PRINTER OUTPUT OPTION ***
911 S1$="DO YOU WANT PRINTER OUTPUT (Y/N)"
912 S1=22:S2=1:GOSUB 24:PRINT S1$;
913 S6$="Y":S1=22:S2=35:GOSUB 9
914 S1$="":RETURN
5000 REM *** MAIN BODY OF PROGRAM *** SEGMENT 4 ***
5005 GOSUB 60000
5010 WIDTH 40:GOSUB 61000
5015 DIM D(4,7),A(25,16),A$(25,1),B$(25,1),B(25,22),E(9)
5020 CLS
5025 PRINT "ENTER PROJECT DESCRIPTION:"
5030 S6$="":S1=3:S2=1:S3=2:S4=0:S5=30:S9=20:GOSUB 9:A$=S$
5035 CLS
5040 PRINT "MISCELLANEOUS MACHINE INFORMATION":PRINT:PRINT
5045 PRINT "INTEREST RATE % MACHINERY CAPITAL":PRINT
5050 PRINT "INTEREST RATE % OPERATING CAPITAL":PRINT
5055 PRINT "OIL COST $/GAL-------------------":PRINT
5060 S6$="0":S1=4:S2=35:S3=1:GOSUB 9:FB=S
5065 S1=6:GOSUB 9:BI=S
5070 S1=8:S5=10:GOSUB 9:OI=S
5075 GOSUB 900:IF S$="N" THEN RR=1:GOTO 5150
5080 S1=4:S2=35:S3=1:S5=30:S6$=STR$(FB):GOSUB 9:FB=S
5085 S1=6:S6$=STR$(BI):GOSUB 9:BI=S
5090 S1=8:S6$=STR$(OI):S5=10:GOSUB 9:OI=S
5095 GOTO 5075
5100 CLS
5105 PRINT TAB(13);"**** MENU ****":PRINT TAB(13);"--------------"
5110 LOCATE 5,1:PRINT " 1 MACHINERY ADDITIONS"
5115 PRINT:PRINT " 2 BUDGET INPUT"
5120 PRINT:PRINT " 3 REAL ESTATE INPUT"
5125 PRINT:PRINT " 4 SUMMARY"
5130 PRINT:PRINT " 5 PRINT FOOTNOTES"
5135 PRINT:PRINT " 6 END OF PROGRAM"
5140 LOCATE 19,1:PRINT "TYPE A NUMBER INDICATING YOUR CHOICE?"
5145 S6$="":S1=19:S2=39:S3=1:S4=1:S5=6:S9=1:GOSUB 9:RR=S:S9=100
5150 ON RR GOSUB 5505,6005,7500,8005,7005,5160
5155 GOTO 5100
5160 CLS:PRINT "THANK YOU HAVE A NICE DAY":WIDTH 80
5170 LOCATE 11,6:COLOR 0,7:PRINT " LOADING PROGRAM MENU ... PLEASE WAIT ":COLOR 7,0:RUN "HELLO"
5500 REM *** MACHINE SECTION *** SEGMENT 5 ***
5505 CLS:PRINT "MACHINERY COMPLEMENT.. MACHINE NO. ";I+1
5510 PRINT
5515 PRINT:PRINT " 1 DESCRIPTION:":PRINT
5520 PRINT " 2 PURCHASE PRICE------------I":PRINT
5525 PRINT " 3 SALVAGE VALUE-------------I":PRINT
5530 PRINT " 4 ANNUAL HOURS OF USE-------I":PRINT
5535 PRINT " 5 NUMBER OF YEARS OF USE----I":PRINT
5540 PRINT " 6 COST OF LIFETIME REPAIR---I":PRINT
5545 PRINT " 7 FUEL CONSUMPTION GAL/HR---I":PRINT
5550 PRINT " 8 FUEL COST $/GAL-----------I":PRINT
5555 PRINT " 9 OIL USED IN GAL PER YEAR--I"
5560 S6$="END":S1=4:S2=18:S3=2:S9=18:GOSUB 9:IF S$="END" GOTO 5685
5565 I=I+1:A$(I,1)=S$
5567 S6$=STR$(A(I,2)):S1=S1+2:S2=32:S3=1:S4=0:S5=999999!:GOSUB 9:A(I,2)=S
5568 S6$=STR$(A(I,3)):S1=S1+2:GOSUB 9:A(I,3)=S
5569 S6$=STR$(A(I,4)):S1=S1+2:S5=2000:GOSUB 9:A(I,4)=S
5570 S6$=STR$(A(I,5)):S1=S1+2:S5=100:GOSUB 9:A(I,5)=S
5571 S6$=STR$(A(I,6)):S1=S1+2:S5=999999!:GOSUB 9:A(I,6)=S
5572 S6$=STR$(A(I,7)):S1=S1+2:S5=100:GOSUB 9:A(I,7)=S
5573 S6$=STR$(A(I,8)):S1=S1+2:S5=10:GOSUB 9:A(I,8)=S
5574 S6$=STR$(A(I,9)):S1=S1+2:S5=1000:GOSUB 9:A(I,9)=S
5575 TT=TT+A(I,2):DE=A(I,2)-A(I,3)
5580 IF A(I,5)=0 THEN CM=0:GOTO 5595
5585 IF FB=0 THEN CM=0:GOTO 5595
5590 CM=DE/((1-(1/((1+(FB/100))^A(I,5))))/(FB/100))
5595 CI=A(I,3)*FB/100
5600 IF A(I,4)=0 THEN A(I,12)=0:A(I,13)=0:GOTO 5625
5605 A(I,12)=(CI+CM)/A(I,4)
5610 IF A(I,5)=0 THEN GOTO 5620
5615 A(I,13)=DE/(A(I,5)*A(I,4)):DY=DY+DE/A(I,5)
5620 A(I,14)=A(I,12)-A(I,13):AN=AN+A(I,14)*A(I,4)
5625 IF A(I,4)=0 THEN RH=0:GOTO 5640
5630 IF A(I,5)=0 THEN RH=0:GOTO 5640
5635 RH=(A(I,6)/A(I,5))/A(I,4)
5640 FS=A(I,7)*A(I,8)
5645 IF A(I,4)=0 THEN OC=0:GOTO 5655
5650 OC=(A(I,9)*OI)/A(I,4)
5655 A(I,15)=FS+OC+RH
5660 GOSUB 900:IF S$="N" THEN GOTO 5505
5665 TT=TT-A(I,2):AN=AN-A(I,14)*A(I,4):IF A(I,5) <> 0 THEN DY=DY-DE/A(I,5)
5670 S6$=A$(I,1):S1=4:S2=18:S3=2:S9=18:GOSUB 9:A$(I,1)=S$
5675 IF S$="END" THEN I=I-1:GOTO 5685
5680 GOTO 5567
5685 CLS:LOCATE 4,1:PRINT "DO YOU WISH SCREEN OUTPUT (Y/N)"
5690 S6$="Y":S1=4:S2=33:S3=3:GOSUB 9:IF S$="Y" THEN GOSUB 10000
5692 CLS:GOSUB 910:IF S$="N" THEN GOTO 5805
5700 CLS:LPRINT:LPRINT:LPRINT:LPRINT:LPRINT:LPRINT "TABLE 1 MACHINE LISTING ";A$
5705 LPRINT:LPRINT:LPRINT "MACH";SPC(25);"ANNUAL TRADE-IN YEARS DEPREC'N INTEREST";
5710 LPRINT " OPERATING":LPRINT "NO. DESCRIPTION COST USE(HRS) VALUE ";
5715 LPRINT "USE COST/HR COST/HR COST/HR":FOR J=1 TO 80:LPRINT "-";:NEXT J:LPRINT
5720 FOR N=1 TO I:LPRINT RIGHT$((" "+STR$(N)),2);
5725 LPRINT LEFT$((" "+A$(N,1)+" "),18);
5730 S3=A(N,2):S4=10:GOSUB 200:LPRINT SPC(1);MID$(S3$,2,6);
5735 S3=A(N,4):GOSUB 200:LPRINT SPC(3);MID$(S3$,4,4);
5740 S3=A(N,3):GOSUB 200:LPRINT SPC(4);MID$(S3$,2,6);
5745 S3=A(N,5):GOSUB 200:LPRINT SPC(3);MID$(S3$,5,3);
5750 S3=A(N,13):S4=9:GOSUB 200:LPRINT S3$;
5755 S3=A(N,14):GOSUB 200:LPRINT S3$;
5760 S3=A(N,15):S4=10:GOSUB 200:LPRINT S3$
5765 NEXT N
5770 LPRINT:LPRINT:
5775 S3=TT:S4=11:GOSUB 200:LPRINT "TOTAL COST OF MACHINERY";SPC(44);S3$
5780 S3=DY:GOSUB 200:LPRINT "TOTAL ANNUAL MACHINERY DEPRECIATION";SPC(32);S3$
5785 S3=AN:GOSUB 200:LPRINT "TOTAL ANNUAL INTEREST ON MACHINERY";SPC(33);S3$
5790 LPRINT:LPRINT:LPRINT:LPRINT:LPRINT:LPRINT SPC(20);"****************************************"
5795 LPRINT:LPRINT:LPRINT:LPRINT:LPRINT
5805 RETURN
6000 REM *** BUDGET OPERATION SECTION *** SEGMENT 6 ***
6005 CLS:S1=10:S2=10:GOSUB 24:COLOR 0,7:PRINT "PLEASE WAIT":COLOR 7,0
6010 FOR V=1 TO 25:FOR J=1 TO 22:B(V,J)=0:NEXT:NEXT
6015 CLS:PRINT "ENTER CROP BUDGET IDENTIFICATION:"
6020 S1=3:S2=1:S3=2:S9=15:S6$="":GOSUB 9:D$=S$
6025 REM *** WAGES,YIELD,PRICE,OVERHEAD COST,SUMMERFALLOW OR NOT ***
6030 CLS:PRINT "**** MISCELLANEOUS BUDGET VALUES ****":PRINT:PRINT:PRINT:PRINT
6035 PRINT "WAGE RATE ($/HR)":PRINT:PRINT "YIELD PER ACRE":PRINT
6040 PRINT "PRICE PER UNIT OF YIELD":PRINT
6045 PRINT "OVERHEAD AS A % OF TOTAL COST":PRINT
6050 PRINT "ENTER 1 FOR FALLOW 0 FOR STUBBLE"
6055 S1=6:S2=34:S6$="0":S3=1:S4=0:S5=100:GOSUB 9:WA=S
6060 S1=S1+2:S5=10000:GOSUB 9:BU=S
6065 S1=S1+2:S5=1000:GOSUB 9:P=S
6070 S1=S1+2:S5=20:GOSUB 9:OV=S
6075 S1=S1+2:S5=1:S9=1:GOSUB 9:IS=S:S9=100
6080 GOSUB 900:IF S$="N" THEN GOTO 6105
6085 S1=6:S2=34:S3=1:S5=100:S6$=STR$(WA):GOSUB 9:WA=S:S1=8:S5=10000:S6$=STR$(BU):GOSUB 9:BU=S
6090 S1=10:S6$=STR$(P):S5=1000:GOSUB 9:P=S:S1=12:S5=20:S6$=STR$(OV):GOSUB 9:OV=S:S1=14:S5=1:S9=1:S6$=STR$(IS):GOSUB 9:IS=S
6095 S5=999999!:S9=100:GOTO 6080
6100 REM *** N IS A COUNTER ***
6105 N=0
6110 N=N+1
6115 CLS:PRINT "DO YOU WISH TO SEE MACHINERY LISTING":PRINT "(Y/N)"
6120 S1=2:S2=10:S3=3:S6$="Y":GOSUB 9:IF S$="Y" THEN GOSUB 10310
6125 REM *** MACHINES USED,TIMES OPERATION DONE,ACRES, HOURS, LABOUR,EXTRA
6130 CLS:PRINT "**** BUDGET OPERATIONS ****":PRINT:PRINT:PRINT
6135 PRINT "1 DESCRIPTION:":PRINT:PRINT "2 TRACTOR NUMBER FOLLOWED BY":PRINT " THREE MORE MACHINE";
6140 PRINT"S OR 0'S--I":PRINT:PRINT:PRINT"3 TIMES PER YEAR OPERATION ":PRINT" IS DONE---------------------I";
6145 PRINT:PRINT:PRINT "4 ACRES PER OPERATION---------I":PRINT:PRINT "5 MACHINE HOURS PER OPERATION-I"
6150 PRINT:PRINT "6 TOTAL LABOUR FOR ALL TIMES--I":PRINT:PRINT "7 MATERIALS AND SERVICES COST-I"
6155 S6$="END"
6160 S1=5:S2=17:S3=2:S9=15:GOSUB 9:B$(N,1)=S$
6165 IF S$="END" THEN GOTO 6350
6170 S5=25:S9=2
6175 S1=8:S2=29:S3=1:FOR J=2 TO 3:S6$=STR$(B(N,J)):S2=S2+4:GOSUB 9:B(N,J)=S:NEXT J
6180 S1=9:S2=29:FOR J=4 TO 5:S6$=STR$(B(N,J)):S2=S2+4:GOSUB 9:B(N,J)=S:NEXT J
6185 S9=100
6187 S1=S1+1:FOR J=6 TO 10:S6$=STR$(B(N,J)):S1=S1+2:S2=32:S5=100
6188 IF J=6 THEN S5=10: GOTO 6191
6189 IF J=7 THEN S5=1000: GOTO 6191
6190 IF J=10 THEN S5=10000:GOTO 6191
6191 GOSUB 9:B(N,J)=S:NEXT J
6195 GOSUB 900:S6$=B$(N,1):IF S$="N" GOTO 6210
6200 GOTO 6160
6205 REM *** TESTS FOR HOW MANY MACHINES USED ***
6210 IF B(N,7)=0 THEN HA=0:GOTO 6220
6215 HA=(B(N,8)/B(N,7))*B(N,6)
6220 IF B(N,5)=0 THEN GOTO 6245
6225 B(N,11)=A(B(N,5),12)*HA
6230 B(N,12)=A(B(N,5),13)*HA
6235 B(N,13)=A(B(N,5),14)*HA
6240 B(N,14)=A(B(N,5),15)*HA
6245 IF B(N,4)=0 GOTO 6270
6250 B(N,11)=A(B(N,4),12)*HA+B(N,11)
6255 B(N,12)=A(B(N,4),13)*HA+B(N,12)
6260 B(N,13)=A(B(N,4),14)*HA+B(N,13)
6265 B(N,14)=A(B(N,4),15)*HA+B(N,14)
6270 IF B(N,3)=0 GOTO 6295
6275 B(N,11)=B(N,11)+A(B(N,3),12)*HA
6280 B(N,12)=B(N,12)+A(B(N,3),13)*HA
6285 B(N,13)=B(N,13)+A(B(N,3),14)*HA
6290 B(N,14)=B(N,14)+A(B(N,3),15)*HA
6295 IF B(N,2)=0 GOTO 6320
6300 B(N,15)=A(B(N,2),12)*HA
6305 B(N,16)=A(B(N,2),13)*HA
6310 B(N,17)=A(B(N,2),14)*HA
6315 B(N,18)=A(B(N,2),15)*HA
6320 IF B(N,7)=0 THEN B(N,19)=0:GOTO 6330
6325 B(N,19)=B(N,9)*WA/B(N,7)
6330 B(N,20)=B(N,10)
6335 B(N,21)=B(N,21)+B(N,15)+B(N,18)+B(N,11)+B(N,14)+B(N,19)+B(N,20)
6340 REM *** LOOPS BACK TO ANOTHER OPERATION ***
6345 NJ=N:GOTO 6110
6350 FOR J=11 TO 21
6355 FOR V=1 TO NJ
6360 B(N,J)=B(N,J)+B(V,J)
6365 NEXT V
6370 NEXT J
6375 TL=B(N,21):NK=N:OD=TL*OV/100
6380 OW=B(NK,15)+B(NK,11):OP=TL-OW
6385 IF IS <> 0 THEN OT=OP*(BI/100)*1.5:GOTO 6395
6390 OT=OP*(BI/100)*0.75
6395 G1=BU*P
6400 SO=TL+OT+OD
6405 CLS:PRINT "DO YOU WISH SCREEN OUTPUT(Y/N)":S1=1:S2=35:S3=3:S6$="Y":GOSUB 9
6410 IF S$="Y" THEN GOSUB 10400
6415 CLS
6417 CLS:GOSUB 910:IF S$="N" THEN GOTO 6630
6425 REM *** PRINTOUT OF OPERATIONS TABLE ***
6430 LPRINT:LPRINT:LPRINT:LPRINT "TABLE 2 ENTERPRISE OPERATIONS ";D$
6435 LPRINT:LPRINT
6440 LPRINT SPC(30);" **TRACTOR COSTS** IMPLEMENT COSTS** MAT &"
6445 LPRINT "LINE OPERATION MACHINE DEPR- INTE- OPER- DEPR- INTE- OPER- ";
6450 LPRINT "SERVCE TOTAL":LPRINT "NO. DESCRIPTION NOS. TION REST ATING";
6455 LPRINT " TION REST ATING COSTS COSTS":LPRINT SPC(31);"-- -- -- -- -- --";
6460 LPRINT "DOLLARS PER ACRE-- -- -- -- --"
6465 FOR N=1 TO NJ:LPRINT RIGHT$((" "+STR$(N)),2);
6470 LPRINT LEFT$((" "+B$(N,1)+" "),15);" ";
6475 FOR J=2 TO 4:LPRINT RIGHT$((" "+STR$(B(N,J))),2);",";:NEXT J
6480 LPRINT RIGHT$((" "+STR$(B(N,J))),2);" ";
6485 S4=6:FOR J=16 TO 18:S3=B(N,J):GOSUB 200:LPRINT S3$;:NEXT J
6490 FOR J=12 TO 14:S3=B(N,J):GOSUB 200:LPRINT S3$;:NEXT J
6495 S4=7:FOR J=20 TO 21:S3=B(N,J):GOSUB 200:LPRINT S3$;:NEXT J:LPRINT
6500 NEXT
6505 LPRINT SPC(31);:FOR J=1 TO 6:LPRINT " -----";:NEXT:LPRINT " ------ ------"
6510 LPRINT
6515 LPRINT RIGHT$((" "+STR$(N)),2);" SUBTOTALS";
6520 FOR J=1 TO 5:LPRINT " --";:NEXT J:LPRINT " -";
6525 S4=6:FOR J=16 TO 18:S3=B(N,J):GOSUB 200:LPRINT S3$;:NEXT J
6530 FOR J=12 TO 14:S3=B(N,J):GOSUB 200:LPRINT S3$;:NEXT J
6535 FOR J=20 TO 21:S3=B(N,J):S4=7:GOSUB 200:LPRINT S3$;:NEXT J:LPRINT
6540 S4=6:S3=B(N,19):GOSUB 200:LPRINT:LPRINT " TOTAL COSTS INCLUDES ";S3$;" IN LABOUR COSTS"
6545 Y$=" "+STR$(NK)
6550 LPRINT:LPRINT:LPRINT:LPRINT
6555 LPRINT " INTEREST ON OPERATING CAPITAL"
6560 LPRINT SPC(11);"(LINE ";RIGHT$(Y$,2);"-OWNERSHIP COSTS)";
6565 S3=BI:S4=5:GOSUB 200:LPRINT S3$;"%X";
6570 S3=OP:S4=6:GOSUB 200:LPRINT S3$;
6575 IF IS <> 0 THEN LPRINT " FOR 1.5 YRS";:GOTO 6585
6580 LPRINT " FOR 3/4 YR.";
6585 S3=OT:S4=7:GOSUB 200:LPRINT SPC(10);S3$
6590 S3=OV:S4=7:GOSUB 200:LPRINT " MISCELLANEOUS OVERHEAD";S3$;
6595 LPRINT " PCT OF LINE ";RIGHT$((" "+STR$(NK)),2);
6600 S3=OD:S4=6:GOSUB 200:LPRINT SPC(25);S3$:LPRINT:LPRINT
6605 LPRINT " TOTAL OPERATIONS COSTS";
6610 S3=SO:S4=6:GOSUB 200:LPRINT SPC(47);S3$
6615 LPRINT:LPRINT:LPRINT:LPRINT:LPRINT "***************************************"
6620 LPRINT:LPRINT:LPRINT:LPRINT:LPRINT
6630 RETURN
7000 REM *** FOOTNOTES ACCEPTED AND PRINTED *** SEGMENT 7 ***
7005 CLS
7010 PRINT "ENTER FOOTNOTE"
7015 S1=2:S2=1:S3=2:S4=0:S5=999999!:S6$="":GOSUB 9:C$=S$
7025 LPRINT TAB(5)"NOTE:";C$
7035 RETURN
7500 REM **** REAL ESTATE TABLESECTION **** SEGMENT 8 ***
7505 CLS:PRINT " **** REAL ESTATE ****":PRINT:PRINT:PRINT
7510 PRINT "1 LAND VALUE PER ACRE----------I":PRINT:PRINT "2 BUILDING VALUE PER ";
7515 PRINT "ACRE------I":PRINT:PRINT "3 BUILDING DEPRECIATION %------I":PRINT
7520 PRINT "4 REAL ESTATE INTEREST RATE----I":PRINT:PRINT "5 TAX PER ACRE FOR ";
7525 PRINT "LAND--------I":PRINT:PRINT "6 TAX PER ACRE FOR REAL ESTATE-I":PRINT
7530 PRINT "7 COST OF IRRIGATION RIGHTS----I":PRINT:PRINT "8 FIXED COST (INSURANCE ETC)---I"
7535 S1=3:S2=35:S3=1:S4=0:S5=999999!
7540 FOR J=1 TO 8:S6$=STR$(E(J)):S1=S1+2:IF J=1 OR J=2 THEN 7543
7541 IF J=3 OR J=4 OR J=7 THEN S5=100:GOTO 7543
7542 S5=1000
7543 GOSUB 9:E(J)=S: NEXT J
7545 GOSUB 900:IF S$="N" GOTO 7550
7547 GOTO 7535
7550 FOR V=1 TO 3:FOR J=1 TO 6:D(V,J)=0:NEXT:NEXT
7555 D(1,2)=E(1)*E(4)/100
7560 D(1,3)=E(5)
7565 D(1,4)=E(7)
7570 FOR J=1 TO 4:D(1,6)=D(1,6)+D(1,J):NEXT
7575 D(2,1)=E(2)*E(3)/100
7580 D(2,2)=E(4)*E(2)/100
7585 D(2,3)=E(6)
7590 D(2,5)=E(8)
7595 FOR J=1 TO 5:D(2,6)=D(2,6)+D(2,J):NEXT
7600 FOR V=1 TO 6:D(3,V)=D(1,V)+D(2,V):NEXT
7605 GT=D(3,6)+SO
7610 CLS:S1=22:S2=1:GOSUB 24:PRINT "DO YOU WISH SCREEN OUTPUT "
7615 S1=22:S2=35:S3=3:S6$="Y":GOSUB 9:IF S$="Y" THEN GOSUB 10600
7617 CLS:GOSUB 910:IF S$="N" THEN GOTO 7750
7620 REM *** PRINTOUT OF REAL ESTATE TABLE ***
7625 CLS
7630 LPRINT:LPRINT:LPRINT:LPRINT
7635 LPRINT "TABLE 3 REAL ESTATE COSTS PER ACRE":LPRINT
7640 LPRINT SPC(14);"MARKET DEPREC-";SPC(30);"INSUR- TOTAL"
7645 LPRINT "ITEM";SPC(10);"VALU IATION INTEREST TAXES WATER";
7650 LPRINT " ANCE PER ACRE":FOR J=1 TO 74:LPRINT "-";:NEXT J:LPRINT
7655 LPRINT "LAND";:S3=E(1):S4=9:GOSUB 200:LPRINT SPC(7);S3$;
7660 S3=D(1,2):GOSUB 200:LPRINT SPC(9);S3$;
7665 S3=D(1,3):GOSUB 200:LPRINT S3$;
7670 S3=D(1,4):GOSUB 200:LPRINT S3$;
7675 S3=D(1,6):GOSUB 200:LPRINT SPC(9);S3$
7680 LPRINT:LPRINT "BUILDINGS ";:S3=E(2):GOSUB 200:LPRINT S3$;
7685 S3=D(2,1):GOSUB 200:LPRINT S3$;
7690 S3=D(2,2):GOSUB 200:LPRINT S3$;
7695 S3=D(2,3):GOSUB 200:LPRINT S3$;
7700 S3=D(2,5):GOSUB 200:LPRINT SPC(9);S3$;
7705 S3=D(2,6):GOSUB 200:LPRINT S3$
7710 LPRINT SPC(11);:FOR J=1 TO 7:LPRINT " --------";:NEXT J
7715 LPRINT:LPRINT "TOTAL COST ";:S3=D(3,6):S4=9:GOSUB 200:LPRINT SPC(54);S3$
7720 LPRINT:LPRINT:LPRINT "TOTAL COST PER ACRE";SPC(46);:S3=GT:GOSUB 200:LPRINT S3$
7725 LPRINT:LPRINT:LPRINT "ESTIMATED GROSS INCOME PER ACRE";:S3=G1:GOSUB 200
7730 LPRINT SPC(34);S3$
7735 LPRINT:LPRINT:LPRINT:LPRINT:LPRINT "****************************************"
7740 LPRINT:LPRINT:LPRINT:LPRINT:LPRINT
7750 RETURN
8000 REM *** SUMMARY TABLE SECTION *** SEGMENT 9 ***
8005 N=NJ+1:GA=G1-B(N,20):TW=D(3,3)+D(1,4)
8010 T1=B(N,18)+B(N,14)+TW+OT+OD:CR=GA-T1:DP=B(N,16)+B(N,12)
8015 EQ=B(N,17)+B(N,13):T2=DP+D(2,1)+B(N,19)
8017 GP=CR-T2
8019 T3=D(1,2)+EQ+D(2,2)
8020 AL=B(N,20)+T1+T2+T3
8025 S1=23:S2=1:GOSUB 24:PRINT "DO YOU WISH SCREEN OUTPUT(Y/N)"
8030 S2=35:S6$="Y":S4=0:S5=999999!:S3=3:GOSUB 9:IF S$="Y" THEN GOSUB 10800
8035 CLS:COLOR 0,7:PRINT "PLEASE WAIT":COLOR 7,0
8037 CLS:GOSUB 910:IF S$="N" THEN GOTO 8215
8040 LPRINT:LPRINT:LPRINT:LPRINT:LPRINT
8045 LPRINT "SUMMARY OF CONSENSUS REPORT - COSTS AND RETURNS"
8050 LPRINT:LPRINT:LPRINT D$
8055 LPRINT:LPRINT:S3=G1:S4=9:GOSUB 200:LPRINT " GROSS INCOME";SPC(51);S3$:LPRINT
8060 LPRINT " DIRECT CASH COSTS"
8065 S3=B(N,20):GOSUB 200:LPRINT " MATERIAL AND SERVICE COSTS";SPC(9);S3$;SPC(2);S3$
8070 S3=GA:GOSUB 200:LPRINT:LPRINT " GROSS MARGIN";SPC(52);S3$:LPRINT:LPRINT
8075 LPRINT " OVERHEAD CASH COSTS"
8080 S3=B(N,18):GOSUB 200:LPRINT " TRACTOR OPERATING";SPC(18);S3$
8085 S3=B(N,14):GOSUB 200:LPRINT " IMPLIMENT OPERATING";SPC(16);S3$
8090 S3=TW:GOSUB 200:LPRINT " TAXES AND WATER";SPC(20);S3$
8095 S3=OT:GOSUB 200:LPRINT " INTEREST ON OPERATING CAPITAL";SPC(6);S3$
8100 S3=OD:GOSUB 200:LPRINT " MISCELLANEOUS OVERHEAD";SPC(13);S3$
8105 LPRINT SPC(48);"------"
8110 S3=T1:GOSUB 200:LPRINT " TOTAL";SPC(30);S3$;SPC(2);S3$:LPRINT:LPRINT
8115 LPRINT " RETURN OVER DIRECT CASH COSTS (CONTRIBUTION MARGIN)";
8120 S3=CR:GOSUB 200:LPRINT SPC(8);S3$:LPRINT:LPRINT
8125 LPRINT "DEPRECIATION AND LABOUR"
8130 S3=DP:GOSUB 200:LPRINT " EQUIPMENT DEPRECIATION";SPC(13);S3$
8135 S3=D(2,1):GOSUB 200:LPRINT " BUILDING DEPRECIATION";SPC(14);S3$
8140 S3=B(N,19):GOSUB 200:LPRINT " OPERATOR AND PAID LABOUR";SPC(11);S3$
8145 LPRINT SPC(48);"------"
8150 S3=T2:GOSUB 200:LPRINT " TOTAL";SPC(30);S3$;SPC(2);S3$:LPRINT:LPRINT:LPRINT
8155 S3=GP:GOSUB 200:LPRINT " INTEREST ON INVESTMENT/GROSS OPERATING PROFIT";SPC(19);S3$:LPRINT:LPRINT:LPRINT
8160 LPRINT " INTEREST/OPPORTUNITY COSTS"
8165 S3=D(1,2):GOSUB 200:LPRINT " REAL ESTATE";SPC(24);S3$
8170 S3=EQ:GOSUB 200:LPRINT " EQUIPMENT";SPC(26);S3$
8175 S3=D(2,2):GOSUB 200:LPRINT " BUILDINGS";SPC(26);S3$
8180 LPRINT SPC(48);"------"
8185 S3=T3:GOSUB 200:LPRINT " TOTAL";SPC(30);S3$;SPC(2);S3$
8190 LPRINT:LPRINT:S3=AL:GOSUB 200:LPRINT " TOTAL OF ALL ECONOMIC COSTS";SPC(24);S3$:LPRINT:LPRINT:LPRINT:LPRINT
8195 LPRINT:LPRINT:LPRINT:LPRINT:LPRINT "****************************************"
8200 LPRINT:LPRINT:LPRINT:LPRINT:LPRINT
8215 RETURN
10000 REM *** SCREEN MACHINE TABLE OUTPUT *** SEGMENT 10 ***
10010 CLS:PRINT "MACHINE TABLE"
10020 PRINT:PRINT TAB(18);"TRADE ANNUAL YEARS"
10030 PRINT "NO MACH COST VALUE USE USE":PRINT
10040 FOR J=1 TO I:PRINT RIGHT$((" "+STR$(J)),2);
10050 PRINT TAB(4);LEFT$(A$(J,1),6);
10060 PRINT TAB(11);INT(A(J,2));
10070 PRINT TAB(18);INT(A(J,3));
10080 PRINT TAB(26);INT(A(J,4));
10090 PRINT TAB(35);INT(A(J,5)):NEXT J
10100 GOSUB 300
10120 CLS:PRINT "MACHINE TABLE":PRINT
10130 PRINT TAB(12);"DEPRECN INTEREST OPERATN"
10140 PRINT "NO MACH COST/HR COST/HR COST/HR"
10150 FOR J=1 TO I:PRINT RIGHT$((" "+STR$(J)),2);
10160 PRINT TAB(4);LEFT$(A$(J,1),6);
10170 PRINT TAB(13);LEFT$(STR$(A(J,13)),6);
10180 PRINT TAB(23);LEFT$(STR$(A(J,14)),6);
10190 PRINT TAB(33);LEFT$(STR$(A(J,15)),6):NEXT J
10200 GOSUB 300
10210 RETURN
10300 REM *** SCREEN MACHINE LISTING OUTPUT *** SEGMENT 11 ***
10310 CLS:PRINT "MACHINERY LISTING"
10320 FOR J=1 TO I:PRINT RIGHT$((" "+STR$(J)),2);
10330 PRINT SPC(5);A$(J,1)
10340 NEXT J
10350 GOSUB 300
10360 RETURN
10400 REM *** SCREEN BUDGET OPERATIONS TABLE *** SEGMENT 12 ***
10410 CLS:PRINT "OPERAT MACHINE MACH LABOR MATER TOTAL"
10420 PRINT " ION NO COSTS COSTS COSTS COSTS"
10430 FOR J=1 TO 40:PRINT "-";:NEXT J:PRINT
10440 FOR J=1 TO NJ:PRINT LEFT$(((B$(J,1))+" "),5);
10450 FOR V=2 TO 4:PRINT RIGHT$((" "+STR$(B(J,V))),2);" ";:NEXT V
10455 PRINT RIGHT$((" "+STR$(B(J,5))),2);
10460 Z=B(J,16)+B(J,17)+B(J,18)+B(J,12)+B(J,13)+B(J,14)
10470 PRINT TAB(17);LEFT$(STR$(Z),5);
10480 PRINT TAB(24);LEFT$(STR$(B(J,19)),5);
10490 PRINT TAB(30);LEFT$(STR$(B(J,20)),5);
10500 PRINT TAB(36);LEFT$(STR$(B(J,21)),5)
10510 NEXT J
10520 PRINT:PRINT "INTEREST ON OPERATING CAPITAL";TAB(34);LEFT$(STR$(OT),6)
10530 PRINT "MISCELLANEOUS OVERHEAD";TAB(34);LEFT$(STR$(OD),6)
10540 PRINT "TOTAL COSTS";TAB(34);LEFT$(STR$(SO),6)
10550 GOSUB 300
10560 RETURN
10600 REM *** SCREEN REAL ESTATE TABLE OUTPUT *** SEGMENT 13 ***
10610 CLS:PRINT "REAL ESTATE COSTS PER ACRE":PRINT
10620 PRINT " DEP INTST TAX WATER INS TOTAL":PRINT
10630 PRINT "LAND";TAB(12);D(1,2);
10640 PRINT TAB(19);D(1,3);
10650 PRINT TAB(24);D(1,4);
10660 PRINT TAB(34);D(1,6)
10670 PRINT "BLDG";TAB(7);D(2,1);
10680 PRINT TAB(12);D(2,2);
10690 PRINT TAB(19);D(2,3);
10700 PRINT TAB(29);D(2,5);
10710 PRINT TAB(34);D(2,6)
10720 PRINT:PRINT "TOTAL COSTS PER ACRE";TAB(34);LEFT$(STR$(GT),6)
10730 PRINT:PRINT "ESTIMATED GROSS INCOME PER ACRE";TAB(34);LEFT$(STR$(G1),6)
10740 GOSUB 300
10750 RETURN
10800 REM *** SCREEN SUMMARY TABLE OUTPUT *** SEGMENT 14 ***
10810 CLS:PRINT "SUMMARY OF CONSENSUS REPORT ";LEFT$(D$,9)
10820 PRINT "---------------------------"
10830 PRINT:PRINT "GROSS INCOME"TAB(33);LEFT$(STR$(G1),6)
10840 PRINT:PRINT "DIRECT CASH COSTS":PRINT "---------------"
10850 PRINT "MATERIAL COSTS";TAB(27);LEFT$(STR$(B(N,20)),6)
10860 PRINT:PRINT "GROSS MARGIN";TAB(33);LEFT$(STR$(GA),6)
10870 PRINT:PRINT "OVERHEAD CASH COSTS":PRINT "-------------------"
10880 PRINT "TRACTOR OPERATING";TAB(27);LEFT$(STR$(B(N,18)),6)
10890 PRINT "IMPLIMENT OPERATAING";TAB(27);LEFT$(STR$(B(N,14)),6)
10900 PRINT "TAXES AND WATER";TAB(27);LEFT$(STR$(TW),6)
10910 PRINT "INTEREST ON OPER. CAPITAL";TAB(27);LEFT$(STR$(OT),6)
10920 PRINT "MISCELLANEOUS OVERHEAD";TAB(27);LEFT$(STR$(OD),6)
10930 PRINT TAB(27);"------"
10940 PRINT "TOTAL";TAB(27);LEFT$(STR$(T1),6)
10950 PRINT:PRINT "RETURN OVER DIRECT CASH COSTS";TAB(33);LEFT$(STR$(CR),6)
10960 GOSUB 300
10970 CLS:PRINT "SUMMARY CONTINUED";TAB(30);LEFT$(D$,9)
10980 PRINT "---------------"
10990 PRINT:PRINT "DEPRECIATION AND LABOUR":PRINT "-----------------------"
11000 PRINT "EQUIPMENT DEPRECIATION";TAB(27);LEFT$(STR$(DP),6)
11010 PRINT "BUILDING DEPRECIATION";TAB(27);LEFT$(STR$(D(2,1)),6)
11020 PRINT "OPERATOR AND PAID LABOUR";TAB(27);LEFT$(STR$(B(N,19)),6)
11030 PRINT TAB(27);"------":PRINT "TOTAL";TAB(27);LEFT$(STR$(T2),6)
11040 PRINT:PRINT "GROSS OPERATING PROFIT";TAB(33);LEFT$(STR$(GP),6)
11050 PRINT:PRINT "INTEREST/OPPORTUNITY COSTS":PRINT "--------------------------"
11060 PRINT "REAL ESTATE";TAB(27);LEFT$(STR$(D(1,2)),6)
11070 PRINT "EQUIPMENT";TAB(27);LEFT$(STR$(EQ),6)
11080 PRINT "BUILDINGS";TAB(27);LEFT$(STR$(D(2,2)),6)
11090 PRINT TAB(27);"------":PRINT "TOTAL"TAB(27);LEFT$(STR$(T3),6)
11100 PRINT:PRINT "TOTAL OF ALL ECONOMIC COSTS";TAB(33);LEFT$(STR$(AL),6)
11110 GOSUB 300
11120 RETURN
60000 REM this is the logo routine
60010 DEF SEG=0:IF (PEEK(&H410) AND &H30)=&H30 GOTO 60550
60020 S=3.141593
60030 KEY OFF
60040 SCREEN 1
60050 COLOR 0,1
60060 CLS
60070 LINE(0,0)-(319,199),3,B
60080 LINE(5,5)-(314,194),3,B
60090 PAINT(1,1),1,3
60100 DRAW"c3;bm40,100;e60;d60;l5;h15;e4;f10;u40;g50;l5;"
60110 PAINT(43,99),1,3
60120 DRAW"C3;bm110,30;d70;L5;U70;R5;"
60130 PAINT(109,99),1,3
60140 DRAW"C3;bm120,40;d60;L5;U60;R5;"
60150 PAINT(119,99),1,3
60160 CIRCLE(135,83),20,3,1.25*S,0.75*S
60170 CIRCLE(135,83),15,3,1.25*S,0.9*S
60180 DRAW"bm119,96;e5;"
60190 PAINT(135,98),1,3
60200 CIRCLE(170,83),20,3,0.2*S,1.85*S
60210 CIRCLE(170,83),15,3,0.25*S,1.8*S
60220 DRAW"C3;BM182,90;R5;"
60230 DRAW"C3;BM187,75;G10;H3;E7;"
60240 PAINT(170,99),1,3
60250 PAINT(170,67),1,3
60260 DRAW"c3;bm195,100;l5;u34;r5;d34;"
60270 CIRCLE(210,83),20,3,0.55*S,0.76*S
60280 CIRCLE(210,83),15,3,0.59*S,0.8799999*S
60290 DRAW"bm207,66;d5;"
60300 PAINT(194,99),1,3
60310 PAINT(206,69),1,3
60320 DRAW"c3;bm217,100;l5;u40;r5;d5;r7;d5;l7;d30;"
60330 PAINT(216,97),1,3
60340 DRAW"C3;bm265,65;d35;L5;U35;R5;"
60350 CIRCLE(245,83),20,3,0.25*S,1.75*S
60360 CIRCLE(245,83),15,3,0.09999999*S,1.7*S
60370 DRAW"bm261,99;h6;"
60380 PAINT(245,98),1,3
60390 PAINT(264,69),1,3
60400 LOCATE 14,22
60410 PRINT"AGRICULTURE"
60420 LOCATE 17,4
60430 PRINT"FIELD SERVICES DIVISION"
60440 LOCATE 18,4
60450 PRINT" & ECONOMIC SERVICES DIVISION"
60460 LOCATE 23,5
60470 PRINT"PROVIDED BY ALBERTA AGRICULTURE"
60480 LOCATE 24,3
60490 PRINT"RESPONSIBILITY RESTS WITH THE USER";
60500 FOR S=1 TO 4100
60510 POKE 106,0
60520 IF INKEY$<>"" GOTO 60540
60530 NEXT S
60540 ON ERROR GOTO 0 :SCREEN 0,0,0:RETURN
60550 REM **MONOCHROME LOGO**
60560 KEY OFF:WIDTH 80:CLS:S$=CHR$(219)
60570 PRINT STRING$(75,S$);
60580 FOR S=2 TO 23:LOCATE S,75:PRINT S$;:NEXT
60590 LOCATE 24,1:PRINT STRING$(75,S$);
60600 FOR S=23 TO 2 STEP -1:LOCATE S,1:PRINT S$;:NEXT
60610 '
60620 '
60630 LOCATE 5,28:PRINT "▌"
60640 LOCATE 6,24:PRINT"/▌ ▌ ▌"
60650 LOCATE 7,23:PRINT"/ ▌ ▌ ▌"
60660 LOCATE 8,22:PRINT"/ ▌ ▌ ▌ ▐"
60670 LOCATE 9,21:PRINT"/ ▌ ▌ ▌ __ __ ▐_ __"
60680 LOCATE 10,20:PRINT"/ ▌ ▌ ▌/ \ / \ ▐/ ▐ / \▌"
60690 LOCATE 11,19:PRINT"/ ▌ ▌ █ ▐ ▌ / ▐ ▐ ▌ ▌"
60700 LOCATE 12,18:PRINT"/ \ ▌ ▌ █ ▐ ▌ ▐ ▐ ▌ ▌"
60710 LOCATE 13,17:PRINT"/ \▌ ▌ ▌\__/ \__/ ▐ ▐ \__/▌"
60720 LOCATE 15,36:PRINT"A G R I C U L T U R E"
60730 LOCATE 18,14:PRINT"FIELD SERVICES & ECONOMIC SERVICES DIVISION"
60740 LOCATE 21,22:PRINT"PROVIDED BY ALBERTA AGRICULTURE."
60750 LOCATE 22,19:PRINT"RESPONSIBILITY RESTS SOLELY WITH USER"
60760 FOR S=1 TO 1500
60770 S$=INKEY$
60780 IF S$=CHR$(13) GOTO 60800
60790 NEXT S
60800 S$=""
60810 ON ERROR GOTO 0
60820 RETURN
61000 REM *** INTRODUCTION TO PROGRAM *** SEGMENT 16 ***
61003 WIDTH 40:CLS:LOCATE 3,1
61005 PRINT TAB(6)"█ █ ████ █ █ ███ "
61010 PRINT TAB(6)"█ █ █ █ █ █ █"
61015 PRINT TAB(6)"████ ███ █ █ █ █"
61020 PRINT TAB(6)"█ █ █ █ █ █ █"
61025 PRINT TAB(6)"█ █ ████ ███ ███ ███ "
61040 LOCATE 10,13:PRINT "WELCOME TO"
61042 PRINT:PRINT
61045 PRINT" ▐██▌ ███▌ ▐██▌ ███▌ ▐██▌ ███▌"
61050 PRINT" █ █ █ █ █ █ █ █ █ █ █ █"
61055 PRINT" █ ███▌ █ ███▌ █ █ ███▌"
61060 PRINT" █ █ █ █ █ █ █ █ █ █ █ "
61065 PRINT" ▐██▌ █ ▐▌ ▐██▌ █ ▐▌ ▐██▌ █ "
61080 LOCATE 20,5:PRINT"CONSENSUS RESEARCH CROPS MODEL"
61085 LOCATE 22,13:PRINT"JULY 1984"
61090 GOSUB 300
61120 CLS:PRINT "YOU WILL BE ASKED TO ANSWER QUESTIONS"
61125 PRINT "SPECIFIC TO TWO INPUT SHEETS"
61130 PRINT:PRINT:PRINT "IF YOU ARE READY THEN LET'S PROCEED"
61135 GOSUB 300
61140 CLS:PRINT "AFTER ANSWERING EACH QUESTION":PRINT "YOU MUST PRESS ";:COLOR 0,7:PRINT "RETURN":COLOR 7,0
61145 PRINT:PRINT "IF YOU MAKE A MISTAKE AND NOTICE IT":PRINT "BEFORE YOU PRESS RETURN SIMPLY ";:COLOR 0,7:PRINT "BACKSPACE":COLOR 7,0
61150 PRINT:PRINT "IF YOU HAVE PRESSED RETURN YOU WILL BE":PRINT "GIVEN A CHANCE TO CORRECT IT LATER"
61155 PRINT:PRINT "TO EXIT THE PROGRAM, ENTER ";:COLOR 0,7:PRINT"`SHIFT <'":COLOR 7,0
61157 PRINT"BUT ALL OF THE INFORMATION WILL BE LOST."
61160 GOSUB 300
61165 RETURN
DIET.BAS
1 REM DIET DETECTIVE JR.
2 REM PROVIDES NUTRIENT ANALYSIS & RECOMMENDATIONS
3 REM PROGRAMMER: A HILLS AUG 1980
4 REM REVISED BY GD FISHER FOR IBM PC
5 REM LAST REVISION: FEB 27/83
8 GOTO 5000
9 S$="":REM THIS IS THE INPUT SUBROUTINE
10 GOSUB 24:PRINT SPACE$(LEN(S$));
11 S8=0:GOSUB 24
12 GOSUB 31
13 GOSUB 35
14 GOSUB 53
15 IF S$="" THEN S$=S6$:GOTO 22
16 IF S3=1 THEN GOSUB 56
17 IF S8=1 GOTO 10
18 IF S3=1 THEN GOSUB 68
19 IF S8=1 GOTO 10
20 IF S3=3 THEN GOSUB 73
21 IF S8=1 GOTO 10
22 IF S3=1 THEN S=VAL(S$)
23 RETURN
24 REM POSITION CURSOR
25 LOCATE S1,S2,1
30 RETURN
31 REM PRINT DEFAULT
32 PRINT S6$;
33 GOSUB 24
34 RETURN
35 REM TRANSPARENT CURSOR ROUTINE
36 S$=""
37 S1$=INPUT$(1)
41 S=ASC(S1$):IF S<>13 GOTO 46
42 IF S$="" THEN GOSUB 24:PRINT " ";:GOSUB 24:GOSUB 31:RETURN
43 IF LEN(S$)>=LEN(S6$) GOTO 45
44 PRINT SPACE$(LEN(S6$)-LEN(S$));
45 RETURN
46 IF S<32 GOTO 50
47 IF S=34 THEN S1$="'"
48 S$=S$+S1$:IF S9>0 THEN IF LEN(S$)>S9 THEN PRINT S1$;:GOTO 52
49 PRINT S1$;:GOTO 37
50 IF LEN(S$)<1 GOTO 36
51 IF LEN(S$)=1 THEN PRINT CHR$(29);:PRINT" ";:PRINT CHR$(29);:GOTO 36
52 S$=LEFT$(S$,LEN(S$)-1):PRINT CHR$(29);:PRINT" ";:PRINT CHR$(29);:GOTO 37
53 REM THIS CHECKS FOR EXIT
54 IF S$="<" THEN CLS:PRINT"NORMAL EXIT":RUN"HELLO"
55 RETURN
56 S1$=S$:S7=0:REM CHECK FOR NUMERIC INPUT
57 IF LEFT$(S1$,1)=" " THEN S1$=RIGHT$(S1$,LEN(S1$)-1):GOTO 57
58 IF RIGHT$(S1$,1)=" " THEN S1$=LEFT$(S1$,LEN(S1$)-1):GOTO 58
59 IF LEN(S1$)<1 GOTO 64
60 FOR S=1 TO LEN(S1$):S6=ASC(MID$(S1$,S,1))
61 IF S6>=48 AND S6<=57 GOTO 66
62 IF (S6=43 OR S6=45) AND S=1 GOTO 66
63 IF S6=46 AND S7=0 THEN S7=1:GOTO 66
64 S2$="NON NUMERIC INPUT":S1$="":GOSUB 78
65 RETURN
66 NEXT S
67 RETURN
68 REM CHECK FOR PROPER LIMITS
69 S6=VAL(S$)
70 IF S6<S4 THEN S2$="INPUT BELOW":S1$=STR$(S4):GOSUB 78:RETURN
71 IF S6>S5 THEN S2$="INPUT ABOVE":S1$=STR$(S5):GOSUB 78:RETURN
72 RETURN
73 REM CHECK FOR YES OR NO
74 IF LEFT$(S$,1)="Y" OR LEFT$(S$,1)="N" GOTO 76
75 S2$="MUST BE YES/NO ANSWER":S1$="":GOSUB 78:RETURN
76 S$=LEFT$(S$,1)
77 RETURN
78 REM ERROR FOR ALL CONDITIONS
79 COLOR 31,0,0:BEEP
80 GOSUB 90
81 PRINT" ";S2$;S1$;
82 FOR S7=1 TO 3000:NEXT S7
83 COLOR 7,0,0
87 GOSUB 93
88 S8=1
89 RETURN
90 REM POSTITION TO LAST LINE
91 LOCATE 25,1,0
92 RETURN
93 REM BLANK LAST LINE
94 LOCATE 25,1,1
95 PRINT SPACE$(39);
96 RETURN
200 REM ****DOLLAR FORMAT SUBROUTINE****
201 S3=INT(S3*100+0.5)/100
202 S3$=SPACE$(30)
203 IF S3=0 THEN S3$=RIGHT$(S3$,S4-4)+"0.00":GOTO 209
204 S4$=STR$(S3)
205 IF ASC(MID$(RIGHT$(S4$,2),1,1))=46 THEN S3$=S3$+S4$+"0":GOTO 208
206 IF ASC(MID$(RIGHT$(S4$,3),1,1))=46 THEN S3$=S3$+S4$:GOTO 208
207 S3$=S3$+S4$+".00"
208 S3$=RIGHT$(S3$,S4)
209 RETURN
300 REM HOLD SCREEN
301 S$="PRESS RETURN TO CONTINUE "
302 COLOR 31,0,0
303 GOSUB 90
304 PRINT" ";S$;
305 POKE 106,0
306 IF INKEY$=CHR$(13) GOTO 307 ELSE GOTO 305
307 COLOR 7,0,0
308 GOSUB 93
314 S$="":S1$=""
315 RETURN
5000 REM *** MAINLINE ***
5004 CLS
5008 DIM A(1,20)
5012 DIM R$(1,19)
5016 DIM O(26,5)
5020 DIM T(77,6)
5024 DIM S(1,7)
5028 DIM R(1,7)
5032 ZR=0:OE=1: REM CONSTANTS
5036 A(1,0)=OE
5040 M=3
5044 GOSUB 60000
5048 REM GOSUB 60010
5052 GOSUB 5600
5056 GOSUB 5700
5060 GOSUB 5748
5064 GOSUB 5900
5068 S6$="":S1=4:S2=23:S3=2:S9=12: GOSUB 9
5072 A$=S$
5076 GOSUB 5700
5080 GOSUB 6000
5084 GOSUB 5550
5088 GOSUB 6300
5092 M=2
5096 GOSUB 5700
5100 GOSUB 6200: REM READ W DATA STMTS
5104 M=3
5108 GOSUB 5700
5112 A1=75
5116 GOSUB 5500
5120 GOSUB 5850
5124 GOSUB 5500
5128 GOSUB 5800
5132 GOSUB 6500
5136 B$="BREAKFAST?"
5140 D$="B"
5144 GOSUB 6600: REM FOOD INTAKE MENU
5148 G=W
5152 GOSUB 6700: REM USER ENTERS INTAKE
5156 B$="LUNCH?"
5160 D$="L"
5164 GOSUB 6600
5168 H=W
5172 GOSUB 6700
5176 D$="D"
5180 B$="DINNER?"
5184 GOSUB 6600
5188 I=W
5192 GOSUB 6700
5196 D$="S"
5200 B$="SNACKS?"
5204 GOSUB 6600
5208 J=W
5212 GOSUB 6700
5216 GOSUB 7900
5224 CLS
5228 GOSUB 7002: REM CALORIE CONSUMPTION
5232 GOSUB 7200
5236 GOSUB 7300
5240 X=W1/2.2*R(1,3)
5244 X= INT(X)
5248 P2=X
5252 GOSUB 8200
5256 GOSUB 5550
5260 X=W1/2.2*R(1,3)
5264 X= INT(X)
5268 P2=X
5272 IF L$<>"ABOVE" THEN 5284
5276 GOSUB 7400
5284 IF Q>200 THEN 5300
5288 A(1,14)=A(1,14)+OE
5292 GOSUB 7100
5296 GOSUB 5550
5300 GOSUB 7500
5304 GOSUB 8300
5308 GOSUB 5550
5312 CLS
5316 Z=ZR
5320 IF T(0,2)<R(1,5) THEN GOSUB 7700
5324 IF T(0,3)<R(1,6) THEN GOSUB 7750
5328 IF T(0,4)<R(1,7) THEN GOSUB 7800
5332 IF Z<>ZR THEN GOSUB 5550
5336 CLS
5340 Z=ZR
5344 IF T(0,5)>200 THEN GOSUB 8000
5348 IF T(0,6)>ZR THEN GOSUB 8050
5352 IF Z>ZR THEN GOSUB 5550
5356 GOSUB 8500
5360 S6$="":S1=23:S2=33:S3=2: GOSUB 9
5364 IF S$="R" THEN 8600: REM RESTART PROG
5368 IF S$<>"S" THEN 5360
5372 GOSUB 8700: GOSUB 5550: REM PRINT STATS
5376 CLS : PRINT : PRINT "THANKS AND THINK NUTRITION"
5380 RUN "HELLO"
5500 FOR V=OE TO A1:X=X*9:X=X/9: NEXT
5502 RETURN
5550 LOCATE 23,10: COLOR 23,0 : PRINT "PRESS 'RETURN' TO PROCEED": COLOR 7,0
5552 S6$="":S1=23:S2=38:S3=2:S9=1: GOSUB 9:S9=0
5554 RETURN
5600 LOCATE 4,15: PRINT "PRESENTS"
5602 A1=120
5604 GOSUB 5500
5606 LOCATE 6,8: COLOR 0,7 : PRINT "`DIET DETECTIVE JUNIOR'": COLOR 7,0
5608 LOCATE 9,12: PRINT "A MICROCOMPUTER"
5610 LOCATE 11,9: PRINT "DIET ANALYSIS PROGRAM"
5611 LOCATE 21,23: PRINT "MARCH 1983"
5612 GOSUB 5550
5614 RETURN
5700 CLS
5702 LOCATE 6,1
5704 ON M GOTO 5706,5710,5714
5706 M1$=" (/-\) "
5708 GOTO 5716
5710 M1$=" ( - ) "
5712 GOTO 5716
5714 M1$=" (\_/)"
5716 PRINT " ### "
5718 PRINT " ####### "
5720 PRINT " !- -! "
5722 PRINT " !Q Q! "
5724 PRINT " ! + ! "
5726 PRINT M1$
5728 PRINT " \_/ "
5730 PRINT " ]=[ "
5732 PRINT " / \ "
5734 PRINT " / O \ "
5736 PRINT "! ! "
5738 PRINT "! O ! "
5740 PRINT "! ! ! ! "
5742 PRINT "! ! O ! ! "
5744 PRINT " <! !> "
5746 RETURN
5748 A1=50
5750 FOR X=OE TO 3
5752 LOCATE 9,6: PRINT "-"
5754 GOSUB 5500
5756 LOCATE 9,6: PRINT "Q"
5758 GOSUB 5500
5760 NEXT
5764 RETURN
5800 LOCATE 15,11: PRINT "^"
5802 PRINT "! \ /"
5804 PRINT "! O !\ /"
5806 PRINT "! ! ! \/ "
5808 PRINT "! ! O ! "
5812 RETURN
5850 LOCATE 16,1: PRINT "! \ "
5852 PRINT "! O !\ \"
5854 PRINT "! ! ! \ \"
5856 PRINT "! ! O ! \>"
5858 PRINT " <! ! "
5860 RETURN
5900 LOCATE 1,2: PRINT "__________________________________"
5902 PRINT "! HI! I'M DIET DETECTIVE JUNIOR. !"
5904 PRINT "! !"
5906 PRINT "! !"
5908 PRINT "!__________________________________!"
5910 LOCATE 6,12: PRINT "/"
5914 GOSUB 5500
5916 LOCATE 4,4: PRINT "WHAT IS YOUR NAME?"
5920 GOSUB 5500
5922 LOCATE 11,1
5924 LOCATE 12,15:PRINT "VVVVVVVVVVVVVVVVVVVVVVVV"
5926 LOCATE 13,15:PRINT "V V"
5928 LOCATE 14,15:PRINT "V TYPE YOUR NAME AFTER V"
5930 LOCATE 15,15:PRINT "V THE ? THEN PRESS V"
5932 LOCATE 16,15:PRINT "V 'RETURN' V"
5934 LOCATE 17,15:PRINT "V V"
5938 LOCATE 18,15:PRINT "VVVVVVVVVVVVVVVVVVVVVVVV"
5940 RETURN
6000 LOCATE 6,10: PRINT "___________________________"
6002 LOCATE 7,9: PRINT "!I CAN TELL YOU HOW WELL YOU!"
6004 LOCATE 8,9: PRINT "!ARE EATING, "
6005 LOCATE 8,22: COLOR 0,7 : PRINT A$: COLOR 7,0
6006 LOCATE 8,37: PRINT "!"
6008 LOCATE 9,9: PRINT "!IF YOU ANSWER MY QUESTIONS.!"
6009 LOCATE 10,9: PRINT "! !"
6010 LOCATE 11,9: PRINT "!FIRST, I WILL ASK YOU SOME !"
6012 LOCATE 12,9: PRINT "!QUESTIONS ABOUT YOURSELF. !"
6014 LOCATE 13,9: PRINT "!___________________________!"
6022 RETURN
6200 REM *** READ WEIGHT DATA ***
6201 W=ZR
6202 READ T$
6204 IF T$<>"W" THEN 6224
6206 N=N+OE
6208 W=W+OE
6210 READ O(N,1),O(N,2),O(N,3),O(N,4),O(N,5)
6222 GOTO 6202
6224 Z= VAL (Y$)
6226 IF Z<13 THEN A(1,2)=A(1,2)+OE
6228 IF Z>12 AND Z<19 THEN A(1,3)=A(1,3)+OE
6230 IF Z>18 AND Z<65 THEN A(1,4)=A(1,4)+OE
6232 IF Z>64 THEN A(1,5)=A(1,5)+OE
6234 IF Z<19 THEN 6264
6236 IF P$="Y" OR N$="Y" THEN 6264
6248 IF SS$="F" THEN 6256
6250 IF L<63 OR L>75 THEN 6264
6254 GOTO 6260
6256 IF L<60 OR L>72 THEN 6264
6260 GOSUB 6800
6262 GOSUB 5550
6264 RETURN
6300 REM *** ENTER PERSONAL DATA ***
6302 CLS : PRINT "ARE YOU MALE OR FEMALE:
6304 PRINT " (TYPE M IF MALE, F IF FEMALE "
6306 PRINT " THEN PRESS 'RETURN') ?"
6308 S6$=SS$:S1=3:S2=33:S3=2: GOSUB 9
6310 SS$=S$
6314 IF SS$="M" OR SS$="F" GOTO 6326
6320 LOCATE 25,1: COLOR 0,7 : COLOR 23,0 : PRINT "ENTER M OR F ONLY";
6321 A1=100: GOSUB 5500: COLOR 7,0 : GOSUB 91: GOSUB 94
6322 GOTO 6308
6326 LOCATE 5,1: PRINT "WHAT IS YOUR AGE IN YEARS:"
6328 PRINT " (ENTER NUMBER ONLY ,
6330 PRINT " THEN PRESS 'RETURN') ?"
6332 S6$=Y$:S1=7:S3=1:S4=1:S5=110: GOSUB 9
6340 Y$= STR$ (S)
6342 LOCATE 9,1: PRINT "WHAT IS YOUR HEIGHT: FEET ?"
6344 PRINT " (PRESS 'RETURN' AFTER"
6346 PRINT " EACH NUMBER) INCHES ?"
6348 S6$= STR$ ( INT(L/12)):S1=9:S4=1:S5=6: GOSUB 9
6350 S6$= STR$ (L- INT(L/12)*12)
6352 L=12*S
6360 S1=11:S4=0:S5=12: GOSUB 9
6362 L=L+S
6370 LOCATE 13,1: PRINT "WHAT IS YOUR WEIGHT IN POUNDS"
6372 PRINT " (ENTER NUMBER ONLY,"
6374 PRINT " THEN PRESS 'RETURN') ?"
6375 S6$=W$
6376 S1=15:S4=10:S5=350: GOSUB 9
6378 W$= STR$ (S)
6388 N$=" "
6390 P$=" "
6392 V= VAL (Y$):S6$="N":S3=3
6394 IF V<16 OR V>50 THEN GOTO 6430
6396 IF SS$<>"F" GOTO 6430
6398 LOCATE 17,1: PRINT "ARE YOU A NURSING MOTHER
6400 PRINT " IF YES,TYPE Y,IF NO,TYPE N ? "
6402 S1=18: GOSUB 9
6404 N$=S$
6414 LOCATE 20,1: PRINT "ARE YOU PREGNANT "
6416 PRINT " IF YES,TYPE Y,IF NO,TYPE N ? "
6418 S1=21: GOSUB 9
6420 P$=S$
6430 LOCATE 23,1: PRINT "ANY CHANGES? (TYPE Y FOR YES,N FOR NO)"
6432 S1=23:S2=39: GOSUB 9
6440 IF S$<>"N" GOTO 6300
6442 IF SS$="M" THEN A(1,12)=A(1,12)+OE
6444 IF SS$="F" THEN A(1,13)=A(1,13)+OE
6446 RETURN
6500 LOCATE 1,13: PRINT " _______________________"
6502 LOCATE 2,13:PRINT "!NOW I'M GOING TO ASK !"
6504 LOCATE 3,13:PRINT "!YOU WHAT YOU ATE FOR !"
6506 LOCATE 4,13:PRINT "!BREAKFAST, LUNCH, DINNER !"
6508 LOCATE 5,13:PRINT "!AND SNACKS YESTERDAY. !"
6510 LOCATE 6,13:PRINT "! !"
6512 LOCATE 7,13:PRINT "!TYPE THE AMOUNT EATEN !"
6514 LOCATE 8,13:PRINT "!BESIDE EACH FOOD, EITHER !"
6516 LOCATE 9,13:PRINT "!AS A WHOLE NUMBER OR IN !"
6518 LOCATE 10,13:PRINT "!DECIMAL FORM. FOR EXAMPLE!"
6520 LOCATE 11,13:PRINT "!IF YOU ARE PRESENTED WITH!"
6524 LOCATE 12,13:PRINT "! !"
6526 LOCATE 13,13:PRINT "! MILK,2%....1 CUP, ? !"
6528 LOCATE 14,13:PRINT "! !"
6530 LOCATE 15,13:PRINT "!AND YOU DRANK ONLY ONE !"
6532 LOCATE 16,13:PRINT "!HALF CUP, THEN TYPE .5 !"
6534 LOCATE 17,13:PRINT "!IF YOU DID NOT EAT A !"
6536 LOCATE 18,13:PRINT "!FOOD LISTED, SIMPLY PRESS!"
6538 LOCATE 19,13:PRINT "! 'RETURN'. !"
6540 LOCATE 20,13:PRINT "!_________________________!"
6542 GOSUB 5550
6599 RETURN
6600 REM *** FOOD INTAKE MENU ***
6602 W=ZR: CLS
6604 PRINT "WHAT DID YOU EAT FOR "B$
6606 PRINT "FOOD SVG.SIZE #SVGS"
6608 PRINT "_______________________________________"
6610 IF T$<>D$ GOTO 6624
6612 SS=SS+OE
6614 W=W+OE
6616 READ R$(1,W),T(SS,1),T(SS,2),T(SS,3),T(SS,4),T(SS,5),T(SS,6)
6618 PRINT R$(1,W)
6620 READ T$
6622 GOTO 6610
6624 LOCATE 24,1: COLOR 0,7 : PRINT "TYPE '-1' TO RETURN TO PREVIOUS LINE";: COLOR 7,0
6699 RETURN
6700 REM *** USER ENTERS FOOD INTAKE ***
6702 S2=36:S4=-1:S5=16
6704 S3=1:V=1
6706 U=U+1
6708 S6$= STR$ (T(U,0)):S1=V+3: LOCATE S1,S2-2: PRINT "?": GOSUB 9: GOSUB 6624
6710 IF S=-1 AND V>1 THEN V=V-1:U=U-1: LOCATE S1,S2: PRINT S6$;" ";: GOTO 6708
6712 T(U,0)=-T(U,0): GOSUB 6750
6714 T(U,0)=S
6716 GOSUB 6750
6718 V=V+1
6720 IF V-1<W THEN 6706
6722 LOCATE 24,1: PRINT "ANY CHANGES (TYPE Y OR N) ? ";
6724 S6$="N":S1=24:S3=3: GOSUB 9
6726 IF S$="N" THEN 6732
6728 U=U-W: GOSUB 91: GOSUB 94
6730 GOTO 6704
6732 RETURN
6750 FOR Z=OE TO 6:T(0,Z)=T(0,Z)+T(U,0)*T(U,Z): NEXT
6752 RETURN
6800 REM *** RECOMMENDED WEIGHT ***
6801 LOCATE 1,1
6802 M=2
6804 K= VAL (W$)
6806 Z=ZR
6808 IF SS$="F" THEN 6816
6810 IF L=O(Z,2) THEN 6830
6812 Z=Z+OE
6814 GOTO 6810
6816 Z=OE
6818 IF O(Z,1)=2 THEN 6824
6820 Z=Z+OE
6822 GOTO 6818
6824 IF L=O(Z,2) THEN 6830
6826 Z=Z+OE
6828 GOTO 6824
6830 LOCATE 3,15: PRINT "A SUGGESTED WEIGHT RANGE"
6832 LOCATE 4,15: PRINT "FOR AN ADULT YOUR HEIGHT"
6834 LOCATE 5,15: PRINT "AND SEX IS "O(Z,3)" TO "O(Z,5)
6836 W2=O(Z,3)
6838 W3=O(Z,5)
6840 LOCATE 6,15: PRINT "POUNDS, WITH AN AVERAGE"
6842 LOCATE 7,15: PRINT "WEIGHT OF "O(Z,4)" POUNDS."
6844 W1=O(Z,4)
6846 P2=O(Z,4)
6848 L$="WITHIN"
6850 M=3
6852 IF K<O(Z,3) THEN M=2:L$="BELOW"
6856 IF K>O(Z,5) THEN M=OE:L$="ABOVE":A(1,6)=A(1,6)+OE
6860 LOCATE 1,1
6862 GOSUB 5702
6864 LOCATE 9,15: PRINT "YOU WEIGH "L$" THE"
6868 LOCATE 10,15: PRINT "SUGGESTED RANGE."
6870 RETURN
7000 REM *** CALORIE SUMMARY ***
7002 PRINT "YESTERDAY, YOU CONSUMED APPROXIMATELY:"
7004 W=ZR
7006 FOR V=OE TO G
7008 W=W+T(V,0)*T(V,1)
7010 NEXT
7012 LOCATE 5,5: PRINT "BREAKFAST: "W" CALORIES"
7014 P=W
7016 Q=W
7018 Z=G+H
7020 W=ZR
7022 FOR V=G+1 TO Z
7024 W=W+T(V,0)*T(V,1)
7026 NEXT
7028 LOCATE 7,5: PRINT " LUNCH: "W" CALORIES"
7030 P=P+W
7032 Z=Z+I
7034 W=ZR
7036 FOR V=G+H+1 TO Z
7038 W=W+T(V,0)*T(V,1)
7040 NEXT
7042 LOCATE 9,5: PRINT " DINNER: "W" CALORIES"
7044 P=P+W
7046 Z=Z+J
7048 W=ZR
7050 FOR V=G+H+I+1 TO Z
7052 W=W+T(V,0)*T(V,1)
7054 NEXT
7056 LOCATE 11,5: PRINT " SNACKS: "W" CALORIES"
7058 P=P+W
7060 LOCATE 12,14: PRINT "______"
7062 LOCATE 14,5: PRINT " TOTAL: "P" CALORIES"
7064 P0=P
7066 RETURN
7100 M=OE
7102 GOSUB 5700
7104 LOCATE 1,11:PRINT"DON'T BE A BREAKFAST SKIMPER!"
7106 LOCATE 2,11:PRINT"THE FOOD YOU EAT AT BREAKFAST"
7108 LOCATE 3,11:PRINT"HELPS YOU GET GOING IN THE"
7110 LOCATE 4,11:PRINT"MORNING."
7112 LOCATE 6,11:PRINT"RESEARCH SUGGESTS THAT YOUR"
7114 LOCATE 7,11:PRINT"BODY USES THE CALORIES FROM"
7116 LOCATE 8,11:PRINT"FOOD MORE EFFICIENTLY IF"
7118 LOCATE 9,11:PRINT"MEALS AND SNACKS ARE SPACED"
7120 LOCATE 10,11:PRINT"EVENLY THROUGHOUT THE DAY."
7122 LOCATE 12,11:PRINT"FOR NUTRITIOUS BREAKFAST"
7124 LOCATE 13,11:PRINT"IDEAS, CONTACT YOUR DISTRICT"
7126 LOCATE 14,11:PRINT"HOME ECONOMIST. "
7128 RETURN
7200 REM *** READ CALORIE RECOMMENDS ***
7202 W=ZR:V=OE
7204 X= VAL (Y$)
7206 IF SS$<>"M" THEN V=2
7208 IF T$<>"C" THEN 7286
7210 READ A,B,C,D,E,F,G
7212 READ T$
7214 IF A<>V THEN 7208
7216 IF B<X THEN 7208
7218 R(1,1)=A
7220 R(1,2)=B
7222 R(1,3)=C
7224 R(1,4)=D
7226 R(1,5)=E
7228 R(1,6)=F
7230 R(1,7)=G
7232 IF V<>2 THEN 7286
7234 IF P$="Y" THEN 7262
7236 IF N$<>"Y" THEN 7286
7238 IF T$<>"C" THEN 7286
7240 IF A=4 THEN 7250
7242 READ A,B,C,D,E,F,G
7244 IF T$<>"C" THEN 7286
7246 READ T$
7248 GOTO 7240
7250 R(1,3)=R(1,3)+C
7252 R(1,4)=R(1,4)+D
7254 R(1,5)=R(1,5)+E
7256 R(1,6)=R(1,6)+F
7258 R(1,7)=R(1,7)+G
7260 GOTO 7286
7262 IF T$<>"C" THEN 7286
7264 IF A=3 THEN 7274
7266 READ A,B,C,D,E,F,G
7268 IF T$<>"C" THEN 7286
7270 READ T$
7272 GOTO 7264
7274 R(1,3)=R(1,3)+C
7276 R(1,4)=R(1,4)+D
7278 R(1,5)=R(1,5)+E
7280 R(1,6)=R(1,6)+F
7282 R(1,7)=R(1,7)+G
7284 IF N$="Y" THEN 7238
7286 RETURN
7300 W= VAL (W$)
7302 X=W/2.2*R(1,3)
7304 IF P$="Y" THEN X=X+300
7306 IF N$="Y" THEN X=X+500
7308 LOCATE 16,1: PRINT "BASED ON YOUR PRESENT WEIGHT OF "W
7310 X= INT(X)
7312 P3=X
7314 PRINT "POUNDS, YOU REQUIRE "X" CALORIES"
7316 PRINT "DAILY,IF YOU ARE MODERATELY ACTIVE."
7318 RETURN
7400 CLS
7402 LOCATE 3,10: PRINT "HOWEVER, AS YOU WEIGH ABOVE"
7404 PRINT TAB(10);"THE SUGGESTED WEIGHT RANGE"
7406 PRINT TAB(10);"FOR YOUR HEIGHT, YOUR"
7408 PRINT TAB(10);"DAILY CALORIC REQUIREMENT"
7410 PRINT TAB(10);"BASED ON THE AVERAGE WEIGHT"
7412 X= INT(X)
7414 P1=X
7416 PRINT TAB(10);"OF "W1" POUNDS IS "P2
7418 PRINT TAB(10);"CALORIES."
7420 LOCATE 12,12: PRINT "TO LOSE 1 POUND A WEEK, YOU"
7422 PRINT TAB(12)"MUST REDUCE YOUR CALORIC"
7424 PRINT TAB(12)"INTAKE BY 500 CALORIES DAILY."
7426 LOCATE 17,12: PRINT "YOUR DISTRICT HOME ECONOMIST"
7428 PRINT TAB(12)"CAN HELP YOU PLAN A SENSIBLE"
7430 PRINT TAB(12)"LOW CALORIE EATING PLAN."
7432 REM BURST BUTTONS
7434 LOCATE 5,1
7436 PRINT " ###
7438 PRINT " #######
7440 PRINT " ! -- !
7442 PRINT " ! Q Q !
7444 PRINT " ! + !
7446 PRINT " !(-)!
7448 PRINT " \___/
7450 PRINT " >=<
7452 PRINT " / \
7454 PRINT "/ 0 \
7456 PRINT "! !
7458 PRINT "! 0 !
7460 PRINT "!! ! !
7462 PRINT "!! 0 ! !
7464 PRINT "<! ! >
7466 A1=200
7468 GOSUB 5500
7470 LOCATE 14,1: PRINT "/ ! \
7472 GOSUB 5500
7474 LOCATE 16,1: PRINT "! ! !
7476 GOSUB 5500
7478 LOCATE 18,1: PRINT "!! ! ! !
7480 GOSUB 5550
7482 M=3
7484 LOCATE 1,1
7488 RETURN
7500 CLS
7502 PRINT "YESTERDAY, YOU CONSUMED APPROXIMATELY:"
7504 W=R(1,5)
7506 T(0,2)= INT(T(0,2))
7508 X=T(0,2)
7510 W$=" "
7512 X$=""
7514 IF X=0 THEN 7518
7516 GOSUB 7600
7518 LOCATE 3,1: PRINT "PROTEIN (GRAMS)"
7520 P4=R(1,5)
7522 LOCATE 5,1: PRINT "RECOMMENDED:"R(1,5)
7524 LOCATE 5,19: COLOR 0,7 : PRINT W$: COLOR 7,0
7526 LOCATE 7,1: PRINT "YOUR INTAKE:"T(0,2)
7528 P5=T(0,2)
7530 LOCATE 7,19: COLOR 0,7 : PRINT X$: COLOR 7,0
7532 W=R(1,6)
7534 T(0,3)= INT(T(0,3))
7536 X=T(0,3)
7538 X$=""
7540 IF X=0 THEN 7544
7542 GOSUB 7600
7544 LOCATE 10,1: PRINT "IRON (MILLIGRAMS):"
7546 P6=R(1,6)
7548 LOCATE 12,1: PRINT "RECOMMENDED:"R(1,6)
7550 LOCATE 12,19: COLOR 0,7 : PRINT W$: COLOR 7,0
7552 LOCATE 14,1: PRINT "YOUR INTAKE:"T(0,3)
7554 P7=T(0,3)
7556 LOCATE 14,19: COLOR 0,7 : PRINT X$: COLOR 7,0
7558 W=R(1,7)
7560 T(0,4)= INT(T(0,4))
7562 X=T(0,4)
7564 X$=""
7566 IF X=0 THEN 7570
7568 GOSUB 7600
7570 LOCATE 17,1: PRINT "VITAMIN C (MILLIGRAMS):"
7572 P8=R(1,7)
7574 LOCATE 19,1: PRINT "RECOMMENDED:"R(1,7)
7576 LOCATE 19,19: COLOR 0,7 : PRINT W$: COLOR 7,0
7578 LOCATE 21,1: PRINT "YOUR INTAKE:"T(0,4)
7580 P9=T(0,4)
7582 LOCATE 21,19: COLOR 0,7 : PRINT X$: COLOR 7,0
7584 RETURN
7600 Y=X/W*10
7602 Z=ZR
7604 Z$=" "
7606 X$=X$+Z$
7608 Z=Z+OE
7610 IF Z>20 OR Z=Y THEN 7614
7612 IF Z<Y THEN 7606
7614 RETURN
7650 Z=ZR
7654 Z$="##"
7656 X$=X$+Z$
7658 Z=Z+OE
7660 IF Z>20 THEN 7664
7662 IF Z<Y THEN 7656
7664 RETURN
7700 PRINT : PRINT : PRINT "TO IMPROVE YOUR PROTEIN INTAKE, EAT"
7702 PRINT "MORE ALBERTA BEEF, PORK, VEAL, LAMB,"
7704 PRINT "POULTRY, CHEESE, MILK AND EGGS."
7706 A(1,7)=A(1,7)+OE
7708 Z=Z+OE
7710 RETURN
7750 PRINT : PRINT : PRINT "TO IMPROVE YOUR IRON INTAKE, EAT MORE
7752 PRINT "LIVER, RED MEATS, DRIED PEAS AND BEANS,
7754 PRINT "WHOLE GRAIN OR ENRICHED BREADS AND
7756 PRINT "CEREALS, LEAFY GREEN VEGTABLES, PRUNES"
7758 PRINT "AND RAISINS"
7760 A(1,8)=A(1,8)+OE
7762 Z=Z+OE
7764 RETURN
7800 PRINT : PRINT : PRINT "TO IMPROVE YOUR VITAMIN C INTAKE, EAT
7802 PRINT "MORE CITRUS FRUITS AND THEIR JUICES,
7804 PRINT "VITAMIZED JUICES, TOMATOES,
7806 PRINT "CANTALOUPE,STRAWBERRIES, BROCCOLI,
7808 PRINT "CABBAGE, TURNIPS AND POTATOES."
7810 A(1,9)=A(1,9)+OE
7812 Z=Z+OE
7814 RETURN
7900 GOSUB 8100
7902 LOCATE 6,15:PRINT"NOW, LET'S SEE HOW WELL"
7904 LOCATE 7,15:PRINT"YOUR MEALS AND SNACKS"
7906 LOCATE 8,15:PRINT"RATED, "A$
7908 LOCATE 10,15:PRINT"AFTER YOU HAVE READ EACH"
7910 LOCATE 11,15:PRINT"SCREEN, PRESS 'RETURN'"
7912 LOCATE 12,15:PRINT"TO PROCEED TO THE NEXT"
7914 LOCATE 13,15:PRINT"SCREEN."
7915 GOSUB 5550
7916 RETURN
8000 LOCATE 3,1: PRINT "YESTERDAY YOU CONSUMED "T(0,5)
8002 A(1,10)=A(1,10)+OE
8004 PRINT "MILLIGRAMS OF CAFFEINE.
8006 PRINT "CAFFEINE IS A STIMULANT THAT ACTS ON"
8008 PRINT "THE CENTRAL NERVOUS SYSTEM CAUSING"
8010 PRINT "INCREASED MENTAL ACTIVITY AND"
8012 PRINT "WAKEFULNESS. IT CAN BE HABIT FORMING"
8014 PRINT "AND EXCESSIVE INTAKE CAN CAUSE "
8016 PRINT "HEADACHE, VOMITING, RAPID HEART BEAT,"
8018 PRINT "DIZZINESS, INSOMNIA AND MUSCLE TREMOR."
8020 LOCATE 14,1
8022 Z=Z+OE
8024 RETURN
8050 PRINT "YOU HAVE CONSUMED "T(0,6)" CALORIES"
8052 A(1,11)=A(1,11)+OE
8054 PRINT "IN ALCOHOLIC BEVERAGES."
8056 PRINT "THESE ARE LOW IN NUTRIENTS BUT"
8058 PRINT "ARE HIGH IN CALORIES.IF YOU SNACK"
8060 PRINT "WITH YOUR DRINKS, YOU HAVE A HIGH"
8062 PRINT "CALORIE COCKTAIL HOUR!"
8064 Z=Z+OE
8066 RETURN
8100 REM *** MAN SIDEWAYS ***
8102 CLS : LOCATE 5,1
8104 PRINT " ###
8106 PRINT " #######
8108 PRINT " ! -!
8110 PRINT " !< 0! []
8112 PRINT " ! __> !
8114 PRINT " ! \ !
8116 PRINT " \_/ >
8118 PRINT " !=* //
8120 PRINT " / //
8122 PRINT " ! //
8124 PRINT " ! /!
8126 PRINT " ! 0!
8128 PRINT " ! !
8130 PRINT " ! 0!
8132 PRINT " ! !
8134 RETURN
8200 REM *** PRINTOUT OF ANALYSIS ***
8202 GOSUB 5550: GOSUB 8100
8203 IF A(1,0)=ZR THEN 8480
8204 Z=ZR
8206 LOCATE 5,15: PRINT "DO YOU WANT A PRINTED
8208 LOCATE 6,15: PRINT "COPY OF YOUR DIET
8210 LOCATE 7,15: PRINT "ANALYSIS
8212 LOCATE 8,17: PRINT "(TYPE Y OR N) ?
8214 S6$="Y":S1=8:S2=33:S3=3: GOSUB 9
8216 A(1,0)=1: IF S$<>"Y" THEN A(1,0)=-1
8220 W$="####################"
8222 IF A(1,0)<OE THEN 8273
8226 LPRINT "DIET DETECTIVE JR ANALYSIS FOR "A$
8228 LPRINT : LPRINT
8230 LPRINT " ###
8232 LPRINT " ####### IN ORDER TO MAINTAIN YOUR PRESENT WEIGHT, YOU"
8234 LPRINT " ! -! REQUIRE "P3" CALORIES DAILY."
8236 LPRINT " !< 0! []
8238 IF W1=ZR THEN 8252
8240 LPRINT " ! \ ! THE SUGGESTED WEIGHT RANGE FOR A PERSON YOUR"
8242 LPRINT " ! \! ! HEIGHT IS "W2" POUNDS TO "W3" POUNDS WITH"
8244 LPRINT " !___! > AN AVERAGE SUGGESTED WEIGHT OF "W1" POUNDS."
8246 LPRINT " ==@ // BASED ON THE AVERAGE SUGGESTED WEIGHT OF "W1
8248 LPRINT " / // POUNDS YOU REQUIRE "P2" CALORIES DAILY."
8250 GOTO 8262
8252 LPRINT " ! \ !"
8254 LPRINT " ! \! !"
8256 LPRINT " !___! >"
8258 LPRINT " ==@ //"
8260 LPRINT " ///"
8262 LPRINT " ! //"
8264 LPRINT " ! O! YOU CONSUMED APPROXIMATELY "P0" CALORIES YESTERDAY."
8266 LPRINT " ! !"
8268 LPRINT " ! O!"
8270 LPRINT " ! !"
8272 REM
8273 A1=700: GOSUB 5500
8274 RETURN
8300 IF A(1,0)<OE THEN 8362
8302 W$="####################"
8304 X$=""
8309 LPRINT
8310 LPRINT "YOUR NUTRIENT INTAKE COMPARED TO THE CANADIAN DIETARY STANDARD:"
8312 LPRINT
8314 LPRINT " PROTEIN (GRAMS)"
8316 LPRINT " RECOMMENDED: "W$" "P4" GRAMS"
8318 Y=P5/P4*10
8320 IF Y=ZR THEN 8324
8322 GOSUB 7650
8324 LPRINT " YOUR INTAKE: "X$" "P5" GRAMS"
8328 LPRINT
8330 LPRINT " IRON (MILLIGRAMS)"
8332 X$=""
8334 LPRINT " RECOMMENDED: "W$" "P6" MILLIGRAMS"
8336 Y=P7/P6*10
8338 IF Y=ZR THEN 8342
8340 GOSUB 7650
8342 LPRINT " YOUR INTAKE: "X$" "P7" MILLIGRAMS"
8344 LPRINT
8346 LPRINT " VITAMIN C (MILLIGRAMS)"
8348 X$=""
8350 LPRINT " RECOMMENDED: "W$" "P8" MILLIGRAMS"
8352 Y=P9/P8*10
8354 IF Y=ZR THEN 8358
8356 GOSUB 7650
8358 LPRINT " YOUR INTAKE: "X$" "P9" MILLIGRAMS"
8360 LPRINT
8362 RETURN
8400 IF A(1,0)<OE THEN 8480
8402 Z=ZR
8404 IF P5>P4 THEN 8414
8406 LPRINT "TO IMPROVE YOUR PROTEIN INTAKE, EAT MORE ALBERTA BEEF, PORK, VEAL"
8408 LPRINT "LAMB, POULTRY, CHEESE, MILK AND EGGS."
8410 LPRINT
8412 Z=Z+3
8414 IF P7>P6 THEN 8426
8416 LPRINT "TO IMPROVE YOUR IRON INTAKE, EAT MORE LIVER, RED MEATS, DRIED PEAS"
8418 LPRINT "AND BEANS, WHOLE GRAIN OR ENRICHED BREADS AND CEREALS, LEAFY"
8420 LPRINT "GREEN VEGETABLES, PRUNES, AND RAISINS."
8422 LPRINT
8424 Z=Z+4
8426 IF P9>P8 THEN 8438
8428 LPRINT "TO IMPROVE YOUR VITAMIN C INTAKE, EAT MORE CITRUS FRUITS AND"
8430 LPRINT "THEIR JUICES, TOATOES, CANTALOUPE, STRAWBERRIES, BROCCOLI,"
8432 LPRINT "CABBAGE, TURNIPS AND POTATOES."
8434 LPRINT
8436 Z=Z+4
8438 IF T(0,5)<201 THEN 8456
8440 LPRINT "YESTERDAY YOU CONSUMED "T(0,5)" MILLIGRAMS OF CAFFEINE."
8442 LPRINT "CAFFEINE IS A STIMULANT THAT ACTS ON THE CENTRAL NERVOUS SYSTEM"
8444 LPRINT "CAUSING INCREASED MENTAL ACTIVITY AND WAKEFULNESS."
8446 LPRINT "IT CAN BE HABIT FORMING AND EXCESSIVE INTAKE CAN CAUSE"
8448 LPRINT "INSOMNIA, HEADACHE, VOMITING, RAPID HEART BEAT, "
8450 LPRINT "DIZZINESS AND MUSCLE TREMOR."
8452 LPRINT
8454 Z=Z+7
8456 IF T(0,6)=ZR THEN 8468
8458 LPRINT "YOU HAVE CONSUMED "T(0,6)" CALORIES IN ALCOHOLIC BEVERAGES"
8460 LPRINT "THESE ARE LOW IN NUTRIENTS, BUT ARE HIGH IN CALORIES. IF YOU"
8462 LPRINT "SNACK WITH YOUR DRINKS, YOU HAVE A HIGH CALORIE COCKTAIL HOUR!"
8464 LPRINT
8466 Z=Z+4
8468 LPRINT "FOR FURTHER INFORMATION CONSULT YOUR DISTRICT HOME ECONOMIST"
8470 LPRINT "WITH ALBERTA AGRICULTURE."
8472 X=31-Z
8474 FOR Z=OE TO X
8476 LPRINT
8478 NEXT
8480 RETURN
8500 CLS:REM *** END ***
8502 LOCATE 3,3: PRINT "FOR A MORE DETAILED DIET ANALYSIS"
8504 LOCATE 5,2: PRINT "CONSULT YOUR DISTRICT HOME ECONOMIST"
8506 LOCATE 7,5: PRINT "FOR ";: COLOR 0,7 : PRINT "DIET DETECTIVE SENIOR": COLOR 7,0
8508 LOCATE 10,4: PRINT "YOUR DISTRICT HOME ECONOMIST CAN
8510 PRINT TAB(4);"PROVIDE UP-TO-DATE INFORMATION"
8512 PRINT TAB(4);"ON A VARIETY OF SUBJECTS: YOUR"
8514 PRINT TAB(4);"HOME AND FAMILY, YOUR MONEY AND"
8516 PRINT TAB(4);"PERSONAL RESOURCES, YOUR HEALTH"
8518 PRINT TAB(4);"AND ENERGY, YOUR COMMUNITY AND"
8520 PRINT TAB(4);"NEIGHBOURS."
8522 GOSUB 8400
8524 GOSUB 5550
8526 CLS
8528 LOCATE 8,14: COLOR 0,7 : PRINT "THE END": COLOR 7,0
8530 LOCATE 14,1: PRINT TAB(4);"THANK YOU FOR PARTICIPATING IN"
8532 LOCATE 16,8:PRINT "DIET DETECTIVE JUNIOR"
8534 RETURN
8600 I= FRE (0): RESTORE
8602 N$=" ":P$=" ":L$=" ":SS$=" ":Y$=" ":W$=" "
8608 FOR I=ZR TO 6:T(0,I)=ZR: NEXT
8610 FOR I=ZR TO 77:T(I,0)=ZR: NEXT
8622 B=ZR:C=ZR:D=ZR:E=ZR:F=ZR:G=ZR:H=ZR
8623 I=ZR:J=ZR:K=ZR:L=ZR:M=ZR:N=ZR:O=ZR
8624 P=ZR:Q=ZR:R=ZR:SS=ZR:T=ZR:U=ZR:V=ZR
8626 W=ZR:X=ZR:Y=ZR:Z=ZR:P0=ZR:P1=ZR
8628 P2=ZR:P3=ZR:W1=ZR:W2=ZR:W3=ZR
8632 GOTO 5040
8700 REM *** PRINT STATISTICS ***
8702 CLS : LOCATE 3,1: PRINT "DO YOU WANT STATISTICS? (Y OR N)"
8704 S6$="Y":S1=3:S2=33:S3=3: GOSUB 9
8706 IF S$="N" THEN 8772
8712 A(1,1)=A(1,12)+A(1,13)
8714 IF A(1,0)<OE THEN 8744
8715 REM
8716 LPRINT:LPRINT:LPRINT:LPRINT"NUMBER OF CLIENTS="A(1,1)
8718 LPRINT"NUMBER OF MALES="A(1,12)
8720 LPRINT"NUMBER OF FEMALES="A(1,13)
8722 LPRINT"CLIENTS AGED 0-12="A(1,2)
8724 LPRINT"CLIENTS AGED 13-18="A(1,3)
8726 LPRINT"CLIENTS AGED 19-64="A(1,4)
8728 LPRINT"CLIENTS AGED 65+="A(1,5)
8730 LPRINT"CLIENTS ABOVE SUGGESTED WEIGHT="A(1,6)
8732 LPRINT"CLIENTS DEFICIENT IN PROTEIN="A(1,7)
8734 LPRINT"CLIENTS DEFICIENT IN IRON="A(1,8)
8736 LPRINT"CLIENTS DEFICIENT IN VITAMIN C="A(1,9)
8738 LPRINT"CLIENTS CONSUMING >200MG CAFFEINE="A(1,10)
8740 LPRINT"CLIENTS CONSUMING ALCOHOL="A(1,11)
8742 LPRINT"CLIENTS CONSUMING <200 CALORIES FOR BREAKFAST="A(1,14)
8744 LOCATE 5,1: PRINT "NUMBER OF CLIENTS= "A(1,1)
8746 PRINT "NUMBER OF MALES="A(1,12)
8748 PRINT "NUMBER OF FEMALES="A(1,13)
8750 PRINT "CLIENTS AGED 0-12="A(1,2)
8752 PRINT "CLIENTS AGED 13-18="A(1,3)
8754 PRINT "CLIENTS AGED 19-64="A(1,4)
8756 PRINT "CLIENTS AGED 65+="A(1,5)
8758 PRINT "CLIENTS ABOVE SUGGESTED WEIGHT="A(1,6)
8760 PRINT "CLIENTS DEFICIENT IN PROTEIN="A(1,7)
8762 PRINT "CLIENTS DEFICIENT IN IRON="A(1,8)
8764 PRINT "CLIENTS DEFICIENT IN VITAMIN C="A(1,9)
8766 PRINT "CLIENTS CONSUMING >200MG CAFFEINE="A(1,10)
8768 PRINT "CLIENTS CONSUMING ALCOHOL="A(1,11)
8770 PRINT "CLIENTS WITH <200 CALS FOR BKFST= "A(1,14)
8772 RETURN
9400 DATA W,1,63,118,129,141
9402 DATA W,1,64,122,133,145
9404 DATA W,1,65,126,137,149
9406 DATA W,1,66,130,142,155
9408 DATA W,1,67,134,147,161
9410 DATA W,1,68,139,151,166
9412 DATA W,1,69,143,155,170
9414 DATA W,1,70,147,159,174
9416 DATA W,1,71,150,163,178
9418 DATA W,1,72,154,167,183
9420 DATA W,1,73,158,171,188
9422 DATA W,1,74,162,175,192
9424 DATA W,1,75,165,178,195
9426 DATA W,2,60,100,109,118
9428 DATA W,2,61,104,112,121
9430 DATA W,2,62,107,115,125
9432 DATA W,2,63,110,118,128
9434 DATA W,2,64,113,122,132
9436 DATA W,2,65,116,125,135
9438 DATA W,2,66,120,129,139
9440 DATA W,2,67,123,132,142
9442 DATA W,2,68,126,136,146
9444 DATA W,2,69,130,140,151
9446 DATA W,2,70,133,144,156
9448 DATA W,2,71,137,148,161
9450 DATA W,2,72,141,152,166
9500 DATA B,"FRUIT JUICE,UNSWEETENED, 1/2 CUP",50,1,.4,55,0,0
9502 DATA B,"FRUIT:1/2 GRAPEFRUIT OR 1 ORANGE",50,1,.4,55,0,0
9504 DATA B,"FRUIT:1 BANANA .................",80,0,.5,6,,
9506 DATA B,"CEREAL,WHOLE GRAIN ..... 3/4 CUP",100,3,1,0,0,
9508 DATA B,"CEREAL,ENRICHED ........ 3/4 CUP",80,2,4,0,0,0
9510 DATA B,"BREAD, WHOLE GRAIN ..... 1 SLICE",73,3,.7,0,0,
9512 DATA B,"BREAD, ENRICHED WHITE... 1 SLICE",82,2,.5,0,0,
9514 DATA B,"MUFFIN.........................1",120,3,.6,0,0,
9516 DATA B,"BUTTER OR MARGARINE . 1 TEASPOON",34,0,0,0,0,
9518 DATA B,"PEANUT BUTTER .......... 1 TBSP.",95,4,.3,0,0,
9520 DATA B,"JAM OR JELLY ........... 1 TBSP.",52,0,.2,.5,0,
9522 DATA B,"EGG ................... 1 LARGE",79,6,1.1,0,0,
9524 DATA B,"BACON, CRISP .......... 2 SLICES",92,5,.4,0,0,
9526 DATA B,"SAUSAGE ...................1 ",95,4,.5,0,0,
9528 DATA B,"CHEESE...................1 OUNCE",105,6,.2,0,0,
9530 DATA B,"MILK, 2% ..................1 CUP",129,9,.1,2,0,
9532 DATA B,"COFFEE, BLACK .............1 CUP",5,0,.2,0,100,
9534 DATA B,"CREAM .................. 1 TBSP.",29,0,0,0,0,
9536 DATA B,"SUGAR ............... 1 TEASPOON",14,0,0,0,0,0
9600 DATA L,"MEAT: BEEF OR PORK ..... 1 OUNCE",82,7.3,.9,0,0,
9602 DATA L,"LUNCHEON MEAT .......... 1 SLICE",93,4.5,.7,0,0,
9604 DATA L,"FISH, EGG, OR POULTRY . 1 OUNCE",80,7,.7,0,0,
9606 DATA L,"CHEESE ................. 1 OUNCE",105,6,.2,0,0,
9608 DATA L,"BREAD, WHOLE GRAIN ..... 1 SLICE",73,3,.7,0,0,
9610 DATA L,"BREAD, ENRICHED WHITE... 1 SLICE",82,2,.5,0,0,
9612 DATA L,"BUTTER OR MARGARINE . 1 TEASPOON",34,0,0,0,0,
9614 DATA L,"LETTUCE OR SALAD ....... 1/2 CUP",20,1,.5,12,0,
9616 DATA L,"SALAD DRESSING ......... 1 TBSP.",65,0,0,0,0,
9618 DATA L,"SOUP,NOODLE OR RICE ...... 1 CUP",65,4,.7,0,0,
9620 DATA L,"SOUP, VEGETABLE .......... 1 CUP",90,3,.9,3,0,
9622 DATA L,"CRACKERS ..................... 4",50,1,.1,0,0,
9624 DATA L,"FRUIT: CITRUS ......... 1 MEDIUM",65,1,.5,66,0,
9626 DATA L,"FRUIT: OTHER (APPLE, BANANA) ONE",80,0,.5,6,0,
9628 DATA L,"MILK, 2% ................. 1 CUP",129,9,.1,2,0,
9630 DATA L,"COOKIE ....................... 1",120,1,.2,0,0,
9632 DATA L,"PASTRY OR CAKE ......... 1 PIECE",145,2,.4,0,0,
9634 DATA L,"TEA,BLACK..................1 CUP",0,0,.2,0,50,
9636 DATA L,"SUGAR.................1 TEASPOON",14,0,0,0,0,
9700 DATA D,"MEAT:BEEF,PORK,VEAL,LAMB 3 OZ.",245,22,2.9,0,0,
9702 DATA D,"FISH,EGGS,POULTRY ........ 3 OZ.",240,21,2.1,0,0,
9704 DATA D,"POTATO, BAKED OR BOILED 1 MEDIUM",85,3,.7,16,0,
9706 DATA D,"PASTA OR RICE, COOKED .. 1/2 CUP",75,2,.7,0,0,
9708 DATA D,"VEGETABLES,COOKED ...... 1/2 CUP",43,2,.8,24,0,
9710 DATA D,"SALAD .................. 1/2 CUP",20,1,.5,12,0,
9712 DATA D,"SALAD DRESSING ......... 1 TBSP.",65,0,,,,
9714 DATA D,"FRUIT, CANNED ......... 1/ 2 CUP",85,0,1.1,5,0,
9716 DATA D,"PUDDING OR ICE CREAM .. 1/ 2 CUP",145,4,.2,.5,0,
9718 DATA D,"PASTRY OR CAKE ......... 1 PIECE",145,2,.4,0,0,
9720 DATA D,"BREAD....................1 SLICE",82,2,.5,0,0,
9722 DATA D,"ROLL...........................1",125,4,.7,0,0,
9724 DATA D,"BUTTER OR MARGARINE 1 TEASPOON",34,,,,,
9726 DATA D,"GRAVY .................. 1 TBSP.",41,0,.1,0,0,
9728 DATA D,"MILK, 2% ................. 1 CUP",129,9,.1,2,0,
9730 DATA D,"TEA, BLACK ............... 1 CUP",0,0,.2,0,50,
9732 DATA D,"COFFEE, BLACK ............ 1 CUP",5,0,.2,0,100,
9734 DATA D,"CREAM .................. 1 TBSP.",29,,,,,
9736 DATA D,"SUGAR ............... 1 TEASPOON",14,,,,,
9800 DATA S,"CHOCOLATE BAR ............ 1 BAR",134,3,0.7,0,25,
9802 DATA S,"DOUGHNUT ..................... 1",125,1,0.4,0,0,
9804 DATA S,"COOKIE ....................... 1",120,1,.2,0,0,
9806 DATA S,"BRAN MUFFIN .................. 1",86,3,1.3,0,0,
9808 DATA S,"PIZZA, 1/8 OF A 12 INCH PIZZA",177,9,.8,4,0,
9810 DATA S,"POTATO CHIPS ......... 10 PIECES",115,1,.4,3,0,
9812 DATA S,"FRENCH FRIES ......... 10 PIECES",155,2,.7,12,0,
9814 DATA S,"FRUIT FLAVORED YOGHURT 1 CARTON",205,9.6,,,,
9816 DATA S,"FRUIT:(APPLE OR BANANA)......ONE",80,0,.5,6,0,
9818 DATA S,"ICE CREAM................1/2 CUP",141,3,.1,0,0,
9820 DATA S,"NUTS OR SEEDS .......... 1/2 CUP",411,18,1.5,0,0,
9822 DATA S,"MILK,2%....................1 CUP",129,9,.1,2,0,
9824 DATA S,"SOFT DRINK (COLA TYPE) 12 OUNCES",144,,,,34,
9826 DATA S,"TEA, BLACK ............... 1 CUP",0,0,.2,0,50,
9828 DATA S,"COFFEE, BLACK ............ 1 CUP",5,0,.2,0,100,
9830 DATA S,"CREAM .................. 1 TBSP.",29,,,,,
9832 DATA S,"SUGAR ............... 1 TEASPOON",14,,,,,
9834 DATA S,"BEER......................12 OZ.",150,1,0,0,0,150
9836 DATA S,"WINE(4-6OZ.) OR 1 1/2 OZ ALCOHOL ",105,0,0,0,0,105
9900 DATA C,1,3,107,13,22,8,20
9902 DATA C,1,6,95,19,27,9,20
9904 DATA C,1,9,81,27,33,10,30
9906 DATA C,1,12,70,36,41,11,30
9908 DATA C,1,15,55,51,52,13,30
9910 DATA C,1,18,50,64,54,14,30
9912 DATA C,1,35,43,70,56,10,30
9914 DATA C,1,50,39,70,56,10,30
9916 DATA C,1,65,33,70,56,10,30
9918 DATA C,1,999,29,70,56,10,30
9920 DATA C,2,3,107,13,22,8,20
9922 DATA C,2,6,95,19,27,9,20
9924 DATA C,2,9,74,27,33,10,30
9926 DATA C,2,12,60,38,40,11,30
9928 DATA C,2,15,45,49,43,14,30
9930 DATA C,2,18,40,54,43,14,30
9932 DATA C,2,35,37.5,56,41,14,30
9934 DATA C,2,50,34,56,41,14,30
9936 DATA C,2,65,32,56,41,9,30
9938 DATA C,2,999,27,56,41,9,30
9940 DATA C,3,999,0,0,20,1,20
9942 DATA C,4,999,0,0,24,1,30
9999 DATA E
60000 REM this is the logo routine
60010 DEF SEG=0:IF (PEEK(&H410) AND &H30)=&H30 GOTO 60550
60020 S=3.141593
60030 KEY OFF
60040 SCREEN 1
60050 COLOR 0,1
60060 CLS
60070 LINE(0,0)-(319,199),3,B
60080 LINE(5,5)-(314,194),3,B
60090 PAINT(1,1),1,3
60100 DRAW"c3;bm40,100;e60;d60;l5;h15;e4;f10;u40;g50;l5;"
60110 PAINT(43,99),1,3
60120 DRAW"C3;bm110,30;d70;L5;U70;R5;"
60130 PAINT(109,99),1,3
60140 DRAW"C3;bm120,40;d60;L5;U60;R5;"
60150 PAINT(119,99),1,3
60160 CIRCLE(135,83),20,3,1.25*S,0.75*S
60170 CIRCLE(135,83),15,3,1.25*S,0.9*S
60180 DRAW"bm119,96;e5;"
60190 PAINT(135,98),1,3
60200 CIRCLE(170,83),20,3,0.2*S,1.85*S
60210 CIRCLE(170,83),15,3,0.25*S,1.8*S
60220 DRAW"C3;BM182,90;R5;"
60230 DRAW"C3;BM187,75;G10;H3;E7;"
60240 PAINT(170,99),1,3
60250 PAINT(170,67),1,3
60260 DRAW"c3;bm195,100;l5;u34;r5;d34;"
60270 CIRCLE(210,83),20,3,0.55*S,0.76*S
60280 CIRCLE(210,83),15,3,0.59*S,0.8799999*S
60290 DRAW"bm207,66;d5;"
60300 PAINT(194,99),1,3
60310 PAINT(206,69),1,3
60320 DRAW"c3;bm217,100;l5;u40;r5;d5;r7;d5;l7;d30;"
60330 PAINT(216,97),1,3
60340 DRAW"C3;bm265,65;d35;L5;U35;R5;"
60350 CIRCLE(245,83),20,3,0.25*S,1.75*S
60360 CIRCLE(245,83),15,3,0.09999999*S,1.7*S
60370 DRAW"bm261,99;h6;"
60380 PAINT(245,98),1,3
60390 PAINT(264,69),1,3
60400 LOCATE 14,22
60410 PRINT"AGRICULTURE"
60420 LOCATE 18,8
60430 PRINT"HOME ECONOMICS BRANCH"
60460 LOCATE 23,5
60470 PRINT"PROVIDED BY ALBERTA AGRICULTURE"
60480 LOCATE 24,3
60490 PRINT"RESPONSIBILITY RESTS WITH THE USER";
60500 FOR S=1 TO 4100
60510 POKE 106,0
60520 IF INKEY$<>"" GOTO 60540
60530 NEXT S
60540 ON ERROR GOTO 0 :SCREEN 0,0,0:RETURN
60550 REM **MONOCHROME LOGO**
60560 KEY OFF:WIDTH 80:CLS:S$=CHR$(219)
60570 PRINT STRING$(75,S$);
60580 FOR S=2 TO 23:LOCATE S,75:PRINT S$;:NEXT
60590 LOCATE 24,1:PRINT STRING$(75,S$);
60600 FOR S=23 TO 2 STEP -1:LOCATE S,1:PRINT S$;:NEXT
60610 '
60620 '
60630 LOCATE 5,28:PRINT "▌"
60640 LOCATE 6,24:PRINT"/▌ ▌ ▌"
60650 LOCATE 7,23:PRINT"/ ▌ ▌ ▌"
60660 LOCATE 8,22:PRINT"/ ▌ ▌ ▌ ▐"
60670 LOCATE 9,21:PRINT"/ ▌ ▌ ▌ __ __ ▐_ __"
60680 LOCATE 10,20:PRINT"/ ▌ ▌ ▌/ \ / \ ▐/ ▐ / \▌"
60690 LOCATE 11,19:PRINT"/ ▌ ▌ █ ▐ ▌ / ▐ ▐ ▌ ▌"
60700 LOCATE 12,18:PRINT"/ \ ▌ ▌ █ ▐ ▌ ▐ ▐ ▌ ▌"
60710 LOCATE 13,17:PRINT"/ \▌ ▌ ▌\__/ \__/ ▐ ▐ \__/▌"
60720 LOCATE 15,36:PRINT"A G R I C U L T U R E"
60730 LOCATE 18,28:PRINT"HOME ECONOMICS BRANCH"
60740 LOCATE 21,22:PRINT"PROVIDED BY ALBERTA AGRICULTURE."
60750 LOCATE 22,19:PRINT"RESPONSIBILITY RESTS SOLELY WITH USER"
60760 FOR S=1 TO 1500
60770 S$=INKEY$
60780 IF S$=CHR$(13) GOTO 60800
60790 NEXT S
60800 S$=""
60810 ON ERROR GOTO 0
60820 RETURN
DOLLAR.BAS
1 REM ***** DOLLAR DETECTIVE *****
2 REM COMPARES PERSONAL SPENDING HABITS TO
3 REM PROVINCIAL AVERAGE
4 REM PROGRAMED IN BASIC FOR RADIO SHACK II
5 REM PROGRAMED BY GARY FISHER; REVISED BY GARY FISHER
6 REM LAST REVISION JUNE 1984
7 REM
8 GOTO 5000
9 S$="":REM THIS IS THE INPUT SUBROUTINE
10 GOSUB 24:PRINT SPACE$(LEN(S$));
11 S8=0:GOSUB 24
12 GOSUB 31
13 GOSUB 35
14 GOSUB 53
15 IF S$="" THEN S$=S6$:GOTO 22
16 IF S3=1 THEN GOSUB 56
17 IF S8=1 GOTO 10
18 IF S3=1 THEN GOSUB 68
19 IF S8=1 GOTO 10
20 IF S3=3 THEN GOSUB 73
21 IF S8=1 GOTO 10
22 IF S3=1 THEN S=VAL(S$)
23 RETURN
24 REM POSITION CURSOR
25 LOCATE S1,S2,1
30 RETURN
31 REM PRINT DEFAULT
32 PRINT S6$
33 GOSUB 24
34 RETURN
35 REM TRANSPARENT CURSOR ROUTINE
36 S$=""
37 S1$=INPUT$(1)
41 S=ASC(S1$):IF S<>13 GOTO 46
42 IF S$="" THEN GOSUB 24:PRINT " ";:GOSUB 24:GOSUB 31:PRINT:RETURN
43 IF LEN(S$)>=LEN(S6$) GOTO 45
44 PRINT SPACE$(LEN(S6$)-LEN(S$));
45 PRINT S1$;:RETURN
46 IF S<32 GOTO 50
47 IF S=34 THEN S1$="'"
48 S$=S$+S1$:IF S9>0 THEN IF LEN(S$)>S9 THEN PRINT S1$;:GOTO 52
49 PRINT S1$;:GOTO 37
50 IF LEN(S$)<1 GOTO 36
51 IF LEN(S$)=1 THEN PRINT CHR$(29);:PRINT" ";:PRINT CHR$(29);:GOTO 36
52 S$=LEFT$(S$,LEN(S$)-1):PRINT CHR$(29);:PRINT" ";:PRINT CHR$(29);:GOTO 37
53 REM THIS CHECKS FOR EXIT
54 IF S$="<" THEN CLS:PRINT" NORMAL EXIT";:LOCATE 11,6:COLOR 0,7:PRINT" PLEASE WAIT ... LOADING MENU ":COLOR 7,0:RUN "HELLO"
55 RETURN
56 S1$=S$:S7=0:REM CHECK FOR NUMERIC INPUT
57 IF LEFT$(S1$,1)=" " THEN S1$=RIGHT$(S1$,LEN(S1$)-1):GOTO 57
58 IF RIGHT$(S1$,1)=" " THEN S1$=LEFT$(S1$,LEN(S1$)-1):GOTO 58
59 IF LEN(S1$)<1 GOTO 64
60 FOR S=1 TO LEN(S1$):S6=ASC(MID$(S1$,S,1))
61 IF S6>=48 AND S6<=57 GOTO 66
62 IF (S6=43 OR S6=45) AND S=1 GOTO 66
63 IF S6=46 AND S7=0 THEN S7=1:GOTO 66
64 S2$="NON NUMERIC INPUT":S1$="":GOSUB 78
65 RETURN
66 NEXT S
67 RETURN
68 REM CHECK FOR PROPER LIMITS
69 S6=VAL(S$)
70 IF S6<S4 THEN S2$="INPUT BELOW":S1$=STR$(S4):GOSUB 78:RETURN
71 IF S6>S5 THEN S2$="INPUT ABOVE":S1$=STR$(S5):GOSUB 78:RETURN
72 RETURN
73 REM CHECK FOR YES OR NO
74 IF LEFT$(S$,1)="Y" OR LEFT$(S$,1)="N" GOTO 76
75 S2$="MUST BE YES/NO ANSWER":S1$="":GOSUB 78:RETURN
76 S$=LEFT$(S$,1)
77 RETURN
78 REM ERROR FOR ALL CONDITIONS
79 COLOR 31,0,0:BEEP
80 GOSUB 90
81 PRINT" ";S2$;S1$;
82 FOR S7=1 TO 3000:NEXT S7
83 COLOR 7,0,0
87 GOSUB 93
88 S8=1
89 RETURN
90 REM POSTITION TO LAST LINE
91 LOCATE 25,1,0
92 RETURN
93 REM BLANK LAST LINE
94 LOCATE 25,1,1
95 PRINT SPACE$(39);
96 RETURN
200 REM ****DOLLAR FORMAT SUBROUTINE****
201 S3=INT(S3*100+0.5)/100
202 S3$=SPACE$(30)
203 IF S3=0 THEN S3$=RIGHT$(S3$,S4-4)+"0.00":GOTO 209
204 S4$=STR$(S3)
205 IF ASC(MID$(RIGHT$(S4$,2),1,1))=46 THEN S3$=S3$+S4$+"0":GOTO 208
206 IF ASC(MID$(RIGHT$(S4$,3),1,1))=46 THEN S3$=S3$+S4$:GOTO 208
207 S3$=S3$+S4$+".00"
208 S3$=RIGHT$(S3$,S4)
209 RETURN
300 REM HOLD SCREEN
301 S$="PRESS RETURN TO CONTINUE "
302 COLOR 31,0,0
303 GOSUB 90
304 PRINT" ";S$;
305 POKE 106,0
306 IF INKEY$=CHR$(13) GOTO 307 ELSE GOTO 305
307 COLOR 7,0,0
308 GOSUB 93
314 S$="":S1$=""
315 RETURN
5000 REM***MAINLINE ROUTINE***
5005 GOSUB 60000:GOSUB 62000:GOSUB 5540
5010 CLS:PRINT"DO YOU WANT TO PRINT RESULTS?<Y OR N>"
5015 S6$="Y":S1=1:S2=39:S3=3:S9=1:GOSUB 9
5020 IF S$="Y" THEN A7=1:GOTO 5023
5022 A7=0
5023 S1=6:S2=1:GOSUB 24:PRINT" ";:COLOR 0,7:PRINT"DON'T PANIC IF YOU MAKE A MISTAKE":COLOR 7,0
5024 S1=9:GOSUB 24: PRINT"YOU WILL BE GIVEN THE OPPORTUNITY TO"
5025 PRINT"CHANGE ANY OF YOUR ANSWERS AT THE END"
5026 PRINT"OF EACH SCREEN."
5027 GOSUB 300
5030 DIM D(17),CH(19,1),C(19,1),C1(19),AG$(19),C2(19),A1$(19)
5090 GOSUB 5880
5100 GOSUB 15000
5105 GOSUB 6600
5108 GOSUB 15000
5110 GOSUB 6870
5120 GOSUB 15000
5130 IF A7=1 THEN LPRINT CHR$(12)
5140 GOSUB 8020
5150 GOSUB 15000
5160 GOSUB 8680
5170 GOSUB 15000
5180 IF A7=1 THEN LPRINT CHR$(12)
5190 GOSUB 9560
5200 GOSUB 15000
5210 GOSUB 10130
5220 GOSUB 15000
5230 IF A7=1 THEN LPRINT CHR$(12)
5240 GOSUB 10540
5250 GOSUB 15000
5260 GOSUB 10780
5270 GOSUB 15000
5280 IF A7=1 THEN LPRINT CHR$(12)
5290 GOSUB 11020
5300 GOSUB 15000
5310 GOSUB 11310
5320 GOSUB 15000
5330 IF A7=1 THEN LPRINT CHR$(12)
5340 GOSUB 11570
5350 GOSUB 15000
5360 GOSUB 12070
5370 GOSUB 15000
5380 IF A7=1 THEN LPRINT CHR$(12)
5390 GOSUB 12310
5400 GOSUB 15000
5410 GOSUB 12740
5420 GOSUB 15000
5430 IF A7=1 THEN LPRINT CHR$(12)
5440 GOSUB 13020
5450 GOSUB 15000
5460 CLS:S1=4:S2=1:GOSUB 24:PRINT"WOULD YOU LIKE TO RUN DOLLAR DETECTIVE"
5470 PRINT"AGAIN? <Y/N>"
5480 S1=5:S2=15:S3=3:S6$="N":GOSUB 9
5490 IF S$="Y" GOTO 5500
5495 IF S$="N" THEN CLS:PRINT :PRINT" GOODBYE AND GOODBUYS"
5497 LOCATE 11,6:COLOR 0,7:PRINT" PLEASE WAIT ... LOADING MENU ":COLOR 7,0:RUN "HELLO"
5500 IF A7=1 THEN LPRINT CHR$(12)
5520 GOTO 5000
5540 REM***INTRO SCREEN***
5560 CLS
5565 WIDTH 40
5570 PRINT"+++++++++++++++++++++++++++++++++++++++"
5580 PRINT"$$$$ $$$ $ $ $ $$$$"
5590 PRINT"$ $ $ $ $ $ $ $ $ $"
5600 PRINT"$ $ $ $ $ $ $ $ $$$$"
5610 PRINT"$ $ $ $ $ $ $$$$$ $ $"
5620 PRINT"$ $ $ $ $ $ $ $ $ $"
5630 PRINT"$$$$ $$$ $$$$$ $$$$$ $ $ $ $"
5635 PRINT
5640 PRINT TAB(15);"DETECTIVE JUNE/84"
5650 PRINT"+++++++++++++++++++++++++++++++++++++++"
5660 PRINT"WHEN THAT $60 IN YOUR WALLET YESTERDAY"
5670 PRINT"TURNS OUT TO BE $5.00 TODAY, ITS TIME"
5680 PRINT" TO FIND OUT WHERE THE MONEY GOES."
5690 PRINT" ANSWER THE QUESTIONS AND LET"
5700 PRINT" DOLLAR DETECTIVE"
5710 PRINT" GIVE YOU SOME CLUES ABOUT GAINING"
5720 PRINT" CONTROL OF YOUR FAMILY SPENDING!"
5730 GOSUB 300
5740 CLS
5750 PRINT" INSTRUCTIONS"
5760 PRINT" DOLLAR DETECTIVE WILL ASK YOU"
5770 PRINT" QUESTIONS ABOUT YOUR FAMILY AND YOUR"
5780 PRINT" SPENDING HABITS."
5790 PRINT" THE QUESTIONS WILL BE EITHER YES/NO"
5800 PRINT" OR THOSE THAT REQUIRE SPECIFIC ANSWERS."
5810 PRINT" THE PROGRAM WILL TELL YOU WHAT KIND OF"
5820 PRINT" ANSWER IS REQUIRED."
5830 PRINT:PRINT"THE MOST IMPORTANT THING TO REMEMBER IS:"
5840 PRINT" PRESS ";:COLOR 0,7:PRINT"ENTER";:COLOR 7,0:PRINT" AFTER EVERY ANSWER!"
5850 PRINT" OK LET'S GO"
5860 GOSUB 300
5870 RETURN
5880 REM*** DATA ENTRY PART I***
5900 CLS:COLOR 0,7:PRINT" DOLLAR DETECTIVE ":COLOR 7,0
5910 PRINT" ----------------"
5920 PRINT" NEEDS TO KNOW ABOUT YOUR FAMILY......"
5930 PRINT "_______________________________________"
5940 COLOR 0,7:PRINT" FAMILY MEMBERS ":COLOR 7,0
5950 PRINT "ANSWER Y OR N TO QUESTIONS 1 & 2. "
5960 PRINT:PRINT "1. HUSBAND...._"
5970 PRINT "2. WIFE......._"
5971 PRINT:PRINT "ENTER THE AGES (B=BABY, 1-19) SEPARATED"
5972 PRINT "BY -'S, OF ANY CHILDREN AT HOME. "
5973 PRINT:PRINT "3. BOYS--------------------------------"
5974 PRINT "4. GIRLS-------------------------------"
5980 PRINT:PRINT"ENTER THE NUMBER OF OTHER ADULTS. "
6000 PRINT:PRINT "5. MALES......_"
6010 PRINT "6. FEMALES...._"
6016 PRINT "_______________________________________"
6100 HU$="Y":WI$="Y":LH$="N":LO$=" "
6102 S6$=HU$:S1=8:S2=15:S3=3:S9=1:GOSUB 9:HU$=S$
6105 S1=9:S6$=WI$:GOSUB 9:WI$=S$
6106 IF HU$<>"Y" AND WI$<>"Y" THEN GOTO 6108
6107 GOTO 6116
6108 S1$="":S2$="HUSBAND OR WIFE MUST BE PRESENT":GOSUB 78:GOTO 6100
6115 S6$=MID$(STR$(OF),2):S1=12:GOSUB 9:OF=S
6116 REM ZERO OUT THE KIDS
6117 FOR I=0 TO 1:FOR I1=0 TO 19:CH(I1,I)=0:NEXT I1:NEXT I
6118 S1=14:S2=11:S3=2:S9=20:S6$=A8$:GOSUB 9
6130 A$=S$
6134 I4=0
6136 GOSUB 6330
6138 IF A$="ERROR" GOTO 6118
6139 IF A$="" GOTO 6150
6140 A8$=A$
6150 GOTO 6515
6325 REM CHECKS FOR NUMBER AND AGE OF KIDS
6330 I2=0:I1=1
6335 IF A$="" GOTO 6510
6340 FOR I=LEN(A$) TO 1 STEP -1
6350 I3=ASC(MID$(A$,I,1))
6360 IF (I3>47 AND I3<58) OR I3=46 OR I3=66 GOTO 6380
6365 IF I3<>32 GOTO 6374
6370 NEXT I:IF I=0 THEN ON (I4+1) GOTO 6290,6515
6374 S1$="":S2$="ENTER AGES B,1 TO 19 OR ENTER '0'":GOSUB 78:A$="ERROR"
6375 FOR I1=0 TO 19:CH(I1,I4)=0:NEXT I1
6376 GOSUB 24:PRINT"--------------------":RETURN
6380 A$=LEFT$(A$,I):IF A$="0" GOTO 6510
6382 FOR I=1 TO LEN(A$):I3=ASC(MID$(A$,I,1))
6383 IF (I3>47 AND I3<58) OR I3=46 OR I3=66 GOTO 6388
6384 IF I3<>32 GOTO 6374
6385 NEXT I
6386 IF A$="" GOTO 6510
6387 GOTO 6374
6388 A$=MID$(A$,I,99):IF A$="0" GOTO 6510
6390 FOR I=1 TO LEN(A$)
6400 IF ASC(MID$(A$,I,1))>57 AND ASC(MID$(A$,I,1))<>66 GOTO 6374
6402 IF ASC(MID$(A$,I,1))<45 OR ASC(MID$(A$,I,1))=47 GOTO 6374
6410 IF MID$(A$,I,1)="-" GOTO 6430
6420 I2=I2+1:GOTO 6470
6430 I3=ABS(INT(VAL(MID$(A$,I1,I2))))
6440 IF I3<0 OR I3>19 GOTO 6374
6450 CH(I3,I4)=CH(I3,I4)+1
6460 I2=0:I1=I+1
6470 NEXT I
6480 I1=I-I2:I3=ABS(INT(VAL(MID$(A$,I1,I2))))
6490 IF I3<0 OR I3>19 GOTO 6374
6500 CH(I3,I4)=CH(I3,I4)+1
6510 RETURN
6515 S1=15:S6$=A9$:GOSUB 9
6520 A$=S$:I4=1:GOSUB 6330
6521 IF A$="ERROR" GOTO 6515
6522 IF A$="" GOTO 6530
6523 A9$=A$
6530 S6$=MID$(STR$(OM),2):S1=19:S2=15:S3=1:S9=1:S4=0:S5=9:GOSUB 9:OM=S
6540 S6$=MID$(STR$(OF),2):S1=20:GOSUB 9:OF=S
6550 S1=23:S2=5:GOSUB 24:COLOR 0,7:PRINT"IS THE DATA OK? (Y/N)":COLOR 7,0
6555 S2=30:S3=3:S9=1:S6$=" ":GOSUB 9
6560 IF S$="N" THEN GOTO 6102
6565 IF S$="Y" THEN GOTO 6580
6570 GOTO 6550 THEN GOTO 6580
6580 RETURN
6600 REM ** SECOND PAGE FAMILY INPUT **
6604 CLS
6606 S1=1:S2=1: GOSUB 24:PRINT" ";:COLOR 0,7:PRINT"DOLLAR DETECTIVE":COLOR 7,0
6608 S1=3:S2=1:GOSUB 24:PRINT "_______________________________________"
6610 S1=4:GOSUB 24:PRINT" ";:COLOR 0,7:PRINT"FAMILY MEMBERS":COLOR 7,0
6612 PRINT"ENTER Y OR N TO QUESTION 7."
6613 PRINT:S1=7:GOSUB 24:PRINT"7. HAVE ANY CHILDREN LEFT HOME?..."
6615 S1=8:GOSUB 24:PRINT"_______________________________________"
6616 PRINT" ";:COLOR 0,7:PRINT"LOCATION":COLOR 7,0
6618 PRINT "ENTER YOUR LOCATION:"
6619 PRINT:S1=12:GOSUB 24:PRINT "8. ";:COLOR 0,7:PRINT"F";:COLOR 7,0:PRINT"ARM, ";:COLOR 0,7:PRINT"C";:COLOR 7,0:PRINT"ITY OR ";:COLOR 0,7:PRINT"T";:COLOR 7,0:PRINT"OWN............."
6620 S1=16:GOSUB 24:PRINT "______________________________________"
6621 PRINT" ";:COLOR 0,7:PRINT"INCOME":COLOR 7,0
6622 PRINT:S1=19:GOSUB 24:PRINT"ENTER THE NUMBER OF $'S AVAILABLE"
6623 PRINT "FOR FAMILY LIVING EACH MONTH.....$"
6624 S1=21:GOSUB 24:PRINT"_______________________________________"
6629 S1=7:S2=36:S6$=LH$:S9=2:S3=3:GOSUB 9:LH$=S$
6630 S1=12:S2=36:S9=1:S3=2:S6$=LO$:GOSUB 9
6635 LO$=S$:IF LO$<>"F" AND LO$<> "T"AND LO$<>"C" THEN GOTO 6630
6640 IF LO$<>"F" THEN GOTO 6655
6645 S1=14:S2=1:GOSUB 24:PRINT"HOW MANY HAVE OFF FARM WORK?......":GOTO 6660
6650 PRINT" FARM?" GOTO 6560
6655 S1=14:S2=1:GOSUB 24:PRINT"HOW MANY WORK OUTSIDE OF THE HOME?"
6660 S1=14:S2=36:S3=1:S6$=MID$(STR$(WO),2):GOSUB 9:WO=S
6665 S1=20:S2=36:S6$=MID$(STR$(PY),2):S4=1:S5=10000:S9=8:GOSUB 9:PY=S
6670 S1=23:S2=5:GOSUB 24:COLOR 0,7:PRINT"IS THE DATA OK? (Y/N)":COLOR 7,0
6675 S2=30:S3=3:S9=1:S6$=" ":GOSUB 9
6680 IF S$="N" THEN GOTO 6629
6682 IF S$="Y" THEN GOTO 6690
6684 GOTO 6675
6690 RETURN
6870 REM*** DATA ENTRY PART II***
6880 CLS:PRINT" ";:COLOR 0,7:PRINT" DOLLAR DETECTIVE ";:COLOR 7,0
6890 PRINT" ----------------"
6900 PRINT" NEEDS YOUR MONTHLY SPENDING ESTIMATES."
6910 PRINT" FIXED EXPENSES VARIABLE EXPENSES"
6920 PRINT"HOUSING-RENT$-------FOOD.......$-------"
6930 PRINT
6940 PRINT" -MORT$-------CLOTHING...$-------"
6950 PRINT
6960 PRINT"UTILITIES...$-------TRANSPORT..$-------"
6970 PRINT
6980 PRINT"CREDIT......$-------HOUSEHOLD..$-------"
6990 PRINT" PAYMENTS OPERATION"
7000 PRINT"INSURANCE...$-------FURNISHINGS$-------"
7010 PRINT" & EQUIP."
7020 PRINT"OTHER FIXED.$-------PERSONAL...$-------"
7030 PRINT" EXPENSES"
7040 PRINT"SAVINGS.....$-------CONTRIBUT..$-------"
7050 PRINT" & GIFTS"
7060 PRINT" HEALTH CARE$-------"
7080 PRINT" RECREATION.$-------"
7100 PRINT" EDUCATION..$-------"
7120 S1=5:S2=14:S3=1:S4=0:S5=99999!
7125 S6$=MID$(STR$(D(11)),2):S9=6:GOSUB 9:D(11)=S
7130 S1=7:S6$=MID$(STR$(D(12)),2):GOSUB 9:D(12)=S
7140 S1=9:S6$=MID$(STR$(D(13)),2):GOSUB 9:D(13)=S
7150 S1=11:S6$=MID$(STR$(D(14)),2):GOSUB 9:D(14)=S
7160 S1=13:S6$=MID$(STR$(D(15)),2):GOSUB 9:D(15)=S
7170 S1=15:S6$=MID$(STR$(D(16)),2):GOSUB 9:D(16)=S
7180 S1=17:S6$=MID$(STR$(D(17)),2):GOSUB 9:D(17)=S
7190 S1=5:S2=33:S6$=MID$(STR$(D(1)),2):GOSUB 9:D(1)=S
7200 S1=7:S6$=MID$(STR$(D(2)),2):GOSUB 9:D(2)=S
7210 S1=9:S6$=MID$(STR$(D(3)),2):GOSUB 9:D(3)=S
7220 S1=11:S6$=MID$(STR$(D(4)),2):GOSUB 9:D(4)=S
7230 S1=13:S6$=MID$(STR$(D(5)),2):GOSUB 9:D(5)=S
7240 S1=15:S6$=MID$(STR$(D(6)),2):GOSUB 9:D(6)=S
7250 S1=17:S6$=MID$(STR$(D(7)),2):GOSUB 9:D(7)=S
7260 S1=19:S6$=MID$(STR$(D(8)),2):GOSUB 9:D(8)=S
7270 S1=20:S6$=MID$(STR$(D(9)),2):GOSUB 9:D(9)=S
7275 S1=21:S6$=MID$(STR$(D(10)),2):GOSUB 9:D(10)=S
7280 S1=22:S2=1:GOSUB 24:PRINT"IS THE DATA OK? <Y/N>";
7290 S2=24:S6$=" ":S3=3:GOSUB 9
7300 IF S$="N" THEN GOTO 7120
7305 IF S$="Y" GOTO 7310
7307 GOTO 7290
7310 RETURN
8020 REM***PAGE 1 ***
8030 TS=0
8040 FOR I=1 TO 16:TS=TS+D(I):NEXT I
8045 PRINT " ";:COLOR 0,7:PRINT"DOLLAR DETECTIVE":COLOR 7,0
8050 PRINT:PRINT:PRINT"YOUR FIGURES SHOW YOU HAVE $";PY
8060 PRINT" A MONTH TO SPEND."
8070 PRINT" TOTALS FROM YOUR ESTIMATES FOR YOUR"
8080 PRINT"FAMILIES' FIXED AND VARIABLE EXPENSES"
8090 PRINT"SHOW YOU ARE SPENDING $";TS;
8100 PRINT"PER MONTH."
8110 PRINT" (THIS DOES NOT INCLUDE SAVINGS!)"
8120 PRINT
8130 IF PY<TS GOTO 8250
8140 I2=TS+D(17)-25:I3=TS+D(17)+25
8150 IF PY>I2 AND PY<I3 GOTO 8170
8160 GOTO 8330
8170 PRINT" DOLLAR DETECTIVE DISCOVERS YOUR"
8180 PRINT"INCOME AND EXPENSES ARE IN BALANCE."
8190 PRINT" KEEP UP THE GOOD WORK!"
8200 PRINT" BUT STUDY THE FOLLOWING FOR IDEAS ON"
8210 PRINT"HOW TO KEEP YOUR BUDGET IN BALANCE WITH"
8220 PRINT"CONTINUING INFLATION."
8230 GOTO 8540
8250 PRINT" DOLLAR DETECTIVE FINDS YOUR FAMILY IS"
8260 PRINT"SPENDING MORE THAN IT MAKES!"
8270 PRINT" TAKE A CLOSE LOOK AT THE FOLLOWING"
8280 PRINT"INFORMATION FOR IDEAS ON WHERE YOU"
8290 PRINT"MIGHT SAVE."
8300 IF ABS(D(17))<=0 THEN RETURN
8310 PRINT" IS YOUR SAVINGS ACCOUNT REALLY SAVING?"
8320 RETURN
8330 IF (PY-TS-D(17))<0 GOTO 8450
8340 PRINT" IS THE $";PY-TS-D(17);
8350 PRINT" THAT IS UNACCOUNTED"
8360 PRINT"FOR JUST SLIPPING THROUGH YOUR FINGERS?"
8370 PRINT" TRY TO KEEP TRACK OF YOUR FAMILY"
8380 PRINT"SPENDING FOR THE NEXT MONTH OR SO."
8390 PRINT" ALBERTA AGRICULTURE'S PUBLICATION -"
8400 PRINT" COPE...WITH FAMILY FINANCIAL RECORDS"
8410 PRINT" WILL HELP."
8420 PRINT" THE FOLLOWING INFORMATION ON YOUR"
8430 PRINT"SPENDING ANALYSIS WILL ALSO HELP."
8440 GOTO 8540
8450 PRINT" WITH YOUR EXPENSES OF $";TS;" YOU"
8460 PRINT"CANNOT SAVE $";D(17);" PER MONTH!"
8470 PRINT" TRY TO KEEP TRACK OF YOUR FAMILY"
8480 PRINT"SPENDING FOR THE NEXT MONTH OR SO."
8490 PRINT" ALBERTA AGRICULTURE'S PUBLICATION -"
8500 PRINT" COPE...WITH FAMILY FINANCIAL RECORDS"
8510 PRINT" WILL HELP."
8520 PRINT" THE FOLLOWING INFORMATION ON YOUR"
8530 PRINT"SPENDING ANALYSIS WILL ALSO HELP."
8540 RETURN
8680 REM***PAGE 2***
8690 NM=OM-(HU$="Y")
8700 NF=OF-(WI$="Y")
8710 AD=NM+NF
8720 RESTORE
8730 FOR I=0 TO 19:READ AG$(I):NEXT I
8740 READ AF,AM
8750 FOR I=0 TO 19:FOR I1=0 TO 1:READ C(I,I1):NEXT I1:NEXT I
8760 FOR I=1 TO 3:READ C1(I):NEXT I
8770 FOR I=1 TO 5:READ C2(I):NEXT I
8780 T=NM*AM+NF*AF
8790 FOR I=0 TO 19:FOR I1=0 TO 1:CH=CH+CH(I,I1):T=T+CH(I,I1)*C(I,I1):NEXT I1:NEXT I
8800 IF CH<>0 GOTO 8850
8810 I=AD
8820 IF AD>3 THEN I=3
8830 T1=C1(I)
8840 GOTO 8910
8850 IF AD=1 THEN T1=C2(1):GOTO 8910
8860 REM**MORE THAN 1 ADULT FIND # OF CHILDREN**
8870 IF CH=1 THEN T1=C2(2):GOTO 8910
8880 IF CH=2 THEN T1=C2(3):GOTO 8910
8890 IF CH=3 THEN T1=C2(4):GOTO 8910
8900 T1=C2(5):REM 4 CHLDREN AND ABOVE**
8910 T3=T+T1
8920 I3=0
8930 IF HU$="Y" AND WI$="Y" AND AD<3 AND WO>1 THEN I3=1
8940 REM**REPORT PRINT ED**
8960 PRINT TAB(17)"******"
8970 PRINT TAB(17)"*FOOD*"
8980 PRINT TAB(17)"******"
8990 PRINT" YOU ESTIMATE YOUR FAMILY SPENDS:"
9000 PRINT" $";MID$(STR$(D(1)),2,6);" PER MONTH FOR FOOD"
9010 PRINT"----------------------------------------";
9020 PRINT" DOLLAR DETECTIVE ESTIMATES FOOD COSTS"
9030 PRINT" WOULD BE $";MID$(STR$(T),2,6);" A MONTH FOR A BASIC"
9040 PRINT" NUTRITIOUS DIET FOR YOUR FAMILY"
9050 PRINT TAB(15)"THIS ALLOWS:"
9060 IF NM>0 THEN PRINT"$";MID$(STR$(AM),2,3);" PER ADULT MALE";:GOTO 9080
9070 IF NF>0 THEN PRINT "$";MID$(STR$(AF),2,3);" PER ADULT FEMALE":GOTO 9090
9080 IF NF>0 THEN PRINT TAB(21);"$";MID$(STR$(AF),2,3);" PER";
9085 IF NF>0 THEN PRINT" ADULT FEMALE";
9090 IF CH=0 GOTO 9290
9100 I4=1
9110 IF CH(0,0)>0 THEN A1$(I4)="$"+MID$(STR$(C(0,0)),2,3)+" PER BABY BOY "
9120 IF CH(0,0)>0 THEN I4=I4+1
9130 IF CH(0,1)>0 THEN A1$(I4)="$"+MID$(STR$(C(0,1)),2,3)+" PER BABY GIRL "
9140 IF CH(0,1)>0 THEN I4=I4+1
9150 FOR I=1 TO 19:FOR I1=0 TO 1
9160 IF CH(I,I1)<1 GOTO 9220
9170 A1$(I4)="$"+MID$(STR$(C(I,I1)),2,3)+"/"+MID$(STR$(I),2,3)+" YEAR OLD"
9180 IF I1=0 THEN A1$(I4)=A1$(I4)+" BOY":GOTO 9200
9190 A1$(I4)=A1$(I4)+" GIRL"
9200 IF LEN(A1$(I4))<20 THEN A1$(I4)=A1$(I4)+" ":GOTO 9200
9210 I4=I4+1
9220 NEXT I1
9230 NEXT I
9240 I4=I4-1
9250 FOR I=1 TO I4
9260 PRINT A1$(I);
9270 NEXT I
9280 IF INT(I4/2)-(I4/2)<>0 THEN PRINT
9290 PRINT
9300 PRINT" HE ALSO ESTIMATES YOUR FAMILY WOULD"
9310 PRINT"SPEND $";MID$(STR$(T1),2,5);" ON FOOD AWAY FROM HOME"
9320 PRINT
9330 IF I3<>1 GOTO 9380
9340 PRINT" FOOD COSTS MAY BE HIGHER FOR YOUR "
9350 PRINT"FAMILY BECAUSE THE WIFE IS WORKING. "
9360 PRINT"THIS USUALLY MEANS MORE MEALS OUT AND"
9370 PRINT"MORE CONVENIENCE FOODS. "
9380 PRINT"DOLLAR DETECTIVE ESTIMATES TOTAL FOOD"
9390 PRINT" COSTS FOR YOUR FAMILY TO BE $";MID$(STR$(T3),2,6)
9400 IF I3=1 THEN RETURN
9410 IF NOT ((D(1)<=T3*0.9) AND (LO$<>"F")) GOTO 9460
9420 PRINT"YOUR FOOD COSTS ARE LOW FOR YOUR FAMILY"
9430 PRINT"SIZE. DO YOU HAVE A GARDEN? DON'T "
9440 PRINT"FORGET ABOUT FOOD EATEN AWAY FROM HOME."
9450 GOTO 9550
9460 IF NOT ((D(1)<=T3*0.85) AND (LO$="F")) GOTO 9510
9470 PRINT"LIVING ON A FARM ALLOWS YOU TO SAVE ON "
9480 PRINT"THE FOOD BUDGET. THE TAX MAN CALLS IT "
9490 PRINT" 'INCOME IN KIND'."
9500 GOTO 9550
9510 IF D(1)<T3*1.2 GOTO 9550
9520 PRINT"FOOD IS A FLEXIBLE FAMILY EXPENSE. ASK "
9530 PRINT"YOUR D.H.E. FOR MORE INFORMATION ON "
9540 PRINT"FOOD BUYMANSHIP."
9550 RETURN
9560 REM***PAGE3 CLOTHING***
9570 READ AF,AM
9580 FOR I=0 TO 19:FOR I1=0 TO 1:READ C(I,I1):NEXT I1:NEXT I
9590 T=NM*AM+NF*AF
9600 FOR I=0 TO 19:FOR I1=0 TO 1
9610 IF I>12 THEN C1=C1+CH(I,I1)
9620 T=T+CH(I,I1)*C(I,I1)
9630 NEXT I1:NEXT I
9650 PRINT TAB(15)"**********"
9660 PRINT TAB(15)"*CLOTHING*"
9670 PRINT TAB(15)"**********"
9680 PRINT" YOU ESTIMATE YOUR FAMILY SPENDS:"
9690 PRINT" $";MID$(STR$(D(2)),2,6);" PER MONTH FOR CLOTHING"
9700 PRINT"----------------------------------------";
9710 PRINT"DOLLAR DETECTIVE ESTIMATES CLOTHING"
9720 PRINT" WOULD BE $";MID$(STR$(T),2,6);" A MONTH"
9730 PRINT" FOR YOUR FAMILY"
9740 PRINT TAB(15)"THIS ALLOWS:"
9750 IF NM>0 THEN PRINT"$";MID$(STR$(AM),2,3);" PER ADULT MALE";:GOTO 9770
9760 IF NF>0 THEN PRINT "$";MID$(STR$(AF),2,3);" PER ADULT FEMALE":GOTO 9780
9770 PRINT""TAB(20);"$";MID$(STR$(AF),2,3);" PER";
9775 IF NF>0 THEN PRINT " ADULT FEMALE";
9780 IF CH=0 GOTO 9980
9790 I4=1
9800 IF CH(0,0)>0 THEN A1$(I4)="$"+MID$(STR$(C(0,0)),2,3)+" PER BABY BOY "
9810 IF CH(0,0)>0 THEN I4=I4+1
9820 IF CH(0,1)>0 THEN A1$(I4)="$"+MID$(STR$(C(0,1)),2,3)+" PER BABY GIRL "
9830 IF CH(0,1)>0 THEN I4=I4+1
9840 FOR I=1 TO 19:FOR I1=0 TO 1
9850 IF CH(I,I1)<1 GOTO 9910
9860 A1$(I4)="$"+MID$(STR$(C(I,I1)),2,3)+"/"+MID$(STR$(I),2,3)+" YEAR OLD"
9870 IF I1=0 THEN A1$(I4)=A1$(I4)+" BOY":GOTO 9890
9880 A1$(I4)=A1$(I4)+" GIRL"
9890 IF LEN(A1$(I4))<20 THEN A1$(I4)=A1$(I4)+" ":GOTO 9890
9900 I4=I4+1
9910 NEXT I1
9920 NEXT I
9930 I4=I4-1
9940 FOR I=1 TO I4
9950 PRINT A1$(I);
9960 NEXT I
9970 IF INT(I4/2)-(I4/2)<>0 THEN PRINT
9980 PRINT
9990 PRINT
10000 IF D(2)>0.8*T GOTO 10050
10010 PRINT" CLOTHING COSTS ARE LOW."
10020 PRINT" DO YOU SEW A LOT?"
10030 PRINT" MAKE GOOD USE OF HAND-ME-DOWNS."
10040 GOTO 10120
10050 IF D(2)<1.2*T GOTO 10120
10060 IF C1<1 GOTO 10090
10070 PRINT" CLUE: WHY NOT PUT YOUR OLDER CHILDREN"
10080 PRINT" ON A CLOTHING ALLOWANCE."
10090 IF WO<2 GOTO 10120
10100 PRINT" COUNT ON EXTRA CLOTHING COSTS BECAUSE"
10110 PRINT" TWO OR MORE FAMILY MEMBERS WORK"
10120 RETURN
10130 REM***PAGE4 TRANSPORTATION***
10140 FOR I=1 TO 3:READ C1(I):NEXT I
10150 FOR I=1 TO 6:READ C2(I):NEXT I
10160 IF CH>0 GOTO 10210
10170 I=AD
10180 IF AD>3 THEN I=3
10190 T=C1(I)
10200 GOTO 10270
10210 IF AD=1 THEN T=C2(1):GOTO 10270
10220 IF AD>2 THEN T=C2(6):GOTO 10270
10230 IF CH=1 THEN T=C2(2):GOTO 10270
10240 IF CH=2 THEN T=C2(3):GOTO 10270
10250 IF CH=3 THEN T=C2(4):GOTO 10270
10260 T=C2(5):REM**2AD+4&MORE CHILDREN
10270 REM**REPORT**
10290 PRINT TAB(12)"****************"
10300 PRINT TAB(12)"*TRANSPORTATION*"
10310 PRINT TAB(12)"****************"
10320 PRINT" YOU ESTIMATE YOUR FAMILY SPENDS:"
10330 PRINT" $";MID$(STR$(D(3)),2,6);" PER MONTH FOR TRANSPORTATION"
10340 PRINT"----------------------------------------";
10350 PRINT"TRANSPORTATION COSTS VARY DEPENDING ON A";
10360 PRINT"FAMILYS' LIFESTYLE, LOCATION, JOB, AND"
10370 PRINT"NUMBER OF CARS."
10380 PRINT
10390 PRINT" A CLUE TO CAR COSTS FROM DOLLAR"
10400 PRINT"DETECTIVE IS THAT YOU CAN COUNT ON $.17"
10410 PRINT"A KM ($.28 A MILE) TO COVER OPERATION"
10420 PRINT"AND MAINTENANCE COSTS."
10430 PRINT"THIS DOES NOT INCLUDE CAR PURCHASE,"
10440 PRINT"FINANCE CHARGES OR DEPRECIATION."
10450 PRINT
10460 PRINT"DOLLAR DETECTIVE ESTIMATES"
10470 PRINT"TRANSPORTATION COSTS WOULD BE ABOUT"
10480 PRINT" $";MID$(STR$(T),2,5);" FOR A FAMILY OF YOUR SIZE."
10500 PRINT" IF YOU'RE INTERESTED IN LOOKING MORE"
10510 PRINT"CLOSELY AT YOUR CAR COSTS TRY OUT THE"
10520 PRINT"VEHICLE COST ANALYSIS PROGRAM"
10530 RETURN
10540 REM***PAGE5 H-O&PERSONAL**
10550 FOR I=1 TO 10:READ C1(I):NEXT I
10560 I4=AD+CH
10570 IF I4>10 THEN I4=10
10580 T=C1(I4)
10600 PRINT TAB(9);"*********************"
10610 PRINT TAB(9);"*HOUSEHOLD OPERATION*"
10620 PRINT TAB(9);"*********************"
10630 PRINT"YOU ESTIMATE $";MID$(STR$(D(4)),2,4);" FOR HOUSEHOLD"
10640 PRINT" OPERATION."
10650 PRINT"----------------------------------------";
10660 PRINT"DOLLAR DETECTIVE ESTIMATES A FAMILY OF"
10670 PRINT AG$(I4);" WOULD SPEND $";MID$(STR$(T),2,4);" PER MONTH."
10680 PRINT" CLUE: IT'S SURPRISING HOW QUICKLY"
10690 PRINT"LAUNDRY, CLEANING AND PAPER PRODUCTS"
10700 PRINT"CAN ADD UP."
10710 PRINT"THIS IS A CATEGORY WHERE YOU CAN SAVE"
10720 PRINT"BY BUYING AT BULK SALES."
10730 PRINT
10740 IF D(4)>0.9*T GOTO 10770
10750 PRINT"ARE SOME OF THESE COSTS INCLUDED IN YOUR"
10760 PRINT"FOOD BUDGET?"
10770 RETURN
10780 REM**PAGE6 F&E**
10790 FOR I=1 TO 10:FOR I1=0 TO 1:READ C(I,I1):NEXT I1:NEXT I
10800 I1=1
10810 IF D(11)>0 AND CH>0 THEN I1=0
10820 IF D(12)>0 AND LH$="Y" THEN I1=0
10830 IF D(11)>0 AND CH=0 THEN I1=1
10840 T=C(I4,I1)
10860 PRINT TAB(6);"***************************"
10870 PRINT TAB(6);"*FURNISHINGS AND EQUIPMENT*"
10880 PRINT TAB(6);"***************************"
10890 PRINT"YOU ESTIMATE $";MID$(STR$(D(5)),2,4);" FOR FURNISHINGS"
10900 PRINT" AND EQUIPMENT."
10910 PRINT"----------------------------------------";
10920 PRINT" THE AMOUNT SPENT ON THIS CATEGORY"
10930 PRINT"DEPENDS VERY MUCH ON WHAT STAGE YOUR"
10940 PRINT"FAMILY IS AT IN THE LIFE CYCLE."
10950 PRINT"DOLLAR DETECTIVE ESTIMATES A FAMILY OF"
10960 PRINT AG$(I4);" WOULD SPEND $";MID$(STR$(T),2,4);" PER MONTH."
10970 PRINT"CLUE: YOU'LL BE SURPRISED AT THE TOTAL"
10980 PRINT"VALUE OF YOUR HOME FURNISHINGS AND"
10990 PRINT"EQUIPMENT. ISN'T NOW A GOOD TIME TO"
11000 PRINT"COMPLETE A HOUSEHOLD INVENTORY?"
11010 RETURN
11020 REM**PAGE7 PC&GIFTS***
11030 READ AF,AM:T=NF*AF+NM*AM
11040 FOR I=0 TO 19:FOR I1=0 TO 1
11050 READ C(I,I1)
11060 T=T+C(I,I1)*CH(I,I1)
11070 NEXT I1:NEXT I
11090 PRINT TAB(12);"****************"
11100 PRINT TAB(12);"*PERSONAL COSTS*"
11110 PRINT TAB(12);"****************"
11120 PRINT"YOU ESTIMATE YOUR FAMILY SPENDS: $";MID$(STR$(D(6)),2,4)
11130 PRINT"PER MONTH ON PERSONAL ITEMS."
11140 PRINT"----------------------------------------";
11150 PRINT"DOLLAR DETECTIVE ESTIMATES PERSONAL"
11160 PRINT"COSTS WOULD BE $";MID$(STR$(T),2,4);" PER MONTH FOR"
11170 PRINT"YOUR FAMILY."
11180 PRINT"*ALCOHOL MAY ADD ON ANOTHER $15.00 PER"
11190 PRINT"MONTH, AND IF SOMEONE SMOKES, COUNT ON"
11200 PRINT"ANOTHER $23.50 PER MONTH."
11210 IF D(6)<1.1*T GOTO 11230
11220 PRINT"IS THIS WHERE YOUR MONEY IS GOING?"
11230 PRINT TAB(7);"*************************"
11240 PRINT TAB(7);"*GIFTS AND CONTRIBUTIONS*"
11250 PRINT TAB(7);"*************************"
11260 PRINT"YOU ESTIMATE YOUR FAMILY SPENDS: $";MID$(STR$(D(7)),2,4)
11270 PRINT"PER MONTH ON GIFTS AND CONTRIBUTIONS."
11280 PRINT"THIS DEPENDS ON THE VALUES AND GOALS OF"
11290 PRINT"YOUR FAMILY AND YOUR LIFESTYLE."
11300 RETURN
11310 REM**PAGE8 HEALTH CARE**
11320 FOR I=1 TO 3:READ C1(I):NEXT I
11330 FOR I=1 TO 3:READ C2(I):NEXT I
11340 FOR I=0 TO 1:FOR I1=0 TO 1:READ C(I,I1):NEXT I1:NEXT I
11350 I4=AD+CH
11360 IF I4>3 THEN I4=3
11370 I3=0
11380 IF I4>1 THEN I3=1
11400 PRINT TAB(13)"*************"
11410 PRINT TAB(13)"*HEALTH CARE*"
11420 PRINT TAB(13)"*************"
11430 PRINT"YOU ESTIMATE YOUR FAMILY SPENDS: $";MID$(STR$(D(8)),2,4)
11440 PRINT"PER MONTH ON HEALTH CARE."
11450 PRINT"----------------------------------------";
11460 PRINT"DOLLAR DETECTIVE ESTIMATES HEALTH CARE"
11470 PRINT"COSTS WOULD BE ABOUT $";MID$(STR$(C1(I4)),2,7);" FOR"
11480 PRINT"DENTAL CARE AND $";MID$(STR$(C1(I4)),2,7);" FOR DRUGS."
11490 IF LO$<>"F" GOTO 11530
11500 PRINT"ALBERTA HEALTH CARE PREMIUMS AVERAGE OUT";
11510 PRINT"TO BE $";MID$(STR$(C(0,I3)),2,7);" A MONTH AND"
11520 PRINT"BLUE CROSS TO BE $";MID$(STR$(C(1,I3)),2,7);" PER MONTH."
11530 IF NOT (AD>1 AND WO=1 AND CH>0) GOTO 11560
11540 PRINT"DO YOU HAVE ADEQUATE LIFE INSURANCE IN"
11550 PRINT"CASE OF A HEALTH EMERGENCY?"
11560 RETURN
11570 REM**PAGE9 RECREATION**
11580 READ AM:T=AD*AM
11590 FOR I=0 TO 19:FOR I1=0 TO 1
11600 READ C(I,I1):T=T+C(I,I1)*CH(I,I1)
11610 IF I>14 THEN C2=C2+CH(I,I1)
11620 NEXT I1:NEXT I
11630 PRINT"";
11640 PRINT TAB(14)"************"
11650 PRINT TAB(14)"*RECREATION*"
11660 PRINT TAB(14)"************"
11670 PRINT"YOU ESTIMATE YOUR FAMILY SPENDS: $";MID$(STR$(D(9)),2,4)
11680 PRINT"PER MONTH ON RECREATION."
11690 PRINT"----------------------------------------";
11700 PRINT"DOLLAR DETECTIVE FINDS FAMILIES OF"
11710 PRINT"YOUR SIZE SPEND ABOUT $";MID$(STR$(T),2,7);" PER MONTH"
11720 PRINT"ON RECREATION."
11730 PRINT TAB(15)"THIS ALLOWS:"
11740 PRINT"$";MID$(STR$(AM),2,3);" PER ADULT"
11750 IF CH=0 GOTO 11950
11760 I4=1
11770 IF CH(0,0)>0 THEN A1$(I4)="$"+MID$(STR$(C(0,0)),2,3)+" PER BABY BOY "
11775 IF CH(0,0)>0 AND LEN(A1$(I4))<20 THEN A1$(I4)=A1$(I4)+" ":GOTO 11775
11780 IF CH(0,0)>0 THEN I4=I4+1
11790 IF CH(0,1)>0 THEN A1$(I4)="$"+MID$(STR$(C(0,1)),2,3)+" PER BABY GIRL "
11795 IF CH(0,1)>0 AND LEN(A1$(I4))<20 THEN A1$(I4)=A1$(I4)+" ":GOTO 11795
11800 IF CH(0,1)>0 THEN I4=I4+1
11810 FOR I=1 TO 19:FOR I1=0 TO 1
11820 IF CH(I,I1)<1 GOTO 11880
11830 A1$(I4)="$"+MID$(STR$(C(I,I1)),2,3)+"/"+MID$(STR$(I),2,3)+" YEAR OLD"
11840 IF I1=0 THEN A1$(I4)=A1$(I4)+" BOY":GOTO 11860
11850 A1$(I4)=A1$(I4)+" GIRL"
11860 IF LEN(A1$(I4))<20 THEN A1$(I4)=A1$(I4)+" ":GOTO 11860
11870 I4=I4+1
11880 NEXT I1
11890 NEXT I
11900 I4=I4-1
11910 FOR I=1 TO I4
11920 PRINT A1$(I);
11930 NEXT I
11940 IF INT(I4/2)-(I4/2)<>0 THEN PRINT
11950 REM
11960 PRINT" THE AMOUNT OF MONEY SPENT ON RECREATION";
11970 PRINT"BY FAMILIES IS VERY INDIVIDUAL. BUT THE"
11980 PRINT"LARGEST INCREASES IN FAMILY EXPENDITURE"
11990 PRINT"HAVE BEEN TOWARDS RECREATION IN RECENT"
12000 PRINT"YEARS."
12010 IF D(9)<T*1.2 GOTO 12060
12020 PRINT" DOLLAR DETECTIVE SUGGESTS YOUR FAMILY"
12030 PRINT"MAY HAVE FUN DISCOVERING SOME"
12040 PRINT"INEXPENSIVE RECREATIONAL ACTIVITIES IN"
12050 PRINT"YOUR COMMUNITY."
12060 RETURN
12070 REM**PAGE10 EDUCATION***
12080 READ AM,AF
12090 T=AM*(AD+C2)
12100 T=T+AF*(CH-C2)
12120 PRINT TAB(14)"***********"
12130 PRINT TAB(14)"*EDUCATION*"
12140 PRINT TAB(14)"***********"
12150 PRINT"YOU ESTIMATE YOUR FAMILY SPENDS: $";MID$(STR$(D(10)),2,4)
12160 PRINT"PER MONTH ON EDUCATION."
12170 PRINT"----------------------------------------";
12180 PRINT"DOLLAR DETECTIVE FINDS FAMILIES OF"
12190 PRINT"YOUR SIZE SPEND ABOUT $";MID$(STR$(T),2,7);" PER MONTH"
12200 PRINT"ON EDUCATION."
12210 PRINT" EDUCATION COSTS DEPEND ON THE LIFE-"
12220 PRINT"STYLE, LOCATION AND STAGE IN THE FAMILY"
12230 PRINT"LIFE CYCLE. THE FIGURES QUOTED ARE"
12240 PRINT"MINIMUMS."
12250 IF CH=0 GOTO 12300
12260 PRINT" EDUCATION IS SOMETHING YOUR FAMILY"
12270 PRINT"MIGHT CONSIDER AS A LONG TERM GOAL."
12280 PRINT" ARE YOU TRYING TO SAVE FOR FUTURE"
12290 PRINT"EDUCATION?"
12300 RETURN
12310 REM**PAGE11 FIXED EXPENSES**
12315 IF PY=0 THEN T2=0:GOTO 12360
12320 T=INT(((D(11)+D(12)+D(13))/PY)*100)
12330 T1=INT(100*(D(14)/PY))
12340 T2=T+T1
12360 PRINT TAB(12);"****************"
12370 PRINT TAB(12);"*FIXED EXPENSES*"
12380 PRINT TAB(12);"****************"
12390 PRINT"HOUSING COSTS (INCLUDING RENT, OR"
12400 PRINT"MORTGAGE & TAXES AND UTILITIES) MAKE UP"
12410 PRINT"";T;"% OF YOUR FAMILY'S TAKE HOME PAY."
12420 PRINT" A GENERAL GUIDELINE IS THAT HOUSING"
12430 PRINT"SHOULD BE ABOUT 30% OF A FAMILY'S INCOME";
12440 IF D(12)=0 GOTO 12490
12450 PRINT" BE AN ENERGY MISER. LOOK TO YOUR HOME"
12460 PRINT"TO IMPROVE INSULATION, WEATHERSTRIPPING"
12470 PRINT"ETC. YOU'LL BE SURPRISED AT THE SAVINGS!";
12480 GOTO 12560
12490 IF D(11)=0 GOTO 12540
12500 PRINT" BE AN ENERGY MISER. LEARN TO CUT BACK"
12510 PRINT"ON ALL KINDS OF ENERGY USE. YOU'LL BE"
12520 PRINT"SURPRISED AT THE SAVINGS."
12530 GOTO 12560
12540 PRINT"AT LEAST YOU'RE NOT FACED WITH HIGH"
12550 PRINT"HOME MORTGAGE RATES!"
12560 PRINT"CREDIT PAYMENTS TOTAL";T1;"% OF YOUR"
12570 PRINT"TAKE HOME PAY."
12580 IF D(12)=0 GOTO 12700
12590 PRINT" A GENERAL GUIDELINE IS THAT YOUR"
12600 PRINT"CONSUMER CREDIT PAYMENTS AND MORTGAGE"
12610 PRINT"PAYMENTS SHOULD NOT BE MORE THAN 40%"
12620 PRINT"OF YOUR TAKE HOME PAY."
12630 PRINT" YOU ARE COMMITTED TO";T2;"% OF YOUR"
12640 PRINT"TAKE HOME PAY FOR CREDIT & MORTGAGE."
12650 IF T2<33 GOTO 12730
12660 PRINT" IT'S EASY TO GET IN TOO DEEP WITH"
12670 PRINT"CREDIT. ASK YOUR D.H.E. FOR GUIDENCE"
12680 PRINT"IN THIS AREA."
12690 GOTO 12730
12700 PRINT" A GENERAL GUIDELINE IS THAT YOUR"
12710 PRINT"CONSUMER CREDIT PAYMENTS SHOULD NOT"
12720 PRINT"EXCEED 25% OF YOUR TAKE HOME PAY."
12730 RETURN
12740 REM**PAGE12 OTHERS**
12750 T=INT((D(16)/PY)*100)
12760 PRINT"INSURANCE"
12770 PRINT" YOU LIKELY PAY YOUR INSURANCE PREMIUMS"
12780 PRINT"TWO OR THREE TIMES PER YEAR. THEY ARE"
12790 PRINT"LESS OF A FINANCIAL BURDEN IF YOU PUT"
12800 PRINT"MONEY FOR INSURANCE IN A SEPARATE"
12810 PRINT"SAVINGS ACCOUNT EACH MONTH."
12820 PRINT" EXAMINE YOUR FAMILY'S INSURANCE NEEDS"
12830 PRINT"EVERY YEAR OR SO TO MAKE SURE YOU'RE"
12840 PRINT"ADEQUATELY, YET ECONOMICALLY COVERED."
12850 PRINT"OTHER FIXED EXPENSES"
12860 PRINT" THESE TAKE UP";T;"% OF YOUR FAMILY'S"
12870 PRINT"TAKE HOME PAY."
12880 PRINT"SAVINGS"
12890 PRINT" DOLLAR DETECTIVE FIGURES YOU SHOULD"
12900 PRINT"HAVE AT LEAST 3 TIMES YOUR MONTHLY"
12910 PRINT"LIVING EXPENSES READILY AVAILABLE IN"
12920 PRINT"CASE OF A FINANCIAL EMERGENCY."
12930 IF NOT (D(17)=0 AND TS>PY) GOTO 12980
12940 PRINT"DOLLAR DETECTIVE FEELS YOU MAY NEED"
12950 PRINT"SOME FINANCIAL COUNCILLING. SEE YOUR"
12960 PRINT"D.H.E. FOR GUIDELINES."
12970 GOTO 13010
12980 IF NOT (D(17)>0.05*PY) GOTO 13010
12990 PRINT"CLUE: ARE YOU GETTING THE BEST AVAILABLE";
13000 PRINT"INTEREST FOR YOUR MONEY? CHECK AROUND."
13010 RETURN
13020 REM**LAST PAGE***
13030 PRINT" MONEY MANAGEMENT IS A VERY INDIVIDUAL"
13040 PRINT"FAMILY MATTER AND IS UNIQUE WITH EACH"
13050 PRINT"FAMILY."
13060 PRINT" GENERAL GUIDELINES, SOME CAUTIONS AND"
13070 PRINT"COMMENTS HAVE BEEN PROVIDED BY"
13080 PRINT"DOLLAR DETECTIVE ON YOUR FAMILY'S"
13090 PRINT"MONEY MANAGEMENT."
13100 PRINT" HE LEAVES YOU WITH THESE CLUES:"
13110 PRINT"DEVELOP INSIGHT INTO THE WAY YOUR"
13120 PRINT"FAMILY VIEWS MONEY."
13130 PRINT"ALLOW INPUT FOR THE USE OF MONEY BY"
13140 PRINT"FAMILY MEMBERS."
13150 PRINT"ALLOW INVOLVEMENT IN HANDLING MONEY"
13160 PRINT"BY ALL FAMILY MEMBERS."
13170 PRINT"EACH FAMILY MEMBER SHOULD HAVE SOME"
13180 PRINT"INCOME SO EACH CAN FULFIL PERSONAL GOALS";
13190 PRINT"CHECK WITH YOUR DISTRICT HOME ECONOMIST"
13200 PRINT"FOR INFORMATION ON THE "
13210 PRINT"COPE...WITH FAMILY FINANCE SERIES. "
13220 RETURN
15000 REM SCREEN PRINT SUBROUTINE
15010 IF A7=1 GOTO 15050
15020 GOSUB 300
15030 CLS:RETURN
15050 LPRINT CHR$(27);"W";CHR$(1);:FOR I=1 TO 3:LPRINT CHR$(10);:NEXT I
15060 CALL PRTSCR
15065 LPRINT CHR$(27);"W";CHR$(0);
15070 CLS:RETURN
60000 REM this is the logo routine
60010 DEF SEG=0:IF (PEEK(&H410) AND &H30)=&H30 GOTO 60550
60020 S=3.141593
60030 KEY OFF
60040 SCREEN 1
60050 COLOR 0,1
60060 CLS
60070 LINE(0,0)-(319,199),3,B
60080 LINE(5,5)-(314,194),3,B
60090 PAINT(1,1),1,3
60100 DRAW"c3;bm40,100;e60;d60;l5;h15;e4;f10;u40;g50;l5;"
60110 PAINT(43,99),1,3
60120 DRAW"C3;bm110,30;d70;L5;U70;R5;"
60130 PAINT(109,99),1,3
60140 DRAW"C3;bm120,40;d60;L5;U60;R5;"
60150 PAINT(119,99),1,3
60160 CIRCLE(135,83),20,3,1.25*S,0.75*S
60170 CIRCLE(135,83),15,3,1.25*S,0.9*S
60180 DRAW"bm119,96;e5;"
60190 PAINT(135,98),1,3
60200 CIRCLE(170,83),20,3,0.2*S,1.85*S
60210 CIRCLE(170,83),15,3,0.25*S,1.8*S
60220 DRAW"C3;BM182,90;R5;"
60230 DRAW"C3;BM187,75;G10;H3;E7;"
60240 PAINT(170,99),1,3
60250 PAINT(170,67),1,3
60260 DRAW"c3;bm195,100;l5;u34;r5;d34;"
60270 CIRCLE(210,83),20,3,0.55*S,0.76*S
60280 CIRCLE(210,83),15,3,0.59*S,0.8799999*S
60290 DRAW"bm207,66;d5;"
60300 PAINT(194,99),1,3
60310 PAINT(206,69),1,3
60320 DRAW"c3;bm217,100;l5;u40;r5;d5;r7;d5;l7;d30;"
60330 PAINT(216,97),1,3
60340 DRAW"C3;bm265,65;d35;L5;U35;R5;"
60350 CIRCLE(245,83),20,3,0.25*S,1.75*S
60360 CIRCLE(245,83),15,3,0.09999999*S,1.7*S
60370 DRAW"bm261,99;h6;"
60380 PAINT(245,98),1,3
60390 PAINT(264,69),1,3
60400 LOCATE 14,22
60410 PRINT"AGRICULTURE"
60420 LOCATE 18,8
60430 PRINT"HOME ECONOMICS BRANCH"
60460 LOCATE 23,5
60470 PRINT"PROVIDED BY ALBERTA AGRICULTURE"
60480 LOCATE 24,3
60490 PRINT"RESPONSIBILITY RESTS WITH THE USER";
60500 FOR S=1 TO 4100
60510 POKE 106,0
60520 IF INKEY$<>"" GOTO 60540
60530 NEXT S
60540 ON ERROR GOTO 0 :SCREEN 0,0,0:RETURN
60550 REM **MONOCHROME LOGO**
60560 KEY OFF:WIDTH 80:CLS:S$=CHR$(219)
60570 PRINT STRING$(75,S$);
60580 FOR S=2 TO 23:LOCATE S,75:PRINT S$;:NEXT
60590 LOCATE 24,1:PRINT STRING$(75,S$);
60600 FOR S=23 TO 2 STEP -1:LOCATE S,1:PRINT S$;:NEXT
60610 '
60620 '
60630 LOCATE 5,28:PRINT "▌"
60640 LOCATE 6,24:PRINT"/▌ ▌ ▌"
60650 LOCATE 7,23:PRINT"/ ▌ ▌ ▌"
60660 LOCATE 8,22:PRINT"/ ▌ ▌ ▌ ▐"
60670 LOCATE 9,21:PRINT"/ ▌ ▌ ▌ __ __ ▐_ __"
60680 LOCATE 10,20:PRINT"/ ▌ ▌ ▌/ \ / \ ▐/ ▐ / \▌"
60690 LOCATE 11,19:PRINT"/ ▌ ▌ █ ▐ ▌ / ▐ ▐ ▌ ▌"
60700 LOCATE 12,18:PRINT"/ \ ▌ ▌ █ ▐ ▌ ▐ ▐ ▌ ▌"
60710 LOCATE 13,17:PRINT"/ \▌ ▌ ▌\__/ \__/ ▐ ▐ \__/▌"
60720 LOCATE 15,36:PRINT"A G R I C U L T U R E"
60730 LOCATE 18,28:PRINT"HOME ECONOMICS BRANCH"
60740 LOCATE 21,22:PRINT"PROVIDED BY ALBERTA AGRICULTURE."
60750 LOCATE 22,19:PRINT"RESPONSIBILITY RESTS SOLELY WITH USER"
60760 FOR S=1 TO 1500
60770 S$=INKEY$
60780 IF S$=CHR$(13) GOTO 60800
60790 NEXT S
60800 S$=""
60810 ON ERROR GOTO 0
60820 RETURN
61000 DATA "BABY","ONE","TWO","THREE","FOUR","FIVE","SIX","SEVEN","EIGHT"
61010 DATA "NINE","TEN","ELEVEN","TWELVE","THIRTEEN","FOURTEEN","FIFTEEN"
61020 DATA "SIXTEEN","SEVENTEEN","EIGHTEEN","NINETEEN"
61030 DATA 93,100
61040 DATA 52,52,59,59,59,59,59,59,68,68,68,68,68,68,77,77,77,77,77,77
61050 DATA 90,90,90,90,90,90,105,100,105,100,105,100,117,100,117,100,117,100
61055 DATA 117,100
61060 DATA 47,63,64
61070 DATA 29,51,52,55,56
61080 DATA 49,50
61090 DATA 39,39,25,25,25,25,25,25,25,25,25,25,35,35,35,35,35,35,35,35,35,35
61100 DATA 35,35,40,40,40,40,40,40,40,40,40,40,40,40,40,40,40,40
61110 DATA 59,97,127
61120 DATA 50,122,124,130,134,137
61130 DATA 11,19,25,31,36,40,45,50,55,65
61140 DATA 40,41,43,92,56,112,70,121,80,123,89,125
61145 DATA 98,125,108,125,110,125,112,125
61150 DATA 22.00,18.00
61160 DATA 3.0,3.0,3.0,3.0,5.50,5.50,5.50,5.50,5.50,5.50,5.50,5.50
61170 DATA 6.5,6.5,6.5,6.5,6.5,6.5,6.5,6.5,6.5,6.5,6.5,6.5
61180 DATA 19.0,20.,19.0,20.,19.0,20.,19.0,20.
61190 DATA 27.0,20.0,27.0,20.0,27.0,20.0,27.0,20.
61200 DATA 8,15,19.0
61210 DATA 8,16,21.0
61220 DATA 14.0,28.0,6.60,13.20
61230 DATA 67
61240 DATA 7.0,7.0,7.0,7.0,7.0,7.0,7.0,7.0,7.0,7.0,7.0,7.0
61250 DATA 17.0,17.0,17.0,17.0,17.0,17.0,17.0,17.0,17.0,17.0,17.0,17.0
61260 DATA 21.0,21.0,21.0,21.0,21.0,21.0,21.0,21.0
61270 DATA 27,27,27,27,27,27,27,27
61280 DATA 12,10
61290 DATA 999
62000 REM THIS IS THE SCREEN PRINT LOADER ACTIVATE WITH 'CALL PRTSCR'
62010 DEF SEG=&H0
62020 POKE &HF1, &HCD
62030 POKE &HF2, &H5
62040 POKE &HF3, &HCB
62050 PRTSCR=&HF1
62060 RETURN
FILES460.TXT
-----------------------------------------------------------------------
Disk No 460 Alberta Agricultural Programs v1 DS2
---------------------------------------------------------------------
This seems to be another useful collection of decision aids for Farm Management.
Basica is required.
AUTOEXEC BAT Batch file BASICA HELLO
BESTCROP BAS Breakeven prices & yields - March 1982
BFP BAS Breakeven feeder prices - July 1984
CARCOST BAS Car or truck costing program - January 1984
CFP BAS Comparative feed pricing - June 1984
COWCRAB BAS Cow calf risk analysis budget - July 1983
CRCROP BAS Concensus research crops model - July 1984
DIET BAS Diet Detective Jr. - March 1983
DOLLAR BAS Dollar Detective - personal budgeting - March 1983
HAYCRAB BAS Hay cost returns and analysis - March 1982
HELLO BAS Alberta Agricluture menu program - August 1984
INSTALL BAT Batch file to add system and BASICA to disk
LANDPUR BAS Land purchase decisions - February 1983
LOAN BAS Loan calculator - August 1984
RATION BAS Ration balancing - May 1984
README DOC Author supplied documentation file
HAYCRAB.BAS
1 REM HAYCRAB
2 REM ** A PROGRAM TO CALCULATE THE ENERGY & PROTEIN EQUIVALENT PRICES OF
3 REM REVISED MARCH , 1982
4 REM CONTACT, GARY FISHER
5 REM FARM BUSINESS MGT BRANCH, OLDS
6 REM PHONE (403) 556-4240
8 GOTO 5000
9 S$="":REM THIS IS THE INPUT SUBROUTINE
10 GOSUB 24:PRINT SPACE$(LEN(S$));
11 S8=0:GOSUB 24
12 GOSUB 31
13 GOSUB 35
14 GOSUB 53
15 IF S$="" THEN S$=S6$:GOTO 22
16 IF S3=1 THEN GOSUB 56
17 IF S8=1 GOTO 10
18 IF S3=1 THEN GOSUB 68
19 IF S8=1 GOTO 10
20 IF S3=3 THEN GOSUB 73
21 IF S8=1 GOTO 10
22 IF S3=1 THEN S=VAL(S$)
23 RETURN
24 REM POSITION CURSOR
25 LOCATE S1,S2,1
30 RETURN
31 REM PRINT DEFAULT
32 PRINT S6$
33 GOSUB 24
34 RETURN
35 REM TRANSPARENT CURSOR ROUTINE
36 S$=""
37 S1$=INPUT$(1)
41 S=ASC(S1$):IF S<>13 GOTO 46
42 IF S$="" THEN GOSUB 24:PRINT " ";:GOSUB 24:GOSUB 31:PRINT:RETURN
43 IF LEN(S$)>=LEN(S6$) GOTO 45
44 PRINT SPACE$(LEN(S6$)-LEN(S$));
45 PRINT S1$;:RETURN
46 IF S<32 GOTO 50
47 IF S=34 THEN S1$="'"
48 S$=S$+S1$:IF S9>0 THEN IF LEN(S$)>S9 THEN PRINT S1$;:GOTO 52
49 PRINT S1$;:GOTO 37
50 IF LEN(S$)<1 GOTO 36
51 IF LEN(S$)=1 THEN PRINT CHR$(29);:PRINT" ";:PRINT CHR$(29);:GOTO 36
52 S$=LEFT$(S$,LEN(S$)-1):PRINT CHR$(29);:PRINT" ";:PRINT CHR$(29);:GOTO 37
53 REM THIS CHECKS FOR EXIT
54 IF S$="<" THEN CLS:PRINT" LOADING MENU...":RUN"HELLO.BAS"
55 RETURN
56 S1$=S$:S7=0:REM CHECK FOR NUMERIC INPUT
57 IF LEFT$(S1$,1)=" " THEN S1$=RIGHT$(S1$,LEN(S1$)-1):GOTO 57
58 IF RIGHT$(S1$,1)=" " THEN S1$=LEFT$(S1$,LEN(S1$)-1):GOTO 58
59 IF LEN(S1$)<1 GOTO 64
60 FOR S=1 TO LEN(S1$):S6=ASC(MID$(S1$,S,1))
61 IF S6>=48 AND S6<=57 GOTO 66
62 IF (S6=43 OR S6=45) AND S=1 GOTO 66
63 IF S6=46 AND S7=0 THEN S7=1:GOTO 66
64 S2$="NON NUMERIC INPUT":S1$="":GOSUB 78
65 RETURN
66 NEXT S
67 RETURN
68 REM CHECK FOR PROPER LIMITS
69 S6=VAL(S$)
70 IF S6<S4 THEN S2$="INPUT BELOW":S1$=STR$(S4):GOSUB 78:RETURN
71 IF S6>S5 THEN S2$="INPUT ABOVE":S1$=STR$(S5):GOSUB 78:RETURN
72 RETURN
73 REM CHECK FOR YES OR NO
74 IF LEFT$(S$,1)="Y" OR LEFT$(S$,1)="N" GOTO 76
75 S2$="MUST BE YES/NO ANSWER":S1$="":GOSUB 78:RETURN
76 S$=LEFT$(S$,1)
77 RETURN
78 REM ERROR FOR ALL CONDITIONS
79 COLOR 31,0,0:BEEP
80 GOSUB 90
81 PRINT" ";S2$;S1$;
82 FOR S7=1 TO 3000:NEXT S7
83 COLOR 7,0,0
87 GOSUB 93
88 S8=1
89 RETURN
90 REM POSTITION TO LAST LINE
91 LOCATE 25,1,0
92 RETURN
93 REM BLANK LAST LINE
94 LOCATE 25,1,1
95 PRINT SPACE$(39);
96 RETURN
200 REM ****DOLLAR FORMAT SUBROUTINE****
201 S3=INT(S3*100+0.5)/100
202 S3$=SPACE$(30)
203 IF S3=0 THEN S3$=RIGHT$(S3$,S4-4)+"0.00":GOTO 209
204 S4$=STR$(S3)
205 IF ASC(MID$(RIGHT$(S4$,2),1,1))=46 THEN S3$=S3$+S4$+"0":GOTO 208
206 IF ASC(MID$(RIGHT$(S4$,3),1,1))=46 THEN S3$=S3$+S4$:GOTO 208
207 S3$=S3$+S4$+".00"
208 S3$=RIGHT$(S3$,S4)
209 RETURN
300 REM HOLD SCREEN
301 S$="PRESS RETURN TO CONTINUE "
302 COLOR 31,0,0
303 GOSUB 90
304 PRINT" ";S$;
305 POKE 106,0
306 IF INKEY$=CHR$(13) GOTO 307 ELSE GOTO 305
307 COLOR 7,0,0
308 GOSUB 93
314 S$="":S1$=""
315 RETURN
5000 REM THIS IS THE MAINLINE FOR HAYCRAB
5010 GOSUB 62000
5020 GOSUB 60000
5030 CLS
5040 PRINT TAB( 15);"HAYCRAB"
5050 PRINT TAB( 15);"======="
5060 PRINT : PRINT TAB( 5);"HAY SELLING COMPUTERIZED RISK"
5070 PRINT TAB( 19);"ANALYSIS BUDGET"
5080 PRINT TAB( 15);"REVISED: MARCH 1982"
5090 PRINT : PRINT : PRINT " THIS PROGRAM IS DESIGNED TO ASSIST IN"
5100 PRINT
5110 PRINT " THE EVALUATION OF WHETHER OR NOT ONE"
5120 PRINT
5130 PRINT " SHOULD SELL HIS HAY AS A STANDING"
5140 PRINT
5150 PRINT " CROP OR HARVEST AND STACK FOR SALE"
5160 PRINT
5170 PRINT " AT A LATER DATE."
5180 GOSUB 300: CLS
5190 PRINT : PRINT " FIVE PIECES OF INFORMATION ARE USED:"
5200 PRINT : PRINT
5210 PRINT " THE FIRST IS THE WORST PRICE PER TON"
5220 PRINT " EXPECTED AT THE FUTURE DATE OF SALE."
5230 PRINT
5240 PRINT " THE SECOND IS THE BEST PRICE PER TON"
5250 PRINT " EXPECTED AT THE FUTURE DATE OF SALE"
5260 PRINT
5270 PRINT " THE THIRD ASKS FOR THE MOST LIKELY"
5280 PRINT " PRICE (/TN) AT THE FUTURE DATE OF SALE"
5290 PRINT
5300 PRINT " THE NEXT TWO QUESTIONS DEAL WITH THE"
5310 PRINT " COSTS OF HARVESTING AND STORAGE."
5320 GOSUB 300
5325 REM DEFAULT VALUES
5330 A=50:B=100:M=80:H=40:C=10
5340 CLS
5350 PRINT : PRINT
5360 PRINT "WORST PRICE (/TN) AT LATER DATE="; STR$(A)
5370 PRINT : PRINT
5380 PRINT "BEST PRICE (/TON) AT LATER DATE="; STR$(B)
5390 PRINT : PRINT
5400 PRINT "MOST LIKELY PRICE AT LATER DATE="; STR$(M)
5410 PRINT : PRINT
5420 PRINT "HARVESTING COST PER TON........="; STR$(H)
5430 PRINT : PRINT
5440 PRINT "STORAGE COST PER TON...........="; STR$(C)
5450 S6$= STR$(A):S1=3:S2=33:S3=1:S4=20:S5=500:S9=5: GOSUB 9:A=S
5460 S6$= STR$(B):S1=6: GOSUB 9:B=S
5470 S6$= STR$(M):S1=9: GOSUB 9:M=S
5480 S6$= STR$(H):S1=12:S4=0: GOSUB 9:H=S
5490 S6$= STR$(C):S1=15: GOSUB 9:C=S
5500 S1=20:S2=1: GOSUB 24
5510 PRINT " ANY ENTRIES TO BE CHANGED (Y/N)?"
5520 S6$="Y":S1=20:S2=35:S3=3: GOSUB 9
5530 IF S$="Y" GOTO 5340
5540 S1=20:S2=1: GOSUB 24
5550 PRINT " DO YOU WISH TO PRINT (Y/N)? "
5560 S6$="N":S2=30: GOSUB 9
5565 REM CLEARS QUESTION BEFORE SCREEN DUMP
5570 IF S$="Y" THEN S2=1: GOSUB 24: PRINT " "
5575 IF S$="Y" THEN CALL PRTSCR
5580 CLS
5590 PRINT " CHANCE OF GETTING LESS THAN--"
5600 PRINT " ============================="
5610 PRINT " PERCENTAGE EXPECTED SELLING PRICE"
5620 PRINT " FROM STACK FROM FIELD"
5630 PRINT " =========== ========== =========="
5640 F1=((M-A)/(B-A))*100
5650 FOR I=0 TO 100 STEP 10
5660 IF I > =F1 AND I < =100 GOTO 5690
5670 X=A+ SQR((I/100)*(M-A)*(B-A))
5680 GOTO 5700
5690 X=B-((1-I/100)*(B-M)*(B-A))^0.5
5700 S3=I:S4=11: GOSUB 200: PRINT S3$;
5710 S3=X: GOSUB 200: PRINT S3$;
5720 IF I=50 THEN A1=S3
5730 S3=X-(H+C): GOSUB 200: PRINT S3$
5740 IF I=50 THEN A2=S3
5750 NEXT I
5760 PRINT
5770 PRINT "GIVEN YOUR ESTIMATES, AN OFFER OF"
5780 PRINT "$";A2;"/TON STANDING WOULD GIVE THE"
5790 PRINT "SAME NET RETURN AS $";A1;"/TON"
5800 PRINT "STACKED. YOU HAVE A 50% CHANCE OF"
5810 PRINT "GETTING LESS THAN THIS VALUE."
5830 PRINT " DO YOU WISH TO PRINT (Y/N)?";
5840 S6$="N":S1=23:S2=30:S3=3: GOSUB 9
5850 S2=1: IF S$="Y" THEN GOSUB 24: PRINT " "
5855 IF S$="Y" THEN CALL PRTSCR
5860 GOSUB 24
5870 PRINT " DO YOU WISH TO RERUN (Y/N)? ";
5880 S6$="Y":S2=30: GOSUB 9
5890 IF S$="Y" GOTO 5340
5900 CLS
5910 PRINT " THANK YOU FOR USING THIS PROGRAM":LOCATE 10,1:COLOR 0,7: PRINT " LOADING MENU .. PLEASE WAIT ":COLOR 7,0:RUN "HELLO"
60000 REM this is the logo routine
60010 DEF SEG=0:IF (PEEK(&H410) AND &H30)=&H30 GOTO 60550
60020 S=3.141593
60030 KEY OFF
60040 SCREEN 1
60050 COLOR 0,1
60060 CLS
60070 LINE(0,0)-(319,199),3,B
60080 LINE(5,5)-(314,194),3,B
60090 PAINT(1,1),1,3
60100 DRAW"c3;bm40,100;e60;d60;l5;h15;e4;f10;u40;g50;l5;"
60110 PAINT(43,99),1,3
60120 DRAW"C3;bm110,30;d70;L5;U70;R5;"
60130 PAINT(109,99),1,3
60140 DRAW"C3;bm120,40;d60;L5;U60;R5;"
60150 PAINT(119,99),1,3
60160 CIRCLE(135,83),20,3,1.25*S,0.75*S
60170 CIRCLE(135,83),15,3,1.25*S,0.9*S
60180 DRAW"bm119,96;e5;"
60190 PAINT(135,98),1,3
60200 CIRCLE(170,83),20,3,0.2*S,1.85*S
60210 CIRCLE(170,83),15,3,0.25*S,1.8*S
60220 DRAW"C3;BM182,90;R5;"
60230 DRAW"C3;BM187,75;G10;H3;E7;"
60240 PAINT(170,99),1,3
60250 PAINT(170,67),1,3
60260 DRAW"c3;bm195,100;l5;u34;r5;d34;"
60270 CIRCLE(210,83),20,3,0.55*S,0.76*S
60280 CIRCLE(210,83),15,3,0.59*S,0.8799999*S
60290 DRAW"bm207,66;d5;"
60300 PAINT(194,99),1,3
60310 PAINT(206,69),1,3
60320 DRAW"c3;bm217,100;l5;u40;r5;d5;r7;d5;l7;d30;"
60330 PAINT(216,97),1,3
60340 DRAW"C3;bm265,65;d35;L5;U35;R5;"
60350 CIRCLE(245,83),20,3,0.25*S,1.75*S
60360 CIRCLE(245,83),15,3,0.09999999*S,1.7*S
60370 DRAW"bm261,99;h6;"
60380 PAINT(245,98),1,3
60390 PAINT(264,69),1,3
60400 LOCATE 14,22
60410 PRINT"AGRICULTURE"
60420 LOCATE 18,4
60430 PRINT"FARM BUSINESS MANAGEMENT BRANCH"
60460 LOCATE 23,5
60470 PRINT"PROVIDED BY ALBERTA AGRICULTURE"
60480 LOCATE 24,3
60490 PRINT"RESPONSIBILITY RESTS WITH THE USER";
60500 FOR S=1 TO 4100
60510 POKE 106,0
60520 IF INKEY$<>"" GOTO 60540
60530 NEXT S
60540 ON ERROR GOTO 0 :SCREEN 0,0,0:RETURN
60550 REM **MONOCHROME LOGO**
60560 KEY OFF:WIDTH 80:CLS:S$=CHR$(219)
60570 PRINT STRING$(75,S$);
60580 FOR S=2 TO 23:LOCATE S,75:PRINT S$;:NEXT
60590 LOCATE 24,1:PRINT STRING$(75,S$);
60600 FOR S=23 TO 2 STEP -1:LOCATE S,1:PRINT S$;:NEXT
60610 '
60620 '
60630 LOCATE 5,28:PRINT "▌"
60640 LOCATE 6,24:PRINT"/▌ ▌ ▌"
60650 LOCATE 7,23:PRINT"/ ▌ ▌ ▌"
60660 LOCATE 8,22:PRINT"/ ▌ ▌ ▌ ▐"
60670 LOCATE 9,21:PRINT"/ ▌ ▌ ▌ __ __ ▐_ __"
60680 LOCATE 10,20:PRINT"/ ▌ ▌ ▌/ \ / \ ▐/ ▐ / \▌"
60690 LOCATE 11,19:PRINT"/ ▌ ▌ █ ▐ ▌ / ▐ ▐ ▌ ▌"
60700 LOCATE 12,18:PRINT"/ \ ▌ ▌ █ ▐ ▌ ▐ ▐ ▌ ▌"
60710 LOCATE 13,17:PRINT"/ \▌ ▌ ▌\__/ \__/ ▐ ▐ \__/▌"
60720 LOCATE 15,36:PRINT"A G R I C U L T U R E"
60730 LOCATE 18,22:PRINT"FARM BUSINESS MANAGEMENT BRANCH"
60740 LOCATE 21,22:PRINT"PROVIDED BY ALBERTA AGRICULTURE."
60750 LOCATE 22,19:PRINT"RESPONSIBILITY RESTS SOLELY WITH USER"
60760 FOR S=1 TO 1500
60770 S$=INKEY$
60780 IF S$=CHR$(13) GOTO 60800
60790 NEXT S
60800 S$=""
60810 ON ERROR GOTO 0
60820 RETURN
62000 REM THIS IS THE SCREEN PRINT LOADER ACTIVATE WITH 'CALL PRTSCR'
62010 DEF SEG=&H0
62020 POKE &HF1, &HCD
62030 POKE &HF2, &H5
62040 POKE &HF3, &HCB
62050 PRTSCR=&HF1
62060 RETURN
HELLO.BAS
1 REM *** HELLO PROGRAM ***
2 REM PRESENTS A MENU OF ADA IBM-PC PROGRAMS
3 REM CON TAINED ON THIS ADA PROGRAM DISKETTE.
4 REM ** UPDATED AUGUST 28, 1984 **
8 GOTO 5000
9 S$="":REM THIS IS THE INPUT SUBROUTINE
10 GOSUB 24:PRINT SPACE$(LEN(S$));
11 S8=0:GOSUB 24
12 GOSUB 31
13 GOSUB 35
14 GOSUB 53
15 IF S$="" THEN S$=S6$:GOTO 22
16 IF S3=1 THEN GOSUB 56
17 IF S8=1 GOTO 10
18 IF S3=1 THEN GOSUB 68
19 IF S8=1 GOTO 10
20 IF S3=3 THEN GOSUB 73
21 IF S8=1 GOTO 10
22 IF S3=1 THEN S=VAL(S$)
23 RETURN
24 REM POSITION CURSOR
25 LOCATE S1,S2,1
30 RETURN
31 REM PRINT DEFAULT
32 PRINT S6$
33 GOSUB 24
34 RETURN
35 REM TRANSPARENT CURSOR ROUTINE
36 S$=""
37 S1$=INPUT$(1)
41 S=ASC(S1$):IF S<>13 GOTO 46
42 IF S$="" THEN GOSUB 24:PRINT " ";:GOSUB 24:GOSUB 31:PRINT:RETURN
43 IF LEN(S$)>=LEN(S6$) GOTO 45
44 PRINT SPACE$(LEN(S6$)-LEN(S$));
45 PRINT S1$;:RETURN
46 IF S<32 GOTO 50
47 IF S=34 THEN S1$="'"
48 S$=S$+S1$:IF S9>0 THEN IF LEN(S$)>S9 THEN PRINT S1$;:GOTO 52
49 PRINT S1$;:GOTO 37
50 IF LEN(S$)<1 GOTO 36
51 IF LEN(S$)=1 THEN PRINT CHR$(29);:PRINT" ";:PRINT CHR$(29);:GOTO 36
52 S$=LEFT$(S$,LEN(S$)-1):PRINT CHR$(29);:PRINT" ";:PRINT CHR$(29);:GOTO 37
53 REM THIS CHECKS FOR EXIT
54 IF S$="<" THEN CLS:PRINT" NORMAL EXIT":END
55 RETURN
56 S1$=S$:S7=0:REM CHECK FOR NUMERIC INPUT
57 IF LEFT$(S1$,1)=" " THEN S1$=RIGHT$(S1$,LEN(S1$)-1):GOTO 57
58 IF RIGHT$(S1$,1)=" " THEN S1$=LEFT$(S1$,LEN(S1$)-1):GOTO 58
59 IF LEN(S1$)<1 GOTO 64
60 FOR S=1 TO LEN(S1$):S6=ASC(MID$(S1$,S,1))
61 IF S6>=48 AND S6<=57 GOTO 66
62 IF (S6=43 OR S6=45) AND S=1 GOTO 66
63 IF S6=46 AND S7=0 THEN S7=1:GOTO 66
64 S2$="NON NUMERIC INPUT":S1$="":GOSUB 78
65 RETURN
66 NEXT S
67 RETURN
68 REM CHECK FOR PROPER LIMITS
69 S6=VAL(S$)
70 IF S6<S4 THEN S2$="INPUT BELOW":S1$=STR$(S4):GOSUB 78:RETURN
71 IF S6>S5 THEN S2$="INPUT ABOVE":S1$=STR$(S5):GOSUB 78:RETURN
72 RETURN
73 REM CHECK FOR YES OR NO
74 IF LEFT$(S$,1)="Y" OR LEFT$(S$,1)="N" GOTO 76
75 S2$="MUST BE YES/NO ANSWER":S1$="":GOSUB 78:RETURN
76 S$=LEFT$(S$,1)
77 RETURN
78 REM ERROR FOR ALL CONDITIONS
79 COLOR 31,0,0:BEEP
80 GOSUB 90
81 PRINT" ";S2$;S1$;
82 FOR S7=1 TO 3000:NEXT S7
83 COLOR 7,0,0
87 GOSUB 93
88 S8=1
89 RETURN
90 REM POSTITION TO LAST LINE
91 LOCATE 25,1,0
92 RETURN
93 REM BLANK LAST LINE
94 LOCATE 25,1,1
95 PRINT SPACE$(39);
96 RETURN
200 REM ****DOLLAR FORMAT SUBROUTINE****
201 S3=INT(S3*100+0.5)/100
202 S3$=SPACE$(30)
203 IF S3=0 THEN S3$=RIGHT$(S3$,S4-4)+"0.00":GOTO 209
204 S4$=STR$(S3)
205 IF ASC(MID$(RIGHT$(S4$,2),1,1))=46 THEN S3$=S3$+S4$+"0":GOTO 208
206 IF ASC(MID$(RIGHT$(S4$,3),1,1))=46 THEN S3$=S3$+S4$:GOTO 208
207 S3$=S3$+S4$+".00"
208 S3$=RIGHT$(S3$,S4)
209 RETURN
220 REM **** GENERAL NUMBER FOR MATTER SUBROUTINE ****
221 S7=10^S5
222 IF S3=0 THEN S3$=RIGHT$(" 0",S4-S5-1)+LEFT$(".0000",S5+1):GOTO 229
223 S6=INT(S3*S7+0.5)/S7
224 S3$=STR$(S6+SGN(S6)*0.1/S7)
225 S6=LEN(S3$)
226 S3$=LEFT$(S3$,S6-1)
227 IF S6=S4+1 THEN 229
228 S3$=LEFT$(" ",S4+1-S6)+S3$
229 RETURN
300 REM HOLD SCREEN
301 S$="PRESS RETURN TO CONTINUE "
302 COLOR 31,0,0
303 GOSUB 90
304 PRINT" ";S$;
305 POKE 106,0
306 IF INKEY$=CHR$(13) GOTO 307 ELSE GOTO 305
307 COLOR 7,0,0
308 GOSUB 93
314 S$="":S1$=""
315 RETURN
5000 REM**MENU PROGRAM**
5010 GOSUB 60000
5015 DEF SEG=0:POKE 1047,96:REM shift lock on cursor off
5020 DIM PG$(100,1)
5025 GOSUB 5250
5030 RESTORE
5040 FOR S=1 TO 100
5050 READ PG$(S,0),PG$(S,1)
5055 IF PG$(S,0)="123456" GOTO 5070
5060 NEXT S
5070 REM NOW GET ON WITH IT
5080 MX=S-1
5090 FOR I=1 TO MX
5100 PRINT TAB(5);I;TAB(9);PG$(I,1)
5110 IF INT(I/12)=I/12 AND I<MX THEN GOSUB 300:GOSUB 5250
5120 NEXT I
5130 S1=21:S2=1:GOSUB 24
5140 PRINT"ENTER A PROGRAM NUMBER:"
5150 S1=22:S2=3:GOSUB 24
5160 PRINT :PRINT"OR HIT THE RETURN KEY TO END"
5190 S1=21:S2=37:S6$="":S3=1:S4=1:S5=MX:S9=2:GOSUB 9
5200 IF S$="" THEN CLS:PRINT"THANK YOU FOR USING THIS PROGRAM":END
5210 PG$=PG$(S,0)
5248 GOTO 6070
5250 CLS:PRINT" A D A P R O G R A M DISKETTE #1 ":PRINT
5260 PRINT" *** LAST UPDATED AUGUST, 1984 ***"
5270 PRINT
5290 RETURN
6070 RUN PG$
6090 END
7000 REM ***THE DATA STATEMENTS FOR THE PROGRAMS START HERE ***
7005 DATA "BESTCROP","BEST CROP ANALYSIS"
7008 DATA "CARCOST","CAR/TRUCK COSTS"
7010 DATA "CFP","COMPARATIVE FEED PRICING"
7030 DATA "DIET","DIET DETECTIVE JR. (NUTRITION )"
7040 DATA "DOLLAR","DOLLAR DETECTIVE (BUDGETS)"
7050 DATA "HAYCRAB","HAY COST AND RETURNS ANALYSIS"
7060 DATA "LOAN","LOAN CALCULATOR"
7070 DATA "RATION ","RATION BALANCING"
7072 DATA "BFP","BREAKEVEN FEEDER PRICES"
7080 DATA "LANDPUR","LAND PURCHASE DECISION "
7090 DATA "CRCROP","C.R.D. FOR CROP ENTERPRISES"
7100 DATA "COWCRAB","COW/CALF RISK ANALYSIS BUDGET"
8000 DATA "123456","123456"
60000 REM this is the logo routine
60010 DEF SEG=0:IF (PEEK(&H410) AND &H30)=&H30 GOTO 60550
60020 S=3.141593
60030 KEY OFF
60040 SCREEN 1
60050 COLOR 0,1
60060 CLS
60070 LINE(0,0)-(319,199),3,B
60080 LINE(5,5)-(314,194),3,B
60090 PAINT(1,1),1,3
60100 DRAW"c3;bm40,100;e60;d60;l5;h15;e4;f10;u40;g50;l5;"
60110 PAINT(43,99),1,3
60120 DRAW"C3;bm110,30;d70;L5;U70;R5;"
60130 PAINT(109,99),1,3
60140 DRAW"C3;bm120,40;d60;L5;U60;R5;"
60150 PAINT(119,99),1,3
60160 CIRCLE(135,83),20,3,1.25*S,0.75*S
60170 CIRCLE(135,83),15,3,1.25*S,0.9*S
60180 DRAW"bm119,96;e5;"
60190 PAINT(135,98),1,3
60200 CIRCLE(170,83),20,3,0.2*S,1.85*S
60210 CIRCLE(170,83),15,3,0.25*S,1.8*S
60220 DRAW"C3;BM182,90;R5;"
60230 DRAW"C3;BM187,75;G10;H3;E7;"
60240 PAINT(170,99),1,3
60250 PAINT(170,67),1,3
60260 DRAW"c3;bm195,100;l5;u34;r5;d34;"
60270 CIRCLE(210,83),20,3,0.55*S,0.76*S
60280 CIRCLE(210,83),15,3,0.59*S,0.8799999*S
60290 DRAW"bm207,66;d5;"
60300 PAINT(194,99),1,3
60310 PAINT(206,69),1,3
60320 DRAW"c3;bm217,100;l5;u40;r5;d5;r7;d5;l7;d30;"
60330 PAINT(216,97),1,3
60340 DRAW"C3;bm265,65;d35;L5;U35;R5;"
60350 CIRCLE(245,83),20,3,0.25*S,1.75*S
60360 CIRCLE(245,83),15,3,0.09999999*S,1.7*S
60370 DRAW"bm261,99;h6;"
60380 PAINT(245,98),1,3
60390 PAINT(264,69),1,3
60400 LOCATE 14,22
60410 PRINT"AGRICULTURE"
60420 LOCATE 18,8
60430 PRINT"A D A P R O G R A M S"
60460 LOCATE 23,5
60470 PRINT"PROVIDED BY ALBERTA AGRICULTURE"
60480 LOCATE 24,3
60490 PRINT"RESPONSIBILITY RESTS WITH THE USER";
60500 FOR S=1 TO 4100
60510 POKE 106,0
60520 IF INKEY$<>"" GOTO 60540
60530 NEXT S
60540 ON ERROR GOTO 0 :SCREEN 0,0,0:RETURN
60550 REM **MONOCHROME LOGO**
60560 KEY OFF:WIDTH 80:CLS:S$=CHR$(219)
60570 PRINT STRING$(75,S$);
60580 FOR S=2 TO 23:LOCATE S,75:PRINT S$;:NEXT
60590 LOCATE 24,1:PRINT STRING$(75,S$);
60600 FOR S=23 TO 2 STEP -1:LOCATE S,1:PRINT S$;:NEXT
60610 '
60620 '
60630 LOCATE 5,28:PRINT "▌"
60640 LOCATE 6,24:PRINT"/▌ ▌ ▌"
60650 LOCATE 7,23:PRINT"/ ▌ ▌ ▌"
60660 LOCATE 8,22:PRINT"/ ▌ ▌ ▌ ▐"
60670 LOCATE 9,21:PRINT"/ ▌ ▌ ▌ __ __ ▐_ __"
60680 LOCATE 10,20:PRINT"/ ▌ ▌ ▌/ \ / \ ▐/ ▐ / \▌"
60690 LOCATE 11,19:PRINT"/ ▌ ▌ █ ▐ ▌ / ▐ ▐ ▌ ▌"
60700 LOCATE 12,18:PRINT"/ \ ▌ ▌ █ ▐ ▌ ▐ ▐ ▌ ▌"
60710 LOCATE 13,17:PRINT"/ \▌ ▌ ▌\__/ \__/ ▐ ▐ \__/▌"
60720 LOCATE 15,36:PRINT"A G R I C U L T U R E"
60730 LOCATE 18,24:PRINT"A D A P R O G R A M S"
60740 LOCATE 21,22:PRINT"PROVIDED BY ALBERTA AGRICULTURE."
60750 LOCATE 22,19:PRINT"RESPONSIBILITY RESTS SOLELY WITH USER"
60760 FOR S=1 TO 1500
60770 S$=INKEY$
60780 IF S$=CHR$(13) GOTO 60800
60790 NEXT S
60800 S$=""
60810 ON ERROR GOTO 0
60820 RETURN
LANDPUR.BAS
1 REM LAND PURCHASE DECISIONS
2 REM LAST REVISED FEB 8,1983
3 REM CONTACT GARY FISHER
4 REM FARM BUSINESS MANAGEMENT BRANCH
5 REM BOX 2000 OLDS, ALTA
6 REM PHONE (403) 556-4240
7 REM CONVERTED TO APPLESOFT BASIC FROM PET BASIC BY G.K. PETERSON APRIL 1982
8 GOTO 5000
9 S$="":REM THIS IS THE INPUT SUBROUTINE
10 GOSUB 24:PRINT SPACE$(LEN(S$));
11 S8=0:GOSUB 24
12 GOSUB 31
13 GOSUB 35
14 GOSUB 53
15 IF S$="" THEN S$=S6$:GOTO 22
16 IF S3=1 THEN GOSUB 56
17 IF S8=1 GOTO 10
18 IF S3=1 THEN GOSUB 68
19 IF S8=1 GOTO 10
20 IF S3=3 THEN GOSUB 73
21 IF S8=1 GOTO 10
22 IF S3=1 THEN S=VAL(S$)
23 RETURN
24 REM POSITION CURSOR
25 LOCATE S1,S2,1
30 RETURN
31 REM PRINT DEFAULT
32 PRINT S6$
33 GOSUB 24
34 RETURN
35 REM TRANSPARENT CURSOR ROUTINE
36 S$=""
37 S1$=INPUT$(1)
41 S=ASC(S1$):IF S<>13 GOTO 46
42 IF S$="" THEN GOSUB 24:PRINT " ";:GOSUB 24:GOSUB 31:PRINT:RETURN
43 IF LEN(S$)>=LEN(S6$) GOTO 45
44 PRINT SPACE$(LEN(S6$)-LEN(S$));
45 PRINT S1$;:RETURN
46 IF S<32 GOTO 50
47 IF S=34 THEN S1$="'"
48 S$=S$+S1$:IF S9>0 THEN IF LEN(S$)>S9 THEN PRINT S1$;:GOTO 52
49 PRINT S1$;:GOTO 37
50 IF LEN(S$)<1 GOTO 36
51 IF LEN(S$)=1 THEN PRINT CHR$(29);:PRINT" ";:PRINT CHR$(29);:GOTO 36
52 S$=LEFT$(S$,LEN(S$)-1):PRINT CHR$(29);:PRINT" ";:PRINT CHR$(29);:GOTO 37
53 REM THIS CHECKS FOR EXIT
54 IF S$="<" THEN CLS:PRINT" LOADING MENU":RUN "HELLO"
55 RETURN
56 S1$=S$:S7=0:REM CHECK FOR NUMERIC INPUT
57 IF LEFT$(S1$,1)=" " THEN S1$=RIGHT$(S1$,LEN(S1$)-1):GOTO 57
58 IF RIGHT$(S1$,1)=" " THEN S1$=LEFT$(S1$,LEN(S1$)-1):GOTO 58
59 IF LEN(S1$)<1 GOTO 64
60 FOR S=1 TO LEN(S1$):S6=ASC(MID$(S1$,S,1))
61 IF S6>=48 AND S6<=57 GOTO 66
62 IF (S6=43 OR S6=45) AND S=1 GOTO 66
63 IF S6=46 AND S7=0 THEN S7=1:GOTO 66
64 S2$="NON NUMERIC INPUT":S1$="":GOSUB 78
65 RETURN
66 NEXT S
67 RETURN
68 REM CHECK FOR PROPER LIMITS
69 S6=VAL(S$)
70 IF S6<S4 THEN S2$="INPUT BELOW":S1$=STR$(S4):GOSUB 78:RETURN
71 IF S6>S5 THEN S2$="INPUT ABOVE":S1$=STR$(S5):GOSUB 78:RETURN
72 RETURN
73 REM CHECK FOR YES OR NO
74 IF LEFT$(S$,1)="Y" OR LEFT$(S$,1)="N" GOTO 76
75 S2$="MUST BE YES/NO ANSWER":S1$="":GOSUB 78:RETURN
76 S$=LEFT$(S$,1)
77 RETURN
78 REM ERROR FOR ALL CONDITIONS
79 COLOR 31,0,0:BEEP
80 GOSUB 90
81 PRINT" ";S2$;S1$;
82 FOR S7=1 TO 3000:NEXT S7
83 COLOR 7,0,0
87 GOSUB 93
88 S8=1
89 RETURN
90 REM POSTITION TO LAST LINE
91 LOCATE 25,1,0
92 RETURN
93 REM BLANK LAST LINE
94 LOCATE 25,1,1
95 PRINT SPACE$(39);
96 RETURN
100 CLS:PRINT"THANK YOU FOR USING THIS PROGRAM":LOCATE 13,1:COLOR 0,7:PRINT"LOADING MENU.... PLEASE WAIT":COLOR 7,0:RUN "HELLO"
200 REM ****DOLLAR FORMAT SUBROUTINE****
201 S3=INT(S3*100+0.5)/100
202 S3$=SPACE$(30)
203 IF S3=0 THEN S3$=RIGHT$(S3$,S4-4)+"0.00":GOTO 209
204 S4$=STR$(S3)
205 IF ASC(MID$(RIGHT$(S4$,2),1,1))=46 THEN S3$=S3$+S4$+"0":GOTO 208
206 IF ASC(MID$(RIGHT$(S4$,3),1,1))=46 THEN S3$=S3$+S4$:GOTO 208
207 S3$=S3$+S4$+".00"
208 S3$=RIGHT$(S3$,S4)
209 RETURN
300 REM HOLD SCREEN
301 S$="PRESS RETURN TO CONTINUE "
302 COLOR 31,0,0
303 GOSUB 90
304 PRINT" ";S$;
305 POKE 106,0
306 IF INKEY$=CHR$(13) GOTO 307 ELSE GOTO 305
307 COLOR 7,0,0
308 GOSUB 93
314 S$="":S1$=""
315 RETURN
5000 REM **THIS IS THE MAINLINE FOR LAND PURCHASE**
5010 GOSUB 60000
5020 CLS : PRINT "PLEASE WAIT, I AM LOADING DATA"
5030 GOSUB 62000
5140 DIM A(20),D(20)
5145 GOSUB 6810
5150 GOSUB 6930
5160 CLS : RESTORE : REM RETURN TO LAND
5170 FOR I=1 TO 15: IF I=2 OR I=6 OR I=12 OR I=15 THEN PRINT
5180 IF I > 1 THEN PRINT " ";
5190 READ A$: PRINT A$;: PRINT TAB( 29);A(I): NEXT I
5200 A1=0:S1=0
5210 FOR I=1 TO 15: IF I=2 OR I=6 OR I=12 OR I=15 THEN PRINT :S1=S1+1
5220 S6$= STR$(A(I)):S1=S1+1:S2=29:S3=1:S4=0:S5=99999999#:S9=11: GOSUB 9
5240 A(I)=S
5250 IF I < 12 THEN D(I)=A(I)
5260 NEXT I
5270 D(14)=A(12):D(15)=A(15)
5280 GOSUB 7100
5285 PRINT
5290 PRINT " TOTAL EXPENSES.......=$"A1:A2=A(1)-A1
5310 PRINT " RETURN TO LAND...........=$"A2
5320 PRINT "CHANGE DATA Y/N MENU M OR PRINT P?";
5330 S6$="":S1=23:S2=36:S3=2:S9=1: GOSUB 9
5335 IF S$="Y" GOTO 5160
5340 IF S$="N" GOTO 5370
5345 IF S$="M" GOTO 6610
5350 IF S$ <> "P" GOTO 5360
5352 S2=1: GOSUB 24: PRINT SPACE$(37):CALL PRTSCR
5354 GOSUB 24: GOTO 5320
5360 GOTO 5330
5370 REM ***PRODUCTIVE VALUE SECTION***
5375 CLS : PRINT " PRODUCTIVE VALUE"
5380 PRINT " ----------------"
5390 PRINT : PRINT "OPPORTUNITY COST OF MONEY = % ";B(1)
5400 PRINT "OWNERSHIP PERIOD IN YEARS = ";B(2)
5410 PRINT "TOTAL ACRES(INCL. LAND PUR.)= ";B(3)
5420 FOR I=1 TO 3
5422 IF B(1) <=0 THEN B(1)=1
5424 IF B(3) <=0 THEN B(3)=1
5425 S6$= STR$(B(I)):S1=I+3:S2=31:S3=1
5428 IF I=1 THEN S4=1:S5=100:S9=5
5430 IF I=2 THEN S4=0:S5=100:S9=7
5435 IF I=3 THEN S4=0.1:S5=1000000!:S9=8
5440 GOSUB 9
5450 B(I)=S
5460 NEXT I
5465 PRINT
5470 C(3)=B(2):C(5)=B(1):E(2)=B(3)
5480 GOSUB 7100
5490 GOSUB 7200
5510 PRINT : PRINT " RETURN TO LAND"
5520 PRINT "PV=--------------------*CAP. FACTOR"
5530 PRINT " TOTAL ACRES IN FARM"
5550 PRINT : PRINT : PRINT " "A2
5560 PRINT "PV=----------*";CF;" ="PV
5570 PRINT " "B(3)
5575 PRINT
5580 PRINT "CHANGE DATA Y/N MENU M OR PRINT P?";
5585 S6$=" ":S1=18:S2=36:S3=2:S9=1: GOSUB 9
5590 IF S$="Y" GOTO 5370
5595 IF S$="M" GOTO 6610
5600 IF S$="N" THEN 5630
5610 IF S$ <> "P" GOTO 5620
5612 S2=1: GOSUB 24: PRINT SPACE$( 37): CALL PRTSCR
5614 GOSUB 24: GOTO 5580
5620 GOTO 5585
5630 REM ***ECONOMIC VALUE SECTION***
5635 CLS : PRINT " ECONOMIC VALUE": PRINT
5637 IF C(5) <=0 THEN C(5)=1
5640 PRINT " <P.V. FUTURE CAP. GAIN (AFTER TAX)>": PRINT
5650 PRINT "CURRENT MARKET LAND VALUE/AC=$ ";C(1)
5660 PRINT "RATE OF INFLATION...........=% ";C(2)
5670 PRINT "OWNERSHIP PERIOD IN YEARS...= ";C(3)
5680 PRINT "MARGINAL TAX RATE...........=% ";C(4)
5690 PRINT "OPPORTUNITY COST OF MONEY...=% ";C(5)
5700 PRINT : PRINT " <P.V. ADD. BORROWING POWER>": PRINT
5710 PRINT "LEVERAGE....................=% ";C(6)
5720 PRINT "% OF ADD. EQUITY THAT CAN"
5730 PRINT "BE BORROWED.................=% ";C(7)
5740 S6$= STR$(C(1)):S1=5:S2=32:S3=1:S4=0:S5=10000:S9=7: GOSUB 9:C(1)=S
5742 S6$= STR$(C(2)):S1=6:S4=0:S5=100:S9=5: GOSUB 9:C(2)=S
5744 S6$= STR$(C(3)):S1=7:S4=0.1:S5=100:S9=7: GOSUB 9:C(3)=S
5746 S6$= STR$(C(4)):S1=8:S4=0:S5=100:S9=5: GOSUB 9:C(4)=S
5748 S6$= STR$(C(5)):S1=9:S4=1: GOSUB 9:C(5)=S
5750 S6$= STR$(C(6)):S1=13:S4=0: GOSUB 9:C(6)=S
5752 S6$= STR$(C(7)):S1=15: GOSUB 9:C(7)=S
5810 B(2)=C(3):B(1)=C(5)
5820 GOSUB 7100
5830 GOSUB 7200
5840 GOSUB 7300
5870 PRINT : PRINT : PRINT "EV= PROD. VALUE+P.V. CAP. GAIN"
5880 PRINT " +P.V. BORR. POWER"
5900 PRINT : PRINT "EV="PV"+"CG"+"BP"="EV
5905 PRINT
5910 PRINT "CHANGE DATA Y/N MENU M OR PRINT P?";
5920 S6$="":S1=23:S2=36:S3=2:S9=1: GOSUB 9
5930 IF S$="Y" GOTO 5630
5932 IF S$="N" GOTO 5960
5934 IF S$="M" GOTO 6610
5940 IF S$ <> "P" GOTO 5950
5942 S2=1: GOSUB 24: PRINT SPC( 37): CALL PRTSCR
5944 GOSUB 24: GOTO 5910
5950 GOTO 5920
5960 CLS : RESTORE : REM CASHFLOW
5970 FOR I=1 TO 11: IF I=2 THEN PRINT
5980 IF I > 1 THEN PRINT " ";
5990 READ A$: PRINT A$;: PRINT TAB( 29);D(I): NEXT I
6000 PRINT "FAMILY LIVING EXPENSE.....=$";D(12)
6010 PRINT "PRIN. & INT. ON EXISTING "
6020 PRINT " CAPITAL LOANS.........=$";D(13)
6030 PRINT "DEPRECIATION..............=$";D(14)
6040 PRINT "INCOME TAX PAYABLE........=$";D(15)
6050 PRINT "ADD. CASH TO FARM NEW LAND=$";D(16)
6060 PRINT "ALLOWANCE FOR RISK........=$";D(17)
6070 B1=0:S1=0
6080 FOR I=1 TO 17: IF I=2 OR I=13 THEN PRINT :S1=S1+1
6090 S6$= STR$(D(I)):S1=S1+1:S2=29:S3=1:S4=0:S5=99999999#:S9=11: GOSUB 9
6100 D(I)=S
6110 IF I < 12 THEN A(I)=D(I)
6120 NEXT I
6130 A(12)=D(14):A(15)=D(15)
6140 GOSUB 7400
6160 PRINT " ======="
6170 PRINT " TOTAL EXPENSES.......=$"B1
6190 PRINT "CASH FLOW AVAILABLE.......=$"B2
6200 PRINT "CHANGE DATA Y/N MENU M OR PRINT P?";
6205 S6$="":S1=23:S2=36:S3=2:S9=1: GOSUB 9
6210 IF S$="Y" GOTO 5960
6215 IF S$="N" GOTO 6240
6220 IF S$="M" GOTO 6610
6225 IF S$ <> "P" GOTO 6234
6230 S2=1: GOSUB 24: PRINT SPC( 37): CALL PRTSCR
6232 GOSUB 24: GOTO 6200
6234 GOTO 6205
6240 CLS : PRINT "BID PRICE:": REM BID PRICE SECTION
6242 IF E(1) <=0 THEN E(1)=1
6243 IF E(2) <=0 THEN E(2)=1
6244 IF E(3) <=0 THEN E(3)=1
6250 PRINT " ACRES IN LAND PURCHASE..=";E(1)
6260 PRINT " TOTAL ACRES IN FARM.....=";E(2)
6270 PRINT " MORTGAGE RATE (%).......=";E(3)
6280 PRINT " MORTGAGE TERM YRS.......=";E(4)
6290 PRINT " CASH DOWN PAYMENT<$/AC>.=";E(5)
6300 S1=1
6310 FOR I=1 TO 5
6320 S6$= STR$(E(I)):S1=S1+1:S2=29:S3=1:S4=0.1:S5=10000:S9=8
6322 IF I=3 THEN S5=100:S9=5
6323 IF I=4 THEN S4=0:S5=100:S9=5
6324 IF I=5 THEN S4=0:S5=99999999#:S9=11
6330 GOSUB 9:E(I)=S
6340 NEXT I
6345 B(3)=E(2)
6350 GOSUB 7400
6360 GOSUB 7500
6390 PRINT : PRINT " TOTAL CASH"
6400 PRINT "BID PRICE =-----------*CAP. FACTOR"
6410 PRINT " ACRES "
6420 PRINT : PRINT " "B2
6430 PRINT "SUBSID- =----------* " INT(C1*1000+0.5)/1000"= "BS
6440 PRINT " "E(1)
6450 PRINT " +"E(5)"= "E(5)+BS
6460 PRINT TAB( 28)"========"
6470 PRINT : PRINT " "B2
6480 PRINT "NON-SUBSID.=---------*" INT(C1*1000+0.5)/1000"= "NB
6490 PRINT " "E(2)
6500 PRINT " +"E(5)"= "E(5)+NB
6510 PRINT TAB( 28)"========"
6520 PRINT "CHANGE DATA Y/N MENU M OR PRINT P?";
6525 S6$="":S1=23:S2=36:S3=2:S9=1: GOSUB 9
6530 IF S$="Y" GOTO 6240
6535 IF S$="N" GOTO 6557
6540 IF S$="M" GOTO 6610
6545 IF S$ <> "P" GOTO 6525
6550 S2=1: GOSUB 24: PRINT SPC( 37): CALL PRTSCR
6555 GOSUB 24: GOTO 6520
6557 GOTO 6610
6560 END
6610 REM **THE MENU **
6620 CLS : PRINT
6630 PRINT " ENTER: FOR:
6640 PRINT " 1 > RETURN TO LAND"
6650 PRINT " 2 > PRODUCTIVE VALUE"
6660 PRINT " 3 > ECONOMIC VALUE"
6670 PRINT " 4 > CASH FLOW AVAILABLE"
6680 PRINT " 5 > BID PRICE:"
6690 PRINT " 6 > TO QUIT"
6700 PRINT " WHICH SECTION?";
6710 S6$=" ":S1=9:S2=18:S3=1:S4=1:S5=6:S9=2: GOSUB 9
6720 IF S=1 THEN RESTORE : GOTO 5160
6730 IF S=2 THEN 5370
6740 IF S=3 THEN 5630
6750 IF S=4 THEN RESTORE : GOTO 5960
6760 IF S=5 THEN 6240
6770 IF S=6 GOTO 100
6780 GOTO 6710
6810 CLS : PRINT : PRINT " LAND PURCHASE DECISIONS"
6815 PRINT : PRINT " <LAST REVISED FEB 8,1983>"
6817 PRINT : PRINT : PRINT
6820 PRINT "THIS PROGRAM IS DESIGNED TO BE USED WITH"
6822 PRINT "THE MANUAL 'LAND PURCHASE DECISION`"
6825 PRINT "PACKAGE OF THE FARM BUSINESS MANAGEMENT"
6830 PRINT "BRANCH, ALBERTA AGRICULTURE"
6840 PRINT
6850 PRINT "FOR FURTHER INFORMATION ON THE PROGRAMM-"
6855 PRINT "ING OF THIS MODEL CONTACT:"
6860 PRINT : PRINT "ALBERTA AGRICULTURE"
6870 PRINT "FARM BUSINESS MANAGEMENT BRANCH"
6880 PRINT "BOX 2000"
6890 PRINT "OLDS,ALTA. PH:556-4240"
6910 GOSUB 300
6920 RETURN
6930 CLS : PRINT " THE PROGRAM IS DIVIDED INTO FIVE"
6935 PRINT " SECTIONS AS FOLLOWS:"
6940 PRINT : PRINT " LAND'S VALUE AS AN INVESTMENT:"
6950 PRINT " 1. RETURN TO LAND"
6960 PRINT " 2. PRODUCTIVE VALUE OF LAND"
6970 PRINT " 3. ECONOMIC VALUE OF LAND"
6980 PRINT " BID PRICE BASED ON ABILITY TO PAY:"
6990 PRINT " 4. CASH AVAILABLE FOR DEBT SERVICING"
7000 PRINT " 5.- OWNED LAND SUBSIDIZES NEW LAND"
7010 PRINT " -NEW LAND PAYS FOR ITSELF"
7020 PRINT : PRINT "** USE THE FOLLOWING CODES FOR ACCESSING THE APPROPRIATE SECTIONS:**"
7021 PRINT : PRINT " ENTER: FOR:
7022 PRINT " 1 > RETURN TO LAND"
7023 PRINT " 2 > PRODUCTIVE VALUE"
7024 PRINT " 3 > ECONOMIC VALUE"
7025 PRINT " 4 > CASH FLOW AVAILABLE"
7026 PRINT " 5 > BID PRICE:"
7027 PRINT " 6 > TO QUIT"
7030 GOSUB 300
7040 RETURN
7100 REM **CALCS FOR RETURN TO LAND**
7105 A1=0
7110 FOR I=2 TO 15:A1=A1+A(I): NEXT I
7120 A2=A(1)-A1
7130 RETURN
7200 REM **CALCS FOR PROD VALUE**
7210 CF=(1-(1/(1+(B(1)/100))^B(2)))/(B(1)/100)
7215 IF B(3) <=0 THEN B(3)=1
7220 PV=(A2/B(3))*CF
7230 CF= INT(CF*1000+0.5)/1000:PV= INT(PV*100+0.5)/100
7240 RETURN
7300 REM **CALCS FOR ECONOMIC VALUE**
7310 PS=C(1)*(1+C(2)/100)^C(3)
7320 BT=PS-C(1)
7330 XT=BT-((BT/2)*C(4)/100)
7340 CG=XT*((1/(1+C(5)/100)^C(3)))
7350 BP=(BT*C(7)/100)*(C(6)/100)*(1/(1+C(5)/100)^C(3))
7360 EV=PV+CG+BP
7370 CG=INT(CG*100+0.5)/100:BP=INT(BP*100+0.5)/100:EV=INT(EV*100+0.5)/100
7380 RETURN
7400 REM **CALCS FOR CASHFLOW**
7410 B1=0
7420 FOR I=2 TO 17:B1=B1+D(I): NEXT I
7430 B2=D(1)-B1
7440 RETURN
7500 REM **CALCS FOR BID PRICES**
7510 C1=((1-(1/(1+E(3)/100)^E(4)))*(1/(E(3)/100)))
7520 BS=INT((B2/E(1))*C1*100+0.5)/100
7530 NB=INT((B2/E(2))*C1*100+0.5)/100
7540 RETURN
8000 DATA "GROSS RECEIPTS........","FUEL & LUB.",REPAIRS,"HIRED LABOUR"
8010 DATA MATERIALS,UTILITIES,INSURANCE,"LAND TAXES","INT. ON OPERATING CAP."
8020 DATA "RENT(INCL. LAND)",OTHER,DEPRECIATION,"INT. ON CAP. INVESTMENT"
8030 DATA "OPERATOR LABOUR & MGNT.","INCOME TAX PAYABLE"
60000 REM this is the logo routine
60010 DEF SEG=0:IF (PEEK(&H410) AND &H30)=&H30 GOTO 60550
60020 S=3.141593
60030 KEY OFF
60040 SCREEN 1
60050 COLOR 0,1
60060 CLS
60070 LINE(0,0)-(319,199),3,B
60080 LINE(5,5)-(314,194),3,B
60090 PAINT(1,1),1,3
60100 DRAW"c3;bm40,100;e60;d60;l5;h15;e4;f10;u40;g50;l5;"
60110 PAINT(43,99),1,3
60120 DRAW"C3;bm110,30;d70;L5;U70;R5;"
60130 PAINT(109,99),1,3
60140 DRAW"C3;bm120,40;d60;L5;U60;R5;"
60150 PAINT(119,99),1,3
60160 CIRCLE(135,83),20,3,1.25*S,0.75*S
60170 CIRCLE(135,83),15,3,1.25*S,0.9*S
60180 DRAW"bm119,96;e5;"
60190 PAINT(135,98),1,3
60200 CIRCLE(170,83),20,3,0.2*S,1.85*S
60210 CIRCLE(170,83),15,3,0.25*S,1.8*S
60220 DRAW"C3;BM182,90;R5;"
60230 DRAW"C3;BM187,75;G10;H3;E7;"
60240 PAINT(170,99),1,3
60250 PAINT(170,67),1,3
60260 DRAW"c3;bm195,100;l5;u34;r5;d34;"
60270 CIRCLE(210,83),20,3,0.55*S,0.76*S
60280 CIRCLE(210,83),15,3,0.59*S,0.8799999*S
60290 DRAW"bm207,66;d5;"
60300 PAINT(194,99),1,3
60310 PAINT(206,69),1,3
60320 DRAW"c3;bm217,100;l5;u40;r5;d5;r7;d5;l7;d30;"
60330 PAINT(216,97),1,3
60340 DRAW"C3;bm265,65;d35;L5;U35;R5;"
60350 CIRCLE(245,83),20,3,0.25*S,1.75*S
60360 CIRCLE(245,83),15,3,0.09999999*S,1.7*S
60370 DRAW"bm261,99;h6;"
60380 PAINT(245,98),1,3
60390 PAINT(264,69),1,3
60400 LOCATE 14,22
60410 PRINT"AGRICULTURE"
60420 LOCATE 18,4
60430 PRINT"FARM BUSINESS MANAGEMENT BRANCH"
60460 LOCATE 23,5
60470 PRINT"PROVIDED BY ALBERTA AGRICULTURE"
60480 LOCATE 24,3
60490 PRINT"RESPONSIBILITY RESTS WITH THE USER";
60500 FOR S=1 TO 4100
60510 POKE 106,0
60520 IF INKEY$<>"" GOTO 60540
60530 NEXT S
60540 ON ERROR GOTO 0 :SCREEN 0,0,0:RETURN
60550 REM **MONOCHROME LOGO**
60560 KEY OFF:WIDTH 80:CLS:S$=CHR$(219)
60570 PRINT STRING$(75,S$);
60580 FOR S=2 TO 23:LOCATE S,75:PRINT S$;:NEXT
60590 LOCATE 24,1:PRINT STRING$(75,S$);
60600 FOR S=23 TO 2 STEP -1:LOCATE S,1:PRINT S$;:NEXT
60610 '
60620 '
60630 LOCATE 5,28:PRINT "▌"
60640 LOCATE 6,24:PRINT"/▌ ▌ ▌"
60650 LOCATE 7,23:PRINT"/ ▌ ▌ ▌"
60660 LOCATE 8,22:PRINT"/ ▌ ▌ ▌ ▐"
60670 LOCATE 9,21:PRINT"/ ▌ ▌ ▌ __ __ ▐_ __"
60680 LOCATE 10,20:PRINT"/ ▌ ▌ ▌/ \ / \ ▐/ ▐ / \▌"
60690 LOCATE 11,19:PRINT"/ ▌ ▌ █ ▐ ▌ / ▐ ▐ ▌ ▌"
60700 LOCATE 12,18:PRINT"/ \ ▌ ▌ █ ▐ ▌ ▐ ▐ ▌ ▌"
60710 LOCATE 13,17:PRINT"/ \▌ ▌ ▌\__/ \__/ ▐ ▐ \__/▌"
60720 LOCATE 15,36:PRINT"A G R I C U L T U R E"
60730 LOCATE 18,22:PRINT"FARM BUSINESS MANAGEMENT BRANCH"
60740 LOCATE 21,22:PRINT"PROVIDED BY ALBERTA AGRICULTURE."
60750 LOCATE 22,19:PRINT"RESPONSIBILITY RESTS SOLELY WITH USER"
60760 FOR S=1 TO 1500
60770 S$=INKEY$
60780 IF S$=CHR$(13) GOTO 60800
60790 NEXT S
60800 S$=""
60810 ON ERROR GOTO 0
60820 RETURN
62000 REM THIS IS THE SCREEN PRINT LOADER ACTIVATE WITH 'CALL PRTSCR'
62010 DEF SEG=&H0
62020 POKE &HF1, &HCD
62030 POKE &HF2, &H5
62040 POKE &HF3, &HCB
62050 PRTSCR=&HF1
62060 RETURN
LOAN.BAS
1 REM ** LOAN CALCULATOR PROGRAM **
2 REM ** ORIGINALLY WRITTEN BY **
3 REM ** ROGER KEAY OF BC MINISTRY **
4 REM ** OF AGRICULTURE AND FOOD **
5 REM ** KAMLOOPS BC (604) 374-3614 **
6 REM ** ADAPTED TO ADA STANDARDS **
7 REM ** REVISED AUGUST 24, 1984 **
8 GOTO 5000
9 S$="":REM THIS IS THE INPUT SUBROUTINE
10 GOSUB 24:PRINT SPACE$(LEN(S$));
11 S8=0:GOSUB 24
12 GOSUB 31
13 GOSUB 35
14 GOSUB 53
15 IF S$="" THEN S$=S6$:GOTO 22
16 IF S3=1 THEN GOSUB 56
17 IF S8=1 GOTO 10
18 IF S3=1 THEN GOSUB 68
19 IF S8=1 GOTO 10
20 IF S3=3 THEN GOSUB 73
21 IF S8=1 GOTO 10
22 IF S3=1 THEN S=VAL(S$)
23 RETURN
24 REM POSITION CURSOR
25 LOCATE S1,S2,1
30 RETURN
31 REM PRINT DEFAULT
32 PRINT S6$
33 GOSUB 24
34 RETURN
35 REM TRANSPARENT CURSOR ROUTINE
36 S$=""
37 S1$=INPUT$(1)
41 S=ASC(S1$):IF S<>13 GOTO 46
42 IF S$="" THEN GOSUB 24:PRINT " ";:GOSUB 24:GOSUB 31:PRINT:RETURN
43 IF LEN(S$)>=LEN(S6$) GOTO 45
44 PRINT SPACE$(LEN(S6$)-LEN(S$));
45 PRINT S1$;:RETURN
46 IF S<32 GOTO 50
47 IF S=34 THEN S1$="'"
48 S$=S$+S1$:IF S9>0 THEN IF LEN(S$)>S9 THEN PRINT S1$;:GOTO 52
49 PRINT S1$;:GOTO 37
50 IF LEN(S$)<1 GOTO 36
51 IF LEN(S$)=1 THEN PRINT CHR$(29);:PRINT" ";:PRINT CHR$(29);:GOTO 36
52 S$=LEFT$(S$,LEN(S$)-1):PRINT CHR$(29);:PRINT" ";:PRINT CHR$(29);:GOTO 37
53 REM THIS CHECKS FOR EXIT
54 IF S$="<" THEN 100
55 RETURN
56 S1$=S$:S7=0:REM CHECK FOR NUMERIC INPUT
57 IF LEFT$(S1$,1)=" " THEN S1$=RIGHT$(S1$,LEN(S1$)-1):GOTO 57
58 IF RIGHT$(S1$,1)=" " THEN S1$=LEFT$(S1$,LEN(S1$)-1):GOTO 58
59 IF LEN(S1$)<1 GOTO 64
60 FOR S=1 TO LEN(S1$):S6=ASC(MID$(S1$,S,1))
61 IF S6>=48 AND S6<=57 GOTO 66
62 IF (S6=43 OR S6=45) AND S=1 GOTO 66
63 IF S6=46 AND S7=0 THEN S7=1:GOTO 66
64 S2$="NON NUMERIC INPUT":S1$="":GOSUB 78
65 RETURN
66 NEXT S
67 RETURN
68 REM CHECK FOR PROPER LIMITS
69 S6=VAL(S$)
70 IF S6<S4 THEN S2$="INPUT BELOW":S1$=STR$(S4):GOSUB 78:RETURN
71 IF S6>S5 THEN S2$="INPUT ABOVE":S1$=STR$(S5):GOSUB 78:RETURN
72 RETURN
73 REM CHECK FOR YES OR NO
74 IF LEFT$(S$,1)="Y" OR LEFT$(S$,1)="N" GOTO 76
75 S2$="MUST BE YES/NO ANSWER":S1$="":GOSUB 78:RETURN
76 S$=LEFT$(S$,1)
77 RETURN
78 REM ERROR FOR ALL CONDITIONS
79 COLOR 31,0,0:BEEP
80 GOSUB 90
81 PRINT" ";S2$;S1$;
82 FOR S7=1 TO 3000:NEXT S7
83 COLOR 7,0,0
87 GOSUB 93
88 S8=1
89 RETURN
90 REM POSTITION TO LAST LINE
91 LOCATE 25,1,0
92 RETURN
93 REM BLANK LAST LINE
94 LOCATE 25,1,1
95 PRINT SPACE$(39);
96 RETURN
100 CLS:PRINT" LOADING MENU...":RUN "HELLO.BAS"
200 REM ****DOLLAR FORMAT SUBROUTINE****
201 S3=INT(S3*100+0.5)/100
202 S3$=SPACE$(30)
203 IF S3=0 THEN S3$=RIGHT$(S3$,S4-4)+"0.00":GOTO 209
204 S4$=STR$(S3)
205 IF ASC(MID$(RIGHT$(S4$,2),1,1))=46 THEN S3$=S3$+S4$+"0":GOTO 208
206 IF ASC(MID$(RIGHT$(S4$,3),1,1))=46 THEN S3$=S3$+S4$:GOTO 208
207 S3$=S3$+S4$+".00"
208 S3$=RIGHT$(S3$,S4)
209 RETURN
220 REM **** GENERAL NUMBER FORMATTER SUBROUTINE ****
221 S7=10^S5
222 IF S3=0 THEN S3$=RIGHT$(" 0",S4-S5-1)+LEFT$(".0000",S5+1):GOTO 229
223 S6=INT(S3*S7+0.5)/S7
224 S3$=STR$(S6+SGN(S6)*0.1/S7)
225 S6=LEN(S3$)
226 S3$=LEFT$(S3$,S6-1)
227 IF S6=S4+1 THEN 229
228 S3$=LEFT$(" ",S4+1-S6)+S3$
229 RETURN
300 REM HOLD SCREEN
301 S$="PRESS RETURN TO CONTINUE "
302 COLOR 31,0,0
303 GOSUB 90
304 PRINT" ";S$;
305 POKE 106,0
306 IF INKEY$=CHR$(13) GOTO 307 ELSE GOTO 305
307 COLOR 7,0,0
308 GOSUB 93
314 S$="":S1$=""
315 RETURN
5000 REM ** LOAN CALCULATOR PROGRAM **
5001 DEF SEG=0:POKE 1047,96:REM shift lock on cursor off
5002 DEFDBL A,B,C,I,P,R,T
5005 GOSUB 60000:GOSUB 62000
5080 CLS: GOSUB 8010: REM DATA FOR ARRAYS
5190 K = 0: ZZ=0: CLS: S1=3: S2=10 : GOSUB 24: PRINT "LOAN CALCULATOR"
5195 PRINT " AUGUST, 1984"
5200 PRINT : PRINT : PRINT "THIS PROGRAM WILL CALCULATE ANY ONE"
5210 PRINT " OF THE FOLLOWING": PRINT : PRINT
5215 REM PAINT SCREEN FOR SELECTION OF CALCULATION
5220 FOR X = 1 TO 4
5230 PRINT TAB( 5);:COLOR 0,7:PRINT X;:COLOR 7,0:PRINT " ";A$(X): PRINT
5240 NEXT X
5250 FOR X = 1 TO 6
5260 A(X) = 0
5270 NEXT X
5280 PRINT : PRINT
5290 PRINT "ENTER THE OPTION NO."
5300 S1 = 21: S2= 26: S3= 1: S4=1:S5=4:S9=1:S6$="4":GOSUB 9: A=S
5305 CLS:PRINT"IS THE LOAN AMORTIZED OR":PRINT"NON-AMORTIZED? (A/N) ":S1=2:S2=22:S3=2:S9=1:S6$="A":GOSUB 9:AM$=S$
5306 IF AM$<>"A" AND AM$<>"N" THEN 5305
5308 IF AM$="N" THEN S1=14:S2=1:GOSUB 24:COLOR 0,7:PRINT "NOTE: IN A NON-AMORTIZED LOAN, THE ":PRINT "COMPOUNDING PERIOD IS ASSUMED TO BE THE":PRINT "SAME AS THE NUMBER OF PAYMENTS PER YEAR":COLOR 7,0:GOSUB 300
5310 CLS : PRINT : PRINT "PLEASE ENTER THE FOLLOWING INFORMATION:": PRINT
5312 S3=1
5315 REM DATA ENTRY DEPENDING ON SELECTION FOR CALCULATION
5320 ON A GOTO 5330,5360,5390,5420
5330 PRINT A$(2);" = ": PRINT
5340 PRINT A$(3);" = ": PRINT
5350 PRINT A$(4);" = ": PRINT: GOTO 5450
5360 PRINT A$(1);" = ": PRINT
5370 PRINT A$(3);" = ": PRINT
5380 PRINT A$(4);" = ": PRINT : GOTO 5450
5390 PRINT A$(1);" = ": PRINT
5400 PRINT A$(2);" = ": PRINT
5410 PRINT A$(4);" = ": PRINT : GOTO 5450
5420 PRINT A$(1);" = ": PRINT
5430 PRINT A$(2);" = ": PRINT
5440 PRINT A$(3);" = ": PRINT
5450 PRINT A$(5);" = ": PRINT
5453 IF AM$="A" THEN PRINT A$(6);" =":GOTO 5457
5457 REM DATA ENTRY DEPENDING ON CALCULATION SELECTION
5458 ON A GOTO 5460,5490,5520,5550
5460 S1 = 4:S2=20:S4=0.08329999:S5=40:S9=5:S6$="5":GOSUB 9:A(2)=S
5470 S1 = 6:S4=1:S5=35:S9=6:S6$="14":GOSUB 9:A(3)=S
5480 S1 = 8:S5=1000000!:S9=9:S6$="232.68":GOSUB 9:A(4)=S:GOTO 5580
5490 S1 = 4:S2=20:S5=9000000#:S9=9:S6$="10000":GOSUB 9:A(1)=S
5500 S1 = 6:S5=35:S9=6:S6$="14":GOSUB 9:A(3)=S
5510 S1 = 8:S5=1000000!:S9=9:S6$="400":GOSUB 9:A(4)=S:GOTO 5580
5520 S1 = 4:S2=20:S5=9000000#:S9=9:S6$="10000":GOSUB 9:A(1)=S
5530 S1 = 6:S5=40:S9=5:S4=0.08329999:S6$="5":GOSUB 9:A(2)=S
5540 S1 = 8:S4=1:S5=1000000!:S9=8:S6$="232.68":GOSUB 9:A(4)=S:GOTO 5580
5550 S1 = 4:S2=20:S5=9000000#:S9=9:S6$="10000":GOSUB 9:A(1)=S
5560 S1 = 6:S4=0.08329999:S5=40:S9=5:S6$="5":GOSUB 9:A(2)=S
5570 S1 = 8:S4=1:S5=35:S9=6:S6$="14":GOSUB 9:A(3)=S
5580 S1 =10:S2=21:S5=26:S9=2:S6$="12":GOSUB 9:A(5)=S
5590 IF AM$="A" THEN S1 = 12:S2=38:S6$="2": GOSUB 9:A(6)=S:GOTO 5600
5595 A(6)=A(5)
5600 CLS : IF A(6) > A(5) THEN A(6) = A(5): REM MAKE SURE THE NO. OF COMPOUNDING PERIODS ARE NOT GREATER THAN THE NUMBER OF PAYMENTS
5605 REM PAINT SCREEN FOR CORRECTION OR CHANGE ROUTINE
5610 PRINT TAB( 6);"DO YOU WISH TO CHANGE ANY OF THE"
5615 PRINT" FOLLOWING?":PRINT
5616 IF AM$="N" THEN J=5:GOTO 5620
5618 J=6
5620 FOR X = 1 TO J
5625 TA=A(X):IF X=4 THEN TA=INT(TA*100)/100
5630 COLOR 0,7:PRINT X;:COLOR 7,0:PRINT"-";A$(X) TAB( 25);"= ";: IF A(X) = 0 THEN PRINT " CALCULATION": PRINT:GOTO 5650
5640 PRINT TA: PRINT
5650 NEXT X
5660 X=0:COLOR 0,7:PRINT X;:COLOR 7,0:PRINT"-PROCEED WITH CALCULATION": PRINT
5670 S1=20: S2=1:GOSUB 24: PRINT "TO CHANGE A VALUE, ENTER ITS LINE":PRINT"NUMBER. ENTER 0 TO PROCEED"
5675 GOSUB 9100: REM CHECK FOR THE NUMBER OF CALCULATIONS REQUESTED
5676 IF AM$="N" THEN S5=5:GOTO 5680
5678 S5=6
5680 S1=21:S2=30:S3=1:S4=0:S9=1:S6$="0":GOSUB 9:S1=20:S2=1:GOSUB 24:PRINT SPACE$(39);:S1=21:GOSUB 24:PRINT SPACE$(39);:X=S:IF X=0 THEN GOTO 5800
5682 REM INPUT FOR CORRECTION OR CHANGE ROUTINE
5685 S2=27
5690 ON X GOTO 5700,5710,5720,5730,5740,5750
5700 S1=4:S5=9000000#:S9=9: GOSUB 9030:S6$=STR$(A(1)):GOSUB 9:A(1)=S:GOSUB 9000:GOTO 5670
5710 S1=6:S5=35:S9=5: GOSUB 9030:S6$=STR$(A(2)):GOSUB 9:A(2)=S:GOSUB 9000:GOTO 5670
5720 S1=8:S5=35:S9=6: GOSUB 9030:S6$=STR$(A(3)):GOSUB 9:A(3)=S:GOSUB 9000:GOTO 5670
5730 S1=10:S5=9000000!:S9=9: GOSUB 9030:S6$=STR$(INT(A(4)*100+0.5)/100):GOSUB 9:A(4)=S:GOSUB 9000:GOTO 5670
5740 S1=12: S2=27: S3=1: S4=1: S5=26: S9=2: S6$=STR$(A(5)):GOSUB 9:A(5)=S:IF A(6) > A(5) AND AM$="A" THEN A(6)=A(5):GOTO 5750
5745 GOTO 5670
5750 S1=15: S2=27: S3=1: S4=1: S5=26: S9=2: S6$=STR$(A(6)):GOSUB 9:A(6)=S
5755 GOTO 5670
5760 A(6)=A(5)
5800 IF Z>1 THEN S2$="ONLY ONE CALCULATION":S1$="":GOSUB 78: GOTO 5670: REM ERROR MESSAGE FOR MORE THAN ONE CALCULATION
5801 IF AM$="N" THEN A(6)=A(5)
5803 REM INPUT ARRAYS CHANGED TO VARIABLES TO SIMPLIFY FORMULAS
5805 P = A(1):Y = A(2):I = A(3):R = INT (A(4) * 100 + 0.5) / 100:N = A(5):C=A(6)
5810 T = INT ((N * Y) + 0.9):Y = T / N
5820 IF I = 0 THEN 5850
5830 I = I / 100
5835 REM INTEREST RATE CHANGED TO EFFECTIVE INTEREST RATE IF MORE THAN ONE PAYMENT PER YEAR
5840 IF N > 1 THEN I = ((1 + I / C) ^ (1 / (N / C)) - 1) * N
5850 IF R = 0 THEN Z = 1
5860 IF P = 0 THEN Z = 2
5870 IF Y = 0 THEN Z = 3
5880 IF I = 0 THEN Z = 4
5890 K = 1:IF AM$="A" THEN GOTO 5900
5895 IF Z=1 THEN RP=P/T:SM=0:FOR J=1 TO (T-1):SM=SM+J:NEXT J
5900 ON Z GOTO 5907,5937,5970,5995
5905 REM CALCULATION OF PAYMENT
5907 IF AM$="N" THEN R=P/T+P*I/N:GOTO 5920
5910 R = (I * P / N) / (1 - 1 / (I / N + 1) ^ (N * Y)):R = INT (R * 100 +0.5)/100:
5920 GOSUB 9050: PRINT " ";A$(4);" =$ ";:PRINT USING "########.##";R
5930 GOTO 6150
5935 REM CALCULATION OF AMOUNT BORROWED
5937 IF AM$="N" THEN P=R/(1/T+I/N):PRINT:GOTO 5950
5940 P = R * N * (1 - 1 / (I / N + 1) ^ (N * Y)) / I: PRINT
5950 GOSUB 9050:PRINT " PRINCIPAL= $ ";:PRINT INT(P*100+0.5)/100
5960 GOTO 6150
5965 REM CALCULATION OF TERM
5970 IF ((P*I)/(N*R))=>1 THEN GOSUB 9300: GOTO 5600: REM ERROR MESSAGE IF PAYMENT ENTERED WILL NOT COVER INTEREST AND PRINCIPAL
5972 IF AM$="N" THEN Y=1/((R-I/N*P)/P)/N:IF (INT(Y)+1-Y)<(1/12) THEN Y=INT(Y)+1:TF=1
5973 IF AM$="N" THEN GOTO 5980
5975 Y = - ( LOG (1 - (P * I) / (N * R)) / ( LOG (1 + I / N) * N))
5977 IF (Y-INT(Y))>=0.95 THEN Y=INT(Y)+1
5980 GOSUB 9050: PRINT " TERM IS "; INT (Y);" YEAR(S), "; INT ((Y -INT (Y))*12+0.5);" MONTH(S)"
5990 GOTO 6150
5995 REM CALCULATES INTEREST RATE
5996 IF R*N*Y<P THEN GOSUB 9300:GOTO 5600
5997 IF AM$="N" THEN I=(R-P/T)/P*N:GOTO 6130
6000 I = 1
6010 I2 = 0
6020 R1 = (I * P / N) / (1 - 1 / (I / N + 1) ^ (N * Y))
6030 R1 = INT (R1 * 10000 + 0.5) / 10000
6040 I3 = ABS (I - I2) / 2
6050 I2 = I
6060 IF R1 = R THEN 6120
6070 IF R1 > R THEN 6100
6080 I = I + I3
6090 GOTO 6020
6100 I = I - I3
6110 GOTO 6020
6120 I = I
6130 GOSUB 9050: PRINT " INTEREST RATE(%) = ";
6140 PRINT INT(C * ((I/N+1)^(N / C) - 1) * 10000 + 0.5) / 100
6150 GOSUB 300:IF AM$="A" THEN GOTO 6160
6153 IF TF=1 THEN RP=R-(P*I)/N:GOTO 6160
6157 RP=P/Y/N
6160 GOTO 9400: REM OPTIONS MENU
6170 REM *** PAINT SCREEN FOR PAYMENT SCHEDULES ***
6171 IF A=2 THEN CLS:GOTO 6174
6173 CLS: PRINT " LOAN REPAYMENT SCHEDULE"
6174 IF N=<12 GOTO 6180
6175 S1=4: S2=1: GOSUB 24: PRINT "ENTER THE NUMBER OF PAYMENTS LEFT IN"
6176 S1=5:PRINT"THE YEAR : ":GOTO 6190
6180 S1=5:S2=1:GOSUB 24: PRINT "WHEN DO PAYMENTS START? (MONTH (1-12)"
6190 S1=6: S2=18: GOSUB 24: PRINT "YEAR (I.E. 1984)? "
6200 PRINT : PRINT "DO YOU WANT A HARD COPY?"
6202 IF A=2 THEN GOTO 6206
6205 IF Y * N > 60 THEN PRINT : PRINT "DO YOU WISH TO HAVE THE COMPLETE":PRINT "SCHEDULE FOR "INT(Y*N)" PAYMENTS "
6206 REM *** INPUT FOR PAYMENT SCHEDULE ***
6207 IF N=<12 GOTO 6213
6209 S1=5: S2=13: S3=1: S4=1: S5=26: S9=2: S6$=STR$(N): GOSUB 9: PL=S
6211 D=12-(12*PL/N)+12/N: GOTO 6215
6213 S1=5: S2=39: S3=1: S4=1: S5=12: S9=2: S6$="1": GOSUB 9: D=S
6215 S1=6: S2=36: S4=1: S5=2000: S9=4: S6$="1984": GOSUB 9: YY=S:TY=S
6220 S1=8: S2=26: S3=3: S9=1: S6$="N": GOSUB 9: C$=S$
6222 IF A=2 THEN GOTO 6230
6225 IF Y * N > 60 THEN S1=11: S2=34:GOSUB 9: M$=S$
6230 S1=13: S2=10:GOSUB 24: PRINT"ANY CHANGES "
6232 S2=23: S3=3: S6$="N": GOSUB 9: A$=S$: IF A$="Y" GOTO 6207
6240 S1=15: S2=8: GOSUB 24: COLOR 31,0,0:PRINT "BE WITH YOU IN A MINUTE":COLOR 7,0,0
6250 REM *** CALCULATION ***
6260 BO = P:IT = 0:PT = 0:F = 1:E=0:FOR J=1 TO Y:AP(J)=0:AI(J)=0:NEXT J:L=INT(N*Y)
6265 REM 6290 MAKES THE FINAL PAYMENT EQUAL TO THE BALANCE OUTSTANDING
6267 IF AM$="N" THEN GOSUB 9600:GOTO 6330:REM CALCULATION FOR NON-AMORTIZED
6270 FOR J = 1 TO L
6280 I(J,1) = INT ((BO * I / N) * 100 + 0.5) / 100
6290 IF J = L THEN I(J,2) = BO:GOTO 6310
6300 I(J,2) = R - I(J,1)
6310 I(J,3) = BO - I(J,2):IF I(J,3)<0 THEN I(J,3)=0
6315 BO=I(J,3)
6320 NEXT J
6330 IF A=1 THEN CLS
6335 IF C$="Y" THEN 7000: REM TO PRINTER ROUTINE
6338 REM *** SCREEN OUTPUT ***
6339 IF A=2 THEN GOTO 6447
6340 S1=3:S2=5:GOSUB 24: IF AM$="A" THEN PRINT "LOAN AMORTIZATION SCHEDULE":GOTO 6360
6350 PRINT "NON-AMORTIZED LOAN SCHEDULE"
6360 PRINT "AMOUNT BORROWED =$"; INT (P * 100 + 0.5) / 100
6363 IF AM$="A" THEN 6368
6365 PRINT "FIRST PAYMENT =$";:GOTO 6370
6368 PRINT "REGULAR PAYMENT =$";
6370 PRINT USING "#######.##";R
6380 PRINT "TERM = "; INT (Y);" YEARS, ";
6390 PRINT INT((Y -INT(Y)+0.5) * 12);" MONTHS"
6400 PRINT "INTEREST RATE(%)="; INT (C * ((I / N + 1) ^ (N / C) - 1)*10000+0.5)/100
6410 PRINT "PAYMENTS / YEAR =";N
6420 PRINT "INTEREST COMPOUNDED ";C;" TIMES PER YEAR"
6425 GOSUB 300
6430 CLS: PRINT " YEAR"
6432 PRINT "PMT ";:COLOR 0,7:PRINT YY;:COLOR 7,0
6434 IF AM$="A" THEN GOTO 6440
6436 PRINT " INTEREST PERIOD CLOSING"
6438 PRINT " NO. DATE PMT BALANCE":GOTO 6444
6440 PRINT " INTEREST PRINCIPAL"
6442 PRINT " NO. DATE DUE OUTSTANDING"
6444 PRINT "---------------------------------------"
6445 IF E=1 THEN RETURN
6447 LC=0:YC=1
6450 FOR J = 1 TO L
6460 IF A=2 THEN GOTO 6530
6470 PRINT USING "###";J;
6480 IF N > 12 THEN PRINT " ";: GOTO 6500
6490 PRINT " "; MO$(D);
6500 PRINT USING " ########.##";I(J,1);
6510 PRINT USING " ########.##";I(J,2);
6520 PRINT USING " #######";I(J,3)
6525 LC=LC+1
6530 AI(YC)= AI(YC) + I(J,1):AP(YC) = AP(YC) + I(J,2):IT = IT + I(J,1):PT = PT + I(J,2)
6540 D = D + (12 / N)
6542 IF A=1 THEN GOTO 6550
6544 IF D>12 OR J=L THEN YC=YC+1
6546 IF J=L THEN GOTO 6660
6548 IF D>12 THEN D=D-12:YY=YY+1
6549 GOTO 6640
6550 IF D>12 OR J=L THEN S1=19:S2=1:GOSUB 24:PRINT "TOTAL";:PRINT USING " ########.##";AI(YC);:PRINT USING " ########.##";AP(YC): YC=YC+1
6555 IF (D>12 OR J=L) AND AM$="N" THEN S1=21:S2=1:GOSUB 24:PRINT "PRINCIPAL PMT PER PERIOD = $ ";:COLOR 0,7:PRINT USING "#######.##";RP:COLOR 7,0
6560 IF J=L THEN GOSUB 300:GOTO 6660
6590 IF M$="Y" THEN 6620
6600 IF J = 60 AND L>60 THEN GOSUB 300:GOTO 9400: REM QUIT AFTER 60 PAYMENTS
6620 IF D>12 AND J<L THEN S1=23:S2=1:GOSUB 24:PRINT"CONTINUE WITH SCHEDULE? (Y/N)";:S2=33:S3=3:S6$="Y":S9=1:GOSUB 9:IF S$="N" THEN GOTO 9400
6625 IF D>12 THEN D=D-12:YY=YY+1:LC=0:F=1:E=1:GOSUB 6430:GOTO 6640
6630 IF LC>11 AND J<L THEN LC=0:GOSUB 300:E=1:GOSUB 6430:E=0
6640 NEXT J
6660 CLS:REM YEARLY SUMMARY
6662 TP=P:YY=TY
6665 FOR J=1 TO YC-1
6667 IF J=1 THEN GOSUB 9700:GOTO 6680
6670 IF (J-1)/12=INT((J-1)/12) THEN GOSUB 300:GOSUB 9700:REM HEADING FOR REPORT
6680 PRINT YY+J-1;:PRINT USING " ########.##";AI(J);:PRINT USING " ########.##";AP(J);
6685 IF AM$="A" THEN TP=TP-AP(J):GOTO 6695
6690 TP=TP-(AP(J)-AI(J))
6695 IF TP<0 THEN TP=0
6696 PRINT USING " #######";INT(TP)
6700 NEXT J
6705 S1=20:S2=1:GOSUB 24:PRINT "TOTAL";:PRINT USING " ########.##";IT;:PRINT USING " ########.##";PT
6740 E = 1: GOSUB 6750:E = 0: GOTO 9400
6750 GOSUB 300:IF E=1 THEN RETURN
7000 REM *** PRINTER ROUTINE ***
7010 REM *** PRINTER ROUTINE ***
7020 REM *** PRINTER ROUTINE ***
7025 IF A=2 THEN GOTO 7107
7030 LPRINT:LPRINT:LPRINT:IF AM$="A" THEN LPRINT TAB(27) "LOAN AMORTIZATION SCHEDULE":GOTO 7040
7035 LPRINT TAB(27) "NON-AMORTIZED LOAN SCHEDULE"
7040 LPRINT:LPRINT TAB(5) "AMOUNT BORROWED ";:LPRINT USING " #######.##";P;:
7050 IF AM$="A" THEN LPRINT SPACE$(10) "REGULAR PAYMENT ";:GOTO 7057
7053 LPRINT SPACE$(10) "FIRST PAYMENT ";
7057 LPRINT USING " #######.##";R
7060 LPRINT SPACE$(4) "TERM ";:LPRINT USING "##";INT(Y);:LPRINT" YEARS, ";:LPRINT USING "##";INT((Y-INT(Y))*12+0.5);:LPRINT" MONTHS";
7070 LPRINT SPACE$(10) "INTEREST RATE % ";:LPRINT USING "##.##";C*((I/N+1)^(N/C)-1)*100
7080 LPRINT SPACE$(4) "PAYMENTS PER YEAR ";:LPRINT USING "##";N;:LPRINT SPACE$(13) "INTEREST COMPOUNDED ";:LPRINT USING "##";C;:LPRINT " TIMES PER YEAR"
7081 IF A=2 THEN GOTO 7107
7083 LPRINT:LPRINT:LPRINT
7085 LPRINT TAB(5) "PMT DATE OPENING PERIOD INTEREST PRINCIPAL CLOSING"
7090 LPRINT TAB(5) " BALANCE PAYMENT PAYMENT PAYMENT BALANCE"
7100 LPRINT TAB(5) "--- ---- ------- ----------- ----------- ----------- ---------"
7105 IF E=1 THEN RETURN
7107 YC=1
7110 FOR J = 1 TO L
7115 AI(YC) = AI(YC) + I(J,1):AP(YC) = AP(YC) + I(J,2):IT = IT + I(J,1):PT = PT + I(J,2)
7116 IF A=1 THEN GOTO 7120
7117 D=D+(12/N):IF (D>12 AND N>1) OR J=L THEN YC=YC+1
7119 GOTO 7260
7120 IF F = 1 THEN LPRINT " YEAR";YY:F = 0
7130 LPRINT SPACE$ (4);:LPRINT USING " ###";J;
7140 IF N > 12 THEN LPRINT SPACE$(5);:GOTO 7151
7150 LPRINT " "; MO$(D);
7151 IF J=1 THEN LPRINT USING " #######.##";P;:GOTO 7153
7152 LPRINT USING " #######.##";I(J-1,3);
7153 IF AM$="A" THEN GOTO 7160
7154 LPRINT USING " ########.##";I(J,2);
7155 LPRINT USING " ########.##";I(J,1);
7156 LPRINT USING " ########.##";I(J,2)-I(J,1);
7157 GOTO 7200
7160 LPRINT USING " ########.##";I(J,1)+I(J,2);
7170 LPRINT USING " ########.##";I(J,1);
7180 LPRINT USING " ########.##";I(J,2);
7200 LPRINT USING " #######.##";I(J,3)
7210 D = D + (12 / N)
7215 IF (D<=12 OR N<=1) AND J<>L THEN 7230
7220 LPRINT: LPRINT SPACE$(4) "TOTAL YEAR";:IF AM$="A" THEN LPRINT TAB(42);:LPRINT USING " ########.##";AI(YC);:LPRINT USING " ########.##";AP(YC):GOTO 7228
7225 LPRINT TAB(28);:LPRINT USING " ########.##";AP(YC);:LPRINT USING " ########.##";AI(YC)
7228 LPRINT:LPRINT:LPRINT:YC=YC+1
7230 IF M$="Y" THEN 7260
7240 IF J=60 THEN LPRINT CHR$(12) CHR$(12):GOTO 9400
7260 IF D > 12 THEN D = D - 12:YY = YY + 1: F=1
7270 NEXT J
7290 GOSUB 9800 REM YEARLY SUMMARY
7325 LPRINT CHR$(12)
7330 GOTO 9400
8000 REM DATA FOR ARRAYS
8010 DIM MO$(12),I(650,3),A$(6),A(6)
8020 FOR D = 1 TO 12
8030 READ MO$(D)
8040 NEXT D
8050 DATA JAN,FEB,MAR,APR,MAY,JUN,JUL,AUG,SEP,OCT,NOV,DEC
8060 FOR X = 1 TO 6
8070 READ A$(X)
8080 NEXT X
8090 DATA AMOUNT BORROWED, TERM IN YEARS,INTEREST RATE, LOAN PAYMENT
8100 DATA PAYMENTS PER YEAR,TIMES INTEREST COMPOUNDED PER YEAR
8105 DIM AI(40):DIM AP(40)
8110 RETURN
9000 REM CHECK FOR CALCULATION
9010 IF S=0 THEN GOSUB 24: PRINT "CALCULATION"
9020 RETURN
9030 REM ERASE "CALCULATION"
9040 GOSUB 24: PRINT SPACE$(12):RETURN
9050 REM CLEAR LINE AND LOCATE CURSOR FOR OUTPUT
9060 LOCATE 20,5,1:PRINT SPACE$(34)
9070 RETURN
9100 REM ** CHECK FOR THE NUMBER OF CALCULATIONS **
9110 Z=0
9120 FOR X=1 TO 4
9130 IF A(X)=0 THEN Z=Z+1
9140 NEXT X
9150 IF Z=1 THEN S1=25:S2=1:GOSUB 24:PRINT SPACE$(39);:GOTO 9190
9160 IF Z=0 THEN S1$="ENTER A 0 IN LINE 1 OR 2 OR 3 OR 4":S2$="":GOTO 9180
9170 S2$="":S1$="ONLY ONE CALCULATION"
9180 GOSUB 78
9190 RETURN
9300 REM ERROR MESSAGE FOR ATTEMPTED CALCULATION OF TERM OF LOAN
9310 S1=21:S2=1:GOSUB 24:COLOR 31,0,0
9320 PRINT"PAYMENTS ARE INSUFFICIENT TO RETIRE THE"
9330 PRINT"PRINCIPAL. CALCULATION IS NOT POSSIBLE.":COLOR 7,0
9340 GOSUB 300: RETURN
9399 REM *** OPTION MENU ***
9400 CLS :LOCATE 5 : PRINT "CHOOSE AN OPTION:": PRINT
9405 TF=0:FOR J=1 TO 40:AI(J)=0:AP(J)=0:NEXT J
9410 PRINT TAB( 5);:COLOR 0,7:PRINT"1";:COLOR 7,0:PRINT" A PAYMENT SCHEDULE": PRINT
9415 PRINT TAB( 5);:COLOR 0,7:PRINT"2";:COLOR 7,0:PRINT" A YEARLY SUMMARY": PRINT
9420 PRINT TAB( 5);:COLOR 0,7:PRINT"3";:COLOR 7,0:PRINT" START AGAIN": PRINT
9430 PRINT TAB( 5);:COLOR 0,7:PRINT"4";:COLOR 7,0:PRINT" MODIFY EXISTING DATA": PRINT
9440 PRINT TAB( 5);:COLOR 0,7:PRINT"5";:COLOR 7,0:PRINT" QUIT": PRINT
9450 S1=22: S2=1: GOSUB 24 : PRINT "ENTER OPTION NO.":S2=18:S3=1:S4=1:S5=5:S9=1:S6$="1":GOSUB 9:A=S
9460 ON A GOTO 6170,6170,5190,9470,9530
9470 REM INSTRUCTIONS ON CHANGES
9480 IF ZZ=1 GOTO 9520
9490 CLS: S1=5: S2=1: GOSUB 24: PRINT "ANY OF THE FIRST FOUR ITEMS CAN BE"
9495 PRINT"CALCULATED BY ENTERING A '0' (ZERO)"
9500 PRINT:PRINT:PRINT "IF YOU DO CHANGE THE ITEM TO BE"
9505 PRINT "CALCULATED BE SURE TO MAKE AN ENTRY":PRINT"FOR THE PREVIOUS CALCULATION"
9510 GOSUB 300
9520 ZZ=1: GOTO 5600
9530 GOTO 100
9600 REM CALCULATION FOR NON-AMORTIZED LOANS
9610 FOR J=1 TO L
9620 I(J,1)=INT(BO*I/N*100+0.5)/100
9625 IF J=L THEN I(J,2)=BO+I(J,1):I(J,3)=0:GOTO 9645
9630 I(J,2)=RP+I(J,1)
9640 I(J,3)=BO-RP:IF I(J,3)<0 THEN I(J,3)=0
9645 BO=I(J,3)
9650 NEXT J
9660 RETURN
9700 REM TITLE FOR YEARLY SUMMARY REPORT
9710 CLS:PRINT " *** YEARLY SUMMARY ***"
9720 IF AM$="N" THEN 9740
9730 PRINT "YEAR INTEREST PRINCIPAL CLOSING":GOTO 9750
9740 PRINT "YEAR INTEREST PERIOD CLOSING"
9750 PRINT " PMT PMT BALANCE"
9760 PRINT "---------------------------------------"
9770 RETURN
9800 REM *** PRINTOUT FOR YEARLY SUMMARY ***
9802 CLS:LPRINT:LPRINT:LPRINT:LPRINT:LPRINT TAB(22);"*** YEARLY SUMMARY ***"
9804 LPRINT:LPRINT:LPRINT
9805 LPRINT TAB(5) " DATE OPENING PERIOD INTEREST PRINCIPAL CLOSING"
9806 LPRINT TAB(5) " BALANCE PAYMENT PAYMENT PAYMENT BALANCE"
9807 LPRINT TAB(5) " ---- ---------- ----------- ----------- ----------- -----------"
9810 TP=P:YY=TY
9830 FOR J=1 TO YC-1
9840 LPRINT USING " ####";YY+J-1;:LPRINT USING " #######.##";TP;:IF AM$="A" THEN GOTO 9855
9850 LPRINT USING " ########.##";AP(J);:LPRINT USING " ########.##";AI(J);:LPRINT USING " ########.##";AP(J)-AI(J);:TP=TP-(AP(J)-AI(J)):GOTO 9860
9855 LPRINT USING " ########.##";AI(J)+AP(J);:LPRINT USING " ########.##";AI(J);:LPRINT USING " ########.##";AP(J);:TP=TP-AP(J)
9860 IF TP<0 THEN TP=0
9865 LPRINT USING " #######.##";TP
9870 NEXT J
9875 LPRINT:LPRINT:LPRINT TAB(10);"TOTAL";:IF AM$="A" THEN LPRINT TAB(43);:LPRINT USING "########.##";IT;:LPRINT USING " ########.##";PT;:GOTO 9877
9876 LPRINT TAB(43);:LPRINT USING "########.##";PT;:LPRINT USING " ########.##";IT
9877 LPRINT:LPRINT:LPRINT:LPRINT TAB(22);"*** END OF REPORT ***"
9880 RETURN
60000 REM this is the logo routine
60010 DEF SEG=0:IF (PEEK(&H410) AND &H30)=&H30 GOTO 60550
60020 S=3.141593
60030 KEY OFF
60040 SCREEN 1
60050 COLOR 0,1
60060 CLS
60070 LINE(0,0)-(319,199),3,B
60080 LINE(5,5)-(314,194),3,B
60090 PAINT(1,1),1,3
60100 DRAW"c3;bm40,100;e60;d60;l5;h15;e4;f10;u40;g50;l5;"
60110 PAINT(43,99),1,3
60120 DRAW"C3;bm110,30;d70;L5;U70;R5;"
60130 PAINT(109,99),1,3
60140 DRAW"C3;bm120,40;d60;L5;U60;R5;"
60150 PAINT(119,99),1,3
60160 CIRCLE(135,83),20,3,1.25*S,0.75*S
60170 CIRCLE(135,83),15,3,1.25*S,0.9*S
60180 DRAW"bm119,96;e5;"
60190 PAINT(135,98),1,3
60200 CIRCLE(170,83),20,3,0.2*S,1.85*S
60210 CIRCLE(170,83),15,3,0.25*S,1.8*S
60220 DRAW"C3;BM182,90;R5;"
60230 DRAW"C3;BM187,75;G10;H3;E7;"
60240 PAINT(170,99),1,3
60250 PAINT(170,67),1,3
60260 DRAW"c3;bm195,100;l5;u34;r5;d34;"
60270 CIRCLE(210,83),20,3,0.55*S,0.76*S
60280 CIRCLE(210,83),15,3,0.59*S,0.8799999*S
60290 DRAW"bm207,66;d5;"
60300 PAINT(194,99),1,3
60310 PAINT(206,69),1,3
60320 DRAW"c3;bm217,100;l5;u40;r5;d5;r7;d5;l7;d30;"
60330 PAINT(216,97),1,3
60340 DRAW"C3;bm265,65;d35;L5;U35;R5;"
60350 CIRCLE(245,83),20,3,0.25*S,1.75*S
60360 CIRCLE(245,83),15,3,0.09999999*S,1.7*S
60370 DRAW"bm261,99;h6;"
60380 PAINT(245,98),1,3
60390 PAINT(264,69),1,3
60400 LOCATE 14,22
60410 PRINT"AGRICULTURE"
60420 LOCATE 18,8
60430 PRINT"A D A P R O G R A M S"
60440 LOCATE 20,5
60450 PRINT "FARM BUSINESS MANAGEMENT BRANCH"
60460 LOCATE 23,5
60470 PRINT"PROVIDED BY ALBERTA AGRICULTURE"
60480 LOCATE 24,3
60490 PRINT"RESPONSIBILITY RESTS WITH THE USER";
60500 FOR S=1 TO 4100
60510 POKE 106,0
60520 IF INKEY$<>"" GOTO 60540
60530 NEXT S
60540 ON ERROR GOTO 0 :SCREEN 0,0,0:RETURN
60550 REM **MONOCHROME LOGO**
60560 KEY OFF:WIDTH 80:CLS:S$=CHR$(219)
60570 PRINT STRING$(75,S$);
60580 FOR S=2 TO 23:LOCATE S,75:PRINT S$;:NEXT
60590 LOCATE 24,1:PRINT STRING$(75,S$);
60600 FOR S=23 TO 2 STEP -1:LOCATE S,1:PRINT S$;:NEXT
60610 '
60620 '
60630 LOCATE 5,28:PRINT "▌"
60640 LOCATE 6,24:PRINT"/▌ ▌ ▌"
60650 LOCATE 7,23:PRINT"/ ▌ ▌ ▌"
60660 LOCATE 8,22:PRINT"/ ▌ ▌ ▌ ▐"
60670 LOCATE 9,21:PRINT"/ ▌ ▌ ▌ __ __ ▐_ __"
60680 LOCATE 10,20:PRINT"/ ▌ ▌ ▌/ \ / \ ▐/ ▐ / \▌"
60690 LOCATE 11,19:PRINT"/ ▌ ▌ █ ▐ ▌ / ▐ ▐ ▌ ▌"
60700 LOCATE 12,18:PRINT"/ \ ▌ ▌ █ ▐ ▌ ▐ ▐ ▌ ▌"
60710 LOCATE 13,17:PRINT"/ \▌ ▌ ▌\__/ \__/ ▐ ▐ \__/▌"
60720 LOCATE 15,36:PRINT"A G R I C U L T U R E"
60730 LOCATE 18,24:PRINT"A D A P R O G R A M S"
60733 LOCATE 20,22
60736 PRINT "FARM BUSINESS MANAGEMENT BRANCH"
60740 LOCATE 21,22:PRINT"PROVIDED BY ALBERTA AGRICULTURE."
60750 LOCATE 22,19:PRINT"RESPONSIBILITY RESTS SOLELY WITH USER"
60760 FOR S=1 TO 1500
60770 S$=INKEY$
60780 IF S$=CHR$(13) GOTO 60800
60790 NEXT S
60800 S$=""
60810 ON ERROR GOTO 0
60820 RETURN
62000 REM THIS IS THE SCREEN PRINT LOADER ACTIVATE WITH 'CALL PRTSCR'
62010 DEF SEG=&H0
62020 POKE &HF1, &HCD
62030 POKE &HF2, &H5
62040 POKE &HF3, &HCB
62050 PRTSCR=&HF1
62060 RETURN
RATION.BAS
1 REM RATION - A PROGRAM FOR BALANCING RATIONS FOR LIVESTOCK
2 REM REVISED MAY/1984
3 REM CONTACT:
4 REM GARY FISHER & GEORGE MONNER
5 REM F.B.M.BRANCH R.E.B.S. BRANCH
6 REM OLDS FAIRVIEW
8 GOTO 5000
9 S$="":REM THIS IS THE INPUT SUBROUTINE
10 GOSUB 24:PRINT SPACE$(LEN(S$));
11 S8=0:GOSUB 24
12 GOSUB 31
13 GOSUB 35
14 GOSUB 53
15 IF S$="" THEN S$=S6$:GOTO 22
16 IF S3=1 THEN GOSUB 56
17 IF S8=1 GOTO 10
18 IF S3=1 THEN GOSUB 68
19 IF S8=1 GOTO 10
20 IF S3=3 THEN GOSUB 73
21 IF S8=1 GOTO 10
22 IF S3=1 THEN S=VAL(S$)
23 RETURN
24 REM POSITION CURSOR
25 LOCATE S1,S2,1
30 RETURN
31 REM PRINT DEFAULT
32 PRINT S6$
33 GOSUB 24
34 RETURN
35 REM TRANSPARENT CURSOR ROUTINE
36 S$=""
37 S1$=INPUT$(1)
41 S=ASC(S1$):IF S<>13 GOTO 46
42 IF S$="" THEN GOSUB 24:PRINT " ";:GOSUB 24:GOSUB 31:PRINT:RETURN
43 IF LEN(S$)>=LEN(S6$) GOTO 45
44 PRINT SPACE$(LEN(S6$)-LEN(S$));
45 PRINT S1$;:RETURN
46 IF S<32 GOTO 50
47 IF S=34 THEN S1$="'"
48 S$=S$+S1$:IF S9>0 THEN IF LEN(S$)>S9 THEN PRINT S1$;:GOTO 52
49 PRINT S1$;:GOTO 37
50 IF LEN(S$)<1 GOTO 36
51 IF LEN(S$)=1 THEN PRINT CHR$(29);:PRINT" ";:PRINT CHR$(29);:GOTO 36
52 S$=LEFT$(S$,LEN(S$)-1):PRINT CHR$(29);:PRINT" ";:PRINT CHR$(29);:GOTO 37
53 REM THIS CHECKS FOR EXIT
54 IF S$="<" THEN CLS:PRINT" LOADING MENU...":RUN "HELLO.BAS"
55 RETURN
56 S1$=S$:S7=0:REM CHECK FOR NUMERIC INPUT
57 IF LEFT$(S1$,1)=" " THEN S1$=RIGHT$(S1$,LEN(S1$)-1):GOTO 57
58 IF RIGHT$(S1$,1)=" " THEN S1$=LEFT$(S1$,LEN(S1$)-1):GOTO 58
59 IF LEN(S1$)<1 GOTO 64
60 FOR S=1 TO LEN(S1$):S6=ASC(MID$(S1$,S,1))
61 IF S6>=48 AND S6<=57 GOTO 66
62 IF (S6=43 OR S6=45) AND S=1 GOTO 66
63 IF S6=46 AND S7=0 THEN S7=1:GOTO 66
64 S2$="NON NUMERIC INPUT":S1$="":GOSUB 78
65 RETURN
66 NEXT S
67 RETURN
68 REM CHECK FOR PROPER LIMITS
69 S6=VAL(S$)
70 IF S6<S4 THEN S2$="INPUT BELOW":S1$=STR$(S4):GOSUB 78:RETURN
71 IF S6>S5 THEN S2$="INPUT ABOVE":S1$=STR$(S5):GOSUB 78:RETURN
72 RETURN
73 REM CHECK FOR YES OR NO
74 IF LEFT$(S$,1)="Y" OR LEFT$(S$,1)="N" GOTO 76
75 S2$="MUST BE YES/NO ANSWER":S1$="":GOSUB 78:RETURN
76 S$=LEFT$(S$,1)
77 RETURN
78 REM ERROR FOR ALL CONDITIONS
79 COLOR 31,0,0:BEEP
80 GOSUB 90
81 PRINT" ";S2$;S1$;
82 FOR S7=1 TO 3000:NEXT S7
83 COLOR 7,0,0
87 GOSUB 93
88 S8=1
89 RETURN
90 REM POSTITION TO LAST LINE
91 LOCATE 25,1,0
92 RETURN
93 REM BLANK LAST LINE
94 LOCATE 25,1,1
95 PRINT SPACE$(39);
96 RETURN
100 CLS:PRINT" LOADING MENU...":RUN "HELLO.BAS"
200 REM ****DOLLAR FORMAT SUBROUTINE****
201 S3=INT(S3*100+0.5)/100
202 S3$=SPACE$(30)
203 IF S3=0 THEN S3$=RIGHT$(S3$,S4-4)+"0.00":GOTO 209
204 S4$=STR$(S3)
205 IF ASC(MID$(RIGHT$(S4$,2),1,1))=46 THEN S3$=S3$+S4$+"0":GOTO 208
206 IF ASC(MID$(RIGHT$(S4$,3),1,1))=46 THEN S3$=S3$+S4$:GOTO 208
207 S3$=S3$+S4$+".00"
208 S3$=RIGHT$(S3$,S4)
209 RETURN
300 REM HOLD SCREEN
301 S$="PRESS RETURN TO CONTINUE "
302 COLOR 31,0,0
303 GOSUB 90
304 PRINT" ";S$;
305 POKE 106,0
306 IF INKEY$=CHR$(13) GOTO 307 ELSE GOTO 305
307 COLOR 7,0,0
308 GOSUB 93
314 S$="":S1$=""
315 RETURN
5000 REM MAINLINE FOR RATION
5010 GOSUB 60000:REM LOGO & DISCLAIMER
5020 CLS:PRINT"PLEASE WAIT, I'M LOADING DATA "
5030 DIM Y(15,15)
5040 GOSUB 62000
5050 GOSUB 5680:REM PROGRAM TITLE PAGE
5060 CLS:PRINT"ENTER # OF ANIMALS FED =";
5065 S6$="1":S1=1:S2=26:S3=1:S4=1:S5=2000:S9=4:GOSUB 9:NO=S
5070 GOSUB 6040:REM **SELECTION OF TYPE OF ANIMAL BEING FED
5080 REM GET REQUIREMENTS FOR THE ANIMALS
5090 ON X+1 GOSUB 6200,6370,6370,6590,6590,6800,6940,6940,6940,6940,6940,6940
5100 IF X=0 THEN 5120
5110 W=1:GOSUB 6200:REM OPTION TO CHANGE DATA
5115 IF W9=1 THEN RETURN:REM THIS IS FOR THE CHANGE ANIMAL CLASS OPTION
5120 GOSUB 7350:REM ENTER FEEDSTUFFS & ALLOW FOR CHANGES
5130 CLS:PRINT" DE CP CA P"
5140 PRINT" ----- ---- ----- -----"
5150 PRINT USING "\ \ ##.## ##.## \ \ \ \";"REQUIREMENTS",DE,CP,CA$,PH$
5170 PRINT"NOW HAVE"
5180 PRINT" ===== ==== ===== ====="
5190 PRINT"AMOUNT OVER"
5200 PRINT" --------------------------"
5210 PRINT"AMOUNT OF DRY MATTER FEEDING="
5220 PRINT
5230 PRINT"======================================="
5240 PRINT"LBS DE CP CA P"
5250 PRINT"FED ---- ---- ----- -----"
5260 FOR J=1 TO W1
5270 PRINT USING "\ \ \ \ #.## #.### \ \ \ \";MID$(STR$(A(J,8)),2,10),A$(J,2),A(J,4),A(J,5),A$(J,6),A$(J,7)
5300 NEXT J
5310 C1=0:C2=0:C3=0:C4=0:C5=0
5320 FOR J=1 TO W1
5330 S6$=MID$(STR$(A(J,8)),2):S1=12+J:S2=1:S3=1:S4=0:S5=999:S9=4:GOSUB 9
5340 A(J,8)=S
5350 S6$=MID$(STR$(S),2)
5360 GOSUB 24:PRINT S6$;
5370 C1=C1+A(J,3)*A(J,8)/100:C2=C2+A(J,4)*A(J,8):C3=C3+A(J,5)*A(J,8)
5380 C4=C4+VAL(A$(J,6))*A(J,8):C5=C5+VAL(A$(J,7))*A(J,8)
5390 NEXT J
5400 S1=4:S2=13:GOSUB 24
5410 PRINT" "
5420 S2=1:GOSUB 24
5430 PRINT USING "\ \ ###.## ##.## .#### .####";"NOW HAVE ",C2,C3,C4,C5
5470 D2=INT((C2-DE)*100+0.5)/100:D3=INT((C3-CP)*100+0.5)/100
5480 D2=INT((C2-DE)*100+0.5)/100:D3=INT((C3-CP)*100+0.5)/100
5490 D4=INT((C4-VAL(CA$))*1000+0.5)/1000:D5=INT((C5-VAL(PH$))*1000+0.5)/1000
5500 S1=6:GOSUB 24:PRINT TAB(13)" ":GOSUB 24
5510 PRINT USING "\ \+###.##+##.## +.#### +.####";"AMOUNT OVER ",D2,D3,D4,D5
5520 S1=8:S2=30:GOSUB 24:PRINT " ":GOSUB 24
5530 PRINT INT(C1*1000)/1000
5540 S1=9:S2=1:GOSUB 24
5545 PRINT"FEED<F>,REQ<R>,CST<C>,PRNT<P>,EXIT<E>";
5550 S6$=" ":S1=9:S2=38:S3=2:S9=1:GOSUB 9
5560 S2=1:GOSUB 24:PRINT" "
5565 IF S$="E" THEN GOTO 100:END
5570 IF S$<>"R" GOTO 5580
5572 CLS:PRINT "DO YOU WANT A NEW ANIMAL CLASS (Y/N)?"
5574 S6$="N":S1=1:S2=38:S3=3:S9=1:GOSUB 9
5576 IF S$="Y" THEN RESTORE:W9=1:GOSUB 5060:W9=0:GOTO 5130
5578 CLS:GOSUB 6200:GOTO 5130
5580 IF S$<>"F" GOTO 5640
5590 GOSUB 9570
5600 GOSUB 9890
5610 IF S$="A" THEN RESTORE:GOSUB 7350:GOTO 5130
5620 IF S$="C" THEN GOSUB 7740:GOSUB 8450:GOSUB 7980:GOTO 5130
5630 GOTO 5130
5640 IF S$="C" THEN GOSUB 8540:GOTO 5130
5650 IF S$="P" THEN CALL PRTSCR:GOTO 5540
5660 GOTO 5310
5670 REM PROGRAM TITLE PAGE
5680 CLS:PRINT" RATION FORMULATION "
5690 PRINT" <REVISION DATE= 5/84>"
5700 PRINT :PRINT" THIS PROGRAM IS DESIGNED TO ASSIST"
5710 PRINT"WITH THE BALANCING OF LIVESTOCK RATIONS."
5720 PRINT" ONE SELECTS AN ANIMAL FROM A LIST"
5730 PRINT"IT THEN HAS 4 NUTRITIONAL REQUIREMENTS:"
5740 PRINT :PRINT"1. DIGESTIBLE ENERGY <MCAL/ANIMAL/DAY>"
5750 PRINT"2. CRUDE PROTEIN <LBS/ANIMAL/DAY>"
5760 PRINT"3. CALCIUM <LBS/ANIMAL/DAY>"
5770 PRINT"4. PHOSPHOROUS <LBS/ANIMAL/DAY>"
5780 PRINT :PRINT"ONE THEN SELECTS FEEDS FROM LISTS"
5790 PRINT"THESE FEEDS HAVE THESE NUTRIENT VALUES:"
5800 PRINT :PRINT"1. % DRY MATTER AS A PERCENTAGE 8%=8"
5810 PRINT"2. DIGESTIBLE ENERGY <MCAL/LB OF FEED>"
5820 PRINT"3. CRUDE PROTEIN <LBS/LB OF FEED>"
5830 PRINT"4. CALCIUM <LBS/LB OF FEED>"
5840 PRINT"5. PHOSPHORUS <LBS/LB OF FEED>"
5850 GOSUB 300
5860 CLS:LOCATE 2,1:PRINT" THE NUTRIENT REQUIREMENTS AND THE"
5870 PRINT"FEED VALUES CAN BE ALTERED AT WILL."
5880 PRINT" NEW FEEDS OR ANIMALS NOT ON THE LIST"
5890 PRINT"CAN BE CUSTOMIZED."
5900 PRINT :PRINT"THE FEEDING TABLE HAS THE FEEDS ENTERED"
5910 PRINT"ON AN AS FED BASIS IN LBS."
5920 PRINT"IT RETURNS THE TOTAL NUTRIENTS SUPPLIED"
5930 PRINT"BY THE RATION AS WELL AS TOTAL DRY"
5940 PRINT"MATTER FEEDING IN LBS/ANIMAL/DAY."
5950 PRINT :PRINT" THE COSTS SECTION REQUIRES THE PRICE"
5960 PRINT"EXPRESSED IN $/UNIT. THE UNITS ARE IN"
5970 PRINT"LBS/UNIT. THE COSTS ARE RETURNED AS"
5980 PRINT"COST/DAY, COST/ANIMAL/DAY, AND"
5990 PRINT" COST/TON OF RATION."
6000 PRINT :PRINT :PRINT" NOTE:IT IS NOT A LEAST COST RATION PRO-GRAM."
6010 GOSUB 300
6020 RETURN
6030 REM **SELECTION OF TYPE OF ANIMAL & GETTING REQUIREMENTS.**
6040 CLS:PRINT"WHICH TYPE OF CATTLE ARE BEING FED?"
6050 PRINT"(ENTER CORRESPONDING NO. <0 = CUSTOM>)"
6060 PRINT"======================================"
6070 PRINT :PRINT"1. DRY PREGNANT COWS:IN MID PREGNANCY"
6080 PRINT :PRINT"2. COWS:LAST 6 WK - 3WKS. AFTER CALVING."
6090 PRINT :PRINT"3. COWS:PROD. 10 LB.MILK - 3-4 MO. AFTER CALVING."
6100 PRINT :PRINT"4. COWS:PROD. 20 LB.MILK - '' "
6110 PRINT :PRINT"5. DAIRY COW: 1300LB COW @ 3.5% FAT TEST"
6120 PRINT :PRINT"6. FEEDLOT CATTLE GAINING 1 LB/DAY"
6130 PRINT"7. GAINING 1.5 LB/DAY"
6140 PRINT"8. GAINING 2.0 LB/DAY"
6150 PRINT"9. GAINING 2.5 LB/DAY"
6160 PRINT"10. GAINING 3.0 LB/DAY"
6165 PRINT"11. GAINING 3.5 LB/DAY"
6170 S6$="0":S1=1:S2=37:S3=1:S4=0:S5=11:S9=2:GOSUB 9:X=S
6180 RETURN
6190 REM**CUSTOM ENTRY & CHANGE ROUTINE FOR REQUIREMENTS
6200 CLS:LOCATE 7,1:PRINT"ENTER NUTRIENT REQUIREMENTS OF ANIMALS"
6210 PRINT" <-----/ANIMAL/DAY>"
6220 PRINT"---------------------------------------"
6230 PRINT :PRINT" DIGESTIBLE ENERGY <MCAL> = ";MID$(STR$(DE),2)
6240 PRINT :PRINT" CRUDE PROTEIN <LBS> = ";MID$(STR$(CP),2)
6250 PRINT :PRINT" CALCIUM <LBS> = ";CA$
6260 PRINT :PRINT" PHOSPHOROUS <LBS> = ";PH$
6270 PRINT :PRINT :PRINT"CHANGE DATA ?(Y OR N)";:IF W=1 THEN 6320
6280 S6$=MID$(STR$(DE),2):S1=11:S2=33:S3=1:S4=0:S5=99:S9=6:GOSUB 9:DE=S
6290 S6$=MID$(STR$(CP),2):S1=13:GOSUB 9:CP=S
6300 S6$=CA$:S1=15:GOSUB 9:CA$=S$
6310 S6$=PH$:S1=17:GOSUB 9:PH$=S$
6320 S6$="N":S1=20:S2=22:S3=3:GOSUB 9:W=0
6330 IF S$="Y" THEN 6280
6340 IF S$="N" THEN RETURN
6350 GOTO 6320
6360 REM**REQUIREMENT ENTRY FOR PREG. COWS (1 & 2)
6370 CLS:LOCATE 5,1:PRINT" WHAT IS APROX. WEIGHT OF THE COWS?"
6380 PRINT" < ENTER CORRESPONDING DIGIT >"
6390 PRINT"======================================"
6400 PRINT" 1. 1000 LBS"
6410 PRINT" 2. 1100 LBS"
6420 PRINT" 3. 1200 LBS"
6430 PRINT" 4. 1300 LBS"
6435 PRINT" 5. 1400 LBS"
6440 PRINT" 6. 1500 LBS"
6450 S6$="3":S1=5:S2=37:S3=1:S4=1:S5=6:GOSUB 9
6460 ON S+((X-1)*6) GOTO 6470,6480,6490,6500,6505,6510,6520,6530,6540,6550,6555,6560
6470 DE=17.9:CP=1.2:CA$=".042":PH$=".032":GOTO 6570
6480 DE=19.2:CP=1.3:CA$=".045":PH$=".034":GOTO 6570
6490 DE=20.5:CP=1.4:CA$=".048":PH$=".035":GOTO 6570
6500 DE=21.8:CP=1.5:CA$=".050":PH$=".036":GOTO 6570
6505 DE=23.1:CP=1.6:CA$=".053":PH$=".038":GOTO 6570
6510 DE=24.3:CP=1.65:CA$=".055":PH$=".040":GOTO 6570
6520 DE=20.6:CP=1.4:CA$=".044":PH$=".034":GOTO 6570
6530 DE=22.1:CP=1.5:CA$=".047":PH$=".036":GOTO 6570
6540 DE=23.6:CP=1.6:CA$=".050":PH$=".038":GOTO 6570
6550 DE=25.1:CP=1.7:CA$=".053":PH$=".040":GOTO 6570
6555 DE=26.5:CP=1.8:CA$=".056":PH$=".042":GOTO 6570
6560 DE=27.9:CP=1.9:CA$=".058":PH$=".045":GOTO 6570
6570 RETURN
6580 REM **REQUIREMENT ENTRY FOR NURSING COWS(3&4)
6590 CLS:LOCATE 5,1:PRINT" WHAT IS APROX. WEIGHT OF THE COWS?"
6600 PRINT" < ENTER CORRESPONDING DIGIT >"
6610 PRINT"======================================"
6620 PRINT" 1. 900 LBS"
6630 PRINT" 2. 1000 LBS"
6640 PRINT" 3. 1100 LBS"
6650 PRINT" 4. 1200 LBS"
6660 PRINT" 5. 1300 LBS"
6662 PRINT" 6. 1400 LBS"
6664 PRINT" 7. 1500 LBS"
6666 PRINT" 8. 1600 LBS"
6670 S6$="4":S1=5:S2=37:S3=1:S4=1:S5=8:GOSUB 9
6680 ON S+((X-3)*8) GOTO 6690,6700,6710,6720,6730,6732,6734,6736,6740,6750,6760,6770,6780,6782,6784,6786
6690 DE=22.4:CP=1.8:CA$=".073":PH$=".059":GOTO 6570
6700 DE=24!:CP=1.9:CA$=".076":PH$=".061":GOTO 6570
6710 DE=25.6:CP=2!:CA$=".080":PH$=".064":GOTO 6570
6720 DE=27.3:CP=2.1:CA$=".085":PH$=".067":GOTO 6570
6730 DE=29!:CP=2.2:CA$=".090":PH$=".069":GOTO 6570
6732 DE=30.7:CP=2.3:CA$=".095":PH$=".070":GOTO 6570
6734 DE=32.4:CP=2.4:CA$=".110":PH$=".072":GOTO 6570
6736 DE=34.1:CP=2.5:CA$=".115":PH$=".074":GOTO 6570
6740 DE=29!:CP=2.6:CA$=".120":PH$=".095":GOTO 6570
6750 DE=30.6:CP=2.7:CA$=".125":PH$=".100":GOTO 6570
6760 DE=32.2:CP=2.8:CA$=".130":PH$=".100":GOTO 6570
6770 DE=33.9:CP=3!:CA$=".135":PH$=".102":GOTO 6570
6780 DE=35.6:CP=3.1:CA$=".140":PH$=".105":GOTO 6570
6782 DE=37.3:CP=3.2:CA$=".145":PH$=".109":GOTO 6570
6784 DE=39!:CP=3.3:CA$=".150":PH$=".114":GOTO 6570
6786 DE=40.7:CP=3.4:CA$=".155":PH$=".118":GOTO 6570
6790 REM REQUIREMENT FOR DAIRY COWS
6800 CLS:LOCATE 6,1:PRINT"WHAT MILK PRODUCTION DO YOU REQUIRE?"
6810 PRINT :PRINT"======================================"
6820 PRINT :PRINT"ENTER A NO. BETWEEN 15 LBS & 120 LBS-"
6830 PRINT" <IN 5 LB INCREMENTS>"
6835 PRINT:PRINT" OR ENTER A ";:COLOR 0,7:PRINT "0";:COLOR 7,0:PRINT " FOR A DRY COW"
6840 S6$="30":S1=6:S2=37:S3=1:S4=0:S5=120:S9=3:GOSUB 9
6845 IF S<15 AND S<>0 THEN S2$="INPUT BELOW":S1$=STR$(15):GOSUB 78:GOTO 6840
6850 IF S/5=INT(S/5) THEN 6880
6860 S1$="":S2$="MUST BE IN 5 LB INCREMENTS":GOSUB 78
6870 GOTO 6840
6880 S1=16:S2=1:GOSUB 24:PRINT "PLEASE WAIT, LOADING DATA";
6882 FOR I=1 TO 35:READ Q,Q$,Q1,Q2,Q3,Q4,Q5:NEXT I
6890 FOR I=1 TO 23
6900 READ M,M1,M2,M3$,M4$
6910 IF M=S THEN DE=M1:CP=M2:CA$=M3$:PH$=M4$:I=11
6920 NEXT I
6930 RESTORE:RETURN
6940 REM REQUIREMENT FOR FEEDLOT CATTLE
6942 CLS:S1=3:S2=1:GOSUB 24:PRINT"TYPE OF CATTLE BEING FED?"
6944 PRINT"====================================="
6946 PRINT"ENTER 'S' FOR STEER OR 'H' FOR HEIFER"
6950 S1=7:S2=1:GOSUB 24:PRINT"WEIGHT OF CATTLE BEING FED?"
6960 PRINT"======================================"
6962 IF X<>11 THEN 6970
6964 PRINT"ENTER A VALUE BETWEEN 500LBS & 1200LBS"
6966 PRINT"(BETWEEN 500LBS & 1100LBS FOR HEIFERS)
6968 GOTO 6980
6970 PRINT"ENTER A VALUE BETWEEN 400LBS & 1200LBS"
6972 PRINT"(BETWEEN 400LBS & 1100LBS FOR HEIFERS)
6980 PRINT" < IN 100 LB INCREMENTS >"
6982 S6$="S":S1=3:S2=27:S3=2:S9=1:GOSUB 9:EX$=S$
6984 IF EX$="S" OR EX$="H" THEN 6990
6986 S1$="":S2$="ENTER S OR W":GOSUB 78
6988 GOTO 6982
6990 S4=400:S6$="400":IF X=11 THEN S4=500:S6$="500"
6991 S5=1200:IF EX$="H" THEN S5=1100
6992 S1=7:S2=29:S3=1:S9=4:GOSUB 9:WT=S
7000 IF WT/100=INT(WT/100) THEN 7030
7010 S1$="":S2$="MUST BE IN 100 LB INCREMENTS":GOSUB 78
7020 GOTO 6990
7030 IF WT>600 THEN 7080
7040 S1=13:S2=1:GOSUB 24:PRINT"WINTERING OR FINISHING THE CALVES?"
7050 PRINT"======================================="
7060 PRINT"ENTER 'W' FOR WINTER OR 'F' FOR FINISH"
7070 S6$="W":S1=13:S2=36:S3=2:S9=1:GOSUB 9
7072 IF S$="W" OR S$="F" THEN 7078
7074 S1$="":S2$="ENTER W OR F":GOSUB 78
7076 GOTO 7070
7078 WF=1:IF S$="F" THEN WF=2
7080 S1=16:S2=1:GOSUB 24:PRINT "PLEASE WAIT, LOADING DATA";
7082 FOR I=1 TO 35:READ Q,Q$,Q1,Q2,Q3,Q4,Q5:NEXT I
7090 FOR I=1 TO 23:READ M,M1,M2,M3,M4:NEXT I
7100 IF EX$="H" THEN 7140
7105 FOR I=1 TO 6
7110 FOR I1=1 TO 9
7115 READ Y(I,I1)
7120 NEXT I1
7125 NEXT I
7130 DE=Y(X-5,INT((WT-300)/100))
7135 FOR I=1 TO 6:READ Q,Q1,Q2,Q3,Q4,Q5,M,M1:NEXT I:GOTO 7175
7140 FOR I=1 TO 6:READ Q,Q1,Q2,Q3,Q4,Q5,M,M1,M2:NEXT I
7145 FOR I=1 TO 6
7150 FOR I1=1 TO 8
7155 READ Y(I,I1)
7160 NEXT I1
7165 NEXT I
7170 DE=Y(X-5,INT((WT-300)/100))
7175 FOR I=1 TO 6
7180 FOR I1=1 TO 9
7185 READ Y(I,I1)
7190 NEXT I1
7195 NEXT I
7200 CP=Y(X-5,INT((WT-300)/100))
7220 IF WT>600 THEN FOR I=1 TO 6:READ CA$,PH$:NEXT I:GOTO 7290
7230 IF WF=2 THEN FOR I=1 TO 3:READ CA$,PH$:NEXT I
7240 FOR I=1 TO INT((WT-300)/100)
7250 READ CA$,PH$
7260 NEXT I
7280 RESTORE:RETURN
7290 FOR I=1 TO INT((WT-600)/100)
7300 READ CA$,PH$
7320 NEXT I
7330 RESTORE:RETURN
7340 REMCHOOSING OF FEEDSTUFFS &O0CHANGE TO NUTRIENT VALUES
7350 Z5=1:Z6=7:GOSUB 7750:LOCATE 3,1:PRINT"**HAY**":GOSUB 7800
7360 S6$="":S1=(Z6-Z5+1)*2+5:S2=33:S3=1:S4=Z5:S5=Z6:S9=2:GOSUB 7860
7370 Z5=11:Z6=14:GOSUB 7750:LOCATE 3,1:PRINT"**GREENFEED**":GOSUB 7800
7380 S1=(Z6-Z5+1)*2+5:S4=Z5:S5=Z6:GOSUB 7860
7390 Z5=21:Z6=29:GOSUB 7750:LOCATE 3,1:PRINT"**SILAGE**":GOSUB 7800
7400 S1=(Z6-Z5+1)*2+5:S4=Z5:S5=Z6:GOSUB 7860
7410 Z5=31:Z6=33:GOSUB 7750:LOCATE 3,1:PRINT"**STRAW** ":GOSUB 7800
7420 S1=(Z6-Z5+1)*2+5:S4=Z5:S5=Z6:GOSUB 7860
7430 Z5=41:Z6=43:GOSUB 7750:LOCATE 3,1:PRINT"**GRAIN**":GOSUB 7800
7440 S1=(Z6-Z5+1)*2+5:S4=Z5:S5=Z6:GOSUB 7860
7450 Z5=51:Z6=59:GOSUB 7750:LOCATE 3,1:PRINT"**SUPPLEMENT**":GOSUB 7800
7460 S1=(Z6-Z5+1)*2+5:S4=Z5:S5=Z6:GOSUB 7860
7470 RESTORE:GOSUB 7750
7480 FOR I=1 TO 35
7490 READ V,V$,V1,V2,V3,V4$,V5$
7500 FOR J=1 TO W1
7510 IF V=A(J,1) GOTO 7530
7520 GOTO 7560
7530 PRINT USING "## \ \###.# #.## #.### \ \ \ \";A(J,1),A$(J,2),A(J,3),A(J,4),A(J,5),A$(J,6),A$(J,7)
7550 GOTO 7590
7560 IF V=W(J) THEN PRINT USING "## \ \###.# #.## #.### \ \ \ \";V,V$,V1,V2,V3,V4$,V5$
7570 IF V=W(J) THEN A(J,1)=V:A$(J,2)=V$:A(J,3)=V1:A(J,4)=V2:A(J,5)=V3
7580 IF V=W(J) THEN A$(J,6)=V4$:A$(J,7)=V5$
7590 IF V=W(J) THEN PRINT
7600 NEXT J
7610 NEXT I
7620 FOR J=1 TO W1
7630 IF A(J,1)<61 GOTO 7660
7640 PRINT USING "## \ \###.# #.## #.### \ \ \ \";A(J,1),A$(J,2),A(J,3),A(J,4),A(J,5),A$(J,6),A$(J,7)
7660 NEXT J
7670 S1=23:S2=1:GOSUB 24:PRINT"DO YOU WANT TO ADD YOUR FEEDS? <Y,N>"
7680 S6$="N":S2=38:S3=3:S9=1:GOSUB 9
7690 IF S$="N" THEN GOSUB 7750:GOSUB 8460:GOSUB 7990:RETURN
7700 IF S$="Y" THEN GOSUB 8210:GOSUB 7750:GOSUB 8460:GOSUB 7990:RETURN
7710 GOTO 7670
7720 GOSUB 7990
7730 RETURN
7740 REM HEADING FOR FEEDSTUFF LISTING
7750 CLS
7760 PRINT TAB(14);"DM DE CP CA P"
7770 PRINT"---------------------------------------"
7780 RETURN
7790 REM ROUTINE FOR READ ING & PRINT ING FEEDSTUFF LISTS
7800 FOR I=Z5 TO Z6
7810 READ V,V$,V1,V2,V3,V4$,V5$
7820 PRINT :PRINT USING "## \ \###.# #.## #.### \ \ \ \";V,V$,V1,V2,V3,V4$,V5$
7830 NEXT I
7840 RETURN
7850 REM ROUTINE FOR CHOOSING FEEDSTUFFS FROM LISTS
7860 PRINT"ENTER THE # OF THE FEED & PRESS RETURN."
7870 PRINT" TO CONTINUE, JUST PRESS RETURN"
7880 FOR J=1 TO 4:GOSUB 9:IF S$="" THEN J=4:GOTO 7960
7890 W1=W1+1:IF W1>10 THEN S1$="":S2$="TOO MANY FEEDS":GOSUB 78:W1=W1-1:GOTO 7970
7900 W(W1)=S
7910 TE=S1:TM=S2
7920 S1=5+(S-Z5)*2:S2=1
7930 GOSUB 24:COLOR 0,7
7932 IF W(W1) >9 THEN PRINT MID$(STR$(W(W1)),2,99); ELSE PRINT STR$(W(W1));
7935 COLOR 7,0
7940 S1=TE:S2=TM
7950 GOSUB 24:PRINT" ";
7960 NEXT J
7970 RETURN
7980 REM ROUTINE FOR CHANGING NUTRIENT VALUES OF THE FEEDSTUFFS
7990 REM CLS
8000 FOR I=1 TO W1
8010 S1=(I-1)*2+4:S2=1:GOSUB 24:PRINT"CHANGE<Y/N>";
8020 S6$="N":S2=13:S3=3:S9=3:GOSUB 9
8030 IF S$="N" GOTO 8120
8040 IF S$="Y" THEN S2=1:GOSUB 24:PRINT" ";
8050 FOR J=3 TO 7
8060 IF J>5 GOTO 8090
8070 S6$=MID$(STR$(A(I,J)),2):S2=(J-3)*6+10:S3=1:S4=0:S5=200:S9=6
8072 IF J=3 THEN S5=100
8074 GOSUB 9
8080 GOTO 8100
8090 S6$=A$(I,J):S2=(J-3)*6+10:S3=1:GOSUB 9
8100 A(I,J)=VAL(S$):A$(I,J)=S$
8110 NEXT J
8120 NEXT I
8130 PRINT
8140 PRINT"MORE CHANGES?<Y/N>";
8150 S6$="N":S1=(I-1)*2+4:S2=20:S3=3:GOSUB 9
8160 IF S$="Y" THEN GOSUB 7750:GOSUB 8460:GOTO 7990
8170 IF S$="N" THEN RETURN
8180 GOTO 8140
8190 RETURN
8200 REM ROUTINE TO ADD NEW FEEDSTUFFS
8210 NI=61
8220 CLS:PRINT"FEEDSTUFF NUMBER "NI
8230 IF W1+1>10 THEN S1$="":S2$="TOO MANY FEEDS":GOSUB 78:RETURN
8240 PRINT"ENTER FEEDSTUFF NAME."A$(W1+1,2)
8250 PRINT"ENTER % DRY MATTER OF FEEDSTUFF. "MID$(STR$(A(W1+1,3)),2)
8260 PRINT"ENTER DE OF FEEDSTUFF. "MID$(STR$(A(W1+1,4)),2)
8270 PRINT"ENTER CP OF FEEDSTUFF. "MID$(STR$(A(W1+1,5)),2)
8280 PRINT"ENTER CA OF FEEDSTUFF."A$(W1+1,6)
8290 PRINT"ENTER P OF FEEDSTUFF."A$(W1+1,7)
8300 PRINT"======================================"
8310 PRINT"CHANGE DATA ?(Y/N)"
8320 PRINT :PRINT"ANOTHER FEEDSTUFF?(Y/N)"
8330 S6$=A$(W1+1,2):S1=2:S2=22:S3=2:S4=0:S5=200:S9=10:GOSUB 9:A$(W1+1,2)=S$
8340 S6$=MID$(STR$(A(W1+1,3)),2):S2=34:S3=1:S1=3:S5=100:S9=5:GOSUB 9:A(W1+1,3)=S
8350 S6$=MID$(STR$(A(W1+1,4)),2):S2=24:S1=4:S5=10:GOSUB 9:A(W1+1,4)=S
8360 S6$=MID$(STR$(A(W1+1,5)),2):S2=24:S1=5:GOSUB 9:A(W1+1,5)=S
8370 S6$=A$(W1+1,6):S2=24:S1=6:S9=7:GOSUB 9:A$(W1+1,6)=S$
8380 S6$=A$(W1+1,7):S2=24:S1=7:GOSUB 9:A$(W1+1,7)=S$
8390 S6$="N":S1=9:S3=3:GOSUB 9:IF S$="Y" THEN 8330
8400 IF S$="N" THEN 8420
8410 GOTO 8390
8420 W1=W1+1:A(W1,1)=NI:NI=NI+1
8430 S1=11:GOSUB 9:IF S$="Y" THEN 8220
8440 IF S$="N" THEN RETURN
8450 REM ROUTINE FOR LISTING FEEDSTUFFS CHOSEN
8460 LOCATE 2,1
8470 FOR I1=1 TO W1
8480 S1=1+I1*2:S2=1:GOSUB 24
8490 PRINT USING "## \ \###.# #.## #.### \ \ \ \";A(I1,1),A$(I1,2),A(I1,3),A(I1,4),A(I1,5),A$(I1,6),A$(I1,7)
8510 NEXT I1
8520 RETURN
8530 REM ROUTINE FOR CALCULATING FEED COSTS
8540 CLS
8550 PRINT" DAILY FEED FOR "NO" ANIMALS."
8560 PRINT" ============================="
8570 PRINT" AM'T COST LBS"
8580 PRINT" # NAME FED $/UNIT /UNIT"
8590 PRINT "---------------------------------------"
8600 F2=0:F3=0
8610 A2=0
8620 FOR I=1 TO W1
8630 A1(I)=A(I,8)*NO
8640 IF A1(I)=0 THEN GOTO 8670
8650 PRINT A(I,1);A$(I,2)TAB(14)"="A1(I)
8660 A2=A2+A(I,8)
8670 NEXT I
8680 F2=0:F3=0:I2=0
8690 FOR I=1 TO W1
8700 IF A1(I)=0 THEN GOTO 8770
8710 S6$=MID$(STR$(FA(I)),2):S5=100000!:S4=0.01:S1=6+I2:S2=24:S3=1
8720 S9=6:GOSUB 9:FA(I)=S
8730 IF FB(I)<=0 THEN FB(I)=1
8740 S6$=MID$(STR$(FB(I)),2):S2=32:GOSUB 9:FB(I)=S
8750 F(I)=FA(I)/FB(I):F2=F2+(A1(I)*F(I)):F3=F3+A(I,8)*F(I)
8760 I2=I2+1
8770 NEXT I
8780 F4=INT((F3*2000/A2)*100+0.5)/100
8790 S1=17:S2=1:GOSUB 24:PRINT" C O S T S "
8800 PRINT" ==========="
8810 PRINT"COST/DAY..........=$"INT(F2*100+0.5)/100
8820 PRINT"COST/ANIMAL/DAY...=$"INT(F3*100+0.5)/100
8830 PRINT"COST/TON OF RATION=$"F4
8840 S1=23:S2=1:GOSUB 24:PRINT"CHANGE? COSTS<C>,LBS.FED<R>,PRINT <P>"
8850 S6$=" ":S2=38:S3=2:S9=1:GOSUB 9
8860 S2=1:GOSUB 24:PRINT" "
8870 IF S$="C" THEN 8680
8880 IF S$="R" THEN RETURN
8890 IF S$="P" THEN CALL PRTSCR:GOTO 8840
8900 GOTO 8840
8910 REM DATA FOR FEEDSTUFF & THEIR NUTRIENT VALUES
8920 DATA 1,ALFLFA-H,89.3,1.05,.159,.0167,.0021
8930 DATA 2,CLOVER-H,87.1,1.00,.133,.0126,.0019
8940 DATA 3,AL-GRS-H,88.2,.99,.121,.0116,.0018
8945 DATA 4,LG-GRS-H,87.9,.97,.112,.0100,.0017
8950 DATA 5,BROME-H,89.2,.91,.088,.0054,.0015
8955 DATA 6,TIMTHY-H,88.8,.89,.081,.0052,.0015
8960 DATA 7,GRASS-H,88.8,.91,.092,.0065,.0016
8970 DATA 11,BRLY-GF,86.8,1.04,.087,.0041,.0020
8980 DATA 12,OATS-GF,88.5,1.02,.083,.0032,.0019
8990 DATA 13,RYE-GF,89.9,1.02,.075,.002,.0016
9000 DATA 14,CREAL-GF,86.1,1.01,.085,.0044,.0020
9010 DATA 21,BRLEY-SL,39.5,.47,.043,.0021,.0011
9020 DATA 22,OATS-SL,36.4,.42,.036,.0018,.0009
9030 DATA 23,CORN-SL,32.8,.43,.029,.0012,.0008
9040 DATA 24,WHEAT-SL,38,.44,.037,.0017,.0009
9050 DATA 25,CREAL-SL,37.6,.44,.038,.0021,.0010
9055 DATA 26,ALFAL-SL,46.3,.55,.082,.0086,.0012
9060 DATA 27,AL-GR-SL,45.0,.50,.065,.0070,.0010
9070 DATA 28,GRASS-SL,38.2,.39,.045,.0034,.0010
9080 DATA 29,LEG-G-SL,44.2,.49,.062,.0061,.0010
9090 DATA 31,BRLEY-ST,88.9,.80,.042,.0042,.0009
9100 DATA 32,OATS-ST,88.7,.87,.040,.0034,.0010
9110 DATA 33,WHEAT-ST,91.1,.75,.036,.0028,.0005
9120 DATA 41,BARLEY-G,88.6,1.47,.109,.0007,.0035
9130 DATA 42,OATS-G,90.2,1.37,.105,.0009,.0032
9140 DATA 43,WHEAT-G,88.4,1.56,.140,.0005,.0034
9150 DATA 51,32% BSUP.,90,1.10,.32,.05,.0100
9160 DATA 52,32% DSUP.,90,1.25,.32,.025,.012
9170 DATA 53,UREA,100,0,2.81,0,0
9180 DATA 54,"2:1-MIN.",100,,,.2,.09
9190 DATA 55,"1:1-MIN.",100,,,.18,.18
9200 DATA 56,LIME,100,,,.38,0
9202 DATA 57,CNOLA ML,90,1.24,.370,.0068,.0115
9204 DATA 58,SOY ML,89,1.44,.475,.0032,.0067
9206 DATA 59,DEHY ALFA,92,1.12,.170,.0140,.0020
9210 REM DATA FOR DAIRY COW REQUIREMENTS
9212 DATA 0,24,2.00,.083,.066
9214 DATA 15,29.1,2.77,.103,.078
9216 DATA 20,32.4,3.16,.118,.088
9218 DATA 25,35.7,3.55,.133,.098
9220 DATA 30,39,3.94,.149,.109
9230 DATA 35,42.3,4.33,.164,.120
9240 DATA 40,45.6,4.72,.180,.131
9250 DATA 45,48.9,5.11,.195,.141
9260 DATA 50,52.2,5.5,.211,.152
9270 DATA 55,55.5,5.89,.226,.163
9280 DATA 60,58.8,6.28,.242,.174
9290 DATA 65,62.1,6.67,.258,.185
9300 DATA 70,65.4,7.06,.274,.196
9310 DATA 75,68.7,7.45,.289,.206
9320 DATA 80,72,7.84,.305,.217
9321 DATA 85,75.3,8.23,.321,.228
9322 DATA 90,78.6,8.62,.336,.239
9323 DATA 95,81.9,9.01,.352,.250
9324 DATA 100,85.2,9.41,.367,.260
9325 DATA 105,88.5,9.79,.383,.271
9326 DATA 110,91.8,10.18,.398,.282
9327 DATA 115,95.1,10.57,.414,.293
9328 DATA 120,98.4,10.96,.430,.303
9330 REM ENERGY REQUIREMENTS FOR FEEDLOT STEERS
9340 DATA 12.8,14.0,14.6,16.4,18.1,19.8,21.4,23.0,24.7
9350 DATA 14.7,15.5,17.7,19.7,21.5,23.4,25.4,27.2,29.2
9360 DATA 16.7,17.5,20.2,22.8,24.8,27.8,29.3,31.4,33.8
9362 DATA 17.7,19.0,22.4,25.9,28.1,30.7,33.2,35.7,37.9
9364 DATA 18.7,20.4,24.5,26.9,29.8,32.5,35.3,37.7,40.3
9366 DATA 00.0,21.8,26.7,28.9,33.1,36.1,39.2,41.9,44.8
9370 REM ENERGY REQUIREMENTS FOR FEEDLOT HEIFERS
9372 DATA 13.4,14.7,15.3,17.2,19.5,21.4,23.1,24.8
9374 DATA 15.4,16.2,18.6,21.3,23.2,25.3,27.4,29.4
9376 DATA 17.5,18.4,21.8,24.6,26.8,29.2,31.6,33.9
9378 DATA 18.6,20.0,24.2,28.0,30.3,33.2,35.9,38.6
9380 DATA 19.6,22.0,26.5,29.0,32.2,35.1,38.1,40.7
9382 DATA 00.0,23.5,28.8,31.2,35.7,39.0,42.3,45.3
9390 REM PROTEIN REQUIREMENTS FOR FEEDLOT CATTLE
9400 DATA 1.18,1.25,1.35,1.42,1.50,1.60,1.70,1.81,1.90
9410 DATA 1.31,1.42,1.53,1.62,1.73,1.84,1.97,2.09,2.15
9420 DATA 1.45,1.52,1.65,1.74,1.85,1.95,2.05,2.13,2.20
9430 DATA 1.49,1.70,1.76,1.85,1.98,2.09,2.22,2.36,2.40
9440 DATA 1.69,1.85,1.90,2.02,2.14,2.26,2.37,2.50,2.60
9445 DATA 1.85,1.98,2.08,2.18,2.31,2.44,2.58,2.68,2.75
9450 REM CA & PH REQUIREMENTS FOR FEEDLOT CATTLE
9460 DATA ".036",".029"
9470 DATA ".040",".032"
9480 DATA ".045",".035"
9490 DATA ".047",".035"
9500 DATA ".054",".040"
9510 DATA ".061",".045"
9520 DATA ".061",".045"
9530 DATA ".068",".050"
9540 DATA ".075",".055"
9550 DATA ".081",".060"
9560 DATA ".088",".065"
9565 DATA ".095",".070"
9570 REM DELETE FEEDS SECTION
9580 CLS
9590 PRINT :PRINT :PRINT"DO YOU WISH TO DELETE FEEDS (Y/N)?"
9600 S6$="N":S1=3:S2=36:S3=3:S9=1:GOSUB 9
9610 IF S$="N" THEN RETURN
9620 GOSUB 7740
9630 GOSUB 8450
9640 FOR I=1 TO W1
9650 S1=(I-1)*2+4:S2=1:GOSUB 24:PRINT"DELETE<Y/N>";
9660 S6$="N":S2=13:S3=3:S9=3:GOSUB 9
9670 IF S$="N" GOTO 9690
9680 A(I,1)=0
9690 NEXT I
9700 I2=0:I3=0:PRINT :S1=24:S2=1:PRINT"DELETING THIS MAY TAKE A WHILE"
9710 FOR I=1 TO W1
9720 IF A(I,1)<>0 GOTO 9810
9730 I2=I2+1:I3=I3+1
9740 IF I=W1 GOTO 9810
9750 FOR I1=I TO W1-1
9760 A(I1,1)=A(I1+1,1)
9770 A$(I1,2)=A$(I1+1,2):A$(I1,6)=A$(I1+1,6):A$(I1,7)=A$(I1+1,7)
9780 A(I1,3)=A(I1+1,3):A(I1,4)=A(I1+1,4):A(I1,5)=A(I1+1,5):A(I1,8)=A(I1+1,8)
9790 FA(I1)=FA(I1+1):FB(I1)=FB(I1+1):W(I1)=W(I1+1)
9800 NEXT I1
9810 NEXT I
9820 IF I2>0 THEN W1=W1-I2:I2=0:GOTO 9710
9830 IF W1+1>10 GOTO 9880
9840 FOR I=W1+1 TO W1+I3
9850 A(I,8)=0:FA(I)=0:FB(I)=0:W(I)=0
9860 A(I,1)=0:A$(I,2)="":A$(I,6)="":A$(I,7)="":A(I,3)=0:A(I,4)=0:A(I,5)=0
9870 NEXT I
9880 RETURN
9890 REM DECIDE ON ADD OR CHANGE
9900 CLS
9910 PRINT :PRINT :PRINT"DO YOU WANT TO ADD<A>, CHANGE<C> FEEDS"
9920 PRINT" OR RETURN<R> TO THE FEEDING TABLE?"
9930 S6$="":S1=4:S2=38:S3=2:S9=1:GOSUB 9
9940 IF S$="A" OR S$="C" OR S$="R" THEN RETURN
9950 GOTO 9930
60000 REM this is the logo routine
60010 DEF SEG=0:IF (PEEK(&H410) AND &H30)=&H30 GOTO 60550
60020 S=3.141593
60030 KEY OFF
60040 SCREEN 1
60050 COLOR 0,1
60060 CLS
60070 LINE(0,0)-(319,199),3,B
60080 LINE(5,5)-(314,194),3,B
60090 PAINT(1,1),1,3
60100 DRAW"c3;bm40,100;e60;d60;l5;h15;e4;f10;u40;g50;l5;"
60110 PAINT(43,99),1,3
60120 DRAW"C3;bm110,30;d70;L5;U70;R5;"
60130 PAINT(109,99),1,3
60140 DRAW"C3;bm120,40;d60;L5;U60;R5;"
60150 PAINT(119,99),1,3
60160 CIRCLE(135,83),20,3,1.25*S,0.75*S
60170 CIRCLE(135,83),15,3,1.25*S,0.9*S
60180 DRAW"bm119,96;e5;"
60190 PAINT(135,98),1,3
60200 CIRCLE(170,83),20,3,0.2*S,1.85*S
60210 CIRCLE(170,83),15,3,0.25*S,1.8*S
60220 DRAW"C3;BM182,90;R5;"
60230 DRAW"C3;BM187,75;G10;H3;E7;"
60240 PAINT(170,99),1,3
60250 PAINT(170,67),1,3
60260 DRAW"c3;bm195,100;l5;u34;r5;d34;"
60270 CIRCLE(210,83),20,3,0.55*S,0.76*S
60280 CIRCLE(210,83),15,3,0.59*S,0.8799999*S
60290 DRAW"bm207,66;d5;"
60300 PAINT(194,99),1,3
60310 PAINT(206,69),1,3
60320 DRAW"c3;bm217,100;l5;u40;r5;d5;r7;d5;l7;d30;"
60330 PAINT(216,97),1,3
60340 DRAW"C3;bm265,65;d35;L5;U35;R5;"
60350 CIRCLE(245,83),20,3,0.25*S,1.75*S
60360 CIRCLE(245,83),15,3,0.09999999*S,1.7*S
60370 DRAW"bm261,99;h6;"
60380 PAINT(245,98),1,3
60390 PAINT(264,69),1,3
60400 LOCATE 14,22
60410 PRINT"AGRICULTURE"
60420 LOCATE 18,6
60430 PRINT"LIVESTOCK INDUSTRY DIVISION"
60460 LOCATE 23,5
60470 PRINT"PROVIDED BY ALBERTA AGRICULTURE"
60480 LOCATE 24,3
60490 PRINT"RESPONSIBILITY RESTS WITH THE USER";
60500 FOR S=1 TO 4100
60510 POKE 106,0
60520 IF INKEY$<>"" GOTO 60540
60530 NEXT S
60540 ON ERROR GOTO 0 :SCREEN 0,0,0:RETURN
60550 REM **MONOCHROME LOGO**
60560 KEY OFF:WIDTH 80:CLS:S$=CHR$(219)
60570 PRINT STRING$(75,S$);
60580 FOR S=2 TO 23:LOCATE S,75:PRINT S$;:NEXT
60590 LOCATE 24,1:PRINT STRING$(75,S$);
60600 FOR S=23 TO 2 STEP -1:LOCATE S,1:PRINT S$;:NEXT
60610 '
60620 '
60630 LOCATE 5,28:PRINT "▌"
60640 LOCATE 6,24:PRINT"/▌ ▌ ▌"
60650 LOCATE 7,23:PRINT"/ ▌ ▌ ▌"
60660 LOCATE 8,22:PRINT"/ ▌ ▌ ▌ ▐"
60670 LOCATE 9,21:PRINT"/ ▌ ▌ ▌ __ __ ▐_ __"
60680 LOCATE 10,20:PRINT"/ ▌ ▌ ▌/ \ / \ ▐/ ▐ / \▌"
60690 LOCATE 11,19:PRINT"/ ▌ ▌ █ ▐ ▌ / ▐ ▐ ▌ ▌"
60700 LOCATE 12,18:PRINT"/ \ ▌ ▌ █ ▐ ▌ ▐ ▐ ▌ ▌"
60710 LOCATE 13,17:PRINT"/ \▌ ▌ ▌\__/ \__/ ▐ ▐ \__/▌"
60720 LOCATE 15,36:PRINT"A G R I C U L T U R E"
60730 LOCATE 18,24:PRINT"LIVESTOCK INDUSTRY DIVISION"
60740 LOCATE 21,22:PRINT"PROVIDED BY ALBERTA AGRICULTURE."
60750 LOCATE 22,19:PRINT"RESPONSIBILITY RESTS SOLELY WITH USER"
60760 FOR S=1 TO 1500
60770 S$=INKEY$
60780 IF S$=CHR$(13) GOTO 60800
60790 NEXT S
60800 S$=""
60810 ON ERROR GOTO 0
60820 RETURN
62000 REM THIS IS THE SCREEN PRINT LOADER ACTIVATE WITH 'CALL PRTSCR'
62010 DEF SEG=&H0
62020 POKE &HF1, &HCD
62030 POKE &HF2, &H5
62040 POKE &HF3, &HCB
62050 PRTSCR=&HF1
62060 RETURN
README.DOC
ALBERTA DEPT. OF AGRICULTURE BASIC PROGRAMS - AUG '84
HELLO BAS 6049 Alberta Agricluture menu program - August 1984
BESTCROP BAS 11245 Breakeven prices & yields - March 1982
BFP BAS 21669 Breakeven feeder prices - July 1984
CARCOST BAS 10573 Car or truck costing program - January 1984
CFP BAS 13758 Comparative feed pricing - June 1984
CRCROP BAS 22813 Concensus research crops model - July 1984
DIET BAS 30240 Diet Detective Jr. - March 1983
DOLLAR BAS 30387 Dollar Detective - personal budgeting - March 1983
HAYCRAB BAS 7709 Hay cost returns and analysis - March 1982
LANDPUR BAS 13141 Land purchase decisions - February 1983
LOAN BAS 20059 Loan calculator - August 1984
RATION BAS 24837 Ration balancing - May 1984
COWCRAB BAS 11265 Cow calf risk analysis budget - July 1983
AUTOEXEC BAT 14 Batch file BASICA HELLO
INSTALL BAT 175 Batch file to add system and BASICA to disk
COMMAND COM 17792 DOS 2.1 COMMAND file
BASICA COM 26112 DOS 2.1 BASICA
README DOC 1152 This file
Directory of PC-SIG Library Disk #0460
Volume in drive A has no label
Directory of A:\
AUTOEXEC BAT 14 2-24-84 10:14a
BESTCROP BAS 11245 6-14-84 11:03a
BFP BAS 21669 7-10-84 3:52p
CARCOST BAS 10573 6-14-84 11:04a
CFP BAS 13758 6-14-84 11:01a
COMMAND COM 25307 3-17-87 12:00p
COWCRAB BAS 11265 7-12-84 1:33p
CRCROP BAS 22813 7-03-84 11:40a
DIET BAS 30240 6-14-84 11:15a
DOLLAR BAS 30387 7-04-84 2:28p
FILES460 TXT 1176 7-10-86 12:28p
HAYCRAB BAS 7709 6-14-84 11:05a
HELLO BAS 6049 8-28-84 8:35a
INSTALL BAT 175 2-24-84 10:14a
LANDPUR BAS 13141 6-14-84 11:13a
LOAN BAS 20059 8-27-84 12:08a
RATION BAS 24837 6-14-84 10:56a
README DOC 1152 8-18-85 12:14a
18 file(s) 251569 bytes
60416 bytes free