Hre is how I would suggest that you accomplish this matching.

while ($text =~ m/(APCs?)((?:\s|,|and|\d{3})+)/xgc) {
    my ($apc, $nums) = ($1, $2);
    my @nums = $nums =~ m/(\d+)/g;
    push @extracts, $apc, @nums;
}

for my $n (0..$#extracts) {
    print "Match $n = $extracts[$n]\n";
}
[download]

- Miller

Update 14:59 UTC: my first method only captured last number.

while (my @match = $text =~ m/(APCs?)(?:(?:\s|,|and)+(\d{3}))+/xgc) {
    push @extracts, @match;
}
[download]