This is my program;

const  date     :array[1..12] of byte
                =(31,28,31,30,31,30,31,31,30,31,30,31);
       ten      :array[1..7] of string
                =('mon','tue','wed','thu','fri','sat','sun');

var    ngay, thang, nam, thu      :word;
       tt                         :array[1..31] of byte;
       so                         :byte;

procedure nhap;
begin
  readln( ngay, thang, nam);
end;


function leap(i :word) :boolean;
begin
   leap := ( ( i mod 4 = 0 ) and ( i mod 100 <> 0 ) )
       or  ( i mod 400 = 0 );
end;


procedure tinh_thu_1_1;
var     i          :word;
begin
  thu := 0;
  for i := 1 to nam do
   if leap(i) then thu := ( thu + 2 ) mod 7
              else thu := ( thu + 1 ) mod 7;
end;


procedure tinh_thu_1_thang;
var    i           :byte;
begin
  for i := 1 to thang-1 do
  begin
    if  ( i = 2 ) and leap(nam) then
      thu := ( thu + 29 ) mod 7
    else thu := ( thu + date[i] ) mod 7;
  end;

  if thu = 0 then thu := 7;
end;


procedure tinh_thu_ca_thang;
var      i            :byte;
begin
  thu := thu-1;
  if ( thang = 2 ) and leap ( nam ) then so := 2
  else so := date[ thang ];

  for i := 1 to so do
  begin  thu := ( thu + 1 ) mod 7;
         if thu = 0 then thu := 7;

         tt[i] := thu;
  end;
end;


procedure solve;
begin
  tinh_thu_1_1;
  tinh_thu_1_thang;
  tinh_thu_ca_thang;
end;


procedure out;
var  i,j  :byte;
     st   :string;
     ok   :boolean;
begin
  str( ngay, st); if ngay < 10 then st := ' ' + st;
  st := '[' + st + ']';

  for i := 1 to 7 do
  begin
    write( ten[i] );

    ok := false;
    if i < tt[1] then begin write(' ':4); ok := true end;

    for j := 1 to so do if tt[j] = i then
    begin
      if j = ngay then
        if ok then write(st:6)
              else write(st:5)
      else
        if j = ngay + 7 then write(j:4)
      else
        if ok then write(j:5)
              else write(j:4);
      ok := true;
    end;

    writeln;
  end;
end;


begin
  nhap;
  solve;
  out;
end.

Your program is wrong. For example, see 1 2 1600 and so on...