Program barbar;
type tip=record
x,y:longint;
end;
tp1=array [1..1000000] of tip;
var a,b,viz:array [0..1005,0..1005] of longint;
c,d:tp1;
aux:array [1..1005] of char;
i,j,n,m,s,f,x1,y1,xf,yf,mid,num:longint;
b1:array [1..1 shl 17] of char;
ok,ok1,ok2:boolean;
fi,fo:text;
procedure solve(var c1,c2:tp1);
var nr,x,y:longint;
begin
nr:=0;
for i:=1 to num do begin
x:=c1[i].x; y:=c1[i].y;
if (a[x,y-1]=-1) and (b[x,y-1]=0) then begin b[x,y-1]:=b[x,y]+1; inc(nr); c2[nr].x:=x; c2[nr].y:=y-1; ok:=true; end;
if (a[x,y+1]=-1) and (b[x,y+1]=0) then begin b[x,y+1]:=b[x,y]+1; inc(nr); c2[nr].x:=x; c2[nr].y:=y+1; ok:=true; end;
if (a[x-1,y]=-1) and (b[x-1,y]=0) then begin b[x-1,y]:=b[x,y]+1; inc(nr); c2[nr].x:=x-1; c2[nr].y:=y; ok:=true; end;
if (a[x+1,y]=-1) and (b[x+1,y]=0) then begin b[x+1,y]:=b[x,y]+1; inc(nr); c2[nr].x:=x+1; c2[nr].y:=y; ok:=true; end;
end;
num:=nr;
end;
procedure solve2(var c1,c2:tp1);
var nr,x,y:longint;
begin
nr:=0;
for i:=1 to num do begin
x:=c1[i].x; y:=c1[i].y;
if (viz[x,y-1]=0) and (b[x,y-1]>=mid) then begin viz[x,y-1]:=1; inc(nr); c2[nr].x:=x; c2[nr].y:=y-1; ok2:=true; end;
if (viz[x,y+1]=0) and (b[x,y+1]>=mid) then begin viz[x,y+1]:=1; inc(nr); c2[nr].x:=x; c2[nr].y:=y+1; ok2:=true; end;
if (viz[x-1,y]=0) and (b[x-1,y]>=mid) then begin viz[x-1,y]:=1; inc(nr); c2[nr].x:=x-1; c2[nr].y:=y; ok2:=true; end;
if (viz[x+1,y]=0) and (b[x+1,y]>=mid) then begin viz[x+1,y]:=1; inc(nr); c2[nr].x:=x+1; c2[nr].y:=y; ok2:=true; end;
end;
num:=nr;
end;
procedure exista(x,y:longint);
begin
num:=1; ok2:=true; c[1].x:=x1; c[1].y:=y1;
while ok2 do begin
ok2:=false;
solve2(c,d);
if ok2 then solve2(d,c);
end;
if viz[xf,yf]=1 then ok1:=true;
fillchar(viz,sizeof(viz),0);
end;
begin
assign(fi,'barbar.in');
assign(fo,'barbar.out');
settextbuf(fi,b1);
reset(fi); rewrite(fo); readln(fi,n,m);
for i:=1 to n do begin
readln(fi,aux);
for j:=1 to m do
if aux[j]='.' then a[i,j]:=-1
else if aux[j]='*' then a[i,j]:=-2
else if aux[j]='D' then begin a[i,j]:=-1; b[i,j]:=1; inc(num); c[num].x:=i; c[num].y:=j; end
else if aux[j]='I' then begin a[i,j]:=-1; x1:=i; y1:=j; end
else begin xf:=i; yf:=j; a[i,j]:=-1; end;
end;
ok:=true;
while ok do begin
ok:=false;
solve(c,d);
if ok then solve(d,c);
end;
if b[x1,y1]>b[xf,yf] then f:=b[xf,yf] else f:=b[x1,y1];
s:=1;
while s<=f do begin
mid:=(s+f) div 2; ok1:=false; exista(x1,y1);
if ok1 then begin ok:=true; s:=mid+1; end else f:=mid-1;
end;
if ok then write(fo,f-1) else write(fo,'-1');
close(fo);
end.