In 1985 whilst at NZWTA they were approached by Russell and Jeanette who farmed a 36,000 acre sheep station (since increased to 54,000 acres) 15 km south of Lindis Pass in the Central Otago High Country.
They were looking for some support to computerise their operation, and to become quite a large customer (some 20,000 samples per year typically).
Needless to say this sort of thing was 'right up my alley'.
I helped them set up their original system (based on the Wang Professional computer), and arranged for pretty much all records from 1980 to be manually entered.
From 1985 onwards manual data entry was to become a thing of the past. Test results were downloaded directly from the test laboratory, but birth details still needed to be matched. This too changed once we were able to get our OCR stamped onto their Kenmor eartags!
This meant that simply waving the wand was enough to get the sheep number passed to the computer and of course matching data became readily possible.
A breakthrough came when we had the ability to clip a removable tag onto the permanent eartag do a cross reference within the computer and then track the fleece once shorn right through the system.
As it is imperative to know exactly how much wool each sheep produces (for breeding purposes) each fleece is weighed and computerisation enabled everything to be matched up and the database updated all without error.
THIS WAS AMAZING.
So much so that in October 1985 we had clipon tags being attached to the existing sheep eartags, then removed by the shearers when shearing that particular sheep, this tag then being waved in front of the wand, the fleece weighed and the whole lot then being 'recorded for posterity' in the Wang Professional in the shearing shed itself.
It may not be apparent just how leading edge this technology was in 1985 – less than 10 years after my first lesson in programming!
Whilst having a beer that night we said something like nobody, but nobody is going to believe we are actually doing this – not just talking about it.
So we had a video made (copies of which are still available – even on CD).
We could all see that while a PC in the shed was sort of fine, we really needed something with more grunt. and probably housed in a 'cleaner' environment.
So we then installed a proper Wang 2200 multiuser mini with its own data storage cabinet, streaming tape drive for daily backup etc. back in the homestead
This had up to 16 terminal capacity - we had the main consul, also the PC set up as a terminal, another terminal in the kitchen, another in the ;upstairs office;, another in the woolshed and another in the conveyor room, over which all sheep travelled several times in their lives.
There was also a dial up modem to receive test lab data, and for remote programmer access for maintenance etc.
By this time we had also developed our automatic drafting gates.
Each of the 9 gates could have appropriate critera set, yield, micron, age,etc,etc and then by waving a wand over the eartag the correct gate would open.
Another marvellous innovation. The program to drive this follows below.
We were making waves – admittedly small ones – but the Rural Programme 'Agreport' then sent a team of 4 people who over the period of about 3 or 4 days recorded about 26 mins of video, edited down to about half and subsequently broadcast on TV1.
By this time we had detailed records of some 200,000 sheep. (This has since increased to over 500,000). The file handling system known as Katie( named after my eldest daughter) can access any record in about a fifth of a second.
I doubt if any modern computer can realistically beat that even now.
It is true to say that I am immensely proud of the file handler called Keyfile Access Technique Including Extras (KATIE) which superceded Latest Upgrade now Copes with Years of data (LUCY).
For the technically minded it uses a keyfile and a true random access data file.
When a sheep no, sex and year of birth is entered a preset algorithm calculates EXACTLY where in a the key file the matching record exists.
There is no need to scan the record is either there or not there.
If not there a message 'Sorry record is not found' is returned' if it is found the keyfile record points directly to the one and only place on the disk that all the data will be found.
This data typically includes yield and micron readings for each year of the sheep's life, all its fleece weights, its sire and dam, sometimes body weights, other features etc.
If the sheep has been sold who it has been sold to is also shown.
It can also include information about its progeny, including their number, av yield. Micron clean fleece weight etc,etc.
The actual birthdate is significant too as is the sampling and more particularly the various shearing dates.
For example if two hoggets (nominally 1 year olds – what can be termed teenagers) both produce the same weight of fleece but one was born (say) 5 days after the other then it is actually a better wool grower because it has been around for less time.
All of this is taken care of the the calculations – certainly in the matter of indexes (sure indicies for the pedantic) as described next.
Over the years the average micron – I.e fibre fineness – which pretty much determines the price eventually received for the wool, has reduced from about 18.5 mic to between 11 mic amd 13mic.
The computer produced histograms showed that whilst the average micron was reducing each year so was the ' spread' thus the bell curve was much narrower.
This without reducing fleece weight i.e. the amount of wool. This has been achieved by INDEXING.
We have had some seven built in indexes, one actually written by me – with some embarrasement on my part because of the sheer numbers of people who used it because of its simplicity.
The others were of course 'proper' each with a string of mathematical equations, which one had to have a PhD to comprehend.
The index for each sheep can be included on the screen and printout.
What we were able to prove was that the top 20% of sheep were he top 20% no matter what index was used and similarly the bottom 20% were always the bottom 20%.
It was those in the middle that had decisions to be made.
We could also prove this by running a program called INDEXES which showed the whole seven indexes for any sheep or range of sheep numbers, For example this information was vital to decide which sheep to keep.
It is also vital information to supply for rams up for sale at the Annual Ram Sale.
2020 was the 36th time this event has been held at the property.
Originally, this was the social event of the year with up to 1000 people attending even arriving by light plane. It has settled down somewhat to more or less just those who intend to buy.
For each and every Ram up for sale we produce an individual Performance Report.
This is something I am really proud of.
It gives all the details of the particular Ram, including yield, micron (at each sampling throughout its life) the fleece weight at each (dated) shearing etc.
But (because we have data going back to 1985 – if not earlier) we are able to give details of ALL its sires (we used to include the dam's side too but that became too unwieldy).
So, we provide to every prospective purchaser, standard details for each Ram's sire (no secrets here) and its sire, and its sire right back to its Grand,Grand,Grand,Grand,Grand,Grand,Grand sire.
In The Shearing Shed
These details also include the no of offspring each sire had produced, AND Av Yields, Av Mic, Av Gsy Weight, and Av Clean Weight. for all of its offspring. The actual program which produces these is also given below.
I had always had a little trepidation about fire, (flood, earthquake) happening at 'the farm', knowing that whilst their insurance company would 'happily?' replace the computer hardware in case of such an event without the data this is pretty useless.
We therefore instituted the concept of an off site back up 1000 km away. This continues to this very day. The entire contents of their computer is sent to me to maintain an exact mirror image on both of my machines. No we don't use the cloud, we manage it all ourselves. .
The actual program listing for the automatic drafting gates control
00001 REM% INDXGATE WBS 10/7/2009 LOTS !!!!!!!!!!! 00002 COM q,q$1,s2,t,t$(16),t1,t1$3,t1$(16),t2,t2$(32)8,t3$12,t6,t7$32,t8,t9,u, u(6),v,x$1,x1$6 00007 SELECT PRINT /005(80) : PRINT HEX(03) : PRINT AT(10,10,30);"*** RETURNING TO MAINMENU, PLEASE WAIT.....***"; : GOTO 200
-00200 DIM l3(9),y6(9),l4(9),m6(9),l5(9),f6(9),l3$4,y6$4,l4$5,m6$5,l5$5,f6$5, d$(10)1,r4$2,r3$(9)3,r2$(9)4,f5$1,s6$1,y1$2,f3$1,g5$1,w0$1,r1$6,s3$4, x$(29)1,z$(8)1,d9$1,b$(5,5)1,s1$1,w9$1,r8$4,r9$4,r8(9),r9(9) 00210 SELECT @PART "KATIE" : s2 = #PART 00215 IF #ID==0 THEN SHELL "27B.EXE COM2" 00220 d9$ = "M" : s1$ = "F" : w9$ = "U" 00225 l4$ = "10.00" 00230 GOSUB '131 : GOSUB '215 : r4 = 99 : GOSUB 530 -00240 SELECT ERROR > 64 : GOSUB '215 00250 PRINT AT(2,25,); : IF f$=="F" THEN PRINT " Forest Range" : ELSE PRINT " Tomich" 00260 y3$ = y1$ : IF y1$=="V" THEN 270 : PRINT AT(3,30);"YEAR Born "; : LINPUT -y3$ -00270 f = POS("FT" == f$) : PRINT AT(2,48,30);" Year ";y3$ : CONVERT y3$ TO y3 : ERROR REM -00280 t0$ = s$
View archived program listing — original page 91
: IF s$<>"V" THEN 290
: PRINT AT(6,30);"Ram,Ewe,Wether";
: KEYIN t0$
-00290 s = POS("REW" == t0$)
: IF s==0 THEN 280
: PRINT AT(2,3,20);
: IF t0$=="R" THEN PRINT " Ram"
: IF t0$=="E" THEN PRINT " Ewe "
: IF t0$=="W" THEN PRINT " Wether"
00299 IF s1$=="S" THEN 10000
-00300 s3$ = " "
: PRINT AT(3,29);"Sheep No <0000>";
: IF w0$=="K" THEN LINPUT -s3$
00305 r5 = 0
00310 IF w0$<>"W" THEN 320
: a$ = " "
: GOSUB 840
: s3$ = STR(a$,3,4)
00314 CONVERT STR(a$,2,1) TO y3
: ERROR y3$ = "N"
00315 IF y3$<>"N" THEN CONVERT y3 TO y3$,(##)
00316 REM FOR NEW WAND -
: IF w9$<>"N" THEN 320
: s3$ = STR(a$,2,4)
: CONVERT STR(a$,,1) TO y3
: ERROR y3$ = "N"
00317 IF y3$<>"N" THEN CONVERT y3 TO y3$,(##)
: IF y1$=="V" THEN PRINT AT(5,40,30);y3$
: IF y3$<>"N" THEN 320
: PRINT AT(5,40,30);"CLIPPON"
: GOSUB '205(s6)
: GOTO 240
-00320 IF s3$==" " THEN 300
: t0,r6 = 0
: CONVERT s3$ TO s3
: ERROR s3 = 0
: PRINT s3$
: PRINT HEXOF(s3$)
: PRINT AT(20,40);"Any key ....";
: KEYIN k$
: GOTO 240
: REM FOR WAND TESTING!!!!!!
00330 IF s3==0 THEN LOAD "START"
: PRINT AT(3,40,39);s3
: PRINT AT(2,60);y3$
00333 IF y3$<>"N" THEN 340
: PRINT AT(2,60,);"CLIPON !!"
: PRINT HEX(07)
: GOSUB '205(s6)View archived program listing — original page 92
: PRINT HEX(07) : GOTO 240 -00340 GOSUB '132(s,f,y3,s3,0) : IF q$==" " THEN 360 00350 PRINT AT(20,28);"SORRY NOT FOUND" : GOSUB '244(2,2) : PRINT AT(20,28,); : GOTO 300 -00360 RESTORE : FOR x = 6 TO 20 STEP 2 : UNPACK(##.##) STR(t7$,x,2) TO z : ERROR z = 0 00370 IF z==20.2 THEN z = 0 : READ d3$ : PRINT AT(x,2);d3$,z : IF x==6 THEN y2 = z/100 : IF z==0 OR x<10 THEN 380 : t0 = t0+z : r6 = r6+1 -00380 IF x==8 THEN m4 = z : NEXT x : PRINT AT(22,3);"Av Clean Wt ";ROUND(t0/r6*y2,2) : IF STR(t7$,30,1)=="D" THEN PRINT AT(7,33);"Dry" : a3 = ROUND(t0/r6*y2,2) : IF r4==0 THEN 450 : GOSUB '132(s,f,y3,s3,20) : IF q$==" " THEN 390 : PRINT AT(10,55);"No More details yet";HEX(06) : GOTO 500 -00390 UNPACK(####) STR(t7$,6,2) TO z : PRINT AT(6,55);"Steel Tag",z; : PRINT AT(8,55);"Feat",STR(t7$,8,6); : UNPACK(######) STR(t7$,14,3) TO s9 : ERROR s9 = 0 00400 IF s9>0 THEN PRINT AT(10,55);"Sire ",s9 : UNPACK(######) STR(t7$,17,3) TO d8 : ERROR d8 = 0 00410 IF g5$=="S" THEN STR(t7$,30,3) = STR(t7$,14,3) 00420 IF d8>0 THEN PRINT AT(11,55);"Dam ",d8 : UNPACK(####) STR(t7$,20,2) TO r5 : ERROR r5 = 0 00421 IF r5==0 THEN r5 = 9999 00430 IF r5>0 AND r5<9999 THEN PRINT AT(13,55);"Rank",r5 : FOR x = 22 TO 28 : UNPACK(##) STR(t7$,x,1) TO z : ERROR z = 0 00440 IF z==20 THEN z = 0 : PRINT AT(x-7,55);"BDY";x-21,z; : NEXT x
View archived program listing — original page 93
-00450 IF r4==0 THEN STR(t7$,30,1) = HEX(00)
: UNPACK(######) STR(t7$,30,3) TO r1
: ERROR r1 = 0
00460 IF r1>0 THEN PRINT AT(22,55,20);"Ram ";r1
00470 IF f3$<>"Y" THEN 480
: PRINT AT(22,30);"Features";
: LINPUT -STR(t7$,8,6)
-00480 IF g5$<>"Y" THEN 490
: PRINT AT(22,30,40);"Ram ";
: LINPUT -r1$
: HEXPACK STR(t7$,30,3) FROM r1$
-00490 GOSUB '233(s,s,t7$,1)
: IF q$<>" " THEN STOP
-00500 IF g8<1 THEN 300
: GOSUB 760
00510 PRINT AT(21,33);HEX(0E);"GATE ";m
: GOSUB 925
00515 IF d9$=="A" THEN GOSUB 660
: SELECT PRINT /005(80)
: GOSUB '205(s6)
00516 REM KEYIN k$
: GOTO 240
00520 DATA "Yield %","Micron ","Gfw 1","Gfw 2","Gfw 3","Gfw 4","Gfw 5","Gfw 6"
-00530 GOSUB '215
: PRINT AT(5,10);"HOW MANY GROUPS DO YOU WANT TODAY <0 - 8> ";
: INPUT g8
: IF g8<1 THEN 540
: IF g8>4 THEN 535
-00533 PRINT AT(6,10,);"Full Display or Scroll Details <F/S> ";
: LINPUT -s1$
: IF POS("FS" == s1$)==0 THEN 533
-00535 FOR g = 1 TO g8
: GOSUB 600
: NEXT g
-00540 GOSUB '215
: PRINT AT(5,10,);"Forest Range/Tomich or Variable"
: KEYIN f$
: PRINT AT(5,50);f$
: PRINT AT(6,10);"Ram/Ewe/Wether or Variable";
: KEYIN s$
: PRINT AT(6,50);s$
: PRINT AT(7,10);"Year or Variable";
: LINPUT -y1$
00545 IF POS("FT" == f$)==0 OR POS("REWV" == s$)==0 THEN 540
00550 PRINT AT(8,10);"Will You be entering Features <Y/N>";
: KEYIN f3$
: PRINT AT(8,50);f3$
: PRINT AT(9,10);"Entering Ram group <Y/N>";
: KEYIN g5$
: PRINT AT(9,50);g5$
: PRINT AT(10,10);"Wand or Keyboard"View archived program listing — original page 94
: KEYIN w0$ : PRINT AT(10,50);w0$ : IF w0$<>"W" THEN 570 00560 GOSUB 790 -00570 PRINT AT(11,10);"Gate OPEN time secs "; : INPUT s6 00580 PRINT AT(12,10);"Auto or Manual Drafting <A/M> "; : LINPUT d9$ 00585 PRINT AT(13,10);"Usual or New WAND <U/N> "; : LINPUT w9$ 00590 RETURN -00600 PRINT HEX(03) : GOSUB '215 : PRINT AT(3,28);"Gate No ";g 00610 l3$ = "40.0" : y6$ = "95.0" : PRINT AT(9,0);"Lower Yield Limit "; : LINPUT -l3$ : PRINT AT(9,50);"Upper Yield Limit "; : LINPUT -y6$ : CONVERT l3$ TO l3(g) : CONVERT y6$ TO y6(g) 00620 l4$ = "10.00" : m6$ = "29.99" : PRINT AT(10,0);"Lower micron Limit"; : LINPUT -l4$ : PRINT AT(10,50);"Upper Micron Limit"; : LINPUT -m6$ : CONVERT l4$ TO l4(g) : CONVERT m6$ TO m6(g) 00630 l5$ = "0.00" : f6$ = "999" : PRINT AT(11,0);"Lower Clean Fleece "; : LINPUT -l5$ : PRINT AT(11,50);"Upper Clean Fleece "; : LINPUT -f6$ : CONVERT l5$ TO l5(g) : CONVERT f6$ TO f6(g) -00640 r2$(g) = "ALL" : PRINT AT(12,0);"Ram Group "; : LINPUT -r2$(g) : r4$ = " " : PRINT AT(12,50);"Year "; : LINPUT -r4$ : IF r2$(g)=="ALL" THEN 645 : IF r4$==" " THEN 640 : CONVERT r2$(g) TO r2 : CONVERT r4$ TO r4 : IF r4==99 THEN r4 = 0 : PACK(##) STR(r3$(g),,1) FROM r4 : PACK(####) STR(r3$(g),2,2) FROM r2
View archived program listing — original page 95
-00645 r8$ = "0"
: r9$ = "9999"
: PRINT AT(13,0);"Ranking from ";
: LINPUT -r8$
: PRINT AT(13,50);"Ranking to ";
: LINPUT -r9$
: CONVERT r8$ TO r8(g)
: CONVERT r9$ TO r9(g)
00650 RETURN
-00660 REM% BASIC CONTROL PROGRAM
00670 STR(p$,2,8) = "01234567"
: STR(p$,,1) = HEX(00)
00680 d$() = ALL(HEX(00))
00690 SELECT PRINT /204(130)
00700 PRINT d$();
00710 FOR x = 1 TO s6*2
00720 d$() = ALL(STR(p$,m+1,1))
: PRINT d$();
00730 GOSUB 780
00740 NEXT x
: d$() = ALL(HEX(00))
: PRINT HEX(000000000000000000000000000000000000000000000000000000000000000
000000000000000000000000000000000000000000000000000000000000000000000
00000000)
00750 RETURN
-00760 REM% This is MOST important - it determines GATE !!!!
00765 FOR m = 1 TO g8+1
: IF y2*100>=l3(m) AND y2*100<=y6(m) AND m4>=l4(m) AND m4<=m6(m) AND
a3>=l5(m) AND a3<=f6(m) AND r5>=r8(m) AND r5<=r9(m) AND r2$(m)==
"ALL" OR r3$(m)==STR(t7$,14,3) THEN 770
: NEXT m
00766 IF m>g8 THEN m = 0
-00770 RETURN
-00780 SELECT INPUT /001
: RETURN
-00790 REM%LOAD UP MXE EQUIV
00800 b$ = "01C"
00810 g0$ = HEX(4402 A000 440C)
: g1$ = HEX(4403 1020 02FF 03FF 1223 C620)
: g6$ = HEX(4408)
: g7$ = HEX(4409 1020 02FF 03FF 1223 C620)
: g9$ = HEX(440A A000 440C)
00820 SELECT #6 <b$>
: SELECT TC <b$>
: $OPEN #6
: ERROR STOP "FOR NOW"
00825 x$() = ALL(HEX(00))
: x$(1) = HEX(1F)View archived program listing — original page 96
: x$(2) = HEX(23)
: x$(3) = HEX(32)
: x$(4) = "?"
: x$(5) = HEX(05)
: x$(6) = HEX(00)
: x$(10) = HEX(0C)
00830 REM SETCONTVECT
: $GIO#6 (HEX(4402 A000 440C),g$)x$()
: REM STARTRECEIV
: $GIO#6 (HEX(4408),g$)
: REM RECEIVE
: $GIO#6 (g6$,g$)
: RETURN
-00840 REM% ACTUAL READING OF CLIPON OR WHATEVER
-00850 GOSUB 890
: KEYIN k$,860,880
00855 REM PRINT AT(22,30);HEXOF(z$())
-00860 IF v<6 OR z$(6)>HEX(00) THEN 850
: GOSUB 900
00870 STR(i$,,6) = STR(t1$(),,6)
: FOR x = 1 TO 6
: IF STR(i$,x,1)>HEX(7F) THEN STR(i$,x,1) = SUB HEX(80)
: NEXT x
: a$ = i$
: RETURN
-00880 PRINT AT(3,40,10);"All tag Characters";
: LINPUT -STR(a$,,6)
: RETURN
-00890 $BREAK
: REM READSTATUS
: $GIO#6 (g1$,g$)z$()
: v = VAL(z$(4))
: RETURN
-00900 $BREAK
: REM TRANSFER
: $GIO#6 (g7$,g$)t1$()
: RETURN
-00925 REM% MAJOR REWRITE TO GIVE BIG NUMBERS - PASS VARIABLE 'M' I.E. GATE
NUMBER
00950 b$() = ALL(HEX(8B))
00980 ON m+1 GOSUB 1000,1100,2000,3000,4000,5000,6000,7000,8000,9000
00990 RETURN
-01000 REM% '0'
01010 b$(2,2),b$(2,3),b$(2,4) = " "
01020 b$(3,2),b$(3,3),b$(3,4) = " "
01040 b$(4,2),b$(4,3),b$(4,4) = " "View archived program listing — original page 97
01099 GOSUB 9999 : RETURN -01100 b$(1,4),b$(1,5) = " " 01200 b$(2,1),b$(2,2),b$(2,5),b$(2,4) = " " 01300 b$(3,1),b$(3,2),b$(3,5),b$(3,4) = " " 01400 b$(4,1),b$(4,2),b$(4,5),b$(4,4) = " " 01999 GOSUB 9999 : RETURN -02000 REM%'2' 02200 b$(2,1),b$(2,2),b$(2,3),b$(2,4) = " " 02400 b$(4,2),b$(4,3),b$(4,4),b$(4,5) = " " 02999 GOSUB 9999 : RETURN -03000 REM% '3' 03200 b$(2,1),b$(2,2),b$(2,3),b$(2,4) = " " 03400 b$(4,1),b$(4,2),b$(4,3),b$(4,4) = " " 03999 GOSUB 9999 : RETURN -04000 b$(1,2),b$(1,3),b$(1,4),b$(1,5) = " " 04100 b$(2,3),b$(2,3),b$(2,4),b$(2,5) = " " 04200 b$(2,2),b$(2,3),b$(2,4),b$(2,5) = " " 04300 b$(3,2),b$(3,3),b$(3,5) = " " 04500 b$(5,2),b$(5,3),b$(5,5) = " " 04999 GOSUB 9999 : RETURN -05000 REM%'5' 05100 b$(2,2),b$(2,3),b$(2,4),b$(2,5) = " " 05200 b$(2,2),b$(2,3),b$(2,4),b$(2,5) = " " 05400 b$(4,1),b$(4,2),b$(4,3),b$(4,4) = " " 05999 GOSUB 9999 : RETURN -06000 REM% '6' 06100 b$(1,1),b$(1,2),b$(1,3),b$(1,4),b$(1,5) = " " 06200 b$(2,2),b$(2,3),b$(2,4),b$(2,5) = " " 06400 b$(4,2),b$(4,3),b$(4,4) = " " 06999 GOSUB 9999 : RETURN -07000 REM%'7' 07200 b$(2,1),b$(2,2),b$(2,3),b$(2,4) = " " 07300 b$(3,1),b$(3,2),b$(3,3),b$(3,4) = " " 07400 b$(4,1),b$(4,2),b$(4,3),b$(4,4) = " " 07500 b$(5,1),b$(5,2),b$(5,3),b$(5,4) = " " 07999 GOSUB 9999 : RETURN
View archived program listing — original page 98
-08000 REM%'8'
08200 b$(2,2),b$(2,3),b$(2,4) = " "
08400 b$(4,2),b$(4,3),b$(4,4) = " "
08999 GOSUB 9999
: RETURN
-09000 REM%'9'
09200 b$(2,2),b$(2,3),b$(2,4) = " "
09400 b$(4,1),b$(4,2),b$(4,3),b$(4,4) = " "
09500 b$(5,1),b$(5,2),b$(5,3),b$(5,4) = " "
09980 GOSUB 9999
: RETURN
09989 STOP
-09999 FOR x1 = 1 TO 5
: FOR y1 = 1 TO 5
: PRINT AT(15+x1,34+y1);b$(x1,y1);
: NEXT y1
: PRINT
: NEXT x1
: RETURN
-10000 REM% 1ST ATTEMPT AT SCROLLING!
: GOSUB '215
: REM FOR NOW!
-10100 PRINT AT(14,0,);
: PRINT BOX(10,79);
10250 PRINT AT(14,20,);
: IF f$=="F" THEN PRINT " Forest Range"
: ELSE PRINT " Tomich"
10270 f = POS("FT" == f$)
: PRINT AT(14,44);y3$
: CONVERT y3$ TO y3
10290 PRINT AT(14,48);
: IF t0$=="R" THEN PRINT "Ram"
: IF t0$=="E" THEN PRINT "Ewe "
: IF t0$=="W" THEN PRINT "Weth"
-10300 s3$ = " "
: PRINT AT(15,30,);"Sheep No <0>";
: IF w0$=="K" THEN LINPUT -s3$
10305 r5 = 0
10310 IF w0$<>"W" THEN 10320
: a$ = " "
: GOSUB 840
: s3$ = STR(a$,3,4)
10315 REM FOR NEW WAND -
: IF w9$=="N" THEN s3$ = STR(a$,2,4)
-10320 IF s3$==" " THEN 10300
: t0,r6 = 0
: CONVERT s3$ TO s3
: ERROR s3 = 0
: PRINT s3$View archived program listing — original page 99
: PRINT HEXOF(s3$) : REM WAS STOP 10330 IF s3==0 THEN 10300 : PRINT AT(15,42,10);s3 10340 GOSUB '132(s,f,y3,s3,0) : IF q$==" " THEN 10360 10350 PRINT AT(20,28);"SORRY NOT FOUND" : GOSUB '244(2,2) : PRINT AT(20,28,); : GOTO 10300 -10360 RESTORE : FOR x = 6 TO 20 STEP 2 : UNPACK(##.##) STR(t7$,x,2) TO z : ERROR z = 0 10370 IF z==20.2 THEN z = 0 : READ d3$ : PRINT AT(11+(x/2),2);d3$,z : IF x==6 THEN y2 = z/100 : IF z==0 OR x<10 THEN 10380 : t0 = t0+z : r6 = r6+1 -10380 IF x==8 THEN m4 = z : NEXT x : PRINT AT(22,2);"Av Clean Wt ";ROUND(t0/r6*y2,2); : IF STR(t7$,30,1)=="D" THEN PRINT AT(7,33);"Dry" : a3 = ROUND(t0/r6*y2,2) : IF r4==0 THEN 10450 : GOSUB '132(s,f,y3,s3,20) : IF q$==" " THEN 10390 : GOTO 10500 -10390 UNPACK(####) STR(t7$,6,2) TO z : PRINT AT(14,55);"Steel Tag",z; : PRINT AT(15,55);"Feat",STR(t7$,8,6); : UNPACK(######) STR(t7$,14,3) TO s9 : ERROR s9 = 0 10400 IF s9>0 THEN PRINT AT(17,55);"Sire ",s9 : UNPACK(######) STR(t7$,17,3) TO d8 : ERROR d8 = 0 10410 IF g5$=="S" THEN STR(t7$,30,3) = STR(t7$,14,3) 10420 IF d8>0 THEN PRINT AT(18,55);"Dam ",d8 : UNPACK(####) STR(t7$,20,2) TO r5 : ERROR r5 = 0 10421 IF r5==0 THEN r5 = 9999 10430 IF r5>0 AND r5<9999 THEN PRINT AT(19,55);"Rank",r5 -10450 IF r4==0 THEN STR(t7$,30,1) = HEX(00) : UNPACK(######) STR(t7$,30,3) TO r1 : ERROR r1 = 0 10460 IF r1>0 THEN PRINT AT(22,55,20);"Ram ";r1 -10500 GOSUB 10760 10510 PRINT AT(22,33);HEX(0E);"GATE ";m
View archived program listing — original page 100
: REM NOW TO GET BIG NUMBER!!
: GOSUB 925
: REM ADJUST THE PRINT POSITION
10515 IF d9$=="A" THEN GOSUB 660
: SELECT PRINT /005(80)
: GOSUB '205(s6)
: REM GOTO 240
10600 REM NOW THE TRICKY BIT TO SORT OF SCROLL.
: PRINT AT(13,1,);
: PRINT TAB(m*15);s3
: PRINT AT(24,1)
: PRINT AT(13,1);
: PRINT BOX(-0,-80)
10620 PRINT AT(0,1);"Group No One Two Three
Four"
: PRINT AT(0,15);
: GOSUB 10800
: PRINT AT(0,30);
: GOSUB 10800
: PRINT AT(0,45);
: GOSUB 10800
: PRINT AT(0,60);
: GOSUB 10800
10650 PRINT AT(23,0);BOX(-0,-80)
10700 GOTO 10100
-10760 REM% This is MOST important - it determines GATE !!!!
10765 FOR m = 1 TO g8+1
: IF y2*100>=l3(m) AND y2*100<=y6(m) AND m4>=l4(m) AND m4<=m6(m) AND
a3>=l5(m) AND a3<=f6(m) AND r5>=r8(m) AND r5<=r9(m) AND r2$(m)==
"ALL" OR r3$(m)==STR(t7$,14,3) THEN 10770
: NEXT m
10766 IF m>g8 THEN m = 0
-10770 RETURN
-10800 PRINT BOX(13,6)
: RETURN
And now the Performance Report oneView archived program listing — original page 101
00001 REM% PERFRPRT 20/11/2013 -SQUEEZED UP
00002 COM q,q$1,s2,t,t$(16),t1,t1$3,t1$(16),t2,t2$(32)8,t3$12,t6,t7$32,t8,t9,u,
u(6),v,x$1,x1$6
00007 SELECT PRINT /005(80)
: PRINT HEX(03)
: PRINT AT(10,10,30);"*** RETURNING TO MAINMENU, PLEASE WAIT.....***";
: GOTO 200
-00200 DIM s(20),d(20),p$(20)2,s$(20)1,y$(20)1,p1$(130)1,p2$(130)1,b(14),p$1,
s3$4,y3$2,d0(12),g0(12),s1$(3)8,m(12),d1$(50)8,d4$(20)8,f1$3,m$(10)3,
s0$(10)3,c2(3),w(6),g$(10)
: SELECT ERROR > 64, @PART "KATIE"
: s2 = #PART
: GOSUB '131
: d4 = 0
00201 GOSUB '239(4)
: GOSUB '130(4,"RAMSF2LE","310")
: IF q$<>" " THEN STOP
00202 c9$ = HEX(1B) & "&k2S"
: c0$ = HEX(1B) & "&k0S"
: c8$ = HEX(1B) & "(s5H"
: REM IF @p$<>"D13" THEN 205
00203 c9$ = HEX(0F)
: c0$ = HEX(12)
: c8$ = HEX(0E)
00205 p$(),p1$(),p2$() = " "
: s() = ZER
: d() = ZER
:s=0
00210 GOSUB '215
: s3$ = " "
: PRINT AT(2,30);"Sheep No ";
: LINPUT -s3$
: IF s3$==" " THEN LOAD RUN
00220 CONVERT s3$ TO s3
: IF s3<1 THEN END
: t9$ = "T"
: PRINT AT(3,25,150);
: IF t9$=="F" THEN PRINT " Forest Range"
: ELSE PRINT " Tomich"
: y3$ = "11"
: PRINT AT(4,30);"YEAR Born ";
: LINPUT -y3$
:f=1
: IF t9$=="T" THEN f = 2
: CONVERT y3$ TO y3
00230 s1$(1) = "RAM"
: s1$(2) = "EWE"
: s1$(3) = "WETHER"
-00240 PRINT AT(5,30,);View archived program listing — original page 102
: t0$ = "R"
: s = POS("REW" == t0$)
: IF s==0 THEN 240
: PRINT AT(5,30,30);
: PRINT " ";s1$(s)
00245 f1$ = "--M"
: STR(f1$,,1) = t0$
: PACK(##) STR(f1$,2,1) FROM y3
: GOSUB '239(5)
: GOSUB '130(5,"SAMPF0RN",@p$)
: IF q$<>" " THEN STOP
: GOSUB '232(5,5,f1$)
: IF q$<>" " THEN STOP
: m$() = STR(t1$(),u,32)
: STR(f1$,3,1) = "S"
: GOSUB '232(5,5,f1$)
: IF q$<>" " THEN STOP
: s0$() = STR(t1$(),u,32)
: GOSUB '239(5)
00246 d1$(),d4$() = ALL("/")
00247 FOR x = 0 TO 8
: y = x*2+1
: HEXUNPACK STR(m$(x+2),,1) TO STR(d1$(y),,2)
: HEXUNPACK STR(m$(x+2),2,1) TO STR(d1$(y),4,2)
: HEXUNPACK STR(m$(x+2),3,1) TO STR(d1$(y),7,2)
: HEXUNPACK STR(s0$(x+2),,1) TO STR(d4$(y),,2)
: HEXUNPACK STR(s0$(x+2),2,1) TO STR(d4$(y),4,2)
: HEXUNPACK STR(s0$(x+2),3,1) TO STR(d4$(y),7,2)
00248 IF STR(d1$(y),,2)=="00" THEN d1$(y) = " "
: IF STR(d4$(y),,2)=="00" THEN d4$(y) = " "
: NEXT x
00250 GOSUB '132(s,f,y3,s3,0)
: IF q$==" " THEN 270
00260 PRINT AT(20,27);HEX(07);"SORRY NOT FOUND"
: GOSUB '244(1,1)
: GOTO 200
-00270 REM WE HAVE THE 00 RECORD SO LETS GET WHAT DETAILS WE NEED i.e.
hogget
yield & micron also greasy fleece wgts
00280 $TRAN(t7$,HEX(00FF))R
:k=0
: FOR x = 6 TO 8 STEP 2
: UNPACK(##.##) STR(t7$,x,2) TO z
: IF z==20.2 THEN z = 0
: k = k+1
: d0(k) = z
: NEXT x
: k1 = 0
: FOR x = 10 TO 20 STEP 2
: k1 = k1+1
: UNPACK(##.##) STR(t7$,x,2) TO zView archived program listing — original page 103
: IF z==20.2 THEN z = 0
: g0(k1) = z
: NEXT x
: REM yld & mic in do(, gsy wgts in g0(
00289 GOSUB 9000
00290 REM will have to get sampling and shearing dates but leave that just
for now
00300 REM now to get what 20 info we have.
00310 GOSUB '132(s,f,y3,s3,20)
: IF q$<>" " THEN STOP
00320 FOR x = 8 TO 13
: IF STR(t7$,x,1)<" " OR STR(t7$,x,1)>"z" THEN STR(t7$,x,1) = " "
: NEXT x
: UNPACK(######) STR(t7$,14,3) TO s9
: ERROR s9 = 0
: REM this gives us the sire
00330 UNPACK(######) STR(t7$,17,3) TO d8
: ERROR d8 = 0
: REM this is dam
00340 b1$ = " "
: IF STR(t7$,12,1)=="2" THEN b1$ = "Twin"
00350 d3 = VAL(STR(t7$,29,1))
: ERROR d3 = 0
: REM THIS ACTUALLY is the birthdate
00351 b8$ = "BORN 19" & y3$
: IF y3$<"80" THEN b8$ = "BORN 20" & y3$
: d3 = d3+98
: IF d3<150 OR d3>350 THEN 370
00355 m(1) = 30
: m(2) = 28
: m(3) = 31
: m(4) = 30
: m(5) = 31
: m(6) = 30
: m(7) = 31
: m(8) = 31
: m(9) = 30
: m(10) = 31
: m(11) = 30
: m(12) = 31
: FOR x = 1 TO 11
: d4 = d4+m(x)
: IF d3-d4<=m(x+1) THEN DO
: m = x+1
: x = 12
: END DO
: NEXT x
00360 REM this will become a katie routine in due course - to extract date
from this one byte
: b8$ = "--/--/" & y3$
: CONVERT d3-d4 TO STR(b8$,,2),(##)
: CONVERT m TO STR(b8$,4,2),(##)View archived program listing — original page 104
-00370 REM now to get the 30 info - this has the subsequent yield/micron
00380 GOSUB '132(s,f,y3,s3,30)
: IF q$<>" " THEN 400
: FOR x = 6 TO 16 STEP 2
: UNPACK(##.##) STR(t7$,x,2) TO z
: k = k+1
: d0(k) = z
: NEXT x
00385 FOR x = 22 TO 28 STEP 2
: UNPACK(##.##) STR(t7$,x,2) TO z
: k = k+1
: d0(k) = z
: NEXT x
00390 REM this code is not correct - it will be used though for its parent
details
-00400 REM D0(5)=D0(1)
: REM REMOVE TO USE CORRECT YIELD
00420 PRINT AT(20,30);"Big/Little/Here ";
: KEYIN p$
: PRINT AT(20,30,);"Printing......"
: GOSUB '216(p$,130)
: PRINT HEX(0F)
: PRINT c0$;HEX(0A)
00425 REM DID HAVE PRINTING DATE HERE
00430 PRINT c8$
: PRINT TAB(10);"FOREST RANGE STATION"
: PRINT c8$;TAB(9);"RAM PERFORMANCE REPORT "
00440 PRINT c8$;TAB(3);"SHEEP No ";s3;" Born 20";y3$
: PRINT HEX(0E)
: REM WONT WORK FOR RAMS BORN PRIOR TO 2000
00450 REM IF y3$<"79" THEN PRINT TAB(30);"BORN 20";y3$ ELSE PRINT TAB(30);
"BORN 19";y3$
00455 PRINT c0$
00456 PRINT HEX(1B72 30);
00460 PRINT TAB(31);"PERFORMANCE DETAILS"
: PRINT TAB(28);"-------------------"
: PRINT "DATE FIBRE DIAMETER YIELD DATE SHORN CLEAN
FLEECE WGT"
: PRINT "---- -------------- ----- ---------- ---------
------"
00470 j = 0
: k1 = 1
: FOR x = 1 TO k STEP 2
: m4$,y2$ = " "
: x2 = MAX(x,x2)
: IF d0(x+1)<>0 THEN DO
: CONVERT d0(x+1) TO m4$,(##.#)
: CONVERT d0(x) TO y2$,(##.#)
: y2 = d0(x)
: END DO
: REM KEEPS THE LAST KNOWN YIELD FOR CLEAN FLEECE CALCS
-00475 c6$ = " "View archived program listing — original page 105
: IF STR(d1$(x2),4,2)<"08" AND STR(d1$(x2),4,2)<>" " THEN 480
: k1 = k1+1
: CONVERT g0(k1-1)*y2/100 TO c6$,(#.##)
-00480 IF d1$(x2)<>" " AND d1$(x2)<>"////////" THEN 481
: IF c6$<>"0.00" AND d4$(x2)==" " THEN d4$(x2) = "Latest "
: IF c6$<>"0.00" THEN 481
: x2 = x2+1
: IF x2>19 THEN 490
: GOTO 475
-00481 IF d1$(x2)=="////////" THEN 490
00482 PRINTUSING "######## ##.# ##.# ########
##.##",d1$(x2),m4$,y2$,d4$(x2),c6$
00485 IF c6$=="0.00" OR c6$==" " THEN 486
: CONVERT c6$ TO c7
: c8 = c8+c7
: j = j+1
-00486 d1$(x2) = " "
-00490 NEXT x
: PRINT TAB(59);"Av ";ROUND(c8/j,2)
00491 FOR x1 = 1 TO 1
: STR(f$,,4) = p$(x1)
: STR(f$,5,1) = HEX(40)
: UNPACK(##) s$(x1) TO s0
: UNPACK(##) y$(x1) TO y0
: UNPACK(####) p$(x1) TO s3
: GOSUB '132(s0,2,y0,s3,40)
: IF q$<>" " THEN 495
: GOSUB '40(x1,0,1)
00492 PRINT c9$
: PRINT ," No of Offspring Av. Yield Av. Micron
Av. Gsy Wgt Av.Clean Wgt"
00493 FOR y = 6 TO 14 STEP 2
: UNPACK(##.##) STR(t7$,y,2) TO b(y)
: NEXT y
: PRINTUSING " #### ##.##
##.## ##.## ##.##",b(6)*100,b(8),b(10),b(12),
b(14)
00494 p1$(),p2$() = " "
: GOSUB '245(1)
-00495 NEXT x1
: REM PRINT c0$;HEX(0A)
00500 PRINT TAB(32);"SIRE REPORTS"
: REM PRINT TAB(32);"------------"
00580 GOSUB 9140
00595 PRINT HEX(0C)
00600 LOAD "PERFRPRT" 200
-09000 REM SUBROUTINE TO SETUP FAM TREE TYPE THINGS
09010 y = y3
09020 GOSUB '132(s,2,y,s3,20)
09030 IF q$<>" " THEN STOPView archived program listing — original page 106
: t7$ = STR(t1$(),u,32) : UNPACK(######) STR(t7$,14,3) TO s(1) 09040 PACK(##) s$(1) FROM s : PACK(##) y$(1) FROM y : PACK(####) p$(1) FROM s3 09050 FOR x = 1 TO 9 : y = INT(s(x)/10000) : y1 = INT(d(x)/10000) : s1 = MOD(s(x),10000) : IF y1==20 THEN y1 = 0 : REM IF S1<1THEN 9090 09060 PACK(##) y$(x+1) FROM y : PACK(####) p$(x+1) FROM s1 09070 GOSUB '132(1,2,y,s1,20) : IF q$==" " THEN 9080 : GOSUB '132(4,2,y,s1,20) -09080 IF q$<>" " THEN 9090 : s$(x+1) = HEX(01) : t7$ = STR(t1$(),u,32) : UNPACK(######) STR(t7$,14,3) TO s(x+1) 09085 IF s(x+1)<>s(x) THEN 9090 : s(x+1) = 0 : x=9 -09090 GOTO 9130 : REM IGNORE DAMS TO CONCENTRATE ON SIRES ETC -09130 NEXT x : RETURN -09140 p1$(),p2$() = " " : PRINT TAB(6);"SIRE"; 09150 GOSUB '40(2,6,15) : PRINT TAB(20);p1$() : PRINT TAB(18);p2$() : p1$(),p2$() = " " : GOSUB '41(2,7,14,30) : PRINT TAB(18);p2$() : p2$() = " " : p1$ = " " : x1 = 2 : GOSUB 9310 09155 FOR g = 3 TO 10 : REM IF S(G+1)=0 THEN 9170 09160 GOSUB '40(g,10,10) : IF p1$()==" " OR STR(p1$(),10,4)=="0000" THEN 9170 : PRINT c0$ : REM ; ADDED TO SQUEEZE 09164 g$(3) = "GRAND SIRE" : g$(4) = "G GRAND SIRE" : g$(5) = "GG GRAND SIRE" : g$(6) = "GGG GRANDSIRE" 09165 PRINT TAB(3);g$(g);
View archived program listing — original page 107
: PRINT TAB(25);p1$() : PRINT TAB(23);p2$() : p1$(),p2$() = " " 09166 GOSUB '41(g,7,14,30) : PRINT TAB(18);p2$() : p1$(),p2$() = " " 09169 x1 = g : GOSUB 9310 : NEXT g -09170 RETURN 09180 DEFFN '40(s,x,y) : s4 = 0 : UNPACK(####) p$(s) TO s1 : UNPACK(##) y$(s) TO y0 : UNPACK(##) s$(s) TO s0 09190 IF s1==2020 OR y1==20 THEN 9210 09200 IF s1<9999 THEN CONVERT s1 TO STR(p1$(),y,4),(####) : ELSE CONVERT s1 TO STR(p1$(),y,5),(#####) : STR(p1$(),y+5,1) = "/" : CONVERT y0 TO STR(p1$(),y+6,2),(##) -09210 IF x>0 THEN GOSUB '41(s,x+1,y-1,0) : RETURN 09220 DEFFN '41(s,x,y,r) : UNPACK(##) s$(s) TO s0 : IF s0<>4 THEN s0 = MIN(s0,2) : UNPACK(##) y$(s) TO y0 : UNPACK(####) p$(s) TO s9 : GOSUB '132(s0,2,y0,s9,r) : IF q$==" " THEN 9230 09225 GOSUB '239(4) : GOSUB '130(4,"RAMSF2LE","310") : IF q$<>" " THEN STOP : s0 = 4 : GOSUB '132(s0,2,y0,s9,r) : IF q$<>" " THEN 9300 -09230 UNPACK(##.##) STR(t1$(),u+5,2) TO y3 : UNPACK(##.##) STR(t1$(),u+7,2) TO m : CONVERT y3 TO STR(p2$(),y,4),(##.#) : STR(p2$(),y+4,1) = "%" 09240 UNPACK(##.##) STR(t1$(),u+9,2) TO c : ERROR c = 0 09241 IF r<>0 THEN 9250 09242 UNPACK(##.##) STR(t1$(),u+11,2) TO w2 : ERROR w2 = 0 09243 UNPACK(##.##) STR(t1$(),u+13,2) TO w(3) : ERROR w(3) = 0 09244 UNPACK(##.##) STR(t1$(),u+15,2) TO w(4) : ERROR w(4) = 0 09245 UNPACK(##.##) STR(t1$(),u+17,2) TO w(5) : ERROR w(5) = 0
View archived program listing — original page 108
09246 UNPACK(##.##) STR(t1$(),u+19,2) TO w(6)
: ERROR w(6) = 0
09247 w(2) = w2
-09250 UNPACK(##.##) STR(t1$(),u+11,2) TO w2
: ERROR w2 = 0
09251 IF r==0 AND s<4 THEN c2(s) = w2
09255 IF r<>30 THEN 9260
: y3,c,m = 0
09256 GOSUB 9400
-09260 CONVERT c*y3/100 TO STR(p2$(),y+14,4),(#.##)
: STR(p2$(),y+19,3) = "Cfw"
: STR(p2$(),y-7,6) = "Hogget"
09265 IF r==30 THEN STR(p2$(),y-13,12) = "AverageAdult"
09266 CONVERT y3 TO STR(p2$(),y,4),(##.#)
: STR(p2$(),y+4,1) = "%"
09270 STR(p2$(),y+10,3) = "mic"
: CONVERT m TO STR(p2$(),y+6,4),(##.#)
: IF s>1 THEN 9300
: f6,w1 = 0
: FOR x = 9 TO 17 STEP 2
: UNPACK(##.##) STR(t1$(),u+x,2) TO c6
: ERROR c6 = 0
09280 IF c6==0 OR c6>10 THEN 9290
: f6 = f6+c6
: w1 = w1+1
-09290 NEXT x
-09300 RETURN
-09310 PRINT c9$
: PRINT ," No of Offspring Av. Yield Av. Micron
Av. Gsy Wgt Av.Clean Wgt"
09315 REM GOSUB '245(1)
: REM ADDED 15/12/2003 TO SPREAD OUT
09320 STR(f$,,4) = p$(x1)
: STR(f$,5,1) = HEX(40)
: UNPACK(##) s$(x1) TO s0
: s0 = MIN(s0,4)
: UNPACK(##) y$(x1) TO y0
: UNPACK(####) p$(x1) TO s3
: GOSUB '132(s0,2,y0,s3,40)
: IF q$==" " THEN 9325
: GOSUB '132(4,2,y0,s3,40)
: IF q$<>" " THEN 9350
-09325 GOSUB '40(x1,0,1)
09330 FOR y = 6 TO 14 STEP 2
: UNPACK(##.##) STR(t7$,y,2) TO b(y)
: NEXT y
: PRINTUSING " #### ##.##
##.## ##.## ##.##",b(6)*100,b(8),b(10),b(12),
b(14)
09340 p1$(),p2$() = " "
-09350 REM PRINT c0$View archived program listing — original page 109
: RETURN
: REM REMOVED C0$ TO SQUEEZE
-09400 REM NEWSTYLE AV ADULT READINGS
09480 k = 0
09580 FOR x = 6 TO 16 STEP 2
: UNPACK(##.##) STR(t7$,x,2) TO z
: k = k+1
: d0(k) = z
: NEXT x
09585 FOR x = 22 TO 28 STEP 2
: UNPACK(##.##) STR(t7$,x,2) TO z
: k = k+1
: d0(k) = z
: NEXT x
09600 c,k1 = 0
: FOR x = 2 TO 6
: IF w(x)==0 THEN 9699
: c = c+w(x)
: k1 = k1+1
-09699 NEXT x
: c = c/k1
:k=0
: FOR x = 1 TO 9 STEP 2
: IF d0(x)==0 THEN 9700
: y3 = y3+d0(x)
: m = m+d0(x+1)
: k = k+1
-09700 NEXT x
: y3 = y3/k
: m = m/k
: RETURN
PRODUCES THE FOLLOWING REPORTView archived program listing — original page 110
