Ar[0,1] // S[Exp[Ar[1,3]+Ar[2,3]+Y[1,2,3,PH[bc]]]]

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

ins = First /@ {drules}

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

outs

hs = If[FreeQ[outs, PH], AH, PH]

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

expmat = MatrixExp[hs, mat];
expmat // MatrixForm