d[P]=.;d[Q]=.;

Solve[{d[P]==r d[Q],d[P]+ d[Q]==qi[n]},{d[P],d[Q]}];

labels[K:(P|Q),n_]:=Range[2,n-1]~Join~{P,Q,next[K]}

labels[Λ,n_]:={P,Q}

labels[P,5]

bEntries[K_,n_]:=Outer[b[K],labels[K,n],labels[K,n]]

bEntries[P,5]

e0[K_,n_]:={d[P]a[P]+d[Q]a[Q]==0,qi[3]b[K][2,2]+a[K]==0}

e0[P,5]

e1[K_,n_]:=Table[b[K][#,j]+b[K][#,j+1]==0,{j,2,n-2}]&/@labels[K,n]

e1[P,5]

e2[K_,n_]:=Table[qi[i]b[K][i,#]+qi[i+2]b[K][i+1,#]==0,{i,2,n-2}]&/@labels[K,n]

e2[P,5]

e3[K_,n_]:=b[K][#,P]+b[K][#,Q]+b[K][#,n-1]==0&/@labels[K,n]

e4[K_,n_]:=d[P]b[K][P,#]+d[Q]b[K][Q,#]+qi[n-1]b[K][n-1,#]==0&/@labels[K,n]

next[P]=Pp;next[Q]=Qp;

e5[K_,n_]:=b[K][#,K]+b[K][#,next[K]]==0&/@labels[K,n]

d[next[#]]=qi[2]d[#]-qi[n]

e6[K_,n_]:=qi[n]b[K][K,#]+(qi[2]d[K]-qi[n])b[K][next[K],#]==0&/@labels[K,n]

e4[P,5]

e7[K_,n_]:={b[K][2,next[K]]((qi[3]qi[2])/(d[K](qi[2]d[K]-qi[n])))==ω b[K][next[K],2]}

With[{K=P,n=5},(bEntries[K,n]/.Solve[Flatten[Join@@(#[K,n]&/@{e0,e1,e2,e3,e4,e5,e6,e7})],Flatten[bEntries[K,n]]][[1]])//TableForm]

Union[Cases[%,b[P][__],∞]]

With[{K=Q,n=5},(bEntries[K,n]/.Solve[Flatten[Join@@(#[K,n]&/@{e0,e1,e2,e3,e4,e5,e6,e7})],Flatten[bEntries[K,n]]][[1]])//TableForm]

Union[Cases[%,b[Q][__],∞]]

Clear[f1,f2]

f1[n_]:=b[Λ][#,P]+b[Λ][#,Q]==0&/@labels[Λ,n]

f1[5]

f2[n_]:=d[P]b[Λ][P,#]+d[Q]b[Λ][Q,#]==0&/@labels[Λ,n]

Solve[Flatten[{f1,f2}],Flatten[bEntries[Λ,5]]]

bEntries[Λ,5]

g[n_]:=Flatten[Outer[
qi[n-1]b[Λ][#1,#2]+d[P]b[P][#1,#2]+d[Q]b[Q][#1,#2]==0&,{P,Q},{P,Q}]]

g[5]

d[Λ]=qi[n-1];

Flatten[bEntries[#,5]&/@{P,Q,Λ}]

With[{n=5},Reduce[Flatten[Outer[#2[#1,n]&,{P,Q},{e0,e1,e2,e3,e4,e5,e6,e7}]~Join~{f1[n],f2[n],g[n]}],Flatten[bEntries[#,n]&/@{P,Q,Λ}]]]

Simplify[g[5]/.sol]

Solve[%,{b[P][Pp,2],b[P][Pp,P],b[Q][Qp,2],b[Q][Qp,Q],b[Λ][Q,Q],a[P],a[Q]}]

With[{n=5},({a[P],a[Q]}~Join~(bEntries[#,n]&/@{P,Q,Λ}))/.(sol=Solve[Flatten[Outer[#2[#1,n]&,{P,Q},{e0,e1,e2,e3,e4,e5,e6,e7}]~Join~{f1[n],f2[n],g[n]}],Flatten[{a[P],a[Q]}~Join~(bEntries[#,n]&/@{P,Q,Λ})]][[1]])]

Union[Cases[%474,b[_][__],∞]]

With[{n=5},Solve[Flatten[Outer[#2[#1,n]&,{P,Q},{e0,e1,e2,e3,e4,e5,e6,e7}]~Join~{f1[n],f2[n]}],Flatten[bEntries[#,n]&/@{P,Q,Λ}]]]

Solve[Flatten[Join@@(#[K,n]&/@{e0,e1,e2,e3,e4,e5,e6,e7})],Flatten[bEntries[K,n]]]