'data entry - ices format
on error goto handle
key off
dim fld(30),dec(30),aname$(30),par$(46,30),qu$(46,30)
'par$ are enterd parameters qu$=quality control flag
'fld is integer size, dec is no of decimal places
'decription
data Country (IOC code),Ship (NODC code),Station number,Station Name (use = for trailing spaces),Latitude,Latitude sector
data Longitude,Longitude sector,Year,Month,Day,Station Time,Sounding
f1=13 'no of fields in master
f2=11 'no of data fields - form 1
f3=5  'no of data fields - form 2

f$=command$
renew:
if f$<>"" then
open f$ for input as #1
for i=1 to 44
for j=1 to f1+f2+f3
input #1,par$(i,j)
next j
next i
close #1
end if
i=0:j=0

beg:
if iceblu<>0 then master
' master record


while i <>f1
incr i
read aname$(i)
wend


 data 2,0,2,0,4,0,10,0,4,2,1,0,5,2,1,0,4,0,2,0,2,0,4,0,4,0
i=0
 while i <>f1
incr i

read fld(i),dec(i)
 wend

'1st data record


while i<>f2+f1
incr i
read aname$(i)
wend
data Depth,Temperature,Salinity,Oxygen,Phosphate,Total Phosphorus
data Silicate,Nitrate,Nitrite,Ammonium content,Total Nitrogen
data 4,0,2,2,2,3,2,2,2,2,2,2,3,1,3,1,2,2,3,1,3,1
i=f1
while i<>f2+f1
incr i
read fld(i),dec(i)
wend

'1st data record extended

data Depth,Hydrogen sulphide,pH,Alkalinity,Chlorophyll 'a'
data 4,0,3,1,1,2,1,3,3,1
while i<>f1+f2+f3
incr i
read aname$(i)
wend
i=f1+f2
while i<>f1+f2+f3
incr i
read fld(i),dec(i)
wend

inr1:
gosub intr
color 0,7:locate 25,2:
print "F6";:color 7,0:print " - Help";
color 0,7:locate 25,20:PRINT "C";:color 7,0
print " - Non-standard units";
color 0,7:locate 25,50:print "Press any other key to procede";
color 7,0
while not instat
wend
s$=inkey$
s=asc(right$(s$,1))
  if s=64 and len(s$)=2 then gosub help:goto inr1
  if ucase$(s$)="C" then
   cls:locate 10,10:print "You have chosen an option to enter nutrient data"
   locate ,10:print "which automatically converts from mg (N)/l etc to SI units"
   locate ,10:print "please confirm that you want this option by typing 'C' again"

   while not instat
   wend
   conv$=ucase$(inkey$)
 end if
  goto master

help:
  cls
  locate 1,1,0
  locate ,20:color 0,7:print "ENTICE - What keys to use and hints"
color 7,0
  locate ,10
  print "F1    - Master record"
  locate ,10
  print "F2    - Data cycles 1 to 22 - first 11 parameters"
  locate ,10
  print "sh-F2 - Data cycles 1-22 - last 4 parameters (depth for info only)"
  locate ,10
  print "F3    - Data cycles 22 to 44 - first 11 parameters"
  locate ,10
  print "sh-F3 - Data cycles 22 to 44 - last 4 parameters (depth for info only)"
  locate ,10
  print "sh-F4 - Doubtful data quality marker - point to field before pressing"
  locate ,10
  print "F10   - Saves data into Blueprint file and file readable by ENTICE"
   locate ,10
  Print "Esc      - Press two (or three) times to abort without save"
  locate ,10
  Print "Cursors  - Use cursor keys to navigate to fields"
  locate ,10
  print "Tab      - Press to move to beginning of next column"
  locate ,10
  print "Ctrl-D   - Delete entry and shuffle fields up."
  locate ,10
  print "Ctrl-E   - Expand; ie create a space and shuffle fields down"
  locate ,10
  Print "Others   - All numeric keys plus delete, < , . , and - are permissible"
  locate ,10
  print "           (assuming permitted by the data entry checks)"
  locate ,10
  Print "Hints    - Once a field is filled, the cursor moves to the next field"
  locate ,10
  print "           Alternatively, if you do not want to use all available"
  locate ,10
  print "           decimal positions in a field, terminate the entry"
  locate ,10
  print "           by pressing <Enter>."
  locate ,10

  print "           Type '.' to avoid typing leading zeros (eg 7. gives  07)"
locate ,10
  print "Beeps    - Your computer will beep if you enter a number that is not"
  locate ,10
  print "           within the allowed range. The greatest control occurs in "
  locate ,10
  print "           in the depth field - these must be entered before any other"
  locate ,10
  print "           parameter - and must be increasing.";


while not instat
wend
s$=inkey$
return

master:
cls
gosub instru
locate 5,30:print "Hydro/chemistry Data Entry"
print:locate ,30:print "........Master record"
d=1:dp1=d:dp2=d: 'only one depth strata in depth record.
 ypos=3:xpos=12:yposs=ypos
 locate xpos-2,ypos
 print "Co  Sh  Stn      Name      Lat    N/S  Lon     E/W Year  Mn  Dy  Time  Dep "
z1=1:z2=f1
 gosub refresh

fldno=z1
gosub distyp:locate xpos,ypos
in:
while not instat
wend
s$=inkey$
s=asc(right$(s$,1))
if (s=59 or s=60 or s=61 or s=64 or s=68 or s=85 or s=86) and len(s$)=2 then
  if len(par$(d,fldno))>=fld(fldno) or par$(d,fldno)="" then
    gosub check
    if disallo=1 then beep:disallo=0:locate xpos,ypos:exit if
     nextpage=1
   end if
end if
if nextpage=1 and s=59 then nextpage=0:goto master
if nextpage=1 and s=60 then nextpage=0:dp1=2:dp2=23:goto dataen
if nextpage=1 and s=61 then nextpage=0:dp1=23:dp2=44:goto dataen
if nextpage=1 and s=85 then nextpage=0:dp1=2:dp2=23:goto dataeo
if nextpage=1 and s=86 then nextpage=0:dp1=23:dp2=44:goto dataeo
if nextpage=1 and s=68 then nextpage=0:goto out1
if nextpage=1 and s=64 then
 nextpage=0
 gosub help
 if fldno<=f1 then goto master
 if fldno<=f1+f2 then goto dataen
 goto dataeo
end if

if s=27 then finsh
 carryon: 'entry completed

if (s=9) or (s=13 and fldno<13) or (len(s$)=2 and s=77) then 'to next field

 if len(par$(d,fldno))>=fld(fldno) or par$(d,fldno)="" then
    gosub check

    if disallo=1 then beep:disallo=0:locate xpos,ypos:exit if

    if s=9 and fldno>f1 then xpos=3:d=dp1
    if fldno=z2 then
      fldno=z1:ypos=yposs
      gosub distyp:locate xpos,ypos
      back=1
    exit if
    end if
    if back=1 then back=0:exit if
    fldno=fldno+1:ypos=ypos+fld(fldno-1)+2
    if dec(fldno-1)<>0 then ypos=ypos+dec(fldno-1)+1
    move=1:gosub distyp:locate xpos,ypos

  end if
end if

if s=87 and len(s$)=2 then 'quality mark

if len(par$(d,fldno))>=fld(fldno) or par$(d,fldno)="" then
  gosub check
  if disallo=1 then beep:disallo=0:locate xpos,ypos:exit if
  if par$(d,fldno)<>"" then gosub quality
 end if
end if

if (s=15) or (len(s$)=2 and s=75)  then 'to preceding field
if len(par$(d,fldno))>=fld(fldno) or par$(d,fldno)="" then
  gosub check
  if disallo=1 then beep:disallo=0:locate xpos,ypos:exit if
  if fldno=z1 then exit if
  fldno=fldno-1:ypos=ypos-fld(fldno)-2
  if dec(fldno)<>0 then ypos=ypos-dec(fldno)-1
   gosub distyp:locate xpos,ypos
 end if
 end if

if s=13 or (s=80 and len(s$)=2) then 'to field one down
 if len(par$(d,fldno))>=fld(fldno) or par$(d,fldno)="" then
  gosub check
  if disallo=1 then disallo=0:beep:locate xpos,ypos:exit if
  if dp1=dp2 then exit if
   if d=dp2 then
     d=dp1:xpos=3
     else
     d=d+1:xpos=xpos+1
   end if
  locate xpos,ypos:KEYST=0
  end if
  end if

if s=72 and len(s$)=2 then 'to field one up
 if len(par$(d,fldno))>=fld(fldno) or par$(d,fldno)="" then
   if dp1=dp2 then exit if
   if d=dp1 then
      d=dp2:xpos=24
      else
      d=d-1:xpos=xpos-1
   end if
  locate xpos,ypos:keyst=0
  end if
  end if

if s=4 and fldno>12 then 'delete entry and move col up

   if len(par$(d,fldno))>=fld(fldno) or par$(d,fldno)="" then
     gosub check
     if disallo=1 then disallo=0:beep:locate xpos,ypos:exit if
     gosub delcol
   end if

end if

if s=5 and fldno>f1 then 'insert a field and move columns down

   if len(par$(d,fldno))>=fld(fldno) or par$(d,fldno)="" then
      gosub check
      if disallo=1 then disallo=0:beep:locate xpos,ypos:exit if
      gosub inscol
   end if
end if


if s=83 and len(s$)=2 then gosub del
if (s<122 and s>=45) and len(s$)=1 then incr keyst:gosub enter
if next1=1 then next1=0:goto carryon else in


end

distyp:
keyst=0
locate 1,1
color 0,7:print string$(80,32);:locate 1,35
print aname$(fldno);
if dp1=2 then locate 1,70:print "Form 1";
if dp1=23 then locate 1,70:print "Form 2";
locate 1,1:print "F10";
print "- Save  Esc- Quit  F6- Help";:color 7,0
return

handle:
if err=53 and fldno=0 then resume beg'input filenot there
if err=53 then
 cls
 locate ,10
 print "i cannot create a file from the given station number"
 locate ,10
 print "Press any key then please change it!"
 while not instat
 wend
 s$=inkey$
 resume master
end if

if err=62 then i=0:j=0:goto beg 'input file too short
if err=61 or err=71 then
   cls
   locate 10,1
   print "Output disk is either full or not ready"
   print "Press any key when ready and repeat saving procedure"
   while not instat
   wend
   s$=inkey$
   resume master
end if

if err=75 then
  cls
  locate 10,1
  print "Your output file is inaccessible, probably read protected."
  print "To recover from this situation you will have to change the"
  print "name of the File ID on page 1"
  print:print "Press any key to procede"
  while not instat
  wend
  s$=inkey$
  resume master
end if
cls
locate 10,10
print "Fatal Error no ";ERR; "     Sorry!)
end
return

enter: 'enter data to given field -horizontal for master, vertical for data
if fld(fldno)=len(par$(d,fldno)) and dec(fldno)>0 and keyst=1 then decr keyst:return
if fldno=f1+f2+1 then beep:return ' cant enter depth in extension frame
if fld(fldno)=len(par$(d,fldno)) and dec(fldno)=0 then return
if fld(fldno)=len(par$(d,fldno)) and dec(fldno)>0 then
 color 7,0:print ".";
end if
if fld(fldno)+dec(fldno)=len(par$(d,fldno)) then return
if fld(fldno)>=len(par$(d,fldno)) and s$="." then
 leadz=len(par$(d,fldno))
 while fld(fldno)>len(par$(d,fldno))
  if lead=0 and left$(par$(d,fldno),1)="<"then
    less=1:par$(d,fldno)="0"+right$(par$(d,fldno),leadz-1)
  end if
 par$(d,fldno)="0"+par$(d,fldno):Incr lead
 wend
 if less=1 then mid$(par$(d,fldno),1)="<":less=0
locate xpos,ypos
color 0,7:print par$(d,fldno);:color 7,0
lead =0
if dec(fldno)=0 and fldno>f1 then s=80:s$="  ":next1=1
if dec(fldno)=0 and fldno<=f1 then s=9:next1=1
return
end if
par$(d,fldno)=par$(d,fldno)+s$:incr keyst
color 0,7:print s$;:color 7,0
if fld(fldno)+dec(fldno)=len(par$(d,fldno)) and dp1=dp2 then s=9:next1=1
if fld(fldno)+dec(fldno)=len(par$(d,fldno)) and dp1<>dp2 then
 s=80:s$="  ":next1=1
end if
return

del:
if fldno=f1+f2+1 then beep:return 'cant delete deptyh in extension frame
locate xpos,ypos
par$(d,fldno)="":qu$(d,fldno)=""
color 0,7:print string$(fld(fldno),32);:color 7,0
if dec(fldno)<>0 then
 locate xpos,pos+1:color 0,7:print string$(dec(fldno),32);
 color 7,0
end if
locate xpos,ypos
 if fldno=f1+1 then par$(d,fldno+f2)=par$(d,fldno):qu$(d,fldno+f2)=qu$(d,fldno)

return

'to delete and shuffle entries up one

delcol:

if fldno=f1+f2+1 then beep:return
gosub dmax
if dmax<d then return
for i=d to dmax-1
par$(i,fldno)=par$(i+1,fldno)
qu$(i,fldno)=qu$(i+1,fldno)
if fldno=f1+1 then par$(i,fldno+f2)=par$(i,fldno):qu$(i,fldno+f2)=qu$(i,fldno)
next i
par$(dmax,fldno)="":qu$(dmax,fldno)=""
if fldno=f1+1 then par$(dmax,fldno+f2)="":qu$(dmax,fldno+f2)=""
xpost=xpos

dd=d:i=fldno
for d= dd to dmax
locate xpos,ypos
gosub sufresh
incr xpos
if xpos=25 then exit for
next d
xpos=xpost:d=dd
locate xpos,ypos
return
'insert a space and move columns down
inscol:

if fldno=f1+f2+1 then beep:return
gosub dmax
if fldno=f1+1 then dmax=dmax+1
if dmax<d then return
if dmax=45 then beep:return
 for i=dmax to d+1 step -1
  par$(i,fldno)=par$(i-1,fldno)
  qu$(i,fldno)=qu$(i-1,fldno)
  if fldno=f1+1 then par$(i,fldno+f2)=par$(i,fldno):qu$(i,fldno+f2)=qu$(i,fldno)
 next i
par$(d,fldno)="":qu$(d,fldno)=""
if fldno=f1+1 then par$(d,fldno+f2)="":qu$(d,fldno+f2)=""
xpost=xpos
dd=d:i=fldno
for d=dd to dmax
locate xpos,ypos
gosub sufresh
incr xpos
if xpos=25 then exit for
next d
xpos=xpost:d=dd
locate xpos,ypos
return

'to determine how many dedpth entries have been made
dmax:
dmax=0
for i = d to 44
if par$(i,f1+1)<>"" then dmax=i
next i
return

' to check individual fields
check:

chk$=par$(d,fldno)
if chk$="" then return
if instr(2,chk$,"-") or instr(2,chk$,"<") <>0 then
 gosub del:disallo=1:beep
 locate xpos,ypos:color 0,7:print par$(d,fldno);:color 7,0
end if
if fldno>f1+4 and fldno<f1+f2+1 and left$(chk$,1) ="<" and par$(d,f1+1)<>"" then return
if fldno=f1+f2+f3 and left$(chk$,1)="<" and par$(d,13)<>"" then return 'clhlorophyll

'quadrants 'NS
if fldno=6 or fldno=8 then
  par$(d,fldno)=ucase$(par$(d,fldno))
    if (fldno=6 and par$(d,fldno)<>"N" and par$(d,fldno)<> "S") or (fldno=8 and par$(d,fldno)<>"W" and par$(d,fldno)<>"E") then
     gosub del:disallo=1:beep
    end if
  locate xpos,ypos:color 0,7:print par$(d,fldno);:color 7,0

'all others in master
else

  if fldno>4 then
     for ll=1 to len(par$(d,fldno))
     if ll=1 and left$(par$(d,fldno),1)="-" then nt1
      if mid$(par$(d,fldno),ll,1)<"0" or mid$(par$(d,fldno),ll,1)>"9" then flt=1
    nt1:
     next ll
       if flt=1 then
       flt=0
     ' if val(par$(d,fldno))=0 and par$(d,fldno)<>string$(len(par$(d,fldno)),48) then
       gosub del:disallo=1
       locate xpos,ypos:color 0,7:print par$(d,fldno);:color 7,0
      end if
   if fldno=5 and (left$(par$(d,5),2)>"90" or mid$(par$(d,5),3,2)>"59") then gosub disa
   if fldno=7 and (left$(par$(d,7),3)>"180" or mid$(par$(d,7),4,2)>"59") then gosub disa
   if fldno=9 and (par$(d,9)>right$(date$,4) or par$(d,9)<"1890") then gosub disa
   if fldno=10 and (par$(d,10)<"01" or par$(d,10)>"12") then gosub disa
   if fldno=11 and par$(d,11)<"01" or par$(d,11)>"31" then gosub disa
   if fldno=12 and par$(d,12)>"2359" then gosub disa 'time
   if fldno=12 and right$(par$(d,12),2)>"59" then gosub disa 'mins
   if fldno>f1+1 and par$(d,f1+1)="" then gosub disa:exit if
  if fldno=f1+1 then
     if par$(d-1,f1+1)="" and d>2 then gosub disa
     if par$(d,f1+1)<=par$(d-1,f1+1) and d>2 then:gosub disa 'increasing depth only
     par$(d,f1+f2+1)=par$(d,f1+1)
   end if
  if fldno=f1+2 and (par$(d,f1+2)>"2850" or val(left$(par$(d,f1+2),2))<-2) then gosub disa 'temperature
  if fldno=f1+3 and (left$(par$(d,f1+3),2)>"45" or left$(par$(d,f1+3),1)="-") then gosub disa
  if fldno=f1+4 and (left$(par$(d,f1+4),2)>"20" or left$(par$(d,f1+4),1)="-") then gosub disa
  if fldno>f1+4 and left$(par$(d,fldno),1)="-" then gosub disa
  if fldno=f1+5 or fldno=f1+6 then fact=31:wid=4:gosub adpo4
  if fldno=f1+7 then fact=28:wid=4:gosub adpo4
  if fldno>f1+7 and fldno<f1+12 then fact=14:wid=4:gosub adpo4
 end if

end if

return
adpo4:'to convert nutrients to SI units
if keyst=0 then return
if conv$<>"C" then return
while len(par$(d,fldno))<fld(fldno)+dec(fldno)
par$(d,fldno)=par$(d,fldno)+"0"
wend
par= val(par$(d,fldno))
par=int(par/fact)
par$(d,fldno)=str$(par)
par$(d,fldno)=right$(par$(d,fldno),len(par$(d,fldno))-1)
'cls:print"'";par$(d,fldno);"'",len(par$(d,fldno)):end
while len(par$(d,fldno))<wid
par$(d,fldno)="0"+par$(d,fldno)
wend
I=FLDNO
LOCATE XPOS,YPOS
GOSUB SUFRESH
return
disa:

gosub del:disallo=1
locate xpos,ypos:color 0,7:print par$(d,fldno);:color 7,0
return

'to redisplay data following differnt screen
refresh:

 locate xpos,ypos
 for i = z1 to z2
 gosub sufresh
 next i

locate xpos,ypos,1
return

sufresh:

 color 0,7:print string$(fld(i),32);
 if par$(d,i)<>"" and qu$(d,i)="" then locate ,pos(1)-fld(i):print left$(par$(d,i),fld(i));
 if par$(d,i)<>"" and qu$(d,i)="1" then
 locate ,pos(1)-fld(i):color 7,0:print left$(par$(d,i),fld(i));
 end if
if dec(i)<>0 then
  color 7,0:print ".";
  if qu$(d,i)="" then color 0,7
   print string$(dec(i),32);
   if len(par$(d,i))>fld(i) then

     locate ,pos(1)-dec(i)
     fixl=fld(i)+dec(i)-len(par$(d,i))
     print right$(par$(d,i),len(par$(d,i))-fld(i));
     if fixl>0 then color 0,7:print string$(fixl,32);

   end if
  end if
  color 7,0:print "  ";
return

quality:
if fldno<=f1 then return
locate xpos,ypos
i=fldno
if qu$(d,i)="" then qu$(d,i)="1" else qu$(d,i)=""
qu$(d,f1+f2+1)=qu$(d,f1+1)
gosub sufresh
locate xpos,ypos
return

intr:
cls
locate 1,36,0
color 0,7
PRINT "ENTICE"
color 7,0
PRINT "                 ***** HYDRO-CHEMISTRY DATA ENTRY UTILITY ******"
print "                      Provided with the compliments of the .."
print "              International Council for the Exploration of the Sea"
Print "                                   (ICES)"
print string$(80,196)
Color 9,0
print spc(55);"*":print:print spc(30);"*":print:print spc(25);"*";spc(9);"*"
print:print spc(40);"*";spc(6);
color 25,0:print "*":color 9,0:print:print spc(40);"*    *"
color 7,0
print string$(80,196)
Print "                              Pal‘gade 2-4"
print "                              1261 Copenhagen K"
print "                              Denmark"
print "                   Telemail - ICES.DK/Omnet"
print
return

'instructions:
instru:
locate 25,1
color 0,7:print "F1";:color 7,0
print "- Master ";
color 0,7:print "F2";:color 7,0
print "- Data1(1-22) ";
color 0,7:print "shF2";:color 7,0
print "- Data2(1-22) ";
color 0,7:print "F3";:color 7,0
print "- Data1(22-43) ";
color 0,7:print "shF3";:color 7,0
print "- Data2(22-43)";
return

'hydro/chemistry data entry

dataen:

cls
locate 2,2
print " Dept   Temp    Sal    Oxy    PO4    TP     Si     NO3    NO2    NH4    TN";
gosub instru
xpos=2:ypos=3:yposs=ypos
z1=f1+1:z2=f2+f1
fldno=z1
gosub distyp

locate xpos,ypos

for d = dp1 to dp2
incr xpos
gosub refresh

next d
xpos=3:ypos=3:d=dp1
locate xpos,ypos
goto in

dataeo: ' data entry extended parameters
cls
locate 2,21
print " Dept   H2S    pH    Alk   Chla"
gosub instru
xpos=2:ypos=22:yposs=ypos
z1=f1+f2+1:z2=f1+f2+f3
fldno=z1
gosub distyp
locate xpos,ypos
for d=dp1 to dp2

incr xpos
gosub refresh
next d
xpos=3:ypos=22:d=dp1
locate xpos,ypos
goto in

'subroutine to cancel run
finsh:
cls
locate 10,10
print "Press <esc> again if you really want to abandon this session"
while not instat
wend
s$=inkey$
if asc(s$)=27 then end else master
return

'output files
out1:
if par$(1,1) ="" or par$(1,2)="" or par$(1,3)="" then
 cls
 locate 8,10,0:Print "I refuse to save your work if you have not completed"
 locate ,10:print "the first three fields of the master record"
print
locate ,10:print "....press any key to procede to the master"
 while not instat
 wend
 s$=inkey$
 goto  master
end if
locate 10,10:
color 15,0:print "SAVING SEQUENCE INITIATED  ... please wait!!":color 7,0
open par$(1,3)+".dat" for output as #1
  if par$(1,4)<>"" then 'remove trailing equals on name
   for i = 1 to len(par$(1,4))
    if mid$(par$(1,4),i,1)="=" then mid$(par$(1,4),i)=" "
   next i
  end if
for i = 1 to 44
for j = 1 to f1+f2+f3
print #1,par$(i,j)
next j
next i
close #1
cls
locate 5,5
print"This station has been saved in an free-formatted file called "
locate ,35:print par$(1,3)+".dat"
locate ,5:print "To read this file back into the data entry program ,please"
locate ,20:print "type ENTICE ";par$(1,3)+".dat"
locate ,20:print "......I am now saving data in blueprint format"
locate ,20:print "appending to file ICES.BLU"

open "B",#1,"ices.blu"
if lof(1)>10 then nrpt=1
close #1

open "temp.dat" for output as #1
'parameter layout, blueprint

if nrpt=0 then 'parameter out before first station of file
nrpt=1
print #1,par$(1,1)+par$(1,2);
print #1,"DEPH7XX01TEMP7RT02PSAL7BS03DOXY7TI04PHOS7XX05PTOT7XX06SLCA7XX07NTRA7XX08EN02"
PRINT #1,PAR$(1,1)+PAR$(1,2);
PRINT #1,"NTRI7XX09AMON7XX10NTOT2XX11HSUL7XX13PHPH7XX14ALKY7XX15CPHL2XX16         EN02"
end if
incr iceblu
'master layout blueprint
mas$="                                                                            EN0J"
hyd$="                                                                            EN10"

mid$(mas$,1)=par$(1,1)+par$(1,2)+par$(1,3)
mid$(mas$,9)=left$(par$(1,5),4)
mid$(mas$,13)=left$(par$(1,7),5)
if par$(1,6)="N" and par$(1,8)="E" then mid$(mas$,18)="0"
if par$(1,6)="N" and par$(1,8)="W" then mid$(mas$,18)="1"
if par$(1,6)="S" and par$(1,8)="E" then mid$(mas$,18)="2"
if par$(1,6)="S" and par$(1,8)="W" then mid$(mas$,18)="3"
mid$(mas$,19)=right$(par$(1,9),3)
mid$(mas$,22)=par$(1,10)
mid$(mas$,24)=par$(1,11)
mid$(mas$,26)=left$(par$(1,12),2)
mid$(mas$,28)=par$(1,13)
if len(par$(1,5))>4 then mid$(mas$,65)=mid$(par$(1,5),5,1)
if len(par$(1,5))=6 then mid$(mas$,66)=mid$(par$(1,5),6,1)
if len(par$(1,7))>5 then mid$(MAS$,67)=mid$(par$(1,7),6,1)
if len(par$(1,7))=7 then mid$(mas$,68)=mid$(par$(1,7),7,1)
mid$(mas$,69)=right$(par$(1,12),2)
mid$(mas$,32)=par$(1,4)
print #1,mas$

'data layout -blueprint
accum=0
mid$(hyd$,1)=par$(1,1)+par$(1,2)+par$(1,3)+right$(par$(1,9),2)
hy$=hyd$
for i = 2 to 44
  for j = f1+1 to f1+f2+f3
   if par$(i,j)<>"" then
    if j=f1+f2+1 then exit if
    incr accum
     rap$=par$(i,j)
     set$=str$(j-f1)
     if len(set$)=3 then set$=right$(set$,2) else set$="0"+right$(set$,1)
     deci=dec(j)
     while len(rap$)<>fld(j)+deci
     decr deci
     wend
     while len(rap$)<6
     rap$="0"+rap$
     wend
       if qu$(i,j)="" then qual$="A" else qual$="S"
       y=instr(rap$,"-")
       if y<>0 then
       mid$(rap$,1,1)="-":mid$(rap$,y,1)="0"
       end if
        y=instr(rap$,"<")
       if y<>0 then mid$(rap$,y,1)="0":qual$=qual$+"<" else qual$=qual$+" "
     o2$=o2$+set$+qual$+rap$+right$(str$(deci),1)
     if accum=6 then
      accum=0
      mid$(hyd$,11)=o2$
      print #1,hyd$
      hyd$=hy$:o2$=""
     end if
    end if
  next j
next i
if o2$<>"" then mid$(hyd$,11)=o2$:print #1,hyd$:o2$=""
close #1
shell "type temp.dat>>ices.blu"

print
locate ,10:print "Appending completed":print
locate ,10:print "PRESS <Esc> to quit session, any other key to continue"
while not instat
wend
s$=inkey$
if asc(s$)<>27 then
  erase par$:erase qu$:fldno=0
  cls
  locate 6,10:print "Press <N> to load .DAT file"
  locate ,10:print "Press any other key to start fresh station"
   while not instat
   wend
   s$=inkey$
    if ucase$(s$)="N" then
     print:
    locate ,10
    print "Enter File Name (.dat extension) ";:input f$:goto renew
    end if
 goto master
end if

cls
locate 5,10:
print "Goodbye and thank you - "
kill "temp.dat"
locate ,10:print iceblu;" stations have been appended to ICES.BLU"


end
