{  30/1/88  07:23  persdbs}


%include "consts.inc"
%include "formats.inc"
%include "menus.inc"
%include "persons.inc"
%include "utils.inc"
%include "vti.inc"

%externalroutine receive broadcast
!  To keep IE happy.
%end

%begin

! If APM.
%externalroutinespec run program(%string(255) comand)
%include "inc:dict.imp"
%include "ie:ie.inc"
%include "inc:fs.imp"
%include "inc:fsutil.imp"
%include "inc:util.imp"
%include "inc:run.imp"
!
%externalroutinespec reset terminal %alias "IE_RESET_TERMINAL"
%externalroutinespec set up terminal %alias "IE_SET_UP_TERMINAL"
%externalbytespec Terminal Model %alias "IE_TT_MODEL"

%integer bottom=0
%record(personf) buff                                 {General workspace.}
%string(31) changefile=""
%routinespec close
%string(63) cmm
%conststring(255) command instructions= %c
"Move the cursor to the appropriate line. Press <RETURN> to obey command.
For help, type ? and press <RETURN>."
%constinteger commandno=7
%switch comm(0:commandno)
%conststring(15)%array command(0:commandno)=
"Stop",         { 0}
"Edit",         { 1}
"Merge",        { 2}
"Select",       { 3}
"Set Editor",   { 4}
"Sort Records", { 5}
"Abandon",      { 6}
""(*)
%ownrecord(dataf)%array commdata(0:commandno)
%constintegerarray commselect(0:7)=        {For use in setting up the menu.}
0, 1, 2, 3, 4, 5, 6, -1
%recordformat df(%integer l, a)
%record(df) d                              {For use in spawning processes.}
%conststring(255) edmess= %c
"Only VECCE and IE are currently known to Persdbs.
Please assign one of these to PERSDBS_EDITOR in your login.com file."
%constinteger edno=3
%integer flag
%constinteger items=29
%record(dataf)%array persdata(0:items)
%string(15) directory="u0:[office]"
%string(7) edt="vecce"
%record(dataf)%array edidata(0:edno)
%constintegerarray ediselect(0:6)=
2,0,1,3,-1,0(*)
%conststring(15)%array editem(0:edno)=
"Editor Input",     { 0}
"Editor Output",    { 1}
"Call Editor",      { 2}
"Abandon Editor"    { 3}
%conststring(255) editing instructions= %c
"Move the cursor off the screen to see more of the menu.
Move the cursor to the appropriate line. Press <RETURN> to alter the value.
Type in the new value and press <RETURN> again.
For help, type ? and press <RETURN>."
%conststring(255) editor instructions= %c
"Move the cursor to the appropriate line, type <RETURN> and type the file
name followed by <RETURN>.
Select Call Editor to edit the input file, Abandon to return to command level.
For help type ? and press <RETURN>"
%routinespec edit person(%record(personf)%name p)
%string(31) input=""
%conststring(19)%array item(0:items)=
"",                 { 0}
"Style",            { 1}
"Initials",         { 2}
"Surname",          { 3}
"Degrees",          { 4}
"Forenames",        { 5}
"ID",               { 6}
"Email address",    { 7}
"Department",       { 8}
"Room",             { 9}
"Firm",             {10}
"Office Address",   {11}
"Office Telephone", {12}
"Extension",        {13}
"Fax",              {14}
"Telex",            {15}
"Interests",        {16}
"Home Address",     {17}
"Home Telephone",   {18}
"Extra",            {19}
"Abandon Editing",  {20}
"Delete Record",    {21}
"Editing finished", {22}
"Next Person",      {23}
"Find",             {24}
"Abandon Pattern",  {25}
"Pattern ready",    {26}
"Insert",           {27}
"Abandon Insert",   {28}
"Insertion Ready",  {29}
""(*)
%constintegerarray insertselect(0:21)=
29,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,28,-1
%constinteger mergeno=4
%record(dataf)%array mergedata(0:mergeno)
%conststring(15)%array mergeitem(0:mergeno)= %c
"Start Merging",    { 0}
"Input 1 ",         { 1}
"Input 2 ",         { 2}
"Output",           { 3}
"Abandon Merging"   { 4}
%constintegerarray mergeselect(0:5)= %c
0,1,2,3,4,-1
%record(personf) pattern
%record(line80listf) nillist
%string(31) outfile="",  persfile=""
%integerarrayname select
%constintegerarray patternselect(0:23)=
26,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,25,-1,0(*)
%constintegerarray personselect(0:28)=
23,21,22,24,27,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,-1,0(*)
%constinteger selectno=4
%ownrecord(dataf)%array seldata(0:selectno)
%ownstring(19)%array selitem(0:selectno)=
"Call Select",           { 0}
"Input",                 { 1}
"Output",                { 2}
"Abandon Selection",     { 3}
""(*)
%constintegerarray selselect(0:selectno)=
0,1,2,3,-1
%routinespec set val(%record(dataf)%arrayname d,%integer i, %string(80) def)
%constinteger sortno=3
%record(dataf)%array sortdata(0:sortno)
%conststring(15)%array sortitem(0:sortno)= %c
"Start Sorting",    { 0}
"Input ",           { 1}
"Output",           { 2}
"Abandon Sorting"   { 3}
%constintegerarray sortselect(0:4)= %c
0,1,2,3,-1
%externalintegerfnspec spawn %alias "LIB$SPAWN"(%record(df)%name d)
%string(31) tempfile=""
%integer top=0

%routine read line(%string(*)%name a)
%integer j
  read symbol(j) %until graphic(j)=yes %and j#sp
  a=""
  %return %if j=nl
  %cycle
    a=a.tostring(j)
    read symbol(j)
  %repeat %until j=nl
%end

%routine read lines(%record(line80listf)%name a, %string(255) s)
%record(line80f)%name p
%string(255) u,v
  a_head==nil; a_tail==nil
  %cycle
    skip symbol %while next symbol=sp
    read line(u)
    v=u; lower(v)
    screen message("Stopped while changing ".s,"stop") %if v=end
    %exit %if v="*"
    p==newline80
    p_line=u
    append cell(p,a)
  %repeat
%end

%routine xedit(%string(255) a)
%string(63) u,w
!  If APM.
%integer start line,start position
!
{!  If Vax.}
{%integer flag}
!
  clear screen
  a=u.w %while a->u.("_").w %or (edt="vecce" %and a->u.(" ").w)
  %if edt="vecce" %thenstart
    w="*" %unless a->a.("/").w
    u="" %unless a->a.(",").u
    u=fix file(u,"","imp")
    a=fix file(a,"","imp")
    %if w="*" %thenstart
      w=a
      a="" %unless exists(a)
    %finishelse %c
    %if w="" %then w=a %else w=fix file(w,"","imp")
    a="No name given for document." %and %return %if w=""
    a=a.",".u %unless u=""
    a=a."/".w
{!  If Vax.}
{    a=edt." ".a}
{    d_a=addr(a)+1; d_l=length(a)}
{    flag=spawn(d)}
!
!  If APM.
    set video mode(screen mode+special pad)
    memed(a)
!
  %finishelse %if edt="ie" %thenstart
    w="" %unless a->a.(" ").w %or a->a.("/").w
    a=fix file(a,"","imp")
    %if w="" %then w=a %else w=fix file(w,"","imp")
    a=a." ".w
{!  If Vax.}
{    u=edt." ".a}
{    d_a=addr(u)+1; d_l=length(u)}
{    flag=spawn(d)}
{    message("Flag from ".u."=".itoh(flag),"") %if flag&1=0}
{    start screen mode}
!
!  If APM.
    start line=1; start position=1
    terminal model=6
    set up terminal
    a=u.w %while a->u.(" ").w
    ie editor(a,a,0,20,start line,start position,
    Default  Profile,Default Keyboard,Confirm!Silent!Reset Heap)
    reset terminal
!
  %finishelse message("You are trying to use ".Edt.".".snl.edmess,"stop")
  a=w
  select input(0); select output(0)
  prompt("")
  set video mode(screenmode+special pad)
%end

%routine edit lines(%record(line80listf)%name lines,%string(255) s)
%record(line80f)%name q
  open output(3,"DBS")
  select output(3)
  q==lines_head
  %while q##nil %cycle
    print string(q_line)
    newline
    q==q_next
  %repeat
  print string("*".snl)
  close output
  delete list(lines)
  select input(0); select output(0)
  xedit("DBS")
  open input(3,"DBS")
  select input(3)
  read lines(lines,s)
  delete("DBS")
%end

!  This compares two lists of lines.
!  It returns -1 if the first precedes the second,
!  0 if they have the same precedence and 
!  1 if the second precedes the first.
!  A nil record precedes a non-nil record.

%integerfn address order(%record(line80listf)%name a,b)
%record(line80f)%name p,q
  %result=-1 %if (a==nil %or a_head==nil) %and (b##nil %and b_head##nil)
  %result=0 %if (a==nil %or a_head==nil) %and (b==nil %or b_head==nil)
  %result=1 %if (a##nil %and a_head##nil) %and (b==nil %or b_head==nil)
  p==a_head; q==b_head
  %while p##nil %and q##nil %cycle
    %result=-1 %if p_line<q_line
    %result=1 %if p_line>q_line
    p==p_next; q==q_next
  %repeat
  %result=-1 %if p==nil %and q##nil
  %result=0 %if p==nil %and q==nil
  %result=1
%end

%integerfn id order(%string(255) a,b)
%integer i, j, k
  a="*" %if a=""; b="*" %if b=""
  %result=0 %if a="*"=b
  %result=-1 %if a#"*"=b
  %result=1 %if a="*"#b
  lower(a); lower(b)
  i=charno(a,length(a)); j=charno(b,length(b))
  %result=-1 %if i<j
  %result=1 %if i>j
  length(a)=length(a)-1
  length(b)=length(b)-1
  %result=-1 %if a<b
  %result=1 %if a>b
  %result=0
%end

!  An item, other than ID, is omitted from the comparison if its value is *
!  for either record. A record with ID=* follows any record with ID#*.

%integerfn person order(%record(personf)%name a,b)
%integer i,j
%string(255) x,y
!  Compare IDs.
  i=id order(a_id,b_id)
  %if i=0 %thenstart
!  Compare surnames.
    x=a_surname; lower(x)
    y=b_surname; lower(y)
    %if x#"*"#y %and x#y %thenstart
      %if x<y %then i=-1 %else i=1
    %finishelsestart
!  Compare forenames.
      x=a_forenames; lower(x)
      y=b_forenames; lower(y)
      %if x#"*"#y %and x#y %thenstart
        %if x<y %then i=-1 %else i=i
      %finishelsestart
!  Compare addresses.
        %if a_officeaddr_head##nil %and a_officeaddr_head_line#"" %c
        %and b_officeaddr_head##nil %and b_officeaddr_head_line#"" %thenstart
          i=address order(a_officeaddr,b_officeaddr)
        %finish
      %finish
    %finish
  %finish
  %result=i
%end

%predicate person match(%record(personf)%name a,b)
%integer ct, ct1
%string(80) x, y
  ct=0; ct1=0
  %if a_id#"*"#b_id %thenstart
    ct1=ct1+1
    x=a_id; y=b_id
    lower(x); lower(y)
    ct=ct+1 %if x=y
  %finish
  %if a_surname#"*"#b_surname %thenstart
    ct1=ct1+1
    x=a_surname; y=b_surname
    lower(x); lower(y)
    ct=ct+1 %if x=y
  %finish
  %true %if ct=ct1#0
  %false
%end

%routine sort records(%record(personf)%arrayname a, %integer last)
%record(personf) c
%integer n

%routine extend heap(%integer i, j)
%record(personf) b
!  This is thought of as a part of the heap beginning at a(1).
!  It brings the latest record to the first position.
  %return %if 2*i>j
  %if 2*i=j %thenstart
    %if person order(a(i),a(j))<0 %thenstart
      b=a(i)
      a(i)=a(j)
      a(j)=b
    %finish
    %return
  %finish
  %if person order(a(2*i), a(2*i+1))>=0 %thenstart
    %if person order(a(i), a(2*i))<0 %thenstart
      b=a(i)
      a(i)=a(2*i)
      a(2*i)=b
      extend heap(2*i,j)
    %finish
  %finishelse %if person order(a(i), a(2*i+1))<0 %thenstart
    b=a(i)
    a(i)=a(2*i+1)
    a(2*i+1)=b
    extend heap(2*i+1,j)
  %finish
%end

  %return %if last<=1
  n=1
  n=2*n %while 2*n<=last
!  Make heap.
  extend heap(n,last) %for n=n-1,-1,1
!  Complete Ordering.
  %for n=last, -1 , 2 %cycle
    c=a(n)
    a(n)=a(1)
    a(1)=c
    extend heap(1, n-1)
  %repeat
%end

%routine sort
%integer i, n
%ownstring(31) input="", output=""
%string(255) x
%record(personf)%array a(0:2048)
%switch case(0:4)
  home cursor
  set val(sortdata, 1, input)
  set val(sortdata, 2, output)
  %cycle
    set up menu(sortdata, sortselect, 1, 1, "")
    write menu
    ->case(cursor depth)

case(0):  ;!  Start Sorting.
    %if input="" %thenstart
      set val(sortdata, 0, "Input not defined.")
      %continue
    %finish
    %if output="" %thenstart
      set val(sortdata, 0, "Output not defined.")
      %continue
    %finish
    tempfile="DBStempfile"
    open input(1, input)
    open output(1, tempfile)
    select input(1)
    %for i=1, 1, 2048 %cycle
      read person(a(i))
      %exit %if a(i)_id=".end"
    %repeat
    n=i-1
    sort records(a, n)
    select output(1)
    %for i=1, 1, n %cycle
      print person(a(i),"file")
    %repeat
    close
    rename(tempfile,output)
    %exit
case(1):  ;!  Input.
    read screen line(input)
    input=".tt" %if input=".in"
    %if input=".tt" %or exists(input) %then set val(sortdata, 1, input) %c
    %else set val(sortdata, 1, input." does not exist.")
    %continue
case(2):  ;!  Output.
    read screen line(output)
    set val(sortdata, 2, output)
    %continue
case(3):  ;!  Abandon.
    set shade(0)
    %return
  %repeat
%end

%routine close
  select input(1)
  close input %if ".in"#infilename#".tt"
  select input(2)
  close input %if ".in"#infilename#".tt"
  select input(0)
  select output(1)
  close output %if ".out"#outfilename#".tt"
  select output(2)
  close output %if ".out"#outfilename#".tt"
  select output(0)
%end

%routine copy rest
%record(personf) buff

  %on %event 9 %start
    %return
  %finish

  %cycle
    read person(buff)
    %exit %if buff_id=".end"
    print person(buff,"file")
  %repeat
%end

!  This assumes that inputes 1 and 2 and output 1 have been opened.

%routine merge files
%record(personf) buff1, buff2
%integer i
  select output(1)
  %cycle
    select input(1)
    read person(buff1)
    select input(2)
    read person(buff2)
    %cycle
      %if buff1_id=".end" %thenstart
        print person(buff2, "file")
        select input(2)
        copy rest
        %return
      %finish
      %if buff2_id=".end" %thenstart
        print person(buff1, "file")
        select input(1)
        copy rest
        %return
      %finish
      i=person order(buff1, buff2)
      %if i=-1 %thenstart
        print person(buff1, "file")
        select input(1)
        read person(buff1)
        %continue
      %finish
      %if i=1 %thenstart
        print person(buff2, "file")
        select input(2)
        read person(buff2)
        %continue
      %finish
      print person(buff1, "file")
      print person(buff2, "file")
      %exit
    %repeat
  %repeat
%end

%routine merge
%integer i, j
%ownstring(31) input1="", input2="", output=""
%string(255) x
%switch case(0:4)
  home cursor
  set val(mergedata, 1, input1)
  set val(mergedata, 2, input2)
  set val(mergedata, 3, output)
  %cycle
    set up menu(mergedata, mergeselect, 1, 1, "")
    write menu
    ->case(cursor depth)

case(0):  ;!  Start Merging.
    %if output="" %thenstart
      set val(mergedata, 0, "Output not defined.")
      %continue
    %finish
    changefile=""
    tempfile="DBStempfile"
    open input(1, input1)
    open input(2, input2)
    open output(1, tempfile)
    merge files
    close
    rename(tempfile,output)
    %exit
case(1):  ;!  Input 1.
    read screen line(input1)
    input1=".tt" %if input1=".in"
    %if input1=".tt" %or exists(input1) %then set val(mergedata, 1, input1) %c
    %else set val(mergedata, 1, input1." does not exist.")
    %continue
case(2):  ;!  Input 2.
    read screen line(input2)
    input2=".tt" %if input2=".in"
    %if input2=".tt"%or  exists(input2) %then set val(mergedata, 2, input2) %c
    %else set val(mergedata, 2, input2." does not exist.")
    %continue
case(3):  ;!  output.
    read screen line(output)
    set val(mergedata, 3, output)
    %continue
case(4):  ;!  Abandon.
    set shade(0)
    %return
  %repeat
%end

%routine initialise buffer(%record(personf)%name p)
%record(line80f)%name q
  p_Degrees="*"
  p_Department="*"
  p_Emailaddr="*"
  p_Ext="*"
  delete list(p_extra)
  q==newline80; q_line="*"
  append cell(q, p_extra)
  p_Fax="*"
  p_Firm="*"
  p_Forenames="*"
  delete list(p_homeaddr)
  q==newline80; q_line="*"
  append cell(q, p_homeaddr)
  p_homephone="*"
  p_ID="*"
  p_Initials="*"
  delete list(p_interests)
  q==newline80; q_line="*"
  append cell(q, p_interests)
  delete list(p_officeaddr)
  q==newline80; q_line="*"
  append cell(q, p_officeaddr)
  p_Officephone="*"
  p_Room="*"
  p_Style="*"
  p_Surname="*"
  p_Telex="*"
%end

%routine set val(%record(dataf)%arrayname data,
%integer stage, %string(80) val)
%record(line80f)%name p
  delete list(data(stage)_val)
  p==newline80
  p_line=val
  append cell(p, data(stage)_val)
%end

%routine set vals(%record(dataf)%arrayname data, 
%integer stage, %record(line80listf)%name val)
%record(line80f)%name p, q
  delete list(data(stage)_val)
  p==val_head
  %while p##nil %cycle
    q==newline80
    q_line=p_line
    append cell(q, data(stage)_val)
    p==p_next
  %repeat
%end

%routine set display vals(%record(personf)%name p)
set val(persdata, 1, p_Style)
set val(persdata, 2, p_Initials)
set val(persdata, 3, p_Surname)
set val(persdata, 4, p_Degrees)
set val(persdata, 5, p_Forenames)
set val(persdata, 6, p_ID)
set val(persdata, 7, p_Emailaddr)
set val(persdata, 8, p_Department)
Set val(persdata, 9, p_Room)
set val(persdata, 10, p_Firm)
set vals(persdata, 11, p_Officeaddr)
set val(persdata, 12, p_Officephone)
set val(persdata, 13, p_Ext)
set val(persdata, 14, p_Fax)
set val(persdata, 15, p_Telex)
set vals(persdata, 16, p_Interests)
set vals(persdata, 17, p_Homeaddr)
set val(persdata, 18, p_Homephone)
set vals(persdata, 19, p_Extra)
%end

%routine display person(%record(personf)%name p)
%integer i
  select output(0)
  clear screen
  set display vals(p)
  set up menu(persdata, select, top, bottom, "*")
  write menu
%end

%routine collect pattern(%record(personf)%name pattern)
%integer oldtop, oldbottom
%integerarrayname oldselect
  oldtop=top; oldbottom=bottom
  oldselect==select
  initialise buffer(pattern)
  set display vals(pattern)
  bottom=1
  select==patternselect
  top=1
  edit person(pattern)
  select==oldselect
  top=oldtop; bottom=oldbottom
%end

%routine hunt for(%record(personf)%name pattern, p)
  %cycle
    read person(p)
    %exit %if p_id=".end"
    %exit %if person match(pattern, p)
    print person(p, "file")
  %repeat
%end

%routine edit person(%record(personf)%name p)
%integer flag, flagp, stage
%record(line80f)%name q
%switch case(0:31)
%integer change=no

  %on %event 15 %start
    close
    %return
  %finish

  flag=1
  restart screen
  %cycle
    select input(0); select output(0)
    display person(p)
    stage=cursor depth
    ->case(stage)

case(1):  ;!  Style.
    read screen line(p_style)
    set val(persdata, 17, p_style)
    ->cont
case(2):  ;!  Initials.
    read screen line(p_initials)
    set val(persdata, 12, p_initials)
    ->cont
case(3):  ;!  Surname.
    read screen line(p_surname)
    set val(persdata, 18, p_surname)
    ->cont
case(4):   ;!  Degrees.
    read screen line(p_degrees)
    set val(persdata,stage,p_degrees)
    ->cont
case(5):   ;!  Forenames
    read screen line(p_forenames)
    set val(persdata, 8, p_forenames)
    ->cont
case(6):  ;!  ID.
    read screen line(p_id)
    set val(persdata, 11, p_id)
    ->cont
case(7):   ;!  Email address.
    read screen line(p_emailaddr)
    set val(persdata, 3, p_emailaddr)
    ->cont
case(8):   ;!  Department.
    read screen line(p_department)
    set val(persdata, 2, p_department)
    ->cont
case(9):  ;!  Room.
    read screen line(p_room)
    set val(persdata, 16, p_room)
    ->cont
case(10):   ;!  Firm.
    read screen line(p_firm)
    set val(persdata, 7, p_firm)
    ->cont
case(11):  ;!  Office address.
    edit lines(p_officeaddr,"Office Address")
    set vals(persdata,stage,p_officeaddr)
    ->cont
case(12):  ;!  Office telephone.
    read screen line(p_officephone)
    set val(persdata, 15, p_officephone)
    ->cont
case(13):   ;!  Extension.
    read screen line(p_ext)
    set val(persdata, 4, p_ext)
    ->cont
case(14):   ;!  Fax.
    read screen line(p_fax)
    set val(persdata, 6, p_fax)
    ->cont
case(15):  ;!  Telex.
    read screen line(p_telex)
    set val(persdata, 19, p_telex)
    ->cont
case(16):  ;!  Interests.
    edit lines(p_interests,"Interests")
    set vals(persdata,stage,p_interests)
    ->cont
case(17):   ;!  Home address.
    edit lines(p_homeaddr,"Home Address")
    set vals(persdata,stage,p_homeaddr)
    ->cont
case(18):  ;!  Home telephone.
    read screen line(p_homephone)
    set val(persdata, 10, p_homephone)
    ->cont
case(19):   ;!  Extra.
    edit lines(p_extra,"Extra")
    set vals(persdata,stage,p_extra)
    ->cont
case(20):  ;!  Abandon.
    clear person(p)
    set shade(0)
    %return
case(21):  ;!  Delete record.
    %exit
case(22):   ;!  Editing finished.
    select output(flag)  ;!  Put changed record to DBSchange.
    print person(p,"file")
    select input(1); select output(1)
    copy rest
    close
    %if changefile="" %then rename(tempfile,outfile) %elsestart
      open input(1, tempfile)
      open input(2, changefile)
      open output(1, outfile)
      merge files
      close
    %finish
    %exit
case(23):  ;!  Next person.
    select output(flag)
    print person(p, "file")
    %exit
case(24):  ;!  Find.
    flagp=flag; flag=1
!  Collect pattern.
    collect pattern(pattern)
    flag=flagp %and ->case(22) %if pattern_id=".end"
!  Hunt for match.
    select input(1)
    %if %not person match(pattern,p) %thenstart
      select output(flag)
      print person(p, "file")
      select output(1)
      hunt for(pattern, p)
      close %and %exit %if p_id=".end"
    %finish
    bottom=1
    select==personselect
    top=5
    %continue
case(25):  ;!  Abandon Find.
    set shade(0)
    clear person(pattern)
    %return
case(26):  ;!  pattern Ready.
    %return
case(27):  ;!  Insert.
    collect pattern(pattern)
    %if changefile="" %thenstart
      changefile="DBSchangefile"
      open output(2,changefile)
    %finish
    select output(2)
    print person(pattern,"file")
    %continue
cont:
    flag=2
    %if changefile="" %thenstart
      changefile="DBSchange"
      open output(2,changefile)
    %finish
  %repeat
%end

%routine edit
%switch case(0:edno)
%integer flag
  home cursor
  set val(edidata, 0, input)
  set val(edidata, 1, outfile)
  %cycle
    select input(0); select output(0)
    clear screen
    set up menu(edidata, ediselect, 1, 1, "")
    write menu
    ->case(cursor depth)

case(0):  ;!  Editor input.
    read screen line(input)
    input=".tt" %if input=".in"
    %if input=".tt" %then set val(edidata, 0, ".tt") %else %c
    %if exists(input) %then set val(edidata, 0, input) %c
    %else set val(edidata, 0, input." does not exist.")
    %continue
case(1):  ;!  Editor output.
    read screen line(outfile)
    set val(edidata, 1, outfile)
    %continue
case(2):  ;!  Call Editor.
    changefile=""
    tempfile="DBStempfile"
    open input(1, input)
    open output(1, tempfile)
    bottom=1
    select==personselect
    top=5
    %cycle
      select input(1)
      read person(buff)
!      %exit %if buff_id=".end"
      edit person(buff)
    %repeat %until buff_id=".end"
    close
    %exit
case(3):  ;!  Abandon.
    set shade(0)
    %return
  %repeat
%end

%routine initial settings
%integer i
  %for i=0, 1, commandno %cycle
    commdata(i)_name=command(i)
    commdata(i)_val_head==nil; commdata(i)_val_tail==nil
  %repeat
  %for i=0, 1, items %cycle
    persdata(i)_name=item(i)
    persdata(i)_val_head==nil; persdata(i)_val_tail==nil
  %repeat
  %for i=0, 1, edno %cycle
    edidata(i)_name=editem(i)
    edidata(i)_val_head==nil; edidata(i)_val_tail==nil
  %repeat
  %for i=0, 1, mergeno %cycle
    mergedata(i)_name=mergeitem(i)
    mergedata(i)_val_head==nil; mergedata(i)_val_tail==nil
  %repeat
  %for i=0, 1, selectno %cycle
    seldata(i)_name=selitem(i)
    seldata(i)_val_head==nil; seldata(i)_val_tail==nil
  %repeat
  %for i=0, 1, sortno %cycle
    sortdata(i)_name=sortitem(i)
    sortdata(i)_val_head==nil; sortdata(i)_val_tail==nil
  %repeat
  nillist_head==nil; nillist_tail==nil
  set up(edt,"persdbs_editor","editor","",nillist)
  set val(commdata, 4, edt)
  helpfile="u0:[office]persdbshelp.imp"
  pattern_extra_head==nil; pattern_extra_tail==nil
  pattern_homeaddr_head==nil; pattern_homeaddr_tail==nil
  pattern_interests_head==nil; pattern_interests_tail==nil
  pattern_officeaddr_head==nil; pattern_officeaddr_tail==nil
 %end

%routine select records
%integer flag
%ownstring(31) input="", output=""
%switch case(0:edno)
  home cursor
  set val(seldata, 0, input)
  set val(seldata, 1, output)
  %cycle
    select input(0); select output(0)
    clear screen
    set up menu(seldata, selselect, 1, 1, "")
    write menu
    ->case(cursor depth)

case(0):  ;!  Call Selection.
    message("Input is not set.","") %and %continue %if input=""
    message("Output is not set.","") %and %continue %if output=""
    message("Input and output may not be the same.","") %and %continue %c
    %if input=output
    tempfile="DBStempfile"
    open input(1, input)
    open output(1, tempfile)
    collect pattern(pattern)
    ->case(3) %if pattern_id=".end"
    select input(1); select output(1)
    %cycle
      read person(buff)
      %exit %if buff_id=".end"
      print person(buff,"file") %if person match(pattern, buff)
    %repeat
    close
    rename(tempfile, output)
    %exit
case(1):  ;!  Selection input.
    read screen line(input)
    input=".tt" %if input=".in"
    %if input=".tt" %then set val(seldata, 1, ".tt") %else %c
    %if exists(input) %then set val(seldata, 1, input) %c
    %else set val(seldata, 1, input." does not exist.")
    %continue
case(2):  ;!   Selection Output.
    read screen line(output)
    set val(seldata, 2, output)
    %continue
case(3):  ;!  Abandon Selection.
    set shade(0)
    %return
  %repeat
%end


{Main program}

  %on %event 9 %start
    trace("Event ".itod(event_event).", ".itod(event_sub)."  ".Event_message)
    close
    message("Stopped by %event 9,".itod(event_sub)."  ".event_message,"stop")
  %finish

  select input(0); select output(0)
  clear person(buff)
  initial settings
  start screen mode
  %cycle
    select input(0); select output(0)
    set up menu(commdata, commselect, 1, 1, "")
    menu instructions=command instructions
    clear screen
    write menu
    ->comm(cursor depth)
comm(0):  ;!  Stop.
    close
    set shade(0)
{!  If Vax.}
{    cmm="comm".seqno.".com"}
{    open output(3,cmm)}
{    select output(3)}
{    print string("delete dbs*.*;*"); newline}
{    print string("$delete ".cmm.";*"); newline}
{    close output}
{    select output(0)}
{    cmm="@".cmm}
{    d_a=addr(cmm)+1; d_l=length(cmm)}
{    flag=0}
{    flag=spawn(d)}
{    %if flag&1=0 %then message("Flag from ".cmm."=".itoh(flag),"")}
!
! If APM.
    delete("dbs*.*;*")
!
    %stop
comm(1):  ;! Edit.
    edit
    home cursor
    ->cont
comm(2):  ;!  Merge.
    merge
    home cursor
    -> cont
comm(3):  ;!  Select Records.
    select records
    -> cont
comm(4):  ;!  Set Editor.
    read screen line(edt)
    set val(commdata, 4, edt)
    ->cont
comm(5):  ;!  Sort
    sort
    home cursor
    -> cont
comm(6):  ;!  Abandon.
    set shade(0)
    message("Program abandoned.","stop")
cont:
  %repeat
%endofprogram