program identity;

Var 
	Pole : Array [1..4000] Of String;
	N : Integer;
	Vysl : Integer;
	Pocet : Integer;
	PoleVysl : Array [1..200] Of String;
 
 Function GetFirstStringIndex(StartCharIndex:Integer):Integer;
 var I : Integer;
     MinChar : Byte;
     Nerovnajise : Boolean;
 begin
 Nerovnajise:=False;
 GetFirstStringIndex:=1;
 MinChar:=Ord(PoleVysl[1][StartCharIndex]);
 For I:=1 To Pocet Do
	begin
	If Ord(PoleVysl[I][StartCharIndex]) = MinChar Then
		Continue;
	If Ord(PoleVysl[I][StartCharIndex]) < MinChar Then
		begin
		Minchar:=Ord(PoleVysl[I][StartCharIndex]);
		GetFirstStringIndex:=I;
		NerovnajiSe:=True;
		end
	Else NerovnajiSe:=True;
	end;
 If Not NerovnajiSe Then
	GetFirstStringIndex:=0;
 end;

 Procedure Porovnej(S:String);
 Var 
	I, J : Integer;
	Pom : String;
	JeVeVsech : Boolean;
 begin
 For J:=Length(S) Downto 1 Do
	begin
	JeVeVsech:=True;
	Pom:= Copy(S, 1, J);
 	For I:=1 To N Do
		begin
		If Pos(Pom,Pole[I]) = 0 Then
			begin
			JeVeVsech:=False;
			Break;
			end; 
		end;
	If (JeVeVsech) And (Vysl < Length(Pom)) Then
		begin
		Pocet:=1;
		PoleVysl[1]:=Pom;
		Vysl:=Length(Pom);
		end
	Else If (JeVeVsech) And (Vysl = Length(Pom)) Then
		begin
		Inc(Pocet);
		PoleVysl[Pocet]:=Pom;
		end;
	end;
 end;

Var 	I, J : Integer;
	Pom : String;
	MinLengthIndex : Integer;
	MinLength : Integer;
	FirstIndex : Integer;
begin
Repeat
Pocet:=0;
Vysl:=0;
MinLength:=255;
Readln(N);
If N = 0 Then
	Break;
For I:=1 To N Do
	Readln(Pole[I]);
For I:=1 To N Do
	begin
	If Length(Pole[I]) < MinLength Then
 		begin
		MinLengthIndex:=I;
		MinLength:=Length(Pole[I]);
		end;
	end;
Pom:=Pole[MinLengthIndex];
While Pom <> '' Do
	begin
	Porovnej(Pom);
	Delete(Pom,1,1);
	end;
If Pocet = 0 Then
	Writeln('IDENTITY LOST')
Else If Pocet = 1 Then
	Writeln(PoleVysl[1])
Else	begin
	FirstIndex:=0;
	I:=1;
	While FirstIndex = 0 Do
		begin
		FirstIndex:=GetFirstStringIndex(I);
		Inc(I);
		end;
	Writeln(PoleVysl[FirstIndex]);
	end;
Until N = 0;
end.