USES  CRT,Printer, Dos;


Type  TZ=record
         CodeOTD:string;
         CodeLab:string;
         Tabnomr:string;
         Data:string;
         CodeNach:string;
         SymmNach:string;
         End;

      HZ=record
         CODEOTDELA:string;
         TAB:string;
         End;

     TZ2=record
         TabNom:string;
         FIOsotr:string;
         SP:string;
         Deti:string;
         End;

     VD1=record
         Cod_OTDELA:string;
         Nazva_otdela:string;
         Code_lab:string;
         Tab_nom:string;
         FIO_sotr:string;
         Nachisleno:string;
         End;

     VD2=record
         Cod_OTDELA:string;
         FIO_zava:string;
         telefnchik:string;
         kol_vo_sotr:string;
         End;

     masiv= array[1..100] of VD2;
     tmasiv= ^masiv;
     mas=array[1..100] of TZ;
     tmas=^mas;
     vmas=array[1..100] of VD1;
     tvmas=^vmas;
     hmas=array[1..100] of HZ;
     thmas=^hmas;

VAR
  spravochnik1:text;
  Zap2:TZ2;
  spravochnik2: file of TZ2;
  Zap_ved2: VD2;
  vedomost2: file of VD2;
  Zap_ved1: VD1;
  vedomost1: file of VD1;
  Zap:TZ;
  osnov: file of TZ;
  helpzap:HZ;


procedure sortirovkaVED2;
Var
  t,k,j,i:integer;
  z:tmasiv;
  c:VD2;
Begin
  assign(vedomost2,'vedomost2');
  reset(vedomost2);
  t:=filesize(vedomost2);
  getmem(z,t*sizeof(Zap_ved2));
  k:=0;
  while not(eof(vedomost2)) do
    begin
      read(vedomost2,Zap_ved2);
      inc(k);
      z^[k]:=Zap_ved2;
    end;
  close(vedomost2);
  For j:=1 to k-1 do
    For i:=1 to k-j do
      if z^[i].Cod_OTDELA > z^[i+1].Cod_OTDELA then
        begin
          c:=z^[i];
          z^[i]:=z^[i+1];
          z^[i+1]:=c;
        end;
  rewrite(vedomost2);
  For i:=1 to t do
    write(vedomost2,z^[i]);
  close(vedomost2);
  freemem(z,t*sizeof(Zap_ved2));
End;



procedure Shapka1;
Var
  a,b,c,d:word;
Begin
  clrscr;
  GetDate(a,b,c,d);
  writeln;writeln;
  writeln('  Ведомость № 1           ВЕДОМОСТЬ НАЧИСЛЕНИЯ                Дата:  ',c,'.',b,'.',a,'');
  writeln('--------------------------------------------------------------------------------');
  writeln('№':3,'    Код     Название   Код   Таб.                  ФИО              Начислено');
  writeln('     Отдела     отдела    Лаб. Номер               Сотрудника           ');
  writeln('--------------------------------------------------------------------------------');
end;



procedure Shapka2;
Begin
  clrscr;
  writeln;writeln;
  writeln('  Ведомость № 2          ВЕДОМОСТЬ ПО КОЛИЧЕСТВУ СОТРУДНИКОВ    ');
  writeln('-------------------------------------------------------------------------------');
  writeln('№':3,'      Код                     ФИО                  Телефон        Количество');
  writeln('       Отдела               зав.отделом                             сотрудников ');
  writeln('-------------------------------------------------------------------------------');
end;





procedure vedomost1_sozdanie;
VAR
  i,w,k,j,t:integer;
  s1,s2,s3,s4,s,q:string;
  z:tvmas;
Begin
  assign(vedomost1,'vedomost1');
  assign(spravochnik1,'spravka1.txt');
  assign(osnov,'osnov');
  assign(spravochnik2,'spravka2');
  rewrite(vedomost1);
  reset(osnov);
  with Zap_ved1 do
    While not(eof(osnov)) do
      begin
        with Zap do
          begin
            read(osnov,Zap);
            Cod_OTDELA:=CodeOTD;
            Nazva_otdela:='';
            Code_lab:=CodeLab;
            Tab_nom:=Tabnomr;
            FIO_sotr:='';
            Nachisleno:=SymmNach;
            write(vedomost1,Zap_ved1);
          end;
      end;
  close(osnov);
  close(vedomost1);

  reset(vedomost1);
  t:=filesize(vedomost1);
  getmem(z,t*sizeof(Zap_ved1));
  k:=0;
  while not(eof(vedomost1)) do
    begin
      read(vedomost1,Zap_ved1);
      inc(k);
      z^[k]:=Zap_ved1;
    end;
  close(vedomost1);
  reset(spravochnik1);
  While not(eof(spravochnik1)) do
    begin
      readln(spravochnik1,s1);
      readln(spravochnik1,s2);
      readln(spravochnik1,s3);
      readln(spravochnik1,s4);
      For j:=1 to k do
        IF z^[j].Cod_OTDELA=s1 then
          z^[j].Nazva_otdela:=s2;
    end;
  rewrite(vedomost1);
  For i:=1 to t do
    write(vedomost1,z^[i]);
  close(vedomost1);
  close(spravochnik1);
  freemem(z,t*sizeof(Zap_ved1));

  reset(vedomost1);
  t:=filesize(vedomost1);
  getmem(z,t*sizeof(Zap_ved1));
  k:=0;
  while not(eof(vedomost1)) do
    begin
      read(vedomost1,Zap_ved1);
      inc(k);
      z^[k]:=Zap_ved1;
    end;
  close(vedomost1);
  reset(spravochnik2);
  While not(eof(spravochnik2)) do
    begin
      With Zap2 do
        begin
          read(spravochnik2,Zap2);
          For j:=1 to k do
            IF z^[j].Tab_nom=Zap2.TabNom then
              z^[j].FIO_sotr:=FIOsotr;
        end;
    end;
  rewrite(vedomost1);
  For i:=1 to t do
    write(vedomost1,z^[i]);
  close(vedomost1);
  close(spravochnik2);
  freemem(z,t*sizeof(Zap_ved1));
End;

procedure sortirovka;
Var
  t,k,j,i:integer;
  z:tmas;
  c:TZ;
Begin
  assign(osnov,'osnov');
  reset(osnov);
  t:=filesize(osnov);
  getmem(z,t*sizeof(Zap));
  k:=0;
  while not(eof(osnov)) do
    begin
      read(osnov,Zap);
      inc(k);
      z^[k]:=zap;
    end;
  close(osnov);
  For j:=1 to k-1 do
    For i:=1 to k-j do
      if z^[i].Tabnomr > z^[i+1].Tabnomr then
        begin
          c:=z^[i];
          z^[i]:=z^[i+1];
          z^[i+1]:=c;
        end;
  rewrite(osnov);
  For i:=1 to t do
    write(osnov,z^[i]);
  close(osnov);
  For j:=1 to k-1 do
    For i:=1 to k-j do
      if z^[i].CodeLab > z^[i+1].CodeLab then
        begin
          c:=z^[i];
          z^[i]:=z^[i+1];
          z^[i+1]:=c;
        end;
  rewrite(osnov);
  For i:=1 to t do
    write(osnov,z^[i]);
  close(osnov);
  For j:=1 to k-1 do
    For i:=1 to k-j do
      if z^[i].CodeOTD > z^[i+1].CodeOTD then
        begin
          c:=z^[i];
          z^[i]:=z^[i+1];
          z^[i+1]:=c;
        end;
  rewrite(osnov);
  For i:=1 to t do
    write(osnov,z^[i]);
  close(osnov);
  reset(osnov);
End;

procedure sortirovkaosnovpo3_1;
Var
  t,k,j,i:integer;
  z:tmas;
  c:TZ;
Begin
  assign(osnov,'osnov');
  reset(osnov);
  t:=filesize(osnov);
  getmem(z,t*sizeof(Zap));
  k:=0;
  while not(eof(osnov)) do
    begin
      read(osnov,Zap);
      inc(k);
      z^[k]:=zap;
    end;
  close(osnov);
  For j:=1 to k-1 do
    For i:=1 to k-j do
      if z^[i].Tabnomr > z^[i+1].Tabnomr then
        begin
          c:=z^[i];
          z^[i]:=z^[i+1];
          z^[i+1]:=c;
        end;
  rewrite(osnov);
  For i:=1 to t do
    write(osnov,z^[i]);
  close(osnov);
  For j:=1 to k-1 do
    For i:=1 to k-j do
      if z^[i].CodeOTD > z^[i+1].CodeOTD then
        begin
          c:=z^[i];
          z^[i]:=z^[i+1];
          z^[i+1]:=c;
        end;
  rewrite(osnov);
  For i:=1 to t do
    write(osnov,z^[i]);
  close(osnov);
  reset(osnov);
  freemem(z,t*sizeof(Zap));
End;


procedure vedomost2_sozdanie;
VAR
  i,w,k,j,t,p,n:integer;
  s1,s2,s3,s4,s,q:string;
  z:tmas;
  x:thmas;
  l:tmasiv;
Begin
  w:=0;
  q:='0';
  i:=0;
  assign(spravochnik1,'spravka1.txt');
  assign(vedomost2,'vedomost2');
  reset(spravochnik1);
  while not(eof(spravochnik1)) do
    begin
      inc(w);
      readln(spravochnik1,s);
    end;
  rewrite(vedomost2);
  reset(spravochnik1);
  with Zap_ved2 do
    While not(eof(spravochnik1)) do
      begin
        readln(spravochnik1,s1);
        readln(spravochnik1,s2);
        readln(spravochnik1,s3);
        readln(spravochnik1,s4);
        Cod_OTDELA:=s1;
        FIO_zava:=s3;
        telefnchik:=s4;
        kol_vo_sotr:=q;
        write(vedomost2,Zap_ved2);
      end;
  close(spravochnik1);
  close(vedomost2);
  sortirovkaVED2;
  sortirovkaosnovpo3_1;

  t:=filesize(osnov);
  getmem(z,t*sizeof(Zap));
  getmem(x,t*sizeof(HZ));
  k:=0;
  while not(eof(osnov)) do
    begin
      read(osnov,Zap);
      inc(k);
      z^[k]:=zap;
    end;
  close(osnov);
  k:=0;
  reset(osnov);
  while not(eof(osnov)) do
    begin
      read(osnov,Zap);
      inc(k);
      x^[k]:=helpzap;
    end;
  close(osnov);
  p:=1;
  For i:=1 to t do
    begin
      IF  z^[i].CodeOTD <> z^[i+1].CodeOTD  then
        begin
          x^[i].CODEOTDELA:=z^[i].CodeOTD;
          str(p,x^[i].TAB);
          p:=1;
        end
      Else
        begin
          IF z^[i+1].Tabnomr<>z^[i].Tabnomr then
            inc(p);
        end;
    end;
  freemem(z,t*sizeof(Zap));



  reset(vedomost2);
  j:=filesize(vedomost2);
  getmem(l,j*sizeof(Zap_ved2));
  k:=0;
  while not(eof(vedomost2)) do
    begin
      read(vedomost2,Zap_ved2);
      inc(k);
      l^[k]:=Zap_ved2;
    end;
  close(vedomost2);
  For i:=1 to j do
    FOR n:=1 to t do
      IF l^[i].Cod_OTDELA=x^[j].CODEOTDELA then
        l^[i].kol_vo_sotr:=x^[j].TAB;
  rewrite(vedomost2);
  For i:=1 to j do
    write(vedomost2,l^[i]);
  close(vedomost2);
  freemem(l,j*sizeof(Zap_ved2));
  freemem(x,t*sizeof(HZ));
  sortirovka;
End;






procedure vivod1;
VAR
  i:integer;
  a,b,c:integer;
Begin
  clrscr;
  Shapka1;
  assign(vedomost1,'vedomost1');
  reset(vedomost1);
  i:=0;
  c:=0;
  repeat
    read(vedomost1,Zap_ved1);
    with Zap_ved1 do
      begin
        inc(i);
        write(i:3);
        writeln(Cod_OTDELA:6,Nazva_otdela:14,Code_lab:6,Tab_nom:6,FIO_sotr:33,Nachisleno:10);
      end;
  until eof(vedomost1);
  close(vedomost1);
  readkey;
End;






procedure vivod2;
VAR
  i:integer;
  a,b,c:integer;
Begin
  clrscr;
  Shapka2;
  assign(vedomost2,'vedomost2');
  reset(vedomost2);
  i:=0;
  c:=0;
  repeat
    read(vedomost2,Zap_ved2);
    with Zap_ved2 do
      begin
        inc(i);
        write(i:3);
        writeln(Cod_OTDELA:8,FIO_zava:35,telefnchik:17,kol_vo_sotr:12);
        Val(Zap_ved2.kol_vo_sotr,a,b);
        c:=c+a;
      end;
  until eof(vedomost2);
  close(vedomost2);
  writeln;
  write('Общий итог:  ':73);
  write(c);
  readkey;
End;

  {

procedure vivodilka;
var
  k,curr_pos,n,p:integer;
  refresh:boolean;
Begin
  assign(osnov,'osnov');
  reset(osnov);
  curr_pos:= 0;
  refresh:=true;
  while not eof(osnov) do
    begin
      read(osnov,Zap);
      inc(n);
    end;
  repeat
    if refresh then
      begin
        reset(osnov);
        k:=1;
        vivodShapki;
        p:=0;
        repeat
          read (osnov,Zap);
          If k in [curr_pos+1..curr_pos+10] then
            with Zap do
              begin
                inc(p);
                write(curr_pos+p:3);
                writeln(CodeOTD:9,CodeLab:12,Tabnomr:15,Data:11,CodeNach:11,SymmNach:14);
              end;
          inc(k);
        until (eof(osnov));
        refresh:=false;
      end;
    case ord(readkey) of
      80:if (curr_pos+10 < n) and ((eof(osnov))) then
            begin
              inc(curr_pos,10);
              refresh:=true;
            end;
      72:if curr_pos-10>=0 then
            begin
              dec(curr_pos, 10);
              refresh:=true;
            end;
      13:break;
    end;
  until false;
  close(osnov);
End;
 }



procedure formerovanie_vedomoste;
Begin
  clrscr;
  vedomost1_sozdanie;
  vedomost2_sozdanie;
  writeln('Ведомости сформированы');
  readkey;
End;



procedure podmenu3;
VAR
  F:integer;
  ch:char;
begin
  repeat
    F:=0;
    clrscr;
    writeln('   Формирование ведомостей: ');
    writeln('1 -> Вывод ведомостей в файл');
    writeln('2 -> Просмотр 1й ведомости на экране');
    writeln('3 -> Просмотр 2й ведомости на экране');
    writeln('4 -> Вывод ведомостей на печать');
    writeln('5 -> Возврат в главное меню');
    repeat
      ch:=readkey;
      IF not(ch in ['1'..'5']) then
        begin
          writeln('неверная клавиша!');
          F:=F+1;
          if F=4 then
            begin
              writeln('программа завершена из-за неправильного ввода данных');
              writeln('нажмите любую кнопку для выхода');
              readkey;
            end
          else
            if F=3 then
              begin
               writeln('у вас ещё ', 4-F,' попытка');
               writeln('выберите существующий пункт подменю');
              end
            else
              begin
                writeln('у вас ещё ', 4-F,' попытки');
                writeln('выберите существующий пункт подменю');
              end;
        end;
    until (ch in ['1'..'5']) or (F=4);
    case ch of
      '1': formerovanie_vedomoste;
      '2': vivod1;
      '3': vivod2;
      '4': ;
    end;
  until (F=4) or (ch='5');
end;





Begin
  podmenu3;
End.