Here is my new program:

Program Network;
 Const Max=100; Mr=Max*Max Div 2;
 Var i,j,n,k,p,v,st:Longint;
     a,b:Array[0..Mr] Of Longint;
Begin
 a[0]:=0; b[0]:=0;
 For i:=1 To Mr Do Begin
  a[i]:=Max+1;
  For j:=3 To Max Do Begin
   v:=i-j*(j-1) Div 2;
   If v>=0 Then
    If a[v]+j<=a[i] Then Begin
     a[i]:=a[v]+j;
     b[i]:=j;
    End;
  End;
 End;
 Readln(n,k);
 k:=n*(n-1) Div 2 - k;
 If a[k]>n Then
  Writeln(-1)
 Else Begin
  p:=1;
  v:=k;
  While v>0 Do Begin
   st:=p;
   If st<>1 Then
    Writeln('1 ',st);
   For i:=1 To b[v]-1 Do Begin
    Writeln(p,' ',p+1);
    Inc(p);
   End;
   Writeln(p,' ',st);
   Inc(p);
   Dec(v,b[v]*(b[v]-1) Div 2);
  End;
  While p<=n Do Begin
   Writeln('1 ',p);
   Inc(p);
  End;
 End;
End.