Записи и динамика, Помогите исправить.... Опции

[vi-rus]

Вот 2 задачки :
1 ) Посчитать дату за m дней до текущей.
Помогите, пожалуйста, исправить. Программа неправильно считает високосный год

progrAM DFHSDJFKSD;
USES CRT;
type
 Date=record
  Day:   integer;
  Month: integer;
  Year:  longint;
 end;
 Mon=array[1..12] of word;
const
 MYV: Mon=(31,29,31,30,31,31,30,31,30,31,30,31);
 MYP: Mon=(31,28,31,30,31,31,30,31,30,31,30,31);
var
 Date1, DateNext, DateBefore:Date;
 m,k,y,plus,i,j:integer;
 d,d1:longint;
begin
clrscr;
 textcolor(11);
 textcolor(15);
 writeln;
 textcolor(12);
 writeln('Vvedite daty');
 writeln;
 textcolor(15);
 with Date1 do
  begin
   write('Day: ');
   readln(Day);
   write('Month: ');
   readln(Month);
   write('Year: ');
   readln(Year);
   write('Vvedite m: ');
   readln(m);



   d:=Year*365;
   d:=d+(Year div 4);

   for i:=1 to Month do
    begin
     if Year mod 4=0 then
      begin
       k:=MYV[i]+k;
      end
     else
      begin
       k:=MYP[i]+k;
      end;
    end;
    d:=d+k;
    d:=d+Day;
   d1:=d+m;
   while d1>=365 do
    begin
     y:=y+1;
     if y mod 4<>0  then
      begin
       d1:=d1-365;
      end
     else
      begin
       d1:=d1-366;
      end;
    end;
    i:=1;


    if y mod 4=0 then
     begin
      while d1>MYV[i] do
      begin
       d1:=d1-MYV[i];
       i:=i+1;
      end;
     d1:=d1-2;
     end
    else
    begin
     while d1>MYP[i] do
      begin
       d1:=d1-MYP[i];
       i:=i+1;
     end;

    end;


    d1:=d1;
    i:=i-1;
   writeln(d1);
   writeln(i);
   writeln(y);
   readln;

   end;
end.

2-я программа: помогите дописать : Составить программу, которая вставляет в список temp за первым вхождением элемента Е все элементы списка temp2, если Е входит в temp.

program task3;
uses
    crt;
type
pl = ^list;
str = string[7];

list = record
    field : str;
    next : pl;
end;

var
e:str;
first,temp,temp2:pl;
begin
highvideo;
clrscr;
{}
new(temp);
first := nil;
temp := first;
{INPUT}
writeln('Type temp ( if u want to finish type END)');
readln(temp^.field);
repeat
      new(temp^.next);
      temp := temp^.next;
      readln(temp^.field);
until temp^.field = 'END';

writeln('Type temp2 ( if u want to finish type END)');
readln(temp2^.field);
repeat
      new(temp2^.next);
      temp := temp2^.next;
      readln(temp2^.field);
until temp2^.field = 'END';

temp := nil;
temp := first;
 writeln('Type e-element');
 readln(e);
{OUTPUT}
temp^.next := first^.next;

while (temp^.field <> 'END') do
      begin
      if temp^.field = e then
         begin
         writeln(temp^.field);
         temp := temp^.next^.next;
         end
      else
         begin
         writeln(temp^.field);
         temp := temp^.next;
         end;
      end;
writeln('Press any key.');
readkey;
end.