TextToCSV.bbc

10 REM > TextToCSV

20 REM Convert Whitby 1891 Census text transcripts to CSV file

30 :

40 verbose%=TRUE

50 max%=19:year%=1891:month%=4

60 :

70 A%=0:X%=1:os%=((USR&FFF4)AND&FF00)DIV256

80 s$=".":fmax%=255:IFos%AND32:d$="\" ELSE IFos%AND8:d$="/" ELSE s$="/":d$=".":fmax%=10

90 DIM head$(max%),info$(max%)

100 FOR A%=0 TO max%:READ head$(A%):NEXT

110 DATA "HOUSEHOLD NUMBER","SURNAME","NAME","AGE","RELATIONSHIP","SEX","MARITAL STATUS","STREET ADDRESS"

120 DATA "OCCUPATION","BIRTH YEAR","BIRTH PLACE","BIRTH COUNTY","BIRTH COUNTRY","INDIVIDUAL NUMBER"

130 DATA "CIVIL PARISH","SUB-REGISTRATION DISTRICT","ENUMERATION DISTRICT","PIECE","PAGE","FOLIO"

140 :

150 ON ERROR REPORT:PROCClose_All:PRINT" at line ";ERL:IF ERR=17:QUIT ELSE END

160 OFF:out%=OPENOUT(LEFT$("Whitby"+STR$year%+s$+"csv",fmax%))

170 IF out%=0:PRINT"Couldn't open output file, is it already open?":END

180 PROCcsv_wr(out%,head$())

190 IF verbose%:CLS:PRINT':FOR A%=0 TO max%:PRINTFNd0(A%,2);": ";head$(A%);":":NEXT

200 :

210 stop%=FALSE

220 total%=0:count%=0

230 male%=0:female%=0

240 page$ =""

250 folio$ =""

260 piece$ =""

270 entry$ =""

280 address$ =""

290 surname$ =""

300 name$ =""

310 relation$ =""

320 sexage$ =""

330 occupation$=""

340 birth$ =""

350 disable$ =""

360 condition$ =""

370 sex$ =""

380 age$ =""

390 :

400 RESTORE +0

410 READ parish$,Min%,Max%

420 REPEAT

430 FOR district%=Min% TO Max%

440 PROCScan(RIGHT$("0"+STR$district%,2)+parish$)

450 NEXT:READ parish$,Min%,Max%

460 UNTIL parish$="*"

470 CLOSE#out%:out%=0

480 QUIT

490 :

500 DATA Whitby,1,8

510 DATA Ruswarp,9,9

520 DATA Whitby,9,9

530 DATA Ruswarp,10,10

540 DATA Whitby,10,11

550 DATA Ruswarp,12,16

560 DATA Workhouse,17,17

570 DATA Hawsker,20,21

580 DATA Whitby,21,21

590 DATA *,0,0

600 :

610 DEFPROCScan(in$)

620 in%=OPENIN(in$+LEFT$(".",d$="\")):IFin%=0:ENDPROC

630 REPEAT

640 A$=GET$#in%:PROCline:PROCentry

650 UNTILEOF#in%

660 CLOSE#in%:in%=0

670 ENDPROC

680 :

690 DEFPROCline

700 LOCAL DATA

710 IF INSTR(A$,"ERROR"):stop%=NOTstop%:ENDPROC

720 IF stop%:A$="*":ENDPROC

730 IF A$="":A$="*":ENDPROC

740 IF INSTR(A$,"(cont"):ENDPROC

750 IF INSTR(A$," cont"):ENDPROC

760 A%=INSTR(A$," page "):IFA%:page$=FNs(MID$(A$,A%+5)):piece$=FNs(LEFT$(A$,10)):folio$=STR$VALMID$(A$,18):ENDPROC

770 A%=INSTR(A$,":"):IFA%:IFMID$(A$,A%,3)<>": ":PROCstreet:ENDPROC

780 IFA%:IFVALA$:entry$=page$+"/"+LEFT$(A$,A%-1):A$=MID$(A$,A%+1)

790 IF LEFT$(A$,2)<>" ":ENDPROC

800 IF INSTR(A$," - ")=0:ENDPROC

810 :

820 REM Split up fields

830 REM surname, name - relation - cond sex age - occupation - birthplace

840 REM surname - relation - cond sex age - occupation - birthplace

850 A$=FNs(A$)+" - "

860 A%=INSTR(A$," - ") :surname$ =FNs(LEFT$(A$,A%-1)):A$=" "+MID$(A$,A%+3):name$=""

870 A%=INSTR(surname$,","):IF A%:name$=FNs(MID$(surname$,A%+2)):surname$=FNs(LEFT$(surname$,A%-1))

880 A%=INSTR(A$," - ") :relation$ =FNs(LEFT$(A$,A%-1)):A$=" "+MID$(A$,A%+3)

890 A%=INSTR(A$," - ") :sexage$ =FNs(LEFT$(A$,A%-1)):A$=" "+MID$(A$,A%+3)

900 A%=INSTR(A$," - ") :occupation$=FNs(LEFT$(A$,A%-1)):A$=" "+MID$(A$,A%+3)

910 A%=INSTR(A$," - ") :birth$ =FNs(LEFT$(A$,A%-1)):A$=" "+MID$(A$,A%+3)

920 A%=INSTR(A$," - ") :disable$ =FNs(LEFT$(A$,A%-1)):A$=" "+MID$(A$,A%+3)

930 :

940 REM Repair split fields

950 REM Storry, William - Head - Widr - 54 - Boat Builder - YKS, Whitby

960 REM Storry, William - Son - S - 24 - Jet worker - YKS, Whitby

970 IF VALoccupation$ THEN

980 sexage$=sexage$+" "+occupation$

990 occupation$=birth$

1000 birth$=disable$

1010 disable$=""

1020 ENDIF

1030 :

1040 REM Expand relation

1050 IFRIGHT$(relation$,4)="Daur":relation$=LEFT$(relation$,LENrelation$-1)+"ghter"

1060 IFRIGHT$(relation$,3)="Dau":relation$=relation$+"ghter"

1070 IFLEFT$(relation$,4)="Grn ":relation$="Grand"+MID$(relation$,5)

1080 IFLEFT$(relation$,3)="G S":relation$="Grands"+MID$(relation$,4)

1090 IFLEFT$(relation$,3)="G D":relation$="Grandd"+MID$(relation$,4)

1100 IFLEFT$(relation$,3)="GrS":relation$="Grands"+MID$(relation$,4)

1110 IFLEFT$(relation$,3)="GrD":relation$="Grandd"+MID$(relation$,4)

1120 relation$=FNswap(relation$,"GranDa","Grandda")

1130 relation$=FNswap(relation$,"GrandD","Grandd")

1140 relation$=FNswap(relation$,"GrandS","Grands")

1150 IFLEFT$(relation$+" ",5)="Serv ":relation$="Servant"+MID$(relation$,6)

1160 relation$=FNswap(relation$," in l","-in-L")

1170 relation$=FNswap(relation$," in L","-in-L")

1180 IFrelation$="S":relation$="Son"

1190 :

1200 REM Default for Sex

1210 sex$="M":REM Paternalistically assume Head=Male, fails where Head=W where W=Widow

1220 IFRIGHT$(relation$,3)="Son" :sex$="M"

1230 IFRIGHT$(relation$,9)="Daughter":sex$="F"

1240 IFRIGHT$(relation$,4)="Wife" :sex$="F"

1250 IFRIGHT$(relation$,6)="Mother" :sex$="F"

1260 IFRIGHT$(relation$,7)="Brother" :sex$="M"

1270 IFRIGHT$(relation$,6)="Sister" :sex$="F"

1280 IFRIGHT$(relation$,5)="Niece" :sex$="F"

1290 IFRIGHT$(relation$,6)="Nephew" :sex$="M"

1300 :

1310 REM Sort out cond/sec/age field

1320 REM surname, name - relation - cond sex age - occupation - birthplace

1330 REM surname, name - relation - cond age - occupation - birthplace

1340 REM surname, name - relation - sex age - occupation - birthplace

1350 REM surname, name - relation - age - occupation - birthplace

1360 condition$="":age$=""

1370 IFsexage$>"@":A%=INSTR(sexage$," "):condition$=LEFT$(sexage$,A%-1):sexage$=FNs(MID$(sexage$,A%+1))

1380 IFLEFT$(condition$,1)="F":sex$=condition$:condition$=""

1390 REM surname, name - relation - sex age - occupation - birthplace

1400 REM surname, name - relation - age - occupation - birthplace

1410 A%=INSTR(sexage$," "):IF A%:sex$=LEFT$(sexage$,A%-1):sexage$=FNs(MID$(sexage$,A%+1))

1420 REM surname, name - relation - age - occupation - birthplace

1430 age$=FNlc(sexage$)

1440 A%=INSTR(age$,"/"):IF A%:age$=LEFT$(age$,A%-1)+" mth"+LEFT$("s",LEFT$(age$,2)<>"1/")

1450 IFRIGHT$(age$,1)="m":age$=age$+"th"

1460 :

1470 REM Expand condition

1480 IFcondition$="":condition$="S":IF relation$="Wife":condition$="M"

1490 IFLEFT$(condition$,1)="S":condition$="Single"

1500 IFLEFT$(condition$,1)="M":condition$="Married"

1510 IFcondition$="Widower":sex$="M"

1520 IFcondition$="Widr" :sex$="M"

1530 IFcondition$="Widow" :sex$="F"

1540 IFcondition$="Wid" :sex$="F"

1550 IFLEFT$(condition$,1)="W":IFLEFT$(sex$,1)="M":condition$="Widower"

1560 IFLEFT$(condition$,1)="W":IFLEFT$(sex$,1)="F":condition$="Widow"

1570 :

1580 REM Expand sex

1590 IFLEFT$(sex$,1)="M":sex$="Male"

1600 IFLEFT$(sex$,1)="F":sex$="Female"

1610 :

1620 REM Expand names

1630 REM Fras

1640 name$=FNswap(name$,"Hy","Henry")

1650 name$=FNswap(name$,"Wm","William")

1660 name$=FNswap(name$,"Thos","Thomas")

1670 name$=FNswap(name$,"Robt","Robert")

1680 name$=FNswap(name$,"Chas","Charles")

1690 name$=FNswap(name$,"Margt","Margaret")

1700 name$=FNswap(name$,"Elizth","Elizabeth")

1710 IF RIGHT$(name$,3)="Geo" :name$=name$+"rge"

1720 IF RIGHT$(name$,4)="Eliz":name$=name$+"abeth"

1730 :

1740 A$="":ENDPROC

1750 :

1760 DEFPROCstreet

1770 A%=INSTR(A$,":"):IFINSTR(A$+"-","-")<A%:ENDPROC

1780 address$=MID$(A$,A%+2):entry$=LEFT$(A$,A%-1)

1790 :

1800 REM Tidy address

1810 A$=FNs(address$)

1820 :

1830 A%=INSTR(A$,"[NB:"):IF A%:B%=INSTR(A$,"]",A%):IF B%:A$=LEFT$(A$,A%-2)+MID$(A$,B%+1)

1840 A%=INSTR(A$,"(Enum"):IF A%:B%=INSTR(A$,")",A%):IF B%:A$=LEFT$(A$,A%-2)+MID$(A$,B%+1)

1850 A%=INSTR(A$,"<"):IF A%:B%=INSTR(A$,">",A%):IF B%:A$=LEFT$(A$,A%-1)+MID$(A$,A%+1,B%-A%-1)+MID$(A$,B%+1)

1860 A%=INSTR(A$,"["):IF A%:B%=INSTR(A$,"]",A%):IF B%:A$=LEFT$(A$,A%-1)+MID$(A$,A%+1,B%-A%-1)+MID$(A$,B%+1)

1870 A%=INSTR(A$,"{"):IF A%:B%=INSTR(A$,"}",A%):IF B%:A$=LEFT$(A$,A%-1)+MID$(A$,A%+1,B%-A%-1)+MID$(A$,B%+1)

1880 B%=INSTR(A$,")"):IF B%:IF B%<>LENA$:A%=INSTR(A$,"("):IF A%:A$=LEFT$(A$,A%-1)+MID$(A$,A%+1,B%-A%-1)+MID$(A$,B%+1)

1890 A%=INSTR(A$," room"):IF A%=0:IF VALRIGHT$(A$,2):A%=LENA$

1900 IF A% THEN

1910 REPEAT:A%=A%-1:UNTILMID$(A$,A%,1)="(" OR A%=0

1920 IF A% THEN

1930 B%=INSTR(A$,")",A%)

1940 IF B%:A$=LEFT$(A$,A%-2)+MID$(A$,B%+1)

1950 ENDIF

1960 ENDIF

1970 IFLEFT$(A$,2)="* ":A$=MID$(A$,3)

1980 :

1990 REM Ensure correct apostrophication

2000 RESTORE +0

2010 READ B$:REPEAT

2020 A$=FNswap(A$,"s "+B$,"'s "+B$)

2030 READ B$

2040 UNTILB$="*"

2050 DATA B,C,G,L,S,T,Y,*

2060 A$=FNswap(A$,"Arm's","Arms")

2070 A$=FNswap(A$," yard"," Yard")

2080 A$=FNswap(A$,"Cros's","Cross")

2090 A$=FNswap(A$,"Lunds Y","Lund's Y")

2100 A$=FNswap(A$,"Wilsons Y","Wilson's Y")

2110 A$=FNswap(A$,"Blackburn Yard","Blackburn's Yard")

2120 A$=FNswap(A$,"Cuthbert Yard","Cuthbert's Yard")

2130 A$=FNswap(A$,"Blacksmith Arms","Blacksmith's Arms")

2140 A$=FNswap(A$,"Blacksmith Arm's","Blacksmith's Arms")

2150 A$=FNswap(A$,"Whitby Arm's","Whitby Arms")

2160 A$=FNswap(A$,"Salt Pan Wells","Salt Pan Well Steps")

2170 A$=FNswap(A$,"Langdale B","Langdale's B")

2180 A$=FNswap(A$,"Sqaure","Square")

2190 A$=FNswap(A$,"Sqauer","Square")

2200 A$=FNswap(A$,"Buldings","Buildings")

2210 A$=FNswap(A$,"Terace","Terrace")

2220 A$=FNswap(A$,"Cliffe","Cliff")

2230 A$=FNswap(A$,"St A","St. A")

2240 A$=FNswap(A$,"St H","St. H")

2250 A$=FNswap(A$,"Hospitals","Hospital Yard")

2260 REPEAT:A$=FNswap(A$,"''","'"):UNTILINSTR(A$,"''")=0

2270 A$=FNswap(A$,"Blacksmith Arm's","Blacksmith's Arms")

2280 A$=FNswap(A$,"Gallow's","Gallows")

2290 A$=FNswap(A$,"Carrs","The Carrs")

2300 REM A$=FNswap(A$,"Hunter's","Hunter")

2310 :

2320 REM Swap addresses around

2330 READ street$

2340 REPEAT

2350 IF LEFT$(A$,LENstreet$)=street$ AND A$<>street$ THEN

2360 A$=FNs(MID$(A$,LENstreet$+2))+", "+street$

2370 ENDIF

2380 READ street$

2390 UNTIL street$="*"

2400 DATA "Church Street"

2410 DATA *

2420 :

2430 REM Canonicalise addresses

2440 READ street$

2450 REPEAT

2460 READ yard$

2470 REPEAT

2480 A$=FNadd(A$,yard$,street$)

2490 READ yard$

2500 UNTILyard$="*"

2510 READ street$

2520 UNTILstreet$="*"

2530 DATA "Salt Pan Well Steps","White Row",*

2540 DATA "123 Church Street","Monkman's",*

2550 DATA "McLachlin's Yard","Bolton's Buildings",*

2560 DATA "Golden Lion Bank","Golden Lion Inn",*

2570 DATA "Downdinner Hill","Hanover Terrace",*

2580 DATA "Spital Bridge/Dog Lane","Olive",*

2590 DATA "Green Lane","New Gardens",*

2600 DATA "High Well Yard, Church Street","Ainsley's",*

2610 DATA "Waterstead Lane","Boghole",*

2620 :

2630 DATA "Church Street"

2640 DATA "Blackburn's","Wilson's","Kiln","Monkmans","Borough","Ditchburn's","Blackhorse"

2650 DATA "Argument's","New Way","Green's","Renwick's","Ainsley's"

2660 DATA "Smale's","Falkingbridge","Fleece Inn Yard","Elbow Yard","Taylerson's"

2670 DATA "School Yard","Corner's","Craven's","Hospital","Dark Entry Yard"

2680 DATA "Cappleman's","Boanson's","Gaskin's","Sayer's","High Walk","Middle Walk","Low Walk","Steps"

2690 DATA "Jefferson's","Prospect Place","Hall's Yard","Ivy Yard","Brewery Yard","Old Gas House Yard"

2700 DATA "Salt Pan","Boulby","Timber","Studley","Horner's","White Horse","Dock Co"

2710 DATA *

2720 DATA "Sandgate"

2730 DATA "Nicholson's","Queen Hotel"

2740 DATA *

2750 DATA "Grape Lane"

2760 DATA "Tin","Lamb's","Raffled Anchor","Custom House Hotel"

2770 DATA *

2780 DATA "Baxtergate"

2790 DATA "Belle Hotel","Mead's","Angel Hotel","Vipond's","Goodwill's","Ward's","Plough Inn"

2800 DATA "Brignell's","Tyreman's","Woodhouse","Mackridge's","Albion Hotel","Trueman's"

2810 DATA "Wald's","Leng's","Coffee Bar","Bland's","Dotchson's","Brunswick Chapel"

2820 DATA "Breckon's"

2830 DATA *

2840 DATA "Flowergate"

2850 DATA "Rose & Crown","Haydock's","McLachlin's","Marwood's","Fawcett's","Easterby"

2860 DATA "Old Abbey Inn","Gardiner's"

2870 DATA *

2880 DATA "Cliff Street"

2890 DATA "Andrew's"

2900 DATA *

2910 DATA "St. Ann's Staith"

2920 DATA "Wear's","Buck Hotel","Old Post Office","St Ann's Lane"

2930 DATA *

2940 DATA "Haggersgate"

2950 DATA "Paradise","Whitby Arms","Elephant","Institute","Neptune"

2960 DATA "Muncaster's","Miller's"

2970 DATA *

2980 DATA "Skinner Street"

2990 DATA "Sandal","Harrison's","Ivy Place","Botham's","Abbey View"

3000 REM "Routh Walk" - uncertain, highway follows Routh Walk, so not a "yard"

3010 DATA *

3020 DATA "Bagdale"

3030 DATA "Broomfield Terrace","Carr's"

3040 DATA *

3050 DATA "Larpool"

3060 DATA "Cock","Crowdy"

3070 DATA *

3080 DATA "Spital Bridge"

3090 DATA "Whitehall","Kelp"

3100 DATA *

3110 DATA *

3120 :

3130 READ check$

3140 REPEAT

3150 READ yard$,street$

3160 IF INSTR(A$,check$)=0:A$=FNadd(A$,yard$,street$)

3170 READ check$

3180 UNTILcheck$="*"

3190 DATA Church Street,Cuthbert's,Haggersgate

3200 DATA Church Street,Ship Inn,Haggersgate

3210 DATA Church Street,Bakehouse,Haggersgate

3220 DATA Church Street,Brown's,Haggersgate

3230 DATA Church Street,Dark Entry,Baxtergate

3240 DATA Church Street,Lockey's,Grape Lane

3250 DATA Brunswick Street,Benson's,Church Street

3260 DATA Well Close,Well,Church Street

3270 DATA Baxtergate,Johnson's,Sandgate

3280 DATA East Cliff,St. Hilda's Cottages,Church Street

3290 DATA Farm,Mount Pleasant,"Elbow Yard, Church Street"

3300 DATA Hawsker,Blacksmith's,Church Street

3310 DATA Cliff Street,Waite's,Church Street

3320 DATA *

3330 IFINSTR(A$,"Stainsacre")=0:IFINSTR(A$,"Cottage")=0:IFINSTR(A$,"Larpool")=0:A$=FNadd(A$,"The Mount","Cliff Street")

3340 IFINSTR(A$,"Fair"):IF RIGHT$(A$,18)="Street, Grape Lane":A$=LEFT$(A$,LENA$-12)

3350 address$=A$

3360 A$=":":ENDPROC

3370 :

3380 DEFFNadd(addr$,yard$,street$)

3390 IF INSTR(addr$,yard$+" "):IF INSTR(addr$,street$)=0:=addr$+", "+street$

3400 IF RIGHT$(addr$,LENyard$)=yard$:IF INSTR(addr$,street$)=0:=addr$+", "+street$

3410 =addr$

3420 :

3430 DEFFNswap(in$,match$,swap$)

3440 A%=INSTR(in$,match$):IF A%:IF INSTR(in$,swap$)=0:in$=LEFT$(in$,A%-1)+swap$+MID$(in$,A%+LENmatch$)

3450 =in$

3460 :

3470 DEFPROCentry

3480 IFVALentry$=0 OR A$<>"":ENDPROC

3490 LOCAL DATA

3500 IFverbose%:VDU30:PRINT surname$;", ";name$;SPC(60-LENname$-LENsurname$)'address$;SPC(75-LENaddress$)

3510 IF LENname$+LENsurname$=0:ENDPROC

3520 WHILE MID$(piece$,3,1)=" ":piece$=LEFT$(piece$,2)+MID$(piece$,4):ENDWHILE

3530 :

3540 info$()=""

3550 info$(0)=entry$ :REM HOUSEHOLD NUMBER

3560 info$(1)=surname$ :REM SURNAME

3570 info$(2)=name$ :REM NAME

3580 info$(3)=age$ :REM AGE

3590 info$(4)=relation$ :REM RELATIONSHIP

3600 info$(5)=sex$ :REM GENDER

3610 info$(6)=condition$ :REM MARITAL STATUS

3620 info$(7)=address$ :REM STREET ADDRESS

3630 info$(8)=occupation$ :REM OCCUPATION

3640 IF VALage$ THEN

3650 info$(9) ="abt "+STR$(year%-VALage$-1)

3660 IF INSTR(age$,"m"):info$(9)=STR$(year%-(VALage$-month%+13)DIV12)

3670 IF INSTR(age$,"d") OR INSTR(age$,"w"):info$(9)=STR$year%

3680 SAVE :REM BIRTH YEAR

3690 :

3700 birth$=FNswap(birth$,"Hood " ,"Hood's ")

3710 birth$=FNswap(birth$,"Hoods ","Hood's ")

3720 A%=INSTR(birth$,", ")

3730 IF A% THEN

3740 info$(11)=FNs(LEFT$(birth$,A%-1)):REM BIRTH COUNTY

3750 birth$=MID$(birth$,A%+2) :REM BIRTH PLACE

3760 ENDIF

3770 :

3780 RESTORE +0:READ country$

3790 REPEAT :REM Move BIRTH to COUNTRY

3800 IF country$=birth$ :IF info$(12)="":info$(12)=birth$:birth$=""

3810 IF country$=info$(11):IF info$(12)="":info$(12)=info$(11):info$(11)=""

3820 READ country$

3830 UNTIL country$="*"

3840 DATA At Sea,Australia,Brazil,British Guinea,Canada,Dominion of Canada,Channel Islands

3850 DATA Denmark,East Indies,France,Germany,India,Italy,Malta

3860 DATA New Zealand,Norway,Portugal,Russia,South Australia,Spain,Tasmania,United States,United States of America

3870 DATA England,Ireland,Scotland,Wales,*

3880 IF info$(12)="":IF info$(11)="":IF LEN birth$=3:info$(11)=birth$:birth$=""

3890 :

3900 RESTORE +0:READ country$

3910 REPEAT

3920 READ cty$,county$ :REM Expand COUNTY and move from PLACE to COUNTY; adding COUNTRY

3930 REPEAT

3940 IF birth$=county$:info$(11)=birth$:birth$=""

3950 IF info$(11)=cty$:info$(11)=county$

3960 IF info$(11)=county$:info$(12)=country$

3970 READ cty$,county$

3980 UNTIL cty$="*"

3990 READ country$

4000 UNTIL country$="*"

4010 DATA England

4020 DATA YKS,Yorkshire,DUR,Durham,KEN,Kent,NFK,Norfolk,LAN,Lancashire,SSX,Sussex

4030 DATA LIN,Lincolnshire,OXF,Oxfordshire,NTT,Nottinghamshire,CHS,Cheshire,GLS,Gloucestershire

4040 DATA CON,Cornwall,MDX,Middlesex,BDF,Bedfordshire,DBY,Derbyshire,DEV,Devon,DOR,Dorset

4050 DATA ESS,Essex,ESX,Essex,HAM,Hampshire,HRT,Hertfordshire,LEI,Leicestershire,LON,London

4060 DATA SRY,Surrey,NTH,Northamptonshire,SFK,Suffolk,SOM,Somerset,WAR,Warwickshire,WIL,Wiltshire

4070 DATA WOR,Worcestershire,HUN,Huntingdonshire,WES,Westmorland,NBL,Northumberland,CUM,Cumberland

4080 DATA STS,Staffordshire,Southampton,Hampshire,RUT,Rutland,CAM,Cambridgeshire,IOW,Isle of Wight

4090 DATA HEF,Herefordshire,SHR,Shropshire

4110 REM Synonyms:

4120 DATA DEV,Devonshire

4130 DATA SAL,Shropshire

4140 DATA ***,Berkshire

4150 DATA ***,Buckinghamshire

4160 DATA ***,Bristol

4170 REM Uncertain:

4180 DATA MON,Monmouthshire

4190 DATA NOR,Northumberland

4200 DATA HAN,Hampshire

4210 DATA STF,Staffordshire

4220 DATA *,*

4230 DATA Scotland

4240 DATA ***,Lanarkshire

4250 DATA *,*

4260 DATA Wales

4270 DATA CAE,Caernarvonshire

4280 DATA ***,South Wales

4290 DATA ***,North Wales

4300 DATA *,*

4310 DATA Ireland

4320 DATA DUB,Dublin

4330 DATA *,*,*

4340 REM IF info$(10)="":IF info$(12)="Scotland":info$(10)=info$(11):info$(11)=""

4350 IF LEFT$(birth$,7)="County ":IF info$(11)="":info$(11)=birth$:birth$=""

4360 :

4370 IF LEFT$(birth$,2)="N ":birth$="North"+MID$(birth$,2)

4380 IF LEFT$(birth$,2)="S ":birth$="South"+MID$(birth$,2)

4390 IF LEFT$(birth$,2)="W ":birth$="West"+MID$(birth$,2)

4400 IF LEFT$(birth$,2)="E ":birth$="East"+MID$(birth$,2)

4410 info$(10)=birth$ :REM BIRTH PLACE

4420 info$(13)="" :REM INDIVIDUAL NUMBER

4430 info$(14)=parish$ :REM CIVIL PARISH

4440 info$(15)="Whitby" :REM SUB-REGISTRATION DISTRICT

4450 info$(16)=STR$district% :REM ED, INSTITUTION, OR VESSEL

4460 info$(17)=piece$ :REM PIECE

4470 info$(18)=page$ :REM PAGE

4480 info$(19)=folio$ :REM FOLIO

4490 :

4500 IF verbose%:FOR A%=0 TO max%:PRINTTAB(36,A%+2);LEFT$(info$(A%),40);SPC(40-LENLEFT$(info$(A%),40)):NEXT

4510 PROCcsv_wr(out%,info$())

4520 ENDPROC

4530 :

4540 DEFPROCClose_All

4550 out%=out%:IFout%:A%=out%:out%=0:CLOSE#A%

4560 in%=in%:IFin%:A%=in%:in%=0:CLOSE#A%

4570 ENDPROC

4580 :

4590 DEFFNd0(A%,N%)=RIGHT$(" "+STR$A%,N%)

4600 DEFFNuc(A$):LOCAL B$:IFA$="":=""

4610 REPEATB$=B$+CHR$(ASCA$AND((A$<"@")OR&DF)):A$=MID$(A$,2):UNTILA$="":=B$

4620 DEFFNlc(A$):LOCAL B$:IFA$="":=""

4630 REPEATB$=B$+CHR$(ASCA$OR((A$<"_")AND&20)):A$=MID$(A$,2):UNTILA$="":=B$

4640 DEFFNs(A$):IFLEFT$(A$,1)=" ":REPEATA$=MID$(A$,2):UNTILLEFT$(A$,1)<>" "

4650 IFRIGHT$(A$,1)=" ":REPEATA$=LEFT$(A$,LENA$-1):UNTILRIGHT$(A$,1)<>" "

4660 =A$

4670 :

4680 DEFPROCcsv_wr(o%,array$())

4690 LOCAL n%,q%:n%=DIM(array$(),1)

4700 FOR A%=0 TO n%:A$=array$(A%)

4710 q%=INSTR(A$,",")

4720 IF q%=0:q%=(ASCA$=48)AND(INSTR(A$,"/")=0) :REM leading zeros 00001

4730 IF q%=0:IFVALLEFT$(A$,1):q%=INSTR(A$,"E") :REM preserve 1234E5678

4740 IF q%=0:q%=LENSTR$VALA$>8 :REM long numbers 12345678901234

4750 IF q%=0:IFVALA$:q%=INSTR(A$,"/")AND(ASCA$<>48):REM fractions 12/34

4760 IF q%=0:q%=LEFT$(A$,1)="-" :REM leading hyphen -

4770 IF q%=0:q%=MID$(A$,3,1)=" "ANDMID$(A$,7,1)=" ":REM dates xx XXX xxxx

4780 IF q%=0:q%=LEFT$(A$,1)="(" :REM prevent (nnn) becoming negative

4790 IF q%:A$=""""+A$+"""":IFINSTR(A$,",")=0:A$="="+A$

4800 BPUT#o%,A$;:IF A%<>n%:BPUT#o%,",";

4810 NEXT A%:BPUT#o%,""

4820 ENDPROC