t1=S[Exp[Ar[1,3]+Ar[2,3]+Y[1,2,3,bch]]]

t2=CanonicalForm[ToPH[5,S[sigma[1,3],sigma[2,3]]]]

MapThread[SameQ, {List @@ t1, List @@t2}]

Last[t1]

Last[t2]

unknowns = DeclareSeries[bc[x[1], x[2]], 1]

drules=Sequence@@ Der[Ar[1,3]+Ar[2,3]+Y[1,2,3,PH[bc]]]

ins = First /@ {drules}

k0 = Length[ins]

outs={};
For[k=1, k≤Length[ins], ++k,
AppendTo[outs, newout=Der[drules][ins[[k]]]];
ins = ins ~Join~ Complement[
Union[Cases[{newout}, Y[ijk__, _] :> Y[ijk, AH[1]], Infinity]],
ins
]
];
--k

ins

outs

zero=Table[0,{k}];
e[{{i_}}] := ReplacePart[zero, 1, i];
mat = Replace[
outs /. Y[ijk__, h_] :> -h e[Position[ins, Y[ijk,AH[1]]]],
0 -> zero,
{1}
]

mat // MatrixForm

drules

drules=Sequence[Ar[3,0]->Y[1,2,0,PH[bc[0,0] x[3] z+((O[z])^2)]]+Y[1,3,0,AH[-1]]+Y[2,3,0,AH[-1]]]

Y[1,3,0,AH[1]] // Der[drules]

Table[
ReducePrimitives[
Der[ToPH[3, Y[1,2,3,AH[1]]]]@Ar[i,j] + Der[Ar[i,j]]@Y[1,2,3,ToPH[3, PH[1]]]
],{i,4},{j,4}
]

Table[ReducePrimitives[Der[ToPH[3, Y[1, 2, 3, AH[1]]]][Ar[i, j]] + Der[Ar[i, j]][Y[1, 2, 3, ToPH[3, PH[1]]]]], {i, 4}, {j, 4}]