performance tuning - Happy 2K prime question

This being the Q number 2K in the site, and this being the day we got the confirmation of mathematica.se graduating soon, I think a celebration question is in order.

So...

What is the fastest way to compute the happy prime number 2000 in Mathematica?

Edit

Here are the Timing[ ] results so far:

 {"JM",      {5.610, 137653}}
 {"Leonid",  {5.109, {12814, 137653}}}
 {"wxffles", {4.11, {12814, 137653}}}
 {"Rojo",    {0.765, {12814, 137653}}}
 {"Rojo1",   {0.547, {12814, 137653}}}

Answer

This answer should be read upside down, since the last edit has the fastest, neatest and shortest answer

Module[{$guard = True},

happyQ[i_] /; $guard := Block[{$guard = False, appeared},
   appeared[_] = False;
   happyQ[i]
   ]
 ]

e : happyQ[_?appeared] := e = False;


happyQ[1] = True;

e : happyQ[i_] := e = (appeared[i] = True; happyQ[#.#&@IntegerDigits[i]])

Now, taking this from @LeonidShiffrin

happyPrimeN[n_] := Module[{m = 0, pctr = 0},
   While[m < n, If[happyQ@Prime[++pctr], m++]];
   {pctr, Prime[pctr]}];

EDIT

Ok, this was cool, but if you don't mind wasting a little memory and not resetting appeared, it becomes simple and less cool

appeared[_] = False;
happyQ[1] = True;
happyQ[_?appeared] = False;
e : happyQ[i_] := e = (appeared[i] = True; happyQ[#.# &@IntegerDigits[i]])

EDIT2

Slightly faster but I like it twice as much

happyQ[1] = True;
e : happyQ[i_] := (e = False; e = happyQ[#.# &@IntegerDigits[i]])

or perhaps to make it slightly shorter and a little bit more memory efficient, reducing the recursion tree's height

happyQ[1] = True;
e : happyQ[i_] := e = happyQ[e = False; #.# &@IntegerDigits[i]]