program Project_MSSO;

{
  v-6.1
  Features:
    -uses menu system
    -add sites, times, students, and trios
    -diplay all sites, times, and students
    -remove sites, times, students, and trios
    -has mouse support
    -uses limited dialogs
}

uses crt,mouse,dos;
type
  str1 = string[1];
  str2 = string[2];
  str3 = string[3];
  str4 = string[4];
  str5 = string[5];
  str20 = string[20];
  str40 = string[40];
  phone_typ = record
    area:str3;
    pre:str3;
    post:str4;
  end;
  addr_typ = record
    street:string;
    city:str40;
    state:str2;
    zip:str5;
  end;
  date_typ = record
    month:str2;
    day:str2;
    year:str4;
  end;
  time_typ = record
    hour:str2;
    min:str2;
    ap:boolean;
  end;
  sistti = ^Rsistti;
  si = ^Rsi;
  st = ^Rst;
  ti = ^Rti;
  Rsi = record
    si_name:str40;
    subsi_name:str40;
    phone,fax:phone_typ;
    addr:addr_typ;
    contact_name:str40;
    max_students:integer;
    trio:sistti;
    next:si;
  end;
  Rst = record
    name:str40;
    first_name,last_name,class:str20;
    TB,HepB,MMR:boolean;
    TB_date,HepB_date,MMR_date:date_typ;
    trio:sistti;
    next:st;
  end;
  Rti = record
    date:date_typ;
    stime,etime:time_typ;
    trio:sistti;
    next:ti;
  end;
  Rsistti = record
    Pti:ti;
    Psi:si;
    Pst:st;
    next_ti,next_st,next_si,next_sistti:sistti;
  end;
  mtype = ^Rmtype;
  Rmtype = record
    item:string;
    next:mtype;
  end;

var
    sites:si;
    students:st;
    times:ti;
    sisttis:sistti;

{  procedure disp_phone(p:phone_typ); forward;
  procedure disp_addr(a:addr_typ); forward;
  procedure disp_dt(dt:ti); forward;
  procedure disp_stti(s:sistti); forward;
  procedure disp_si(s:si); forward;
  procedure new_site(var s:si); forward;
  procedure make_test_cases(var sits:si;var tim:ti;var stud:st); forward;
  procedure init(var sites:si;var students:st;var times:ti); forward;
  procedure main; forward;}

  procedure dialog(x1,y1,x2,y2:integer);
  var
    i:integer;
  begin
    clrscr;
    for i:=y1+1 to y2-1 do
    begin
      gotoxy(x1,i);
      write('³');
      gotoxy(x2,i);
      write('³');
    end;
    for i:=x1+1 to x2-1 do
    begin
      gotoxy(i,y1);
      write('Ä');
      gotoxy(i,y2);
      write('Ä');
    end;
    gotoxy(x1,y1);
    write('Ú');
    gotoxy(x1,y2);
    write('À');
    gotoxy(x2,y2);
    write('Ù');
    gotoxy(x2,y1);
    write('¿');
  end;

  procedure message(s:string);
  var
    l,x1,x2:integer;
  begin
    l:=length(s);
    x1:=trunc((80-l)/2);
    x2:=x1+l;
    dialog(x1-4,11,x2+4,15);
    gotoxy(x1,13);
    write(s);
    readln;
  end;

  procedure list_files;
  var
   DirInfo: SearchRec;
  begin
    FindFirst('*.mss', Archive, DirInfo);
    while DosError = 0 do
    begin
      Writeln(DirInfo.Name);
      FindNext(DirInfo);
    end;
  end;

  procedure ERROR;
  begin
    clrscr;
    write('There has been an error!! Exiting...');
    halt;
  end;

  function tinum(t:ti):integer;
  var
    i:integer;
    tem:ti;
  begin
    i:=0;
    tinum:=0;
    while tem<>nil do
    begin
      i:=i+1;
      if tem=t then tinum:=i;
    end;
  end;

  function sinum(t:si):integer;
  var
    i:integer;
    tem:si;
  begin
    i:=0;
    sinum:=0;
    while tem<>nil do
    begin
      i:=i+1;
      if tem=t then sinum:=i;
    end;
  end;

  function stnum(t:st):integer;
  var
    i:integer;
    tem:st;
  begin
    i:=0;
    stnum:=0;
    while tem<>nil do
    begin
      i:=i+1;
      if tem=t then stnum:=i;
    end;
  end;

  function sisnum(t:sistti):integer;
  var
    i:integer;
    tem:sistti;
  begin
    i:=0;
    sisnum:=0;
    while tem<>nil do
    begin
      i:=i+1;
      if tem=t then sisnum:=i;
    end;
  end;

  procedure save;
  var
    f:text;
    str:string;
    tti:ti;
    tst:st;
    tsi:si;
    tsis:sistti;
  begin
    write('Enter file name: ');
    readln(str);
    assign(f,str);
    rewrite(f);
    tsis:=sisttis;
    while tsis<>nil do
    begin
      writeln(f,tinum(tsis^.Pti));
      writeln(f,stnum(tsis^.Pst));
      writeln(f,sinum(tsis^.Psi));
      writeln(f,sisnum(tsis^.next_ti));
      writeln(f,sisnum(tsis^.next_st));
      writeln(f,sisnum(tsis^.next_si));
    end;
    writeln(f,0);
  end;

  procedure disp_phone(p:phone_typ);
    {display phone number}
  begin
    write('(',p.area,') ',p.pre,'-',p.post);
  end;

  procedure disp_addr(a:addr_typ);
    {display address}
  begin
    writeln(a.street);
    write('     ',a.city,', ',a.state,' ',a.zip);
  end;

  procedure disp_dt(dt:ti);
    {display date and time}
  begin
    write(dt^.date.month,'/',dt^.date.day,'/',dt^.date.year,' ');
    write(dt^.stime.hour,':',dt^.stime.min,' ');
    if dt^.stime.ap then write('AM - ') else write('PM - ');
    write(dt^.etime.hour,':',dt^.etime.min,' ');
    if dt^.etime.ap then write('AM') else write('PM');
  end;

  procedure disps_si(s:sistti);
    {display student name and times}
  begin
    if s<>nil then
    begin
      write('    ',s^.Pst^.last_name,', ',s^.Pst^.first_name,' ');
      disp_dt(s^.Pti);
      writeln;
      disps_si(s^.next_si);
    end;
  end;

  procedure disps_ti(s:sistti);
    {display site and student}
  begin
    if s<>nil then
    begin
      writeln('    ',s^.Pst^.last_name,', ',s^.Pst^.first_name,' - ',s^.Psi^.si_name,' ',s^.Psi^.subsi_name);
      disps_ti(s^.next_ti);
    end;
  end;

  procedure disps_st(t:sistti);
    {display time and site}
  begin
    if t<>nil then
    begin
      write('    ');
      disp_dt(t^.Pti);
      writeln(' ',t^.Psi^.si_name,' ',t^.Psi^.subsi_name);
      disps_st(t^.next_st);
    end;
  end;

  procedure disp_ti(t:ti);
    {display time}
  begin
    if t<>nil then
    begin
      disp_dt(t);
      writeln;
      disps_ti(t^.trio);
      disp_ti(t^.next);
    end;
  end;

  procedure disp_si(s:si);
    {display site}
  begin
    if s<>nil then
    begin
      writeln('Site name: ',s^.si_name);
      writeln('Sub-site name: ',s^.subsi_name);
      write('Phone: '); disp_phone(s^.phone); writeln;
      write('Fax: '); disp_phone(s^.fax); writeln;
      write('Addr: '); disp_addr(s^.addr); writeln;
      writeln('Contact name: ',s^.contact_name);
      writeln('Max students: ',s^.max_students);
      disps_si(s^.trio);
      writeln;
      disp_si(s^.next);
    end;
  end;

  procedure disp_st(s:st);
    {display student}
  begin
    if s<>nil then
    begin
      writeln('Student name: ',s^.last_name,', ',s^.first_name);
      if s^.TB then begin
        write('  Had TB shots on ');
        writeln(s^.TB_date.month,'/',s^.TB_date.day,'/',s^.TB_date.year,' ');
      end;
      if s^.HepB then begin
        write('  Had Hepatitus B shots on ');
        writeln(s^.HepB_date.month,'/',s^.HepB_date.day,'/',s^.HepB_date.year,' ');
      end;
      if s^.MMR then begin
        write('  Had MMR shots on ');
        writeln(s^.MMR_date.month,'/',s^.MMR_date.day,'/',s^.MMR_date.year,' ');
      end;
      disps_st(s^.trio);
      writeln;
      disp_st(s^.next);
    end;
  end;

  procedure dispa_ti(t:ti);
    {display time}
  begin
    if t<>nil then
    begin
      disp_dt(t);
      writeln;
    end;
  end;

  procedure dispa_si(s:si);
    {display site}
  begin
      writeln(s^.si_name,' ',s^.subsi_name);
  end;

  procedure dispa_st(s:st);
    {display student}
  begin
      writeln(s^.last_name,', ',s^.first_name);
  end;

  procedure new_site(var s:si);
    {save memory and initialize a site}
  begin
    new(s);
    s^.next:=nil;
    s^.si_name:='';
    s^.subsi_name:='';
    s^.phone.area:='';
    s^.phone.pre:='';
    s^.phone.post:='';
    s^.fax.area:='';
    s^.fax.pre:='';
    s^.fax.post:='';
    s^.addr.street:='';
    s^.addr.city:='';
    s^.addr.state:='';
    s^.addr.zip:='';
    s^.contact_name:='';
    s^.max_students:=1;
    s^.trio:=nil;
  end;

  procedure new_time(var t:ti);
    {save memory and initialize a time}
  begin
    new(t);
    t^.date.month:='';
    t^.date.day:='';
    t^.date.year:='';
    t^.stime.hour:='';
    t^.stime.min:='';
    t^.stime.ap:=true;
    t^.etime.hour:='';
    t^.etime.min:='';
    t^.etime.ap:=true;
    t^.trio:=nil;
    t^.next:=nil;
  end;

  procedure new_student(var s:st);
    {save memory and initialize a student}
  begin
    new(s);
    s^.first_name:='';
    s^.last_name:='';
    s^.TB:=false;
    s^.HepB:=false;
    s^.MMR:=false;
    s^.TB_date.month:='';
    s^.TB_date.day:='';
    s^.TB_date.year:='';
    s^.HepB_date.month:='';
    s^.HepB_date.day:='';
    s^.HepB_date.year:='';
    s^.MMR_date.month:='';
    s^.MMR_date.day:='';
    s^.MMR_date.year:='';
    s^.trio:=nil;
    s^.next:=nil;
  end;

  procedure new_trio(var t:sistti);
  var
    tem:sistti;
  begin
    new(t);
    t^.Psi:=nil;
    t^.Pst:=nil;
    t^.Pti:=nil;
    t^.next_si:=nil;
    t^.next_st:=nil;
    t^.next_ti:=nil;
    tem:=sisttis;
    if tem=nil then sisttis:=t
    else begin
      while tem^.next_sistti<>nil do tem:=tem^.next_sistti;
      tem^.next_sistti:=t;
    end;
  end;

  procedure add_site(var sites,s:si);
  var
    t,a:si;
    r:boolean;
  begin
    if sites=nil then sites:=s
    else begin
      t:=sites;
      r:=false;
      while t<>nil do
      begin
        if t^.si_name=s^.si_name then
          if t^.subsi_name=s^.subsi_name then
          begin
            dispose(s);
            s:=nil;
            r:=true;
          end;
        t:=t^.next;
      end;
      if not r then
      begin
        t:=sites;
        a:=t;
        if t^.si_name>s^.si_name then
        begin
          sites:=s;
          s^.next:=t;
        end else begin
          while (t<>nil) and (not r) do
          begin
            t:=t^.next;
            if t^.si_name>s^.si_name then
            begin
              a^.next:=s;
              s^.next:=t;
              r:=true;
            end else if t<>nil then a:=t;
          end;
          if not r then
          begin
            a^.next:=s;
          end;
        end;
      end;
    end;
  end;

  function greater_time(a,b:ti):boolean;
  begin
    if (((((a^.date.month>=b^.date.month) and
      (a^.date.day>=b^.date.day)) and
      ((a^.date.year>=b^.date.year) and
      (a^.stime.hour>=b^.stime.hour))) and
      ((a^.stime.min>=b^.stime.min) and
      (a^.stime.ap>=b^.stime.ap))) and
      ((a^.etime.hour>=b^.etime.hour) and
      (a^.etime.min>=b^.etime.min) and
      (a^.etime.ap>=b^.etime.ap))) then
        greater_time:=true else greater_time:=false;
  end;

  function same_time(a,b:ti):boolean;
  begin
    if (((((a^.date.month=b^.date.month) and
      (a^.date.day=b^.date.day)) and
      ((a^.date.year=b^.date.year) and
      (a^.stime.hour=b^.stime.hour))) and
      ((a^.stime.min=b^.stime.min) and
      (a^.stime.ap=b^.stime.ap))) and
      ((a^.etime.hour=b^.etime.hour) and
      (a^.etime.min=b^.etime.min) and
      (a^.etime.ap=b^.etime.ap))) then
        same_time:=true else same_time:=false;
  end;

  procedure add_time(var times,s:ti);
  var
    t,a:ti;
    r:boolean;
  begin
    if times=nil then times:=s
    else begin
      t:=times;
      r:=false;
      while t<>nil do
      begin
        if same_time(t,s) then
        begin
          dispose(s);
          s:=nil;
          r:=true;
        end;
        t:=t^.next;
      end;
      if not r then
      begin
        t:=times;
        a:=t;
        if greater_time(t,s) then
        begin
          times:=s;
          s^.next:=t;
        end else begin
          while (t<>nil) and (not r) do
          begin
            t:=t^.next;
            if greater_time(t,s) then
            begin
              a^.next:=s;
              s^.next:=t;
              r:=true;
            end else if t<>nil then a:=t;
          end;
          if not r then a^.next:=s;
        end;
      end;
    end;
  end;

  procedure add_student(var students,s:st);
  var
    t,a:st;
    r:boolean;
  begin
    if students=nil then students:=s
    else begin
      t:=students;
      r:=false;
      while t<>nil do
      begin
        if (t^.first_name=s^.first_name) and (t^.last_name=s^.last_name) then
        begin
          dispose(s);
          s:=nil;
          r:=true;
        end;
        t:=t^.next;
      end;
      if not r then
      begin
        t:=students;
        a:=t;
        if t^.last_name>s^.last_name then
        begin
          students:=s;
          s^.next:=t;
        end else begin
          while (t<>nil) and (not r) do
          begin
            t:=t^.next;
            if t^.last_name>s^.last_name then
            begin
              a^.next:=s;
              s^.next:=t;
              r:=true;
            end else if t<>nil then a:=t;
          end;
          if not r then a^.next:=s;
        end;
      end;
    end;
  end;

  procedure make_site(var sites:si);
  var
    s:si;
    ph:string;
    i:integer;
  begin
    new_site(s);
    write('Enter site name:');
    readln(s^.si_name);
    write('Enter sub-site name:');
    readln(s^.subsi_name);
    write('Enter phone number[(area) pre-post]:');
    readln(ph);
    for i:=2 to 4 do s^.phone.area:=s^.phone.area+ph[i];
    for i:=7 to 9 do s^.phone.pre:=s^.phone.pre+ph[i];
    for i:=11 to 15 do s^.phone.post:=s^.phone.post+ph[i];
    write('Enter fax number[(area) pre-post]:');
    readln(ph);
    for i:=2 to 4 do s^.fax.area:=s^.fax.area+ph[i];
    for i:=7 to 9 do s^.fax.pre:=s^.fax.pre+ph[i];
    for i:=11 to 15 do s^.fax.post:=s^.fax.post+ph[i];
    write('Enter address:');
    readln(s^.addr.street);
    write('Enter city:');
    readln(s^.addr.city);
    write('Enter state:');
    readln(s^.addr.state);
    write('Enter zip:');
    readln(s^.addr.zip);
    write('Enter contact name:');
    readln(s^.contact_name);
    write('Enter max students:');
    readln(s^.max_students);
    add_site(sites,s);
    readln;
  end;

{  procedure make_student(var students:st);
  begin
    dialog(10,5,70,20);
    readln;
  end;}

  procedure make_student(var students:st);
  var
    s:st;
    r:str1;
    d:string;
    i:integer;
  begin
    new_student(s);
    write('Enter last name:');
    readln(s^.last_name);
    write('Enter first name:');
    readln(s^.first_name);
    write('Has the student had their TB shot? <y/n> :');
    readln(r);
    if r='y' then begin
      s^.TB:=true;
      write('  Enter date of shot [mm/dd/yyyy]:');
      readln(d);
      for i:=1 to 2 do s^.TB_date.month:=s^.TB_date.month+d[i];
      for i:=4 to 5 do s^.TB_date.day:=s^.TB_date.day+d[i];
      for i:=7 to 10 do s^.TB_date.year:=s^.TB_date.year+d[i];
    end;
    write('Has the student had their Hepatitus B shot? <y/n> :');
    readln(r);
    if r='y' then begin
      s^.HepB:=true;
      write('  Enter date of shot [mm/dd/yyyy]:');
      readln(d);
      for i:=1 to 2 do s^.HepB_date.month:=s^.HepB_date.month+d[i];
      for i:=4 to 5 do s^.HepB_date.day:=s^.HepB_date.day+d[i];
      for i:=7 to 10 do s^.HepB_date.year:=s^.HepB_date.year+d[i];
    end;
    write('Has the student had their MMR shot? <y/n> :');
    readln(r);
    if r='y' then begin
      s^.MMR:=true;
      write('  Enter date of shot [mm/dd/yyyy]:');
      readln(d);
      for i:=1 to 2 do s^.MMR_date.month:=s^.MMR_date.month+d[i];
      for i:=4 to 5 do s^.MMR_date.day:=s^.MMR_date.day+d[i];
      for i:=7 to 10 do s^.MMR_date.year:=s^.MMR_date.year+d[i];
    end;
    add_student(students,s);
  end;

  procedure make_time(var times:ti);
  var
    t:ti;
    d:string;
    i:integer;
  begin
    new_time(t);
    write('Enter Date [mm/dd/yyyy]:');
    readln(d);
    for i:=1 to 2 do t^.date.month:=t^.date.month+d[i];
    for i:=4 to 5 do t^.date.day:=t^.date.day+d[i];
    for i:=7 to 10 do t^.date.year:=t^.date.year+d[i];
    write('Enter start time [hh:mm a/p]:');
    readln(d);
    for i:=1 to 2 do t^.stime.hour:=t^.stime.hour+d[i];
    for i:=4 to 5 do t^.stime.min:=t^.stime.min+d[i];
    if d[7]='a' then t^.stime.ap:=true else t^.stime.ap:=false;
    write('Enter end time [hh:mm a/p]:');
    readln(d);
    for i:=1 to 2 do t^.etime.hour:=t^.etime.hour+d[i];
    for i:=4 to 5 do t^.etime.min:=t^.etime.min+d[i];
    if d[7]='a' then t^.etime.ap:=true else t^.etime.ap:=false;
    add_time(times,t);
  end;

  procedure make_test_cases(var sits:si;var tim:ti;var stud:st);
  var
    stu:st;
    sites:si;
    times:ti;
    tr,tr2:sistti;
  begin
    new_site(sites);
    sites^.next:=nil;
    sites^.si_name:='Boswell Hospital';
    sites^.subsi_name:='Emergency Room';
    sites^.phone.area:='602';
    sites^.phone.pre:='584';
    sites^.phone.post:='7605';
    sites^.addr.street:='15405 W. Paradise Ln.';
    sites^.addr.city:='Surprise';
    sites^.addr.state:='AZ';
    sites^.addr.zip:='85374';
    sites^.contact_name:='Albert';
    sites^.max_students:=1;
    new_time(times);
    times^.date.month:='12';
    times^.date.day:='14';
    times^.date.year:='1980';
    times^.stime.hour:='08';
    times^.stime.min:='00';
    times^.stime.ap:=true;
    times^.etime.hour:='10';
    times^.etime.min:='30';
    times^.etime.ap:=true;
    times^.next:=nil;
    new_student(stu);
    stu^.name:='Bubba Joe';
    new_student(stu^.next);
    stu^.next^.name:='Johhny Smith';
    new_trio(tr);
    times^.trio:=tr;
    stu^.trio:=tr;
    sites^.trio:=tr;
    tr^.Pti:=times;
    tr^.Pst:=stu;
    tr^.Psi:=sites;
    new_trio(tr2);
    tr^.next_si:=tr2;
    tr^.next_ti:=tr2;
    tr2^.Psi:=sites;
    tr2^.Pti:=times;
    tr2^.Pst:=stu^.next;
    stu^.next^.trio:=tr2;
    add_student(stud,stu);
    add_site(sits,sites);
    add_time(tim,times);
  end;

  procedure init;
  begin
    showmouse;
    sites:=nil;
    students:=nil;
    times:=nil;
    sisttis:=nil;
  end;

  procedure make_trio(var sit:si;var stu:st;var tim:ti);
  var
    a,e:sistti;
    b:si;
    c:st;
    d:ti;
    i,s:integer;
  begin
    if sit=nil then message('No sites.')
    else if stu=nil then message('No students.')
    else if tim=nil then message('No times.')
    else begin
      new_trio(a);
      b:=sit;
      i:=0;
      while b<>nil do
      begin
        i:=i+1;
        write(i,') ');
        dispa_si(b);
        b:=b^.next;
      end;
      write('Enter site number:');
      readln(s);
      b:=sit;
      for i:=2 to s do b:=b^.next;
      c:=stu;
      i:=0;
      while c<>nil do
      begin
        i:=i+1;
        write(i,') ');
        dispa_st(c);
        c:=c^.next;
      end;
      write('Enter student number:');
      readln(s);
      c:=stu;
      for i:=2 to s do c:=c^.next;
      d:=tim;
      i:=0;
      while d<>nil do
      begin
        i:=i+1;
        write(i,') ');
        dispa_ti(d);
        d:=d^.next;
      end;
      write('Enter time number:');
      readln(s);
      d:=tim;
      for i:=2 to s do d:=d^.next;
      a^.Psi:=b;
      a^.Pti:=d;
      a^.Pst:=c;
      e:=b^.trio;
      b^.trio:=a;
      a^.next_si:=e;
      e:=c^.trio;
      c^.trio:=a;
      a^.next_st:=e;
      e:=d^.trio;
      d^.trio:=a;
      a^.next_ti:=e;
    end;
  end;

  procedure rm_student(var s:st);
  var
    t,u:st;
    i,a:integer;
  begin
    if s<>nil then
    begin
      t:=s;
      i:=0;
      while t<>nil do
      begin
        i:=i+1;
        writeln(i,') ',t^.last_name,', ',t^.first_name);
        t:=t^.next;
      end;
      write('Enter Student:');
      readln(a);
      if (a>0) and (a<=i) then begin
      t:=s;
      if a=1 then
      begin
        if t^.trio<>nil then message('Must delete all trios before you can delete this student.')
        else begin
          s:=t^.next;
          dispose(t);
        end
      end else begin
        for i:=3 to a do t:=t^.next;
        if t^.next^.trio<>nil then message('Must delete all trios before you can delete this student.')
        else begin
          u:=t^.next;
          t^.next:=t^.next^.next;
          dispose(u);
        end;
      end;
      end;
    end;
  end;

  procedure rm_site(var s:si);
  var
    t,u:si;
    i,a:integer;
  begin
    if s<>nil then
    begin
      t:=s;
      i:=0;
      while t<>nil do
      begin
        i:=i+1;
        writeln(i,') ',t^.si_name,' ',t^.subsi_name);
        t:=t^.next;
      end;
      write('Enter Site:');
      readln(a);
      if (a>0) and (a<=i) then begin
      t:=s;
      if a=1 then
      begin
        if t^.trio<>nil then message('Must delete all trios before you can delete this site.')
        else begin
          s:=t^.next;
          dispose(t);
        end
      end else begin
        for i:=3 to a do t:=t^.next;
        if t^.next^.trio<>nil then message('Must delete all trios before you can delete this site.')
        else begin
          u:=t^.next;
          t^.next:=t^.next^.next;
          dispose(u);
        end;
      end;
      end;
    end;
  end;

  procedure rm_time(var s:ti);
  var
    t,u:ti;
    i,a:integer;
  begin
    if s<>nil then
    begin
      t:=s;
      i:=0;
      while t<>nil do
      begin
        i:=i+1;
        write(i,') ');
        dispa_ti(t);
        t:=t^.next;
      end;
      write('Enter time:');
      readln(a);
      if (a>0) and (a<=i) then begin
      t:=s;
      if a=1 then
      begin
        if t^.trio<>nil then message('Must delete all trios before you can delete this time.')
        else begin
          s:=t^.next;
          dispose(t);
        end
      end else begin
        for i:=3 to a do t:=t^.next;
        if t^.next^.trio<>nil then message('Must delete all trios before you can delete this time.')
        else begin
          u:=t^.next;
          t^.next:=t^.next^.next;
          dispose(u);
        end;
      end;
      end;
    end;
  end;

  procedure kil_trio(var t:sistti);
  var
    tem:sistti;
  begin
    tem:=sisttis;
    if t=tem then
    begin
      tem := tem^.next_sistti;
      dispose(t);
    end else
      while tem^.next_sistti<>nil do
      begin
        if tem^.next_sistti=t then
        begin
          tem^.next_sistti:=t^.next_sistti;
          dispose(t);
        end;
        tem:=tem^.next_sistti;
      end;
  end;

  procedure rm_trio(var tim:ti);
  var
    t:ti;
    i,c:integer;
    s,r:sistti;
  begin
    if tim<>nil then
    begin
      t:=tim;
      i:=0;
      while t<>nil do
      begin
        s:=t^.trio;
        if s<>nil then begin
        disp_dt(t);
        writeln;
        while s<>nil do
        begin
          i:=i+1;
          writeln(i,') ',s^.Pst^.last_name,', ',s^.Pst^.first_name,' - ',s^.Psi^.si_name,' ',s^.Psi^.subsi_name);
          s:=s^.next_ti;
        end;
        writeln;
        end;
        t:=t^.next;
      end;
      write('Enter trio:');
      readln(c);
      t:=tim;
      i:=1;
      if c=1 then
      begin
        s:=t^.trio;
        t^.trio:=s^.next_ti;
        if s^.Pst^.trio=s then s^.Pst^.trio:=s^.next_st;
        if s^.Psi^.trio=s then s^.Psi^.trio:=s^.next_si;
        kil_trio(s);
      end else begin
        while t<>nil do
        begin
          s:=t^.trio;
          while s<>nil do
          begin
            i:=i+1;
            if i=c then r:=s;
            s:=s^.next_ti;
          end;
          t:=t^.next;
        end;
        s:=r^.next_ti;
        r^.next_ti:=s^.next_ti;
        if s^.Pti^.trio=s then s^.Pti^.trio:=s^.next_ti;
        if s^.Pst^.trio=s then s^.Pst^.trio:=s^.next_st;
        if s^.Psi^.trio=s then s^.Psi^.trio:=s^.next_si;
        kil_trio(s);
      end;
    end;
  end;

  function newitem(s:string;n:mtype):mtype;
  var
    m:mtype;
  begin
    new(m);
    m^.item:=s;
    m^.next:=n;
    newitem:=m;
  end;

  function menu(m:mtype):integer;
  var t:mtype;
    d,c,a,i,x1,y1,n:integer;
  begin
    x1:=5;
    y1:=2;
    t:=m;
    dialog(5,2,75,23);
    gotoxy(25,24);
    write('Use ',chr(30),chr(31),' or mouse to select item.');
    gotoxy(30,25);
    write('[esc] to go back/exit');
    a:=length(t^.item);
    gotoxy(trunc((80-a)/2),1);
    write(t^.item);
    t:=t^.next;
    i:=0;
    while t<>nil do
    begin
      i:=i+1;
      gotoxy(x1+5,y1+1+i);
      write(i,') ',t^.item);
      t:=t^.next;
    end;
    c:=1;
    d:=0;
      gotoxy(x1+3,y1+1+c);
      write('¯');
    repeat begin
      d:=0;
      if leftpressed then
      begin
        n:=getmousey;
        n:=n-y1;
        if n=c then d:=13
        else
        if (n>0) and (n<i+1) then
        begin
          gotoxy(x1+3,y1+1+c);
          write(' ');
          c:=n;
          gotoxy(x1+3,y1+1+c);
          write('¯');
          delay(1000);
        end;
      end;
      if keypressed then
      begin
        d:=ord(readkey);
        if d=0 then d:=ord(readkey);
      end;
      case d of
        80:begin
          gotoxy(x1+3,y1+1+c);
          write(' ');
          c:=c+1;
          if c>i then c:=1;
          gotoxy(x1+3,y1+1+c);
          write('¯');
          end;
        72:begin
          gotoxy(x1+3,y1+1+c);
          write(' ');
          c:=c-1;
          if c<1 then c:=i;
          gotoxy(x1+3,y1+1+c);
          write('¯');
          end;
        27:begin
          c:=0;
          d:=13;
          end;
      end;
    end until d=13;
    menu:=c;
  end;
    {ÀÄ¿¯ÚÙ³}

  procedure add_menu;
  var
    m:mtype;
    c:integer;
  begin
    m:=newitem('What do you want to add?',
       newitem('Student',
       newitem('Site',
       newitem('Time',
       newitem('Trio',nil)))));
    repeat begin
      c:=menu(m);
      clrscr;
      case c of
        1:make_student(students);
        2:make_site(sites);
        3:make_time(times);
        4:make_trio(sites,students,times);
      end;
    end until c=0;
  end;

  procedure remove_menu;
  var
    m:mtype;
    c:integer;
  begin
    m:=newitem('What do you want to remove?',
       newitem('Student',
       newitem('Site',
       newitem('Time',
       newitem('Trio',nil)))));
    repeat begin
      c:=menu(m);
      clrscr;
      case c of
        1:rm_student(students);
        2:rm_site(sites);
        3:rm_time(times);
        4:rm_trio(times);
      end;
    end until c=0;
  end;

  procedure view_all_menu;
  var
    m:mtype;
    c:integer;
  begin
    m:=newitem('What do you want to view?',
       newitem('Students',
       newitem('Sites',
       newitem('Times',nil))));
    repeat begin
      c:=menu(m);
      clrscr;
      case c of
        1:disp_st(students);
        2:disp_si(sites);
        3:disp_ti(times);
      end;
      if c<>0 then readln;
    end until c=0;
  end;

  procedure main_menu;
  var
    m:mtype;
    c:integer;
  begin
    m:=newitem('Main Menu',
       newitem('Add',
       newitem('Remove',
       newitem('Edit',
       newitem('View',
       newitem('File',
       newitem('Options',nil)))))));
    repeat begin
      c:=menu(m);
      case c of
        1:add_menu;
        2:remove_menu;
{        3:edit_menu;}
        4:view_all_menu;
{        5:file_menu;
        6:options_menu;}
      end;
    end until c=0;
  end;

  procedure main;
  var
    m:integer;
  begin
    clrscr;
    init;
{    make_test_cases(sites,times,students);}
{    m:=100;
    repeat
    begin
      m:=menu;
      clrscr;
      case m of
        1:make_site(sites);
        2:make_time(times);
        3:make_student(students);
        4:disp_si(sites);
        5:disp_ti(times);
        6:disp_st(students);
        7:make_trio(sites,students,times);
        8:rm_trio(times);
        9:rm_student(students);
        10:rm_site(sites);
        11:rm_time(times);
      end;
      readln;
    end until m=0;}
    main_menu;
  end;

begin
  main;
end.