SetDirectory["C:\\drorbn\\AcademicPensieve\\Projects\\SL2Portfolio2"];
<< KnotTheory`;
<<"../Profile/Profile.m";
<<"Engine-Speedy.m";
<<"Objects.m";
<<"KT.m";
(Subscript[PP, w_]):=Identity
HL[ℰ_] := Style[ℰ, Background -> Green];

$k=2;γ=1;

Using Dror’s Objects and Speedy engine downloaded in August 2019  from http://drorbn.net/AcademicPensieve/Projects/SL2Portfolio2/   
Recall the double multiplication was defined as:
Define[(Subscript[dm, i,j->k])=(((Subscript[sΥ, i->4,4,1,1])//(Subscript[aΔ, 1->1,2])//(Subscript[aΔ, 2->2,3])//(Subscript[(OverBar[aS]), 3]))((Subscript[sΥ, j->-1,-1,-4,-4])//(Subscript[bΔ, -1->-1,-2])//(Subscript[bΔ, -2->-2,-3])))//((Subscript[P, -1,3])(Subscript[P, -3,1])(Subscript[am, 2,-4->k])(Subscript[bm, 4,-2->k]))]
The essential bit that is hard to justify due to the cancellation of terms (1/ℏ) is this:

EssentialBit=(Subscript[aΔ, i->1,2])//(Subscript[aΔ, 2->k,3])//(Subscript[(OverBar[aS]), 3])(Subscript[bΔ, j->-1,-2])//(Subscript[bΔ, -2->l,-3])//((Subscript[P, -1,3])(Subscript[P, -3,1]))

Rewriting it step by step using the definition of Δ to move all pairings to the left and all R-matrices to the right we see the essential bit is the dual of something simpler, let’s call that the core.

((Subscript[R, $1,1])(Subscript[R, $2,2]))//(Subscript[bm, $1,$2->$3])//(Subscript[P, $3,i])//((Subscript[R, $1,k])(Subscript[R, $2,3]))//(Subscript[bm, $1,$2->$3])//(Subscript[P, $3,2])//(Subscript[(OverBar[aS]), 3])(Subscript[bΔ, j->-1,-2])//(Subscript[bΔ, -2->l,-3])//((Subscript[P, -1,3])(Subscript[P, -3,1]))
((Subscript[R, b1,1])(Subscript[R, bb1,k])(Subscript[R, bb2,3]))//(Subscript[bm, bb1,bb2->bb3])//(Subscript[bm, b1,bb3->b3])//(Subscript[P, b3,i])//((Subscript[(OverBar[aS]), 3])(Subscript[R, m1,a1])(Subscript[R, l,aa1])(Subscript[R, m3,aa2]))//(Subscript[am, aa1,aa2->a2])//(Subscript[am, a1,a2->a3])//(Subscript[P, j,a3])//((Subscript[P, m1,3])(Subscript[P, m3,1]))
((Subscript[R, b1,1])(Subscript[R, bb1,k])(Subscript[R, bb2,3])(Subscript[R, l,aa1]))//(Subscript[bm, bb1,bb2->bb3])//(Subscript[bm, b1,bb3->b3])//((Subscript[(OverBar[aS]), 3]))//(Subscript[am, aa1,1->a2])//(Subscript[am, 3,a2->a3])//(Subscript[P, j,a3])//(Subscript[P, b3,i])
((Subscript[R, bb1,k])(Subscript[R, l,aa1]))//((Subscript[R, b1,1])(Subscript[R, bb2,3]))//(Subscript[bm, bb1,bb2->bb3])//(Subscript[bm, b1,bb3->b3])//((Subscript[(OverBar[aS]), 3]))//(Subscript[am, aa1,1->a2])//(Subscript[am, 3,a2->a3])//((Subscript[P, j,a3])(Subscript[P, b3,i]))

And the core is:

((Subscript[R, b1,1])(Subscript[R, bb2,3]))//(Subscript[bm, bb1,bb2->bb3])//(Subscript[bm, b1,bb3->b3])//((Subscript[(OverBar[aS]), 3]))//(Subscript[am, aa1,1->a2])//(Subscript[am, 3,a2->a3])

As the pairing is technically inaccessible we prefer to compute the dual of the core using the Fake Pairing FP

Define[(Subscript[FP, i,j])= (Subscript[P, i,j])/.U2l/.{(Subscript[α, j])->ℏ (Subscript[α, j]),(Subscript[ξ, j])->ℏ (Subscript[ξ, j])}/.l2U]

(Subscript[R, 3,2])//(Subscript[FP, 1,2])

(Subscript[FP, i,j])

Faking the essential bit:

(((((Subscript[R, bb1,k])(Subscript[R, l,aa1]))//((Subscript[R, b1,1])(Subscript[R, bb2,3]))//(Subscript[bm, bb1,bb2->bb3])//(Subscript[bm, b1,bb3->b3])//((Subscript[(OverBar[aS]), 3]))//(Subscript[am, aa1,1->a2])//(Subscript[am, 3,a2->a3])//((Subscript[FP, j,a3])(Subscript[FP, b3,i])))/.U2l/.{(Subscript[α, i])->(ℏ^(-1)) (Subscript[α, i]),(Subscript[ξ, i])->(ℏ^(-1)) (Subscript[ξ, i]),(Subscript[β, j])->(ℏ^(-1)) (Subscript[β, j]),(Subscript[η, j])->(ℏ^(-1))(Subscript[η, j])}/.l2U)//.l2U )≡EssentialBit

With hindsight the operations aΔ,bΔ, aS, (OverBar[aS]) ,bS, (OverBar[bS]) can all be computed using a similar argument with the Fake Pairing FP.