REM > CSVtoEARS 1.11
      REM Convert CSV canvass file into EARS telecanvass file
      REM Looking electors up in city-wide EARS to find elector numbers
      REM Needs to output one file per constituency
      :
      REM v1.00 - manually trawls through elector DBs to find phone numbers
      REM v1.10 - Uses phone.idx lookup
      REM v1.11 - Generate ward stats
      :
      jon%=FALSE         :REM Running on Jon's machine?
      nethergreen%=TRUE  :REM Running at Nethergreen?
      cammst%=FALSE      :REM Running at home?
      PROCFSInit         :REM Find root, directory and extension characters
      IF jon%:MODE 32:r$=""
      :
      dial$="0114":base%=01142000000:size%=4
      shef$="Shef":REM Use "Shef" in full-city version
      data$="Data":REM Use "Data" in full-city version
      :
      indir$=r$+"EARS71"+d$+"Incoming"+d$+"Ant"
      in$=indir$+d$+"Export"+e$+"csv"
      tcin$="TCIN"
      tcanv$="TCANVASS"+e$+"IN"
      out$=r$+"EARS71"
      nul$=r$+"EARS71"+d$+"TCInput"
      ears$=r$+"EARS71"+d$+shef$
      pidx$=r$+"EARS71"+d$+"TCInput"+d$+"PHONE"+e$+"IDX"
      useDB%=TRUE
      verbose%=TRUE-TRUE
      :
      DIM mem% 127,zp% 7:rd%=3:wr%=1
      ON ERROR PRINT:REPORT:PROCCloseAll:PRINTLEFT$(" at line "+STR$ERL,(ERL<>0)AND255):PROCEnd:END
      wards$="ABCDEFGHIJKLMNOPQRSTUVWXYZ23"
      DIM c$(5,1)
      c$(0,0)="At":c$(0,1)="CDIS3"  :REM Attercliffe
      c$(1,0)="Br":c$(1,1)="MVW"    :REM Brightside
      c$(2,0)="Ce":c$(2,1)="FGRT"   :REM Central
      c$(3,0)="Ha":c$(3,1)="EHJLN"  :REM Hallam
      c$(4,0)="He":c$(4,1)="ABOPU"  :REM Heeley
      c$(5,0)="Hi":c$(5,1)="KQXYZ2" :REM Hillsborough
      DIM ward$(40,2):A%=0:RESTORE
      REPEAT READ ward$(A%,1),ward$(A%,2),ward$(A%,0):A%=A%+1:UNTIL ward$(A%-1,0)="*"
      REM Ward code, Constituency area, Ward name
      DATA A,He,ARBOURTHORNE
      DATA B,He,BEAUCHIEF AND GREENHILL
      DATA B,He,BEAUCHIEF & GREENHILL
      DATA C,At,BEIGHTON
      DATA D,At,BIRLEY
      DATA E,Ha,BROOMHILL
      DATA F,Ce,BURNGREAVE
      DATA G,Ce,CENTRAL
      DATA H,Ha,CROOKES
      DATA I,At,DARNALL
      DATA J,Ha,DORE AND TOTLEY
      DATA J,Ha,DORE & TOTLEY
      DATA K,Hi,EAST ECCLESFIELD
      DATA L,Ha,ECCLESALL
      DATA M,Br,FIRTH PARK
      DATA N,Ha,FULWOOD
      DATA O,He,GLEADLESS VALLEY
      DATA P,He,GRAVES PARK
      DATA Q,Hi,HILLSBOROUGH
      DATA R,Ce,MANOR AND CASTLE
      DATA R,Ce,MANOR & CASTLE
      DATA S,At,MOSBOROUGH
      DATA T,Ce,NETHER EDGE
      DATA U,He,RICHMOND
      DATA V,Br,SHIREGREEN AND BRIGHTSIDE
      DATA V,Br,SHIREGREEN & BRIGHTSIDE
      DATA W,Br,SOUTHEY
      DATA X,Hi,STANNINGTON
      DATA Y,Hi,STOCKSBRIDGE AND UPPER DON
      DATA Y,Hi,STOCKSBRIDGE & UPPER DON
      DATA Z,Hi,WALKLEY
      DATA 2,Hi,WEST ECCLESFIELD
      DATA 2,Hi,WESTECC1
      DATA 3,At,WOODHOUSE
      DATA *,*,*
      :
      IFos%=32:OSCLI"."+indir$+"\*.csv" ELSE OSCLI"."+indir$
      PRINT "Input file ("in$") ";:INPUT":"A$:IF A$<>"":in$=A$:IFINSTR(in$,d$)=0:in$=indir$+d$+in$
      PRINT "EARS programs directory (";out$;") ";:INPUT":"A$:IF A$<>"":out$=A$
      PRINT "Sheffield EARS directory (";ears$;") ";:INPUT":"A$:IF A$<>"":ears$=A$
      PRINT "Numbers file (";pidx$;")";:INPUT":"A$:IF A$<>"":pidx$=A$
      PRINT "Recreate phone number database? ";:INPUT""A$:A$=LEFT$(A$,1)
      IFA$="Y"ORA$="y":PROCPhoneDB:PROCEnd:END
      PRINT "Just create ward statistics? ";:INPUT""A$:A$=LEFT$(A$,1):stats%=(A$="Y"ORA$="y")
      IFuseDB%:numb%=OPENIN(pidx$):IFnumb%:CLOSE#numb%:numb%=0 ELSE useDB%=FALSE
      in%=OPENIN(in$):IF in%=0:PRINT "Can't open '"in$"'":PROCEnd
      :
      REM Blank out all output files
      IFNOTstats%:out%=OPENOUT(out$+d$+"At"+d$+tcin$+d$+tcanv$):CLOSE#out%:out%=0
      IFNOTstats%:out%=OPENOUT(out$+d$+"Br"+d$+tcin$+d$+tcanv$):CLOSE#out%:out%=0
      IFNOTstats%:out%=OPENOUT(out$+d$+"Ce"+d$+tcin$+d$+tcanv$):CLOSE#out%:out%=0
      IFNOTstats%:out%=OPENOUT(out$+d$+"Ha"+d$+tcin$+d$+tcanv$):CLOSE#out%:out%=0
      IFNOTstats%:out%=OPENOUT(out$+d$+"He"+d$+tcin$+d$+tcanv$):CLOSE#out%:out%=0
      IFNOTstats%:out%=OPENOUT(out$+d$+"Hi"+d$+tcin$+d$+tcanv$):CLOSE#out%:out%=0
      IFNOTstats%:out%=OPENOUT(nul$+d$+"00"+e$+"txt"):CLOSE#out%:out%=0
      :
      PROCProcess
      CLOSE#in%:in%=0:PROCEnd:END
      :
      :
      REM =================================================
      REM Read through input CSV file and process each line
      REM -------------------------------------------------
      DEF PROCProcess
      PRINT'"Unmatched entries:"
      idx%=0:IFuseDB%:idx%=OPENIN(pidx$)
      IFstats%:out%=OPENUP(nul$+d$+"Stats"+e$+"txt"):IFout%=0:out%=OPENOUT(nul$+d$+"Stats"+e$+"txt")
      IFstats%:IFout%:PTR#out%=EXT#out%
      REPEAT
        line$=FNrd(in%):IFline$="" AND NOTEOF#in%:line$=FNrd(in%)
        name1$="":name2$="":telnum$="":canvass$="":ward$=""
        REPEAT
          A%=INSTR(line$+",",","):A$=LEFT$(line$,A%-1):line$=MID$(line$,A%+1)
          PROCfield(A$)
        UNTIL LEN line$<2
        PRINT LEFT$(name1$,14);TAB(15);LEFT$(name2$,14);TAB(30);
        PRINT LEFT$(telnum$,14);TAB(45);LEFT$(canvass$,14);TAB(60);
        PRINT LEFT$(ward$,10);TAB(70);
        canvass%=FNcanvass :REM Convert canvass$ to standard value
        id$     =FNlookup  :REM Find elector ID
        PROCoutput:PRINTCHR$13;
      UNTIL EOF#in%
      IFout%:CLOSE#out%:out%=0
      IFidx%:CLOSE#idx%:idx%=0
      ENDPROC
      :
      :
      REM ====================================
      REM Work out what current field contains
      REM ------------------------------------
      DEF PROCfield(A$):A$=FNuc(A$):IF A$="":ENDPROC
      IF LEFT$(A$,1)=" ":A$=MID$(A$,2)
      IF LEFT$(A$,1)="""":A$=MID$(A$,2)
      IF RIGHT$(A$,1)="""":A$=LEFT$(A$,LEN A$-1)
      IF LEFT$(A$,3)="MR "  :A$=MID$(A$,4)
      IF LEFT$(A$,3)="MS "  :A$=MID$(A$,4)
      IF LEFT$(A$,4)="MRS " :A$=MID$(A$,5)
      IF LEFT$(A$,5)="MISS ":A$=MID$(A$,6)
      A$=FNs(A$)
      IF RIGHT$(A$,1)=".":A$=LEFT$(A$,LENA$-1)
      IF VAL A$:IF INSTR(A$,"/")=0:telnum$=A$:ENDPROC
      IF name1$=""   :name1$  =A$:ENDPROC
      IF name2$=""   :name2$  =A$:ENDPROC
      IF canvass$="" :canvass$=A$:ENDPROC
      IF ward$=""    :ward$   =A$:ENDPROC
      ENDPROC
      :
      :
      REM =================================================
      REM Convert mangled canvass string into canvass value
      REM -------------------------------------------------
      DEF FNcanvass
      REM Def Prob HCon SCon HLab SLab Grn FarLft FarRgt Other UnDec Anti
      REM  1   2    3    4    5    6    7   8      9      10     11   12
      IF INSTR(canvass$,"LIB"):=1
      IF INSTR(canvass$,"DEF"):=1
      IF INSTR(canvass$,"PROB"):=2
      IF INSTR(canvass$,"CON"):=4+(INSTR(canvass$,"HARD")<>0)
      IF INSTR(canvass$,"LAB"):=6+(INSTR(canvass$,"HARD")<>0)
      IF INSTR(canvass$,"GR"):=7
      IF INSTR(canvass$,"LEFT"):=8
      IF INSTR(canvass$,"LFT"):=8
      IF INSTR(canvass$,"RIGHT"):=9
      IF INSTR(canvass$,"RGT"):=9
      IF INSTR(canvass$,"OTH"):=10
      IF INSTR(canvass$,"UND"):=11
      IF INSTR(canvass$,"ANT"):=12
      =-1
      :
      :
      REM ==================================
      REM Output this elector's canvass data
      REM ----------------------------------
      DEFPROCoutput
      PRINT id$;SPC(15-LEN id$);canvass%;" ";CHR$8;
      IFstats%:PROCstats:ENDPROC
      id%=VALMID$(id$,7):IF canvass%<1 OR id%<1:PROCunknown:ENDPROC
      file$=out$+d$+LEFT$(id$,2)+d$+tcin$+d$+tcanv$
      out%=OPENUP(file$):IFout%=0:out%=OPENOUT(file$)
      IFout%=0:PRINT"Can't open '"file$"' for output":ENDPROC
      PTR#out%=EXT#out%
      BPUT#out%,2:BPUT#out%,ASCMID$(id$,4,1):BPUT#out%,ASCMID$(id$,5,1)
      BPUT#out%,0:BPUT#out%,0:BPUT#out%,0:BPUT#out%,0:BPUT#out%,0
      BPUT#out%,id%:BPUT#out%,id%DIV256
      BPUT#out%,0:BPUT#out%,0:BPUT#out%,0:BPUT#out%,0:BPUT#out%,0
      BPUT#out%,0:BPUT#out%,0:BPUT#out%,5
      BPUT#out%,canvass%
      CLOSE#out%:out%=0
      ENDPROC
      :
      :
      REM =========================================
      REM Unknown canvass return or unknown elector
      REM -----------------------------------------
      DEFPROCunknown:IFcanvass%<0:ENDPROC
      file$=nul$+d$+"00"+e$+"txt"
      out%=OPENUP(file$):IFout%=0:out%=OPENOUT(file$)
      IFout%=0:PRINT"Can't open '"file$"' for output":ENDPROC
      PTR#out%=EXT#out%
      BPUT#out%,name1$;:BPUT#out%,STRING$(20-LENname1$," ");
      BPUT#out%,name2$;:BPUT#out%,STRING$(20-LENname2$," ");
      BPUT#out%,telnum$;:BPUT#out%,STRING$(20-LENtelnum$," ");
      BPUT#out%,canvass$;:BPUT#out%,STRING$(20-LENcanvass$," ");
      BPUT#out%,ward$;
      IFos%=32 OR os%<6:BPUT#out%,13
      IFos%>5:BPUT#out%,10
      CLOSE#out%:out%=0:PRINT
      ENDPROC
      :
      :
      REM =========================
      REM Output to statistics file
      REM -------------------------
      DEFPROCstats
      BPUT#out%,id$;
      IFos%=32 OR os%<6:BPUT#out%,13
      IFos%>5:BPUT#out%,10
      ENDPROC
      :
      :
      REM ===========================================================
      REM Look for an elector ID based on a telephone number and name
      REM -----------------------------------------------------------
      DEF FNlookup
      IF VALname1$:=""
      IF telnum$="":=""
      IF LEFT$(telnum$,1)<>"0":telnum$=dial$+telnum$
      IFLENtelnum$<>LEN"01142000000":="00:00:0"
      IFNOTuseDB%:=FNlookupmanual
      :
      :
      REM ========================================================
      REM Look an elector by indexing via phone numbers index file
      REM --------------------------------------------------------
      phone%=VALtelnum$-base%
      PTR#idx%=phone%*4
      wardcode$=CHR$BGET#idx%
      pollcode$=CHR$BGET#idx%
      id0%=BGET#idx%+256*BGET#idx%:REM Initial elector ID
      IFstats%:=FNconst(INSTR(wards$,wardcode$))+":"+wardcode$+pollcode$+":"+STR$id0%
      info%=OPENIN(ears$+d$+data$+d$+"E"+wardcode$+pollcode$+e$+"VX"):REM Elector information
      IFinfo%=0:=FNconst(INSTR(wards$,wardcode$))+":"+wardcode$+pollcode$+":0"
      found%=FALSE:diff%=-1
      REPEAT
        ptr%=(id0%-1)*&79:!mem%=0:PROCgbpb(rd%,info%,mem%,&79,ptr%)
        id%=!mem% AND &FFFF:IFid0%<>id%:PROCfindinfo
        surnameptr%=mem%!&A AND &FFFF:pernameptr%=mem%!&C AND &FFFF
        PROCRdNames(INSTR(wards$,wardcode$),ASCpollcode$)
        REM PRINT'"target=";id0%;" Found=";id%;" "surname$"/"pername$"//"name1$"/"name2$"/";:IFGET
        found%=(surname$=name1$ AND pername$=name2$) OR (surname$=name2$ AND pername$=name1$)
        IFNOTfound%:IF surname$=name1$ OR surname$=name2$:IF name1$=LEFT$(pername$,LENname1$) OR name2$=LEFT$(pername$,LENname2$):found%=TRUE
        REM IFNOTfound%:id0%=id0%+diff%:diff%=(ABSdiff%+1)*(0-SGNdiff%)
        IFNOTfound%:id0%=id0%-1
      UNTILfound% OR id0%<1:REM  OR diff%>59
      CLOSE#info%:info%=0
      IFNOTfound%:=FNconst(INSTR(wards$,wardcode$))+":"+wardcode$+pollcode$+":0"
      =FNconst(INSTR(wards$,wardcode$))+":"+wardcode$+pollcode$+":"+STR$id%
      :
      :
      REM ==============================
      REM Scan info file to find elector
      REM ------------------------------
      DEFPROCfindinfo
      LOCAL found%
      ptr%=-1
      REPEAT
        ptr%=ptr%+1:!mem%=0:PROCgbpb(rd%,info%,mem%,&79,ptr%*&79):id%=!mem% AND &FFFF:REM PRINTCHR$13;id%;
        surnameptr%=mem%!&A AND &FFFF:pernameptr%=mem%!&C AND &FFFF
        PROCRdNames(INSTR(wards$,wardcode$),ASCpollcode$)
        found%=(surname$=name1$ AND pername$=name2$) OR (surname$=name2$ AND pername$=name1$)
        IFNOTfound%:IF surname$=name1$ OR surname$=name2$:IF name1$=LEFT$(pername$,LENname1$) OR name2$=LEFT$(pername$,LENname2$):found%=TRUE
      UNTILfound% OR ptr%>=EXT#info% OR id%=0:IFfound%:id0%=id% ELSE id0%=-1
      ENDPROC
      :
      ai%=OPENIN(ears$+d$+data$+d$+"E"+wardcode$+pollcode$+e$+"AI"):ptr%=id0%*2-2
      IFptr%>=0 AND ptr%<EXT#ai%:PTR#ai%=ptr%:ptr%=BGET#ai%+256*BGET#ai% ELSE ptr%=-1
      CLOSE#ai%:ai%=0:id%=0:ptr%=ptr%*&79
      IFptr%>=0 AND ptr%<EXT#info%:PROCgbpb(rd%,info%,mem%,&79,ptr%):id%=!mem% AND &FFFF
      ENDPROC
      :
      :
      REM ===================================================================
      REM Manually for look an elector by searching for matching phone number
      REM -------------------------------------------------------------------
      DEFFNlookupmanual
      REM If ward$ set, look in that ward
      REM If ward$ not set, look through entire database in wards$
      LOCAL wardcode$,id$,found%
      IF ward$<>"":wardcode$=FNwardcode:REM eg "Hi:Z"
      IFstats%:IFward$<>"":=wardcode$+"0:0000"
      ward%=1:IF wardcode$<>"":ward%=INSTR(wards$,MID$(wardcode$,4,1))
      PRINTSPC10;
      REPEAT
        pd%=ASC"A"-1
        REPEAT
          pd%=pd%+1
          PRINT STRING$(9,CHR$8);"Trying ";MID$(wards$,ward%,1)+CHR$ pd%;
          info%=OPENIN(ears$+d$+data$+d$+"E"+MID$(wards$,ward%,1)+CHR$ pd%+e$+"VX"):REM Elector information
          numb%=OPENIN(ears$+d$+data$+d$+"E"+MID$(wards$,ward%,1)+CHR$ pd%+e$+"TP"):REM Telephone numbers
          nopd%=info%=0:IF NOT nopd%:id$=FNsearchpd:found%=id$<>""
          IF info%:CLOSE#info%:info%=0
          IF numb%:CLOSE#numb%:numb%=0
        UNTIL found% OR nopd%:REM run out of pds, or found entry
        IF NOT found% AND wardcode$="":ward%=ward%+1:nopd%=FALSE:REM Try next ward if searching all wards
      UNTIL found% OR nopd% OR ward%>LEN wards$
      PRINTSTRING$(9,CHR$8);
      IF found%:=FNconst(ward%)+":"+MID$(wards$,ward%,1)+CHR$(pd%)+":"+id$
      IF wardcode$="":="00:00:0000"
      =wardcode$+"0:0000"
      :
      :
      REM ==========================================================================================
      REM Search a polling district until a matching phone number found, with matching elector names
      REM ------------------------------------------------------------------------------------------
      DEF FNsearchpd
      Phone$=""
      REPEAT
        PROCgbpb(rd%,info%,mem%,&79,PTR#info%)
        phoneptr%=256*mem%?&4C+mem%?&4D
        surnameptr%=mem%!&A AND &FFFF
        pernameptr%=mem%!&C AND &FFFF
        IF phoneptr%:Phone$=FNs(FNRdPhone(numb%,phoneptr%))
        IF Phone$=telnum$:PROCRdNames(ward%,pd%):IF (surname$<>name1$ AND pername$<>name2$) AND (surname$<>name2$ AND pername$<>name1$):Phone$=""
      UNTIL EOF#info% OR Phone$=telnum$
      IF Phone$=telnum$:=STR$(mem%!0)
      =""
      :
      DEF PROCRdNames(ward%,pd%):surname$="":pername$=""
      IFsurnameptr%=0 OR pernameptr%=0:ENDPROC
      name%=OPENIN(ears$+d$+data$+d$+"E"+MID$(wards$,ward%,1)+CHR$ pd%+e$+"MP"):REM Surnames file
      PTR#name%=surnameptr%+&200:surname$=FNs(FNuc(FNRdStr7(name%))):CLOSE#name%:name%=0
      name%=OPENIN(ears$+d$+data$+d$+"E"+MID$(wards$,ward%,1)+CHR$ pd%+e$+"V2"):REM Forenames file
      PTR#name%=pernameptr%*16-16:pername$=FNs(FNuc(FNRdStr(name%))):CLOSE#name%:name%=0
      IFRIGHT$(surname$,1)=".":surname$=LEFT$(surname$,LENsurname$-1)
      IFRIGHT$(pername$,1)=".":pername$=LEFT$(pername$,LENpername$-1)
      ENDPROC
      :
      :
      REM ==================================
      REM Find ward codes and constituencies
      REM ----------------------------------
      DEF FNwardcode:ward$=FNuc(ward$):A%=-1
      REPEAT:A%=A%+1:UNTIL ward$=LEFT$(ward$(A%,0),LEN ward$) OR ward$(A%,0)="*"
      IF ward$(A%,0)="*":="" ELSE =ward$(A%,2)+":"+ward$(A%,1)
      :
      DEF FNconst(w%):A%=-1:REPEAT A%=A%+1:UNTIL ward$(A%,1)=MID$(wards$,w%,1):=ward$(A%,2)
      :
      :
      REM =============================
      REM Create phone numbers database
      REM -----------------------------
      DEFPROCPhoneDB
      out%=OPENOUT(pidx$)
      FOR const%=0 TO 5
        FOR ward%=1 TO LEN c$(const%,1)
          ward$=MID$(c$(const%,1),ward%,1)
          path$=ears$+d$+data$+d$+"E"+ward$
          PRINT path$
          pd%=0:REPEAT:pd%=pd%+1
            pd$=CHR$(64+pd%)
            info$=path$+pd$+e$+"VX"
            numb$=path$+pd$+e$+"TP"
            info%=OPENIN(info$):found%=info%<>0
            numb%=OPENIN(numb$)
            IFfound%:PROCScanFile
            IFinfo%:CLOSE#info%:info%=0
            IFnumb%:CLOSE#numb%:numb%=0
          UNTIL NOTfound%
          PRINTCHR$13;SPC60;CHR$13;
        NEXT
      NEXT
      CLOSE#out%:out%=0
      ENDPROC
      :
      DEF PROCScanFile
      REPEAT
        PROCgbpb(rd%,info%,mem%,&79,PTR#info%)
        id%=mem%!0:phoneptr%=mem%?&4D+256*mem%?&4C
        IF phoneptr%<>0:PROCAddNum
      UNTIL EOF#info%
      ENDPROC
      :
      DEF PROCAddNum
      LOCAL @%:@%=&A0A
      phone$=FNs(FNRdPhone(numb%,phoneptr%))
      IF LEFT$(phone$,1)="T":phone$=MID$(phone$,2)
      IF LEFT$(phone$,2)<>"01" AND LEFT$(phone$,2)<>"02":ENDPROC
      IF LEFT$(phone$,LENdial$)<>dial$:ENDPROC
      IF LENphone$<>LEN"01140000000":ENDPROC
      IF verbose%:PRINT phone$;"->";
      phone%=FNPhoneFromStr(phone$):IF verbose%:PRINT ;phone%;"->";
      ptr%=(phone%-base%)*size%    :IF verbose%:PRINT ;ptr%;
      PTR#out%=ptr%                :IF verbose%:PRINT ": &";~ptr%;
      IF size%>0:BPUT#out%,ASCward$
      IF size%>1:BPUT#out%,ASCpd$
      IF size%>3:BPUT#out%,id%:BPUT#out%,id%DIV256
      IF verbose%:PRINTSPC4;CHR$13;
      ENDPROC
      :
      :
      REM ====================
      REM Read data from files
      REM --------------------
      DEF FNRdPhone(ch%,ptr%):IF ptr%=0:=""
      IF ptr%*8>EXT#ch%-7:=""
      LOCAL A$,A%,B%:PTR#ch%=ptr%*8-8
      FOR A%=1 TO 8:B%=BGET#ch%
        IF(B%AND&F0)=&F0:A$=A$+"T" ELSE IF (B%AND&F0)=&A0:A$=A$+" " ELSE A$=A$+STR$~(B%DIV16)
        IF(B%AND&0F)=&0F:A$=A$+"T" ELSE IF (B%AND&0F)=&0A:A$=A$+" " ELSE A$=A$+STR$~(B%AND15)
      NEXT:=A$
      :
      DEF FNRdStr(ch%):LOCAL n%,A$
      FOR n%=1 TO BGET#ch%:A$=A$+CHR$ BGET#ch%:NEXT:=A$
      :
      DEF FNRdStr7(ch%):LOCAL A%,A$
      REPEAT A%=BGET#ch%:A$=A$+CHR$(A%AND127):UNTIL A%>127:=A$
      :
      REM =============
      REM File routines
      REM -------------
      DEF FNrd(ch%):IF EOF#ch%:=""
      LOCAL A$,A%
      REPEAT:A%=BGET#ch%:IF A%<>10 AND A%<>13:A$=A$+CHR$ A%
      UNTIL A%=10 OR A%=13 OR LEN A$>254:=A$
      :
      DEFPROCgbpb(A%,ch%,ad%,nm%,ptr%)
      IFptr%<0 OR ptr%>=EXT#ch%:ENDPROC
      PTR#ch%=ptr%:IFnm%=0:ENDPROC
      IFos%=32:IFA%=rd%:SYS"ReadFile",@hfile%(ch%),ad%,nm%,zp%,0:ENDPROC
      IFos%=32:IFA%=wr%:SYS"WriteFile",@hfile%(ch%),ad%,nm%,zp%,0:ENDPROC
      IFA%=rd%:REPEAT?ad%=BGET#ch%:ad%=ad%+1:nm%=nm%-1:UNTILnm%<1
      IFA%=wr%:REPEATBPUT#ch%,?ad%:ad%=ad%+1:nm%=nm%-1:UNTILnm%<1
      ENDPROC
      :
      DEF PROCbput32(ch%,A%):!zp%=A%
      BPUT#ch%,?zp%:BPUT#ch%,zp%?1:BPUT#ch%,zp%?2:BPUT#ch%,zp%?3
      ENDPROC
      :
      DEF PROCCloseAll
      ai%=ai%:IFai%:A%=ai%:ai%=0:CLOSE#A%
      in%=in%:IF in%:A%=in%:in%=0:CLOSE#A%
      out%=out%:IF out%:A%=out%:out%=0:CLOSE#A%
      idx%=idx%:IF idx%:A%=idx%:idx%=0:CLOSE#A%
      info%=info%:IF info%:A%=info%:info%=0:CLOSE#A%
      name%=name%:IF name%:A%=name%:name%=0:CLOSE#A%
      numb%=numb%:IF numb%:A%=numb%:numb%=0:CLOSE#A%
      ENDPROC
      :
      REM ===================
      REM Environment support
      REM -------------------
      DEF PROCFSInit
      d$=".":e$="/":r$="$.EARS."
      A%=0:X%=1:os%=((USR&FFF4)AND&FF00)DIV256:IFos%=32:d$="\":e$=".":r$="C:\":IFjon%:r$="C:\Apps\"
      ENDPROC
      :
      DEF PROCEnd
      IFos%=32:PRINT "*** Press SPACE to return to desktop ***";:IFGET
      *Quit
      ENDPROC
      :
      REM ===============
      REM String routines
      REM ---------------
      DEF FNd(A%,N%)=RIGHT$("         "+STR$ A%,N%)
      DEF FNh0(A%,N%)=RIGHT$("0000000"+STR$~A%,N%)
      :
      DEF FNuc(A$):IF A$="":=""
      FOR A%=1TOLEN A$:IF MID$(A$,A%,1)>"_":A$=LEFT$(A$,A%-1)+CHR$(ASC MID$(A$,A%,1)-32)+MID$(A$,A%+1)
      NEXT:=A$
      :
      DEF FNs(A$):REPEAT
        A%=INSTR(A$," "):IF A%:A$=LEFT$(A$,A%-1)+MID$(A$,A%+1)
      UNTIL A%=0:=A$
      :
      REM > BLib.Phone 1.00 20-Apr-2000
      :
      REM Display and store UK telephone numbers
      REM ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      :
      DEF FNPhoneToStr(A%):LOCAL@%,A$:@%=&A0A:A$=RIGHT$("000000000"+STR$ A%,10)
      ="0"+STR$(2-VAL LEFT$(A$,1))+MID$(A$,2)
      DEF FNPhoneFromStr(A$):A$=RIGHT$("000000000"+A$,10)
      =VAL(STR$(2-VAL LEFT$(A$,1))+MID$(A$,2))
      DEF FNPhoneToStrF(A%):LOCAL A$,B%,C%:A$=FNPhoneToStr(A%)
      B%=MID$(A$,3,1)="1" OR MID$(A$,4,1)="1":C%=MID$(A$,2,1)="2"
      =LEFT$(A$,5+(B%ANDNOTC%)+2*C%)+" "+MID$(A$,6+(B%ANDNOTC%)+2*C%,3-C%)+" "+MID$(A$,9+(B%ANDNOTC%)+C%)