10 REM > DownToCSV
   20 REM Extract data from 1911 Census downloads
   30 :
   40 REM Need to continue canonicalising addresses
   50 REM Calculates household numbers from pages
   60 REM Look up addresses in index files
   70 :
   80 verbose%=TRUE
   90 max%=19:year%=1911:month%=4:day%=2
  100 :
  110 A%=0:X%=1:os%=((USR&FFF4)AND&FF00)DIV256
  120 s$=".":fmax%=255:IFos%AND32:d$="\" ELSE IFos%AND8:d$="/" ELSE s$="/":d$=".":fmax%=10
  130 DIM head$(max%),info$(max%),addr$(max%)
  140 FOR A%=0 TO max%:READ head$(A%):NEXT
  150 DATA "HOUSEHOLD NUMBER","SURNAME","NAME","AGE","RELATIONSHIP","SEX","MARITAL STATUS","STREET ADDRESS"
  160 DATA "OCCUPATION","BIRTH YEAR","BIRTH PLACE","BIRTH COUNTY","BIRTH COUNTRY","INDIVIDUAL NUMBER"
  170 DATA "CIVIL PARISH","SUB-REGISTRATION DISTRICT","ENUMERATION DISTRICT","PIECE","PAGE","FOLIO"
  180 :
  190 ON ERROR REPORT:PROCClose_All:PRINT" at line ";ERL:END:IF ERR=17:QUIT ELSE END
  200 out%=OPENOUT(LEFT$("Whitby"+STR$year%+s$+"csv",fmax%))
  210 IF out%=0:PRINT"Couldn't open output file, is it already open?":END
  220 :
  230 lastH$="":lastS$=""
  240 lookup$="":lookup%=0:lookptr%=0
  250 REM lookup$="Addrs"+s$+"csv"
  260 REM lookup%=OPENIN(lookup$):lookptr%=0:looklast%=0
  270 PROCcsv_wr(out%,head$())
  280 IF verbose%:CLS:PRINT':FOR A%=0 TO max%:PRINTFNd0(A%,2);": ";head$(A%);":":NEXT:OFF
  290 head$(4)="RELATION":head$(5)="GENDER":head$(16)="ED, INSTITUTION, OR VESSEL"
  300 :
  310 FOR item%=30416000 TO 32799999
  320   REM   FOR item%=32790000 TO 32799999
  330   dir%=(item%DIV10000)MOD100
  340   item$="Downloads"+STR$dir%+d$+LEFT$(STR$item%+s$+"htm",fmax%)
  350   IF verbose%:VDU 30:PRINT SPC4;item%;
  360   in%=OPENIN(item$):IF in%:PROCprocess
  370   IF item%=30421000:item%=31530000
  380   IF item%=31560000:item%=32760000
  390 NEXT item%
  400 IF lookup%:CLOSE#lookup%:lookup%=0
  410 CLOSE#out%:out%=0:ON
  420 QUIT
  430 :
  440 DEFPROCprocess
  450 info$()=""
  460 info$(13)=STR$item%
  470 REPEAT:a$=GET$#in%:UNTIL INSTR(a$,"id=""record-main""") OR EOF#in%
  480 REPEAT
  490   a$=FNuc(GET$#in%)
  500   IF INSTR(a$,"<TH>") THEN
  510     REPEAT:b$=FNs(GET$#in%):UNTILINSTR(FNuc(b$),"<TD") OR EOF#in%
  520     b$=MID$(b$,INSTR(b$,"<"))
  530     REPEAT
  540       A%=INSTR(b$,"<"):B%=INSTR(b$,">",A%)
  550       IF A%:b$=LEFT$(b$,A%-1)+MID$(b$,B%+1)
  560     UNTILA%=0
  570     REPEAT
  580       A%=INSTR(b$,"&")
  590       IF A%:b$=LEFT$(b$,A%-1)+"&"+MID$(b$,A%+5)
  600     UNTILA%=0
  610     FOR A%=max% TO 1 STEP -1
  620       IF INSTR(a$,head$(A%)):IF info$(A%)="":info$(A%)=b$
  630     NEXT A%
  640   ENDIF
  650 UNTIL INSTR(a$,"HOUSEHOLD MEMBERS:") OR EOF#in%
  660 REPEAT:A$=GET$#in%:A%=INSTR(A$,"iid="):UNTIL A% OR EOF#in%:iid$=MID$(A$,A%+4,18)
  670 REPEAT:A$=GET$#in%:A%=INSTR(A$,"Class:"):UNTIL A% OR EOF#in%
  680 IF A%:A$=MID$(A$,A%):A$=MID$(A$,INSTR(A$,"<i>")+3):A$=LEFT$(A$,INSTR(A$,"<")-1):info$(17)=A$+"/"+info$(17)
  690 CLOSE#in%:in%=0
  700 IF FNuc(info$(15))<>"WHITBY":ENDPROC
  710 A$=FNuc(info$(14)):A$=LEFT$(A$,INSTR(A$+" "," ")-1)
  720 parish$=A$:sub$=""
  730 IF A$="HELREDALE":sub$="1"
  740 IF A$="WHITBY"   :sub$="2"
  750 IF A$="RUSWARP"  :sub$="3"
  760 IF A$="HAWSKER"  :sub$="4"
  770 IF sub$="":ENDPROC
  780 ed$=info$(16):IF STR$VALed$=ed$:ed$=FNd0(VALed$,2)
  790 info$(16)=ed$:REM "533/"+ed$
  800 info$(18)=STR$VALMID$(iid$,12)
  810 :
  820 REM Clean entries
  830 FOR A%=0 TO max%
  840   A$=info$(A%)
  850   REM Quotes mess up CSV output
  860   REPEAT:B%=INSTR(A$,CHR$34):IF B%:A$=LEFT$(A$,B%-1)+"'"+MID$(A$,B%+1)
  870   UNTIL B%=0
  880   :
  890   REM Demote parts in [...]
  900   B%=INSTR(A$,"["):IF B%:A$=LEFT$(A$,B%-1)
  910   :
  920   REM Promote parts in [....]
  930   REM B%=INSTR(A$,"["):IF B%:REPEAT:A$=MID$(A$,B%+1):B%=INSTR(A$,"["):UNTILB%=0
  940   REM B%=INSTR(A$,"]"):IF B%:A$=LEFT$(A$,B%-1)
  950   IF A$<>"":info$(A%)=A$
  960 NEXT A%
  970 IF verbose%:PRINTSPC3;info$(2);SPC(40-LENinfo$(2))'SPC4;LEFT$(info$(7),60);SPC(60-LENinfo$(7))
  980 :
  990 REM Seperate surname
 1000 A%=LENinfo$(2):REPEAT:A%=A%-1:UNTILMID$(info$(2),A%,1)=" " OR A%=0
 1010 IF A%:info$(1)=MID$(info$(2),A%+1):info$(2)=LEFT$(info$(2),A%-1)
 1020 :
 1030 REM Spelling mistakes:
 1040 REM A$=info$(1)
 1050 REM A$=FNswap(A$,"Brouz","Brown")
 1060 REM A$=FNswap(A$,"Kepling","Kipling")
 1070 REM A$=FNswap(A$,"Warsay","Marsay")
 1080 REM A$=FNswap(A$,"Mc ","Mc")
 1090 REM A$=FNswap(A$,"Sleighthoha","Sleightholme")
 1100 REM A$=FNswap(A$,"Slaightholane","Sleightholme")
 1110 REM info$(1)=A$
 1120 :
 1130 REM Contractions:
 1140 A$=info$(2)
 1150 A$=FNswap(A$,"Hy","Henry")
 1160 A$=FNswap(A$,"Wm","William")
 1170 A$=FNswap(A$,"Thos","Thomas")
 1180 A$=FNswap(A$,"Geo ","George ")
 1190 IF RIGHT$(A$,3)="Geo":A$=A$+"rge"
 1200 info$(2)=A$
 1210 :
 1220 REM Tidy age
 1230 A%=INSTR(info$(3),"/12"):IF A%:info$(3)=LEFT$(info$(3),A%-1)+"mth"+LEFT$("s",VALinfo$(3)<>1)
 1240 :
 1250 REM REM Find household number, adjust for missing pages
 1260 pg%=VALMID$(iid$,12):hh%=pg%DIV2+1:off%=0
 1270 IF info$(16)="01":IF hh%>002:off%=1
 1280 IF info$(16)="04":IF hh%>060:off%=1:IF hh%>139:off%=2:IF hh%>181:off%=3
 1290 IF info$(16)="07":IF hh%>017:off%=1:IF hh%>196:off%=2
 1300 IF info$(16)="08":IF hh%>156:off%=1
 1310 IF info$(16)="09":IF hh%>190:off%=1
 1320 IF info$(16)="11":IF hh%>025:off%=1
 1330 info$(0)=STR$(hh%-off%)
 1340 IF hh%=60:IF info$(16)="04":info$(0)="59A"
 1350 :
 1360 REM Find corrected address in index file
 1370 REM info$(19)=info$(7):REM debug
 1380 A$=FNlookup
 1390 IF A$<>"":info$(7)=A$ ELSE info$(7)="["+info$(7)+"]"
 1400 REM IF info$(7)<>"":IF LEFT$(info$(19),LENinfo$(7))=info$(7):info$(19)="":REM debug
 1410 :
 1420 REM Canonicalise addresses
 1430 A$=info$(7)
 1440 LOCAL DATA:RESTORE +0
 1450 READ street$
 1460 REPEAT
 1470   READ yard$
 1480   REPEAT
 1490     A$=FNadd(A$,yard$,street$)
 1500     READ yard$
 1510   UNTIL yard$="*"
 1520   READ street$
 1530 UNTIL street$="*"
 1540 info$(7)=A$
 1550 RESTORE DATA
 1560 REM :
 1570 REM Miller's Yard   on Church Street, Flowergate and Haggersgate
 1580 REM Clarke's Yard   on Church Street and Flowergate
 1590 REM Brown's Yard    on Church Street and Haggersgate
 1600 REM Andrew's Yard   on Church Street and Cliff Street
 1610 REM Lockey's Yard   on Church Street and Grape Lane
 1620 REM Dark Entry Yard on Church Street and Baxtergate
 1630 REM Johnson's Yard  on Baxtergate and Sandgate
 1640 REM Raft Yard       on Spital Bridge and Baxtergate/New Quay
 1650 REM Shield's Yard   on Baxtergate and Wellington Road
 1660 REM Langdale Terrace and Langdale Buildings, Baxtergate
 1670 DATA "Long Steps"
 1680 DATA "High Walk","Middle Walk","Low Walk"
 1690 DATA *
 1700 DATA "Church Street"
 1710 DATA "Borough","Blackburn","Woodwark","Kiln","Brewster","White Horse","Forester","Renwick"
 1720 DATA "Well Yard","Bolton's Yard","Primitive","Elbow","Taylorson","Corner","Infant School Yard"
 1730 DATA "Hospital Yard","Stanley Yard","Boulby Bank","Ellerby","Horse","Prospect Place","Laverick"
 1740 DATA "Long Steps","Sayer's","Gaskin","Boausom","Horner","Studley","Timber","Electricity"
 1750 DATA "Ropery Walk","Church Steps","Brewery Yard","St. Hilda's Cottages","Gaskin"
 1760 REM DATA "Ainsley's","Bank's","Benson's","Blacksmith's","Bonson's"
 1770 REM DATA "Cappleman's","Cockpit","Craven's","Flintoft's","Frank's"
 1780 REM DATA "Green's","Imperial Yard","Ivy Yard","Kelly's","Kirby's","Locker's"
 1790 REM DATA "Marshall's","Monkman's","New Way","Outhard's"","School"
 1800 REM DATA "Smales' Gallery","Steps","Turner's","Well Yard"
 1810 DATA *
 1820 REM DATA "Sandgate"
 1830 REM DATA "Nicholson's","Queen Hotel"
 1840 REM DATA *
 1850 REM DATA "Grape Lane"
 1860 REM DATA "Tin Ghaut","Lamb's","Raffled Anchor","Custom House Hotel"
 1870 REM DATA *
 1880 DATA "Baxtergate"
 1890 DATA "Belle Hotel","Plough Inn","Tyreman","Hilton","Mackridge","Linskill Square"
 1900 DATA "Beck","Elm Yard","Albion Hotel"
 1910 REM DATA "Belle Hotel","Mead's","Angel Hotel","Vipond's","Goodwill's","Ward's"
 1920 REM DATA "Brignell's","Woodhouse","Albion Hotel","Trueman's"
 1930 REM DATA "Wald's","Leng's","Coffee Bar","Bland's","Dotchson's","Brunswick Chapel"
 1940 REM DATA "Breckon's"
 1950 DATA *
 1960 DATA "Flowergate"
 1970 DATA "Abbey Inn","Marwood","Easterby","St. Ann's Lane","Staffordshire","Burn"
 1980 DATA "Waterloo","Haydock","Oyston"
 1990 REM DATA "Rose"
 2000 REM DATA "Abbey Yard","Duck's","Forth's","Gardiner's","Haydock's","Kidd's","Staffordshire"
 2010 DATA *
 2020 REM DATA "Cliff Street"
 2030 REM DATA "Andrew's","Bolton's","Cole's"
 2040 REM DATA *
 2050 DATA "St. Ann's Staith"
 2060 DATA "Wear's","Buck Hotel","Old Post Office","Red Lion"
 2070 DATA *
 2080 DATA "Haggersgate"
 2090 DATA "Paradise","Cuthbert","Bakehouse","Elephant"
 2100 REM DATA "Whitby Arms","Institute","Neptune"
 2110 REM DATA "Muncaster's"
 2120 DATA *
 2130 REM DATA "Skinner Street"
 2140 REM DATA "Sandal","Harrison's","Ivy Place","Botham's","Abbey View","Ruth's"
 2150 REM DATA *
 2160 DATA "Bagdale"
 2170 DATA "Arundel House","Broomfield Terrace","Carr's","Broomfield House"
 2180 DATA *
 2190 DATA "Waterstead Lane"
 2200 DATA "South View"
 2210 DATA *
 2220 DATA "Windsor Terrace"
 2230 DATA "Esk Place"
 2240 DATA *
 2250 REM DATA "Larpool"
 2260 REM DATA "Cock","Crowdy"
 2270 REM DATA *
 2280 REM DATA "Spital Bridge"
 2290 REM DATA "Whitehall","Kelp"
 2300 DATA *
 2310 DATA *
 2320 :
 2330 REM Whitby Workhouse
 2340 IF info$(16)="15":info$(7)="Whitby Union Workhouse, Green Lane":info$(0)="":info$(18)=STR$(VALinfo$(18)-5):info$(14)="Whitby"
 2350 :
 2360 REM Vessels
 2370 IF ed$="17" THEN
 2380   IF info$(0)="1":info$(7)="Vessel Wynyard Park"
 2390   IF info$(0)="2":info$(7)="Vessel John Usher"
 2400   IF info$(0)="3":info$(7)="Vessel Ossian"
 2410 ENDIF
 2420 :
 2430 REM Split up birth location
 2440 A$=info$(10)
 2450 A%=INSTR(A$,","):B%=0:IF A%:B%=INSTR(A$,",",A%+1)
 2460 IF A% THEN
 2470   IF B%:info$(12)=MID$(A$,B%+2):info$(11)=MID$(A$,A%+2,B%-A%-2) ELSE info$(12)="":info$(11)=MID$(A$,A%+2)
 2480   info$(10)=LEFT$(A$,A%-1)
 2490 ENDIF
 2500 :
 2510 REM Some entries town="Norwich" are not Norwich, but are foreign countries, originals need to be checked
 2520 :
 2530 REM Correct spelling mistakes in places
 2540 A$=info$(10)
 2550 IF FNuc(LEFT$(A$,3))="AT ":A$=MID$(A$,4)
 2560 IF FNuc(LEFT$(A$,8))="BORN IN ":A$=MID$(A$,9)
 2570 IF FNuc(LEFT$(A$,8))="CITY OF ":A$=MID$(A$,9)
 2580 IF FNuc(RIGHT$(A$,5))=" CITY":A$=LEFT$(A$,LENA$-5)
 2590 IF FNuc(RIGHT$(A$,6))="(CITY)":A$=LEFT$(A$,LENA$-7)
 2600 IF FNuc(RIGHT$(A$,7))=" PARISH":A$=LEFT$(A$,LENA$-7)
 2610 IF FNuc(RIGHT$(A$,9))=" RESIDENT":A$=LEFT$(A$,LENA$-9)
 2620 IF FNuc(RIGHT$(A$,10))="(RESIDENT)":A$=LEFT$(A$,LENA$-11)
 2630 IF LEFT$(A$,4)="N R ":A$=MID$(A$,5)
 2640 IF LEFT$(A$,9)="N Riding ":A$=MID$(A$,10)
 2650 IF LEFT$(A$,10)="Parish of ":A$=MID$(A$,11)
 2660 IF LEFT$(A$,7)="Parish ":A$=MID$(A$,8)
 2670 IF LEFT$(A$,2)="W ":A$="West"+MID$(A$,2)
 2680 A$=FNswapX(A$,"Ravenscar Scarbro","Ravenscar")
 2690 A$=FNswap(A$,"Robin Hood's Boy","Robin Hood's Bay")
 2700 A$=FNswap(A$,"Robin Hoods Bay", "Robin Hood's Bay")
 2710 A$=FNswap(A$,"Robin Hoods Boy", "Robin Hood's Bay")
 2720 A$=FNswap(A$,"Robor Hood Bay",  "Robin Hood's Bay")
 2730 A$=FNswap(A$,"Robor Hood Boy",  "Robin Hood's Bay")
 2740 A$=FNswap(A$,"Robin Hood Bay",  "Robin Hood's Bay")
 2750 A$=FNswap(A$,"Robin Hood Boy",  "Robin Hood's Bay")
 2760 A$=FNswap(A$,"Robin Hord Bay",  "Robin Hood's Bay")
 2770 A$=FNswap(A$,"Robin Wood Bay",  "Robin Hood's Bay")
 2780 A$=FNswap(A$,"R H Bay",         "Robin Hood's Bay")
 2790 :
 2800 A$=FNswap(A$,"Scarbrough",     "Scarborough")
 2810 A$=FNswap(A$,"Scarboro",       "Scarborough")
 2820 A$=FNswap(A$,"Scarbro",        "Scarborough")
 2830 A$=FNswap(A$,"Guisbrough",     "Guisborough")
 2840 A$=FNswap(A$,"Guisboro",       "Guisborough")
 2850 A$=FNswap(A$,"Guisbro",        "Guisborough")
 2860 A$=FNswap(A$,"Middlesborough", "Middlesbrough")
 2870 A$=FNswap(A$,"Middlesboro",    "Middlesbrough")
 2880 A$=FNswap(A$,"Middlesbro",     "Middlesbrough")
 2890 A$=FNswap(A$,"Middlesbo",      "Middlesbrough")
 2900 A$=FNswap(A$,"Westhartlepool", "West Hartlepool")
 2910 A$=FNswap(A$,"Whithy",         "Whitby")
 2920 A$=FNswap(A$," - In - ",       "-in-")
 2930 IF A$="Whitby":IF info$(11)="Durham":A$="Whitley"
 2940 IF A$="Whitley":IF info$(11)="Yorkshire":A$="Whitby"
 2950 IF A$="Hawsker-cum-St" :A$="Hawsker-cum-Stainsacre"
 2960 IF A$="Hawsker-cum-sta":A$="Hawsker-cum-Stainsacre"
 2970 info$(10)=A$
 2980 :
 2990 REM Correct spelling mistakes in counties
 3000 A$=info$(11)
 3010 IF FNuc(LEFT$(A$,3))="CO ":A$=MID$(A$,4)
 3020 IF FNuc(LEFT$(A$,7))="COUNTY ":A$=MID$(A$,8)
 3030 IF FNuc(RIGHT$(A$,5))=" CITY":A$=LEFT$(A$,LENA$-5)
 3040 IF FNuc(RIGHT$(A$,6))="(CITY)":A$=LEFT$(A$,LENA$-7)
 3050 IF FNuc(RIGHT$(A$,9))=" RESIDENT":A$=LEFT$(A$,LENA$-9)
 3060 IF FNuc(RIGHT$(A$,10))="(RESIDENT)":A$=LEFT$(A$,LENA$-11)
 3070 A$=FNswapX(A$,"Yorkshire North Riding","Yorkshire")
 3080 A$=FNswapX(A$,"East Yorkshire","Yorkshire")
 3090 A$=FNswapX(A$,"Dorsetshire",  "Dorset")
 3100 A$=FNswapX(A$,"Devonshire",  "Devon")
 3110 A$=FNswap(A$,"Chester",     "Cheshire")
 3120 A$=FNswap(A$,"Hereford",    "Herefordshire")
 3130 A$=FNswap(A$,"Lancaster",   "Lancashire")
 3140 A$=FNswap(A$,"Lincoln",     "Lincolnshire")
 3150 A$=FNswap(A$,"Northampton", "Northamptonshire")
 3160 A$=FNswap(A$,"Warwick",     "Warwickshire")
 3170 A$=FNswap(A$,"York",        "Yorkshire")
 3180 A$=FNswap(A$,"Aberdeen",    "Aberdeenshire")
 3190 A$=FNswap(A$,"Lanark",      "Lanarkshire")
 3200 A$=FNswap(A$,"Beds",        "Bedfordshire")
 3210 A$=FNswap(A$,"Bucks",       "Buckinghamshire")
 3220 A$=FNswap(A$,"North Riding","Yorkshire")
 3230 A$=FNswap(A$,"East Riding", "Yorkshire")
 3240 A$=FNswap(A$,"Hants",       "Hampshire")
 3250 A$=FNswap(A$,"Herts",       "Hertfordshire")
 3260 A$=FNswap(A$,"Northland",   "Northumberland")
 3270 A$=FNswap(A$,"Limk",        "Limerick")
 3280 IF A$="Northam":A$="Northumberland"
 3290 info$(11)=A$
 3300 :
 3310 IF FNuc(RIGHT$(info$(12),10))="(RESIDENT)":info$(12)=LEFT$(info$(12),LENinfo$(12)-11)
 3320 :
 3330 REM Add missing birth countries
 3340 IF info$(12)="" THEN
 3350   A$=info$(10)
 3360   IF A$="Cardiff"             :info$(12)="Wales"
 3370   IF INSTR(A$,"London")       :info$(12)="England"
 3380   IF INSTR(A$,"Birmingham")   :info$(12)="England"
 3390   IF INSTR(A$,"Middlesbrough"):info$(12)="England"
 3400   :
 3410   A$=info$(11)
 3420   IF A$="Kent"            :info$(12)="England"
 3430   IF A$="Devon"           :info$(12)="England"
 3440   IF A$="Dorset"          :info$(12)="England"
 3450   IF A$="London"          :info$(12)="England"
 3460   IF A$="Durham"          :info$(12)="England"
 3470   IF A$="Cornwall"        :info$(12)="England"
 3480   IF A$="Yorshire"        :info$(12)="England":info$(11)="Yorkshire"
 3490   IF A$="Yorkshire"       :info$(12)="England"
 3500   IF A$="Hampshire"       :info$(12)="England"
 3510   IF A$="Bedfordshire"    :info$(12)="England"
 3520   IF A$="Isle of Wight"   :info$(12)="England"
 3530   IF A$="Hertfordshire"   :info$(12)="England"
 3540   IF A$="Northumberland"  :info$(12)="England"
 3550   IF A$="Cambridgeshire"  :info$(12)="England"
 3560   IF A$="Huntingdonshire" :info$(12)="England"
 3570   IF A$="Buckinghamshire" :info$(12)="England"
 3580   IF A$="Nottinghamshire" :info$(12)="England"
 3590   IF A$="Northamptonshire":info$(12)="England"
 3600   IF A$="Ross-shire"      :info$(12)="Scotland"
 3610   IF A$="Lanarkshire"     :info$(12)="Scotland"
 3620   IF A$="Aberdeenshire"   :info$(12)="Scotland"
 3630   IF A$="Invernessshire"  :info$(12)="Scotland"
 3640   IF A$="Linlithgowshire" :info$(12)="Scotland"
 3650   IF A$="Forfarshire"     :info$(12)="Scotland"
 3660   IF A$="Galway"          :info$(12)="Ireland"
 3670   IF A$="Limerick"        :info$(12)="Ireland"
 3680   IF A$="Glamorgan"       :info$(12)="Wales"
 3690   IF A$="Monmouthshire"   :info$(12)="Wales"
 3700   IF A$="Carnarvonshire"  :info$(12)="Wales"
 3710   :
 3720   A$=info$(10)
 3730   IF A$="Malta"           :info$(12)=A$:info$(10)=info$(11)
 3740   IF A$="France"          :info$(12)=A$:info$(10)=info$(11)
 3750   IF A$="Russia"          :info$(12)=A$:info$(10)=info$(11)
 3760   IF A$="Brazil"          :info$(12)=A$:info$(10)=info$(11)
 3770   IF A$="Germany"         :info$(12)=A$:info$(10)=info$(11)
 3780   IF A$="Prussia"         :info$(12)=A$:info$(10)=info$(11)
 3790   IF A$="Portugal"        :info$(12)=A$:info$(10)=info$(11)
 3800   IF A$="New Zealand"     :info$(12)=A$:info$(10)=info$(11)
 3810   IF A$="Switzerland"     :info$(12)=A$:info$(10)=info$(11)
 3820   IF A$="United States"   :info$(12)=A$:info$(10)=info$(11)
 3830   IF A$="England"         :info$(12)=A$:info$(10)=info$(11)
 3840   IF A$="Ireland"         :info$(12)=A$:info$(10)=info$(11)
 3850   :
 3860   A$=info$(11)
 3870   IF A$="Wales"           :info$(12)=info$(11):info$(11)=""
 3880   IF A$="India"           :info$(12)=info$(11):info$(11)=""
 3890   IF A$="Italy"           :info$(12)=info$(11):info$(11)=""
 3900   IF A$="Canada"          :info$(12)=info$(11):info$(11)=""
 3910   IF A$="France"          :info$(12)=info$(11):info$(11)=""
 3920   IF A$="Russia"          :info$(12)=info$(11):info$(11)=""
 3930   IF A$="Poland"          :info$(12)=info$(11):info$(11)=""
 3940   IF A$="England"         :info$(12)=info$(11):info$(11)=""
 3950   IF A$="Ireland"         :info$(12)=info$(11):info$(11)=""
 3960   IF A$="Scotland"        :info$(12)=info$(11):info$(11)=""
 3970   IF A$="Australia"       :info$(12)=info$(11):info$(11)=""
 3980   IF A$="Switzerland"     :info$(12)=info$(11):info$(11)=""
 3990   IF A$="United States"   :info$(12)=info$(11):info$(11)=""
 4000   IF A$="Channel Islands" :info$(12)=info$(11):info$(11)=""
 4010 ENDIF
 4020 :
 4030 REM Add missing birth counties
 4040 IF info$(11)="" THEN
 4050   A$=info$(10)
 4060   IF A$="Robin Hood's Bay"  :info$(11)="Yorkshire" :info$(12)="England"
 4070   IF A$="Middlesbrough"     :info$(11)="Yorkshire" :info$(12)="England"
 4080   IF A$="York"              :info$(11)="Yorkshire" :info$(12)="England"
 4090   IF A$="Leeds"             :info$(11)="Yorkshire" :info$(12)="England"
 4100   IF INSTR(A$,"Whitby")     :info$(11)="Yorkshire" :info$(12)="England"
 4110   IF INSTR(A$,"Guisborough"):info$(11)="Yorkshire" :info$(12)="England"
 4120   IF INSTR(A$,"Sheffield")  :info$(11)="Yorkshire" :info$(12)="England"
 4130   IF A$="Staithes"          :info$(11)="Yorkshire" :info$(12)="England"
 4140   IF A$="Ravenscar"         :info$(11)="Yorkshire" :info$(12)="England"
 4150   IF A$="Doncaster"         :info$(11)="Yorkshire" :info$(12)="England"
 4160   IF A$="Durham"            :info$(11)="Durham"    :info$(12)="England"
 4170   IF A$="Huddersfield"      :info$(11)="Yorkshire" :info$(12)="England"
 4180   IF INSTR(A$,"Hartlepool") :info$(11)="Durham"    :info$(12)="England"
 4190   IF A$="Lincoln"      :info$(11)="Lincolnshire"   :info$(12)="England"
 4200   IF A$="Worcester"    :info$(11)="Worcestershire" :info$(12)="England"
 4210   IF A$="Nottingham"   :info$(11)="Nottinghamshire":info$(12)="England"
 4220   IF A$="Aberdeen"     :info$(11)="Aberdeenshire"  :info$(12)="Scotland"
 4230   IF A$="Cardiff"      :info$(11)="Glamorgan"      :info$(12)="Wales"
 4240   IF A$="West Norfolk" :info$(11)=A$:info$(10)="":info$(12)="England"
 4250   IF A$="Ross-shire"   :info$(11)=A$:info$(10)="":info$(12)="Scotland"
 4260   IF A$="Devon"        :info$(11)=A$:info$(10)=""
 4270   IF A$="Essex"        :info$(11)=A$:info$(10)=""
 4280   IF A$="Jersey"       :info$(11)=A$:info$(10)=""
 4290   IF A$="Sussex"       :info$(11)=A$:info$(10)=""
 4300   IF A$="Norfolk"      :info$(11)=A$:info$(10)=""
 4310   IF A$="Yorkshire"    :info$(11)=A$:info$(10)=""
 4320   IF A$="Lancashire"   :info$(11)=A$:info$(10)=""
 4330   IF A$="Westmorland"  :info$(11)=A$:info$(10)=""
 4340   IF A$="Lincolnshire" :info$(11)=A$:info$(10)=""
 4350   IF A$="Northamptonshire":info$(11)=A$:info$(10)=""
 4360   IF A$="Nk"              :info$(10)="not known"
 4370   IF A$="Chester"       :IF info$(12)="England":info$(11)="Cheshire"
 4380   IF A$="Hertford"      :IF info$(12)="England":info$(11)="Hertfordshire"
 4390   IF A$="Great Yarmouth":IF info$(12)="England":info$(11)="Norfolk"
 4400 ENDIF
 4410 :
 4420 IF verbose%:FOR A%=0 TO max%:PRINTTAB(36,A%+2);LEFT$(info$(A%),56);SPC(56-LENLEFT$(info$(A%),56));:NEXT
 4430 PROCcsv_wr(out%,info$())
 4440 ENDPROC
 4450 :
 4460 REM DEFFNlookup(Z%,   R%,     P$,     D%,       P%,   H$,F1$,F2$,F3$)
 4470 REM REM         flag, return, parish, district, page, household
 4480 REM IF lookup%=0:=""
 4490 REM REM looklast%=PTR#lookup%
 4500 REM PTR#lookup%=looklast%
 4510 REM match%=FALSE
 4520 REM REPEAT
 4530 REM lookptr%=PTR#lookup%:PROCcsv_rd(lookup%,addr$())
 4540 REM IF F1$="" :IF addr$(14)=P$:IF VALaddr$(16)=D%:IF addr$(0)=H$:match%=TRUE
 4550 REM IF F1$<>"":IF addr$(14)=P$:IF VALaddr$(16)=D%:IF addr$(0)=H$:IF addr$(1)=F1$:IF addr$(2)=F2$:IF addr$(3)=F3$:match%=TRUE
 4560 REM UNTIL match% OR EOF#lookup% OR VALaddr$(16)*1000+VALaddr$(18)>D%*1000+P%+1
 4570 REM REM IF Z%:IF match%:PTR#lookup%=lookptr% ELSE PTR#lookup%=looklast%
 4580 REM IF Z%:IF match%:looklast%=lookptr% ELSE looklast%=looklast%
 4590 REM IF match%:=addr$(R%)
 4600 REM =""
 4610 :
 4620 REM Can be sped up by remembering last PTR
 4630 DEFFNlookup
 4640 A$=FNd0(VALed$,2)+parish$+s$+"txt"
 4650 IF lookup$<>A$ THEN
 4660   IF lookup%:CLOSE#lookup%:lookup%=0:lookup$=""
 4670   lookup%=OPENIN("Indexes"+d$+A$):IF lookup%:lookup$=A$
 4680 ENDIF
 4690 IF lookup%=0:=""
 4700 REPEAT
 4710   lookptr%=PTR#lookup%
 4720   A0$="":A1$=GET$#lookup%:A2$="":IF INSTR(A1$,":"):A2$=FNs(GET$#lookup%)
 4730   A%=INSTR(A1$,":"):A0$=LEFT$(A1$,A%-1):A1$=MID$(A1$,A%+2)
 4740   A%=INSTR(A1$,";"):IF A%:A1$=LEFT$(A1$,A%-1)
 4750   REM A%=INSTR(A1$,"("):IF A%:A1$=FNs(LEFT$(A1$,A%-1))+FNs(MID$(A$,INSTR(A$,")",A%)+1))
 4760   A3$=LEFT$(A2$,INSTR(A2$,",")-1)
 4770   A2$=MID$(A2$,INSTR(A2$,",")+2)
 4780   REM A0$=household number
 4790   REM A1$=address with ;... removed
 4800   REM A2$=secondpart of name, secondpart
 4810   REM A3$=firstpart  of firstpart, name
 4820   REM match1%=(info$(1)=A2$ OR info$(1)=A3$)
 4830   REM match2%=info$(7)=A1$ AND match1%
 4840   REM IF match1%=0:A%=INSTR(info$(7),","):IF A%:IF VALinfo$(7)=0:match2%=match1% AND FNs(MID$(info$(7),A%+1))=A1$
 4850   match%=A0$=info$(0)
 4860 UNTIL match% OR EOF#lookup%
 4870 IF NOT match%:PTR#lookup%=0:=""
 4880 PTR#lookup%=lookptr%
 4890 =A1$
 4900 :
 4910 DEFFNadd(addr$,yard$,street$)
 4920 IF INSTR(addr$,yard$+" "):IF INSTR(addr$,street$)=0:=addr$+", "+street$
 4930 IF RIGHT$(addr$,LENyard$)=yard$:IF INSTR(addr$,street$)=0:=addr$+", "+street$
 4940 =addr$
 4950 :
 4960 DEFFNswap(in$,match$,swap$)
 4970 A%=INSTR(in$,match$):IF A%:IF INSTR(in$,swap$)=0:in$=LEFT$(in$,A%-1)+swap$+MID$(in$,A%+LENmatch$)
 4980 =in$
 4990 :
 5000 DEFFNswapX(in$,match$,swap$)
 5010 A%=INSTR(in$,match$):IF A%:in$=LEFT$(in$,A%-1)+swap$+MID$(in$,A%+LENmatch$)
 5020 =in$
 5030 :
 5040 DEFPROCClose_All
 5050 lookup%=lookup%:IFlookup%:A%=lookup%:lookup%=0:CLOSE#A%
 5060 out%=out%:IFout%:A%=out%:out%=0:CLOSE#A%
 5070 in%=in%:IFin%:A%=in%:in%=0:CLOSE#A%
 5080 ENDPROC
 5090 :
 5100 DEFPROCcsv_rd(i%,array$())
 5110 LOCAL n%:n%=0:array$()="":A$=GET$#i%:IFA$="":A$=GET$#i%
 5120 A$=A$+","
 5130 REPEAT
 5140   IF LEFT$(A$,2)="=""":A$=MID$(A$,2)
 5150   IF LEFT$(A$,1)="""" THEN
 5160     A%=INSTR(A$,""",",2)+1:array$(n%)=MID$(A$,2,A%-3)
 5170   ELSE
 5180     A%=INSTR(A$,","):array$(n%)=LEFT$(A$,A%-1)
 5190   ENDIF
 5200   A$=MID$(A$,A%+1):n%=n%+1
 5210 UNTILA$=""
 5220 ENDPROC
 5230 :
 5240 DEFPROCcsv_wr(o%,array$())
 5250 LOCAL n%,q%:n%=DIM(array$(),1)
 5260 FOR A%=0 TO n%:A$=array$(A%)
 5270   q%=INSTR(A$,",")
 5280   IF q%=0:q%=(ASCA$=48)AND(INSTR(A$,"/")=0)     :REM leading zeros 00001
 5290   IF q%=0:IFVALLEFT$(A$,1):q%=INSTR(A$,"E")     :REM preserve 1234E5678
 5300   IF q%=0:q%=LENSTR$VALA$>8                     :REM long numbers 12345678901234
 5310   IF q%=0:IFVALA$:q%=INSTR(A$,"/")AND(ASCA$<>48):REM fractions 12/34
 5320   IF q%=0:q%=LEFT$(A$,1)="-"                    :REM leading hyphen -
 5330   IF q%=0:q%=MID$(A$,3,1)=" "ANDMID$(A$,7,1)=" ":REM dates xx XXX xxxx
 5340   IF q%:A$=""""+A$+"""":IFINSTR(A$,",")=0:A$="="+A$
 5350   BPUT#o%,A$;:IF A%<>n%:BPUT#o%,",";
 5360 NEXT A%:BPUT#o%,""
 5370 ENDPROC
 5380 :
 5390 DEFFNd0(A%,N%)=RIGHT$("00000000"+STR$A%,N%)
 5400 DEFFNuc(A$):IFA$="":=""
 5410 FOR A%=1 TO LEN A$:IFMID$(A$,A%,1)>"_":A$=LEFT$(A$,A%-1)+CHR$(ASCMID$(A$,A%,1)AND&DF)+MID$(A$,A%+1)
 5420 NEXT:=A$
 5430 DEFFNs(A$):IFLEFT$(A$,1)=" ":REPEATA$=MID$(A$,2):UNTILLEFT$(A$,1)<>" "
 5440 IFRIGHT$(A$,1)=" ":REPEATA$=LEFT$(A$,LENA$-1):UNTILRIGHT$(A$,1)<>" "
 5450 =A$

Download DownToCSV.bbc

BBC BASIC detokeniser and syntax highlighter by Ben Ryves.