BGP0DP1D.m

BGP0DP1D ; IHS/CMI/LAB - print ind 1 21 Mar 2009 12:55 PM 01 Jul 2009 11:40 AM ;

 ;;10.0;IHS CLINICAL REPORTING;**1**;JUN 18, 2010

ONM1 ;EP

 I $G(BGPAREAA),$G(BGPEXCEL) D

 .Q:$P(^BGPINDTC(BGPPC,0),U,6)=""

 .;set each numerator and percent,then set BGPONN1

 .NEW X S X=0 F  S X=$O(BGPSUL(X)) Q:X'=+X  D

 ..S $P(BGPEXCT(X,1),U,1)=$P($G(^BGPGPDCT(X,N)),U,P),$P(BGPEXCT(X,1),U,3)=$S($P(BGPEXCT(X,1),U,2):(($P(BGPEXCT(X,1),U,1)/$P(BGPEXCT(X,1),U,2))*100),1:"")

 ..S $P(BGPEXCT(X,2),U,1)=$P($G(^BGPGPDPT(X,N)),U,P),$P(BGPEXCT(X,2),U,3)=$S($P(BGPEXCT(X,2),U,2):(($P(BGPEXCT(X,2),U,1)/$P(BGPEXCT(X,2),U,2))*100),1:"")

 ..S $P(BGPEXCT(X,3),U,1)=$P($G(^BGPGPDBT(X,N)),U,P),$P(BGPEXCT(X,3),U,3)=$S($P(BGPEXCT(X,3),U,2):(($P(BGPEXCT(X,3),U,1)/$P(BGPEXCT(X,3),U,2))*100),1:"")

 .S X=0 F  S X=$O(BGPEXCT(X)) Q:X'=+X  D

 ..S A=$P(BGPEXCT(X,1),U,1),B=$P(BGPEXCT(X,1),U,2),C=$P(BGPEXCT(X,1),U,3)

 ..S D=$P(BGPEXCT(X,2),U,1),E=$P(BGPEXCT(X,2),U,2),F=$P(BGPEXCT(X,2),U,3)

 ..S G=$P(BGPEXCT(X,3),U,1),H=$P(BGPEXCT(X,3),U,2),I=$P(BGPEXCT(X,3),U,3)

 ..I $P($P(^BGPINDTC(BGPPC,0),U,4),".")="023" S Y=$P(^BGPINDTC(BGPPC,0),U,6),$P(BGPONN1(X),U,Y)=$S(B:B,1:0),$P(BGPONN1(X),U,(Y+3))=$S(E:E,1:0),$P(BGPONN1(X),U,(Y+6))=$S(H:H,1:0) Q

 ..I $P($P(^BGPINDTC(BGPPC,0),U,4),".",1,2)="014.A" S Y=$P(^BGPINDTC(BGPPC,0),U,6),$P(BGPONN1(X),U,Y)=$S(B:B,1:0),$P(BGPONN1(X),U,(Y+3))=$S(E:E,1:0),$P(BGPONN1(X),U,(Y+6))=$S(H:H,1:0) Q

 ..I $P(^BGPINDTC(BGPPC,0),U,4)="016.A.1" S Y=$P(^BGPINDTC(BGPPC,0),U,6),$P(BGPONN1(X),U,Y)=$S(B:B,1:0),$P(BGPONN1(X),U,(Y+3))=$S(E:E,1:0),$P(BGPONN1(X),U,(Y+6))=$S(H:H,1:0) Q

 ..I $P($G(^BGPINDTC(BGPPC,19)),U,13) S Y=$P(^BGPINDTC(BGPPC,21),U,1),$P(BGPONN1(X),U,Y)=$S(B:B,1:0),$P(BGPONN1(X),U,(Y+3))=$S(E:E,1:0),$P(BGPONN1(X),U,(Y+6))=$S(H:H,1:0) Q

 ..S Y=$P(^BGPINDTC(BGPPC,0),U,6)

 ..S $P(BGPONN1(X),U,$P(^BGPINDTC(BGPPC,0),U,6))=$S(A:A,1:0),$P(BGPONN1(X),U,(Y+1))=$S(B:B,1:0),$P(BGPONN1(X),U,(Y+2))=$$SL(C)

 ..S $P(BGPONN1(X),U,(Y+3))=$S(D:D,1:0),$P(BGPONN1(X),U,(Y+4))=$S(E:E,1:0),$P(BGPONN1(X),U,(Y+5))=$$SL(F),$P(BGPONN1(X),U,(Y+6))=$S(G:G,1:0),$P(BGPONN1(X),U,(Y+7))=$S(H:H,1:0),$P(BGPONN1(X),U,(Y+8))=$$SL(I)

ONN2 ;

 I $G(BGPAREAA),$G(BGPEXCEL) D

 .Q:$P(^BGPINDTC(BGPPC,0),U,7)=""

 .;set each numerator and percent,then set BGPONN2

 .NEW X S X=0 F  S X=$O(BGPSUL(X)) Q:X'=+X  D

 ..S $P(BGPEXCT(X,1),U,1)=$P($G(^BGPGPDCT(X,N)),U,P),$P(BGPEXCT(X,1),U,3)=$S($P(BGPEXCT(X,1),U,2):(($P(BGPEXCT(X,1),U,1)/$P(BGPEXCT(X,1),U,2))*100),1:"")

 ..S $P(BGPEXCT(X,2),U,1)=$P($G(^BGPGPDPT(X,N)),U,P),$P(BGPEXCT(X,2),U,3)=$S($P(BGPEXCT(X,2),U,2):(($P(BGPEXCT(X,2),U,1)/$P(BGPEXCT(X,2),U,2))*100),1:"")

 ..S $P(BGPEXCT(X,3),U,1)=$P($G(^BGPGPDBT(X,N)),U,P),$P(BGPEXCT(X,3),U,3)=$S($P(BGPEXCT(X,3),U,2):(($P(BGPEXCT(X,3),U,1)/$P(BGPEXCT(X,3),U,2))*100),1:"")

 .S X=0 F  S X=$O(BGPEXCT(X)) Q:X'=+X  D

 ..S A=$P(BGPEXCT(X,1),U,1),B=$P(BGPEXCT(X,1),U,2),C=$P(BGPEXCT(X,1),U,3)

 ..S D=$P(BGPEXCT(X,2),U,1),E=$P(BGPEXCT(X,2),U,2),F=$P(BGPEXCT(X,2),U,3)

 ..S G=$P(BGPEXCT(X,3),U,1),H=$P(BGPEXCT(X,3),U,2),I=$P(BGPEXCT(X,3),U,3)

 ..I $P($P(^BGPINDTC(BGPPC,0),U,4),".")="023" S Y=$P(^BGPINDTC(BGPPC,0),U,7),$P(BGPONN2(X),U,Y)=$S(B:B,1:0),$P(BGPONN2(X),U,(Y+3))=$S(E:E,1:0),$P(BGPONN2(X),U,(Y+6))=$S(H:H,1:0) Q

 ..I $P($P(^BGPINDTC(BGPPC,0),U,4),".",1,2)="014.A" S Y=$P(^BGPINDTC(BGPPC,0),U,7),$P(BGPONN2(X),U,Y)=$S(B:B,1:0),$P(BGPONN2(X),U,(Y+3))=$S(E:E,1:0),$P(BGPONN2(X),U,(Y+6))=$S(H:H,1:0) Q

 ..I $P(^BGPINDTC(BGPPC,0),U,4)="016.A.1" S Y=$P(^BGPINDTC(BGPPC,0),U,7),$P(BGPONN2(X),U,Y)=$S(B:B,1:0),$P(BGPONN2(X),U,(Y+3))=$S(E:E,1:0),$P(BGPONN2(X),U,(Y+6))=$S(H:H,1:0) Q

 ..I $P(^BGPINDTC(BGPPC,0),U,4)="STI.AA.1A" S Y=$P(^BGPINDTC(BGPPC,0),U,7),$P(BGPONN2(X),U,Y)=$S(B:B,1:0),$P(BGPONN2(X),U,(Y+3))=$S(E:E,1:0),$P(BGPONN2(X),U,(Y+6))=$S(H:H,1:0) Q

 ..I $P(^BGPINDTC(BGPPC,0),U,4)="STI.AB.4A" S Y=$P(^BGPINDTC(BGPPC,0),U,7),$P(BGPONN2(X),U,Y)=$S(B:B,1:0),$P(BGPONN2(X),U,(Y+3))=$S(E:E,1:0),$P(BGPONN2(X),U,(Y+6))=$S(H:H,1:0) Q

 ..I $P($G(^BGPINDTC(BGPPC,19)),U,13) S Y=$P(^BGPINDTC(BGPPC,21),U,1),$P(BGPONN2(X),U,Y)=$S(B:B,1:0),$P(BGPONN2(X),U,(Y+3))=$S(E:E,1:0),$P(BGPONN2(X),U,(Y+6))=$S(H:H,1:0) Q

 ..S Y=$P(^BGPINDTC(BGPPC,0),U,7)

 ..S $P(BGPONN2(X),U,$P(^BGPINDTC(BGPPC,0),U,7))=$S(A:A,1:0),$P(BGPONN2(X),U,(Y+1))=$S(B:B,1:0),$P(BGPONN2(X),U,(Y+2))=$$SL(C)

 ..S $P(BGPONN2(X),U,(Y+3))=$S(D:D,1:0),$P(BGPONN2(X),U,(Y+4))=$S(E:E,1:0),$P(BGPONN2(X),U,(Y+5))=$$SL(F),$P(BGPONN2(X),U,(Y+6))=$S(G:G,1:0),$P(BGPONN2(X),U,(Y+7))=$S(H:H,1:0),$P(BGPONN2(X),U,(Y+8))=$$SL(I)

ONN3 ;

 I $G(BGPAREAA),$G(BGPEXCEL) D

 .Q:$P($G(^BGPINDTC(BGPPC,21)),U,7)=""

 .;set each numerator and percent,then set BGPONN3

 .NEW X S X=0 F  S X=$O(BGPSUL(X)) Q:X'=+X  D

 ..S $P(BGPEXCT(X,1),U,1)=$P($G(^BGPGPDCT(X,N)),U,P),$P(BGPEXCT(X,1),U,3)=$S($P(BGPEXCT(X,1),U,2):(($P(BGPEXCT(X,1),U,1)/$P(BGPEXCT(X,1),U,2))*100),1:"")

 ..S $P(BGPEXCT(X,2),U,1)=$P($G(^BGPGPDPT(X,N)),U,P),$P(BGPEXCT(X,2),U,3)=$S($P(BGPEXCT(X,2),U,2):(($P(BGPEXCT(X,2),U,1)/$P(BGPEXCT(X,2),U,2))*100),1:"")

 ..S $P(BGPEXCT(X,3),U,1)=$P($G(^BGPGPDBT(X,N)),U,P),$P(BGPEXCT(X,3),U,3)=$S($P(BGPEXCT(X,3),U,2):(($P(BGPEXCT(X,3),U,1)/$P(BGPEXCT(X,3),U,2))*100),1:"")

 .S X=0 F  S X=$O(BGPEXCT(X)) Q:X'=+X  D

 ..S A=$P(BGPEXCT(X,1),U,1),B=$P(BGPEXCT(X,1),U,2),C=$P(BGPEXCT(X,1),U,3)

 ..S D=$P(BGPEXCT(X,2),U,1),E=$P(BGPEXCT(X,2),U,2),F=$P(BGPEXCT(X,2),U,3)

 ..S G=$P(BGPEXCT(X,3),U,1),H=$P(BGPEXCT(X,3),U,2),I=$P(BGPEXCT(X,3),U,3)

 ..I $P($P(^BGPINDTC(BGPPC,0),U,4),".")="023" S Y=$P(^BGPINDTC(BGPPC,21),U,7),$P(BGPONN3(X),U,Y)=$S(B:B,1:0),$P(BGPONN3(X),U,(Y+3))=$S(E:E,1:0),$P(BGPONN3(X),U,(Y+6))=$S(H:H,1:0) Q

 ..I $P($P(^BGPINDTC(BGPPC,0),U,4),".",1,2)="014.A" S Y=$P(^BGPINDTC(BGPPC,21),U,7),$P(BGPONN3(X),U,Y)=$S(B:B,1:0),$P(BGPONN3(X),U,(Y+3))=$S(E:E,1:0),$P(BGPONN3(X),U,(Y+6))=$S(H:H,1:0) Q

 ..I $P(^BGPINDTC(BGPPC,0),U,4)="016.A.1" S Y=$P(^BGPINDTC(BGPPC,21),U,7),$P(BGPONN3(X),U,Y)=$S(B:B,1:0),$P(BGPONN3(X),U,(Y+3))=$S(E:E,1:0),$P(BGPONN3(X),U,(Y+6))=$S(H:H,1:0) Q

 ..I $P(^BGPINDTC(BGPPC,0),U,4)="STI.AA.1A" S Y=$P(^BGPINDTC(BGPPC,21),U,7),$P(BGPONN3(X),U,Y)=$S(B:B,1:0),$P(BGPONN3(X),U,(Y+3))=$S(E:E,1:0),$P(BGPONN3(X),U,(Y+6))=$S(H:H,1:0) Q

 ..I $P(^BGPINDTC(BGPPC,0),U,4)="STI.AB.4A" S Y=$P(^BGPINDTC(BGPPC,21),U,7),$P(BGPONN3(X),U,Y)=$S(B:B,1:0),$P(BGPONN3(X),U,(Y+3))=$S(E:E,1:0),$P(BGPONN3(X),U,(Y+6))=$S(H:H,1:0) Q

 ..I $P($G(^BGPINDTC(BGPPC,19)),U,13) S Y=$P(^BGPINDTC(BGPPC,21),U,7),$P(BGPONN3(X),U,Y)=$S(B:B,1:0),$P(BGPONN3(X),U,(Y+3))=$S(E:E,1:0),$P(BGPONN3(X),U,(Y+6))=$S(H:H,1:0) Q

 ..S Y=$P(^BGPINDTC(BGPPC,21),U,7)

 ..S $P(BGPONN3(X),U,$P(^BGPINDTC(BGPPC,21),U,7))=$S(A:A,1:0),$P(BGPONN3(X),U,(Y+1))=$S(B:B,1:0),$P(BGPONN3(X),U,(Y+2))=$$SL(C)

 ..S $P(BGPONN3(X),U,(Y+3))=$S(D:D,1:0),$P(BGPONN3(X),U,(Y+4))=$S(E:E,1:0),$P(BGPONN3(X),U,(Y+5))=$$SL(F),$P(BGPONN3(X),U,(Y+6))=$S(G:G,1:0),$P(BGPONN3(X),U,(Y+7))=$S(H:H,1:0),$P(BGPONN3(X),U,(Y+8))=$$SL(I)

 Q

SL(V) ;

 I V="" S V=0

 Q $$STRIP^XLFSTR($J(V,5,1)," ")

 ;

DEVEL1 ;EP

 I $G(BGPAREAA),$G(BGPEXCEL) D

 .Q:$P($G(^BGPINDTC(BGPPC,21)),U,3)=""

 .;set each numerator and percent,then set BGPEIDV1

 .NEW X S X=0 F  S X=$O(BGPSUL(X)) Q:X'=+X  D

 ..S $P(BGPEXCT(X,1),U,1)=$P($G(^BGPGPDCT(X,N)),U,P),$P(BGPEXCT(X,1),U,3)=$S($P(BGPEXCT(X,1),U,2):(($P(BGPEXCT(X,1),U,1)/$P(BGPEXCT(X,1),U,2))*100),1:"")

 ..S $P(BGPEXCT(X,2),U,1)=$P($G(^BGPGPDPT(X,N)),U,P),$P(BGPEXCT(X,2),U,3)=$S($P(BGPEXCT(X,2),U,2):(($P(BGPEXCT(X,2),U,1)/$P(BGPEXCT(X,2),U,2))*100),1:"")

 ..S $P(BGPEXCT(X,3),U,1)=$P($G(^BGPGPDBT(X,N)),U,P),$P(BGPEXCT(X,3),U,3)=$S($P(BGPEXCT(X,3),U,2):(($P(BGPEXCT(X,3),U,1)/$P(BGPEXCT(X,3),U,2))*100),1:"")

 .S X=0 F  S X=$O(BGPEXCT(X)) Q:X'=+X  D

 ..S A=$P(BGPEXCT(X,1),U,1),B=$P(BGPEXCT(X,1),U,2),C=$P(BGPEXCT(X,1),U,3)

 ..S D=$P(BGPEXCT(X,2),U,1),E=$P(BGPEXCT(X,2),U,2),F=$P(BGPEXCT(X,2),U,3)

 ..S G=$P(BGPEXCT(X,3),U,1),H=$P(BGPEXCT(X,3),U,2),I=$P(BGPEXCT(X,3),U,3)

 ..I $P($P(^BGPINDTC(BGPPC,0),U,4),".")="023" S Y=$P(^BGPINDTC(BGPPC,21),U,3),$P(BGPEIDV1(X),U,Y)=$S(B:B,1:0),$P(BGPEIDV1(X),U,(Y+3))=$S(E:E,1:0),$P(BGPEIDV1(X),U,(Y+6))=$S(H:H,1:0) Q

 ..I $P($P(^BGPINDTC(BGPPC,0),U,4),".",1,2)="014.A" S Y=$P(^BGPINDTC(BGPPC,21),U,3),$P(BGPEIDV1(X),U,Y)=$S(B:B,1:0),$P(BGPEIDV1(X),U,(Y+3))=$S(E:E,1:0),$P(BGPEIDV1(X),U,(Y+6))=$S(H:H,1:0) Q

 ..I $P(^BGPINDTC(BGPPC,0),U,4)="016.A.1" S Y=$P(^BGPINDTC(BGPPC,21),U,3),$P(BGPEIDV1(X),U,Y)=$S(B:B,1:0),$P(BGPEIDV1(X),U,(Y+3))=$S(E:E,1:0),$P(BGPEIDV1(X),U,(Y+6))=$S(H:H,1:0) Q

 ..I $P($G(^BGPINDTC(BGPPC,19)),U,13) S Y=$P(^BGPINDTC(BGPPC,21),U,3),$P(BGPEIDV1(X),U,Y)=$S(B:B,1:0),$P(BGPEIDV1(X),U,(Y+3))=$S(E:E,1:0),$P(BGPEIDV1(X),U,(Y+6))=$S(H:H,1:0) Q

 ..S Y=$P(^BGPINDTC(BGPPC,21),U,3)

 ..S $P(BGPEIDV1(X),U,$P(^BGPINDTC(BGPPC,21),U,3))=$S(A:A,1:0),$P(BGPEIDV1(X),U,(Y+1))=$S(B:B,1:0),$P(BGPEIDV1(X),U,(Y+2))=$$SL(C)

 ..S $P(BGPEIDV1(X),U,(Y+3))=$S(D:D,1:0),$P(BGPEIDV1(X),U,(Y+4))=$S(E:E,1:0),$P(BGPEIDV1(X),U,(Y+5))=$$SL(F),$P(BGPEIDV1(X),U,(Y+6))=$S(G:G,1:0),$P(BGPEIDV1(X),U,(Y+7))=$S(H:H,1:0),$P(BGPEIDV1(X),U,(Y+8))=$$SL(I)

GPRANT4 ;

 I $G(BGPAREAA),$G(BGPEXCEL) D

 .Q:$P($G(^BGPINDTC(BGPPC,21)),U,4)=""

 .;set each numerator and percent,then set BGPEIDV2

 .NEW X S X=0 F  S X=$O(BGPSUL(X)) Q:X'=+X  D

 ..S $P(BGPEXCT(X,1),U,1)=$P($G(^BGPGPDCT(X,N)),U,P),$P(BGPEXCT(X,1),U,3)=$S($P(BGPEXCT(X,1),U,2):(($P(BGPEXCT(X,1),U,1)/$P(BGPEXCT(X,1),U,2))*100),1:"")

 ..S $P(BGPEXCT(X,2),U,1)=$P($G(^BGPGPDPT(X,N)),U,P),$P(BGPEXCT(X,2),U,3)=$S($P(BGPEXCT(X,2),U,2):(($P(BGPEXCT(X,2),U,1)/$P(BGPEXCT(X,2),U,2))*100),1:"")

 ..S $P(BGPEXCT(X,3),U,1)=$P($G(^BGPGPDBT(X,N)),U,P),$P(BGPEXCT(X,3),U,3)=$S($P(BGPEXCT(X,3),U,2):(($P(BGPEXCT(X,3),U,1)/$P(BGPEXCT(X,3),U,2))*100),1:"")

 .S X=0 F  S X=$O(BGPEXCT(X)) Q:X'=+X  D

 ..S A=$P(BGPEXCT(X,1),U,1),B=$P(BGPEXCT(X,1),U,2),C=$P(BGPEXCT(X,1),U,3)

 ..S D=$P(BGPEXCT(X,2),U,1),E=$P(BGPEXCT(X,2),U,2),F=$P(BGPEXCT(X,2),U,3)

 ..S G=$P(BGPEXCT(X,3),U,1),H=$P(BGPEXCT(X,3),U,2),I=$P(BGPEXCT(X,3),U,3)

 ..I $P($P(^BGPINDTC(BGPPC,0),U,4),".")="023" S Y=$P(^BGPINDTC(BGPPC,21),U,4),$P(BGPEIDV2(X),U,Y)=$S(B:B,1:0),$P(BGPEIDV2(X),U,(Y+3))=$S(E:E,1:0),$P(BGPEIDV2(X),U,(Y+6))=$S(H:H,1:0) Q

 ..I $P($P(^BGPINDTC(BGPPC,0),U,4),".",1,2)="014.A" S Y=$P(^BGPINDTC(BGPPC,21),U,4),$P(BGPEIDV2(X),U,Y)=$S(B:B,1:0),$P(BGPEIDV2(X),U,(Y+3))=$S(E:E,1:0),$P(BGPEIDV2(X),U,(Y+6))=$S(H:H,1:0) Q

 ..I $P(^BGPINDTC(BGPPC,0),U,4)="016.A.1" S Y=$P(^BGPINDTC(BGPPC,21),U,4),$P(BGPEIDV2(X),U,Y)=$S(B:B,1:0),$P(BGPEIDV2(X),U,(Y+3))=$S(E:E,1:0),$P(BGPEIDV2(X),U,(Y+6))=$S(H:H,1:0) Q

 ..I $P($G(^BGPINDTC(BGPPC,19)),U,13) S Y=$P(^BGPINDTC(BGPPC,21),U,4),$P(BGPEIDV2(X),U,Y)=$S(B:B,1:0),$P(BGPEIDV2(X),U,(Y+3))=$S(E:E,1:0),$P(BGPEIDV2(X),U,(Y+6))=$S(H:H,1:0) Q

 ..S Y=$P(^BGPINDTC(BGPPC,21),U,4)

 ..S $P(BGPEIDV2(X),U,$P(^BGPINDTC(BGPPC,21),U,4))=$S(A:A,1:0),$P(BGPEIDV2(X),U,(Y+1))=$S(B:B,1:0),$P(BGPEIDV2(X),U,(Y+2))=$$SL(C)

 ..S $P(BGPEIDV2(X),U,(Y+3))=$S(D:D,1:0),$P(BGPEIDV2(X),U,(Y+4))=$S(E:E,1:0),$P(BGPEIDV2(X),U,(Y+5))=$$SL(F),$P(BGPEIDV2(X),U,(Y+6))=$S(G:G,1:0),$P(BGPEIDV2(X),U,(Y+7))=$S(H:H,1:0),$P(BGPEIDV2(X),U,(Y+8))=$$SL(I)

 Q

BGP0DP1D  ; IHS/CMI/LAB - print ind 1 21 Mar 2009 12:55 PM 01 Jul 2009 11:40 AM ;

 +1       ;;10.0;IHS CLINICAL REPORTING;**1**;JUN 18, 2010

ONM1      ;EP

 +1        IF $GET(BGPAREAA)

               IF $GET(BGPEXCEL)

                   Begin DoDot:1

 +2                    IF $PIECE(^BGPINDTC(BGPPC,0),U,6)=""

                           QUIT 

 +3       ;set each numerator and percent,then set BGPONN1

 +4                    NEW X

                       SET X=0

                       FOR 

                           SET X=$ORDER(BGPSUL(X))

                           IF X'=+X

                               QUIT 

                           Begin DoDot:2

 +5                            SET $PIECE(BGPEXCT(X,1),U,1)=$PIECE($GET(^BGPGPDCT(X,N)),U,P)

                               SET $PIECE(BGPEXCT(X,1),U,3)=$SELECT($PIECE(BGPEXCT(X,1),U,2):(($PIECE(BGPEXCT(X,1),U,1)/$PIECE(BGPEXCT(X,1),U,2))*100),1:"")

 +6                            SET $PIECE(BGPEXCT(X,2),U,1)=$PIECE($GET(^BGPGPDPT(X,N)),U,P)

                               SET $PIECE(BGPEXCT(X,2),U,3)=$SELECT($PIECE(BGPEXCT(X,2),U,2):(($PIECE(BGPEXCT(X,2),U,1)/$PIECE(BGPEXCT(X,2),U,2))*100),1:"")

 +7                            SET $PIECE(BGPEXCT(X,3),U,1)=$PIECE($GET(^BGPGPDBT(X,N)),U,P)

                               SET $PIECE(BGPEXCT(X,3),U,3)=$SELECT($PIECE(BGPEXCT(X,3),U,2):(($PIECE(BGPEXCT(X,3),U,1)/$PIECE(BGPEXCT(X,3),U,2))*100),1:"")

                           End DoDot:2

 +8                    SET X=0

                       FOR 

                           SET X=$ORDER(BGPEXCT(X))

                           IF X'=+X

                               QUIT 

                           Begin DoDot:2

 +9                            SET A=$PIECE(BGPEXCT(X,1),U,1)

                               SET B=$PIECE(BGPEXCT(X,1),U,2)

                               SET C=$PIECE(BGPEXCT(X,1),U,3)

 +10                           SET D=$PIECE(BGPEXCT(X,2),U,1)

                               SET E=$PIECE(BGPEXCT(X,2),U,2)

                               SET F=$PIECE(BGPEXCT(X,2),U,3)

 +11                           SET G=$PIECE(BGPEXCT(X,3),U,1)

                               SET H=$PIECE(BGPEXCT(X,3),U,2)

                               SET I=$PIECE(BGPEXCT(X,3),U,3)

 +12                           IF $PIECE($PIECE(^BGPINDTC(BGPPC,0),U,4),".")="023"

                                   SET Y=$PIECE(^BGPINDTC(BGPPC,0),U,6)

                                   SET $PIECE(BGPONN1(X),U,Y)=$SELECT(B:B,1:0)

                                   SET $PIECE(BGPONN1(X),U,(Y+3))=$SELECT(E:E,1:0)

                                   SET $PIECE(BGPONN1(X),U,(Y+6))=$SELECT(H:H,1:0)

                                   QUIT 

 +13                           IF $PIECE($PIECE(^BGPINDTC(BGPPC,0),U,4),".",1,2)="014.A"

                                   SET Y=$PIECE(^BGPINDTC(BGPPC,0),U,6)

                                   SET $PIECE(BGPONN1(X),U,Y)=$SELECT(B:B,1:0)

                                   SET $PIECE(BGPONN1(X),U,(Y+3))=$SELECT(E:E,1:0)

                                   SET $PIECE(BGPONN1(X),U,(Y+6))=$SELECT(H:H,1:0)

                                   QUIT 

 +14                           IF $PIECE(^BGPINDTC(BGPPC,0),U,4)="016.A.1"

                                   SET Y=$PIECE(^BGPINDTC(BGPPC,0),U,6)

                                   SET $PIECE(BGPONN1(X),U,Y)=$SELECT(B:B,1:0)

                                   SET $PIECE(BGPONN1(X),U,(Y+3))=$SELECT(E:E,1:0)

                                   SET $PIECE(BGPONN1(X),U,(Y+6))=$SELECT(H:H,1:0)

                                   QUIT 

 +15                           IF $PIECE($GET(^BGPINDTC(BGPPC,19)),U,13)

                                   SET Y=$PIECE(^BGPINDTC(BGPPC,21),U,1)

                                   SET $PIECE(BGPONN1(X),U,Y)=$SELECT(B:B,1:0)

                                   SET $PIECE(BGPONN1(X),U,(Y+3))=$SELECT(E:E,1:0)

                                   SET $PIECE(BGPONN1(X),U,(Y+6))=$SELECT(H:H,1:0)

                                   QUIT 

 +16                           SET Y=$PIECE(^BGPINDTC(BGPPC,0),U,6)

 +17                           SET $PIECE(BGPONN1(X),U,$PIECE(^BGPINDTC(BGPPC,0),U,6))=$SELECT(A:A,1:0)

                               SET $PIECE(BGPONN1(X),U,(Y+1))=$SELECT(B:B,1:0)

                               SET $PIECE(BGPONN1(X),U,(Y+2))=$$SL(C)

 +18                           SET $PIECE(BGPONN1(X),U,(Y+3))=$SELECT(D:D,1:0)

                               SET $PIECE(BGPONN1(X),U,(Y+4))=$SELECT(E:E,1:0)

                               SET $PIECE(BGPONN1(X),U,(Y+5))=$$SL(F)

                               SET $PIECE(BGPONN1(X),U,(Y+6))=$SELECT(G:G,1:0)

                               SET $PIECE(BGPONN1(X),U,(Y+7))=$SELECT(H:H,1:0)

                               SET $PIECE(BGPONN1(X),U,(Y+8))=$$SL(I)

                           End DoDot:2

                   End DoDot:1

ONN2      ;

 +1        IF $GET(BGPAREAA)

               IF $GET(BGPEXCEL)

                   Begin DoDot:1

 +2                    IF $PIECE(^BGPINDTC(BGPPC,0),U,7)=""

                           QUIT 

 +3       ;set each numerator and percent,then set BGPONN2

 +4                    NEW X

                       SET X=0

                       FOR 

                           SET X=$ORDER(BGPSUL(X))

                           IF X'=+X

                               QUIT 

                           Begin DoDot:2

 +5                            SET $PIECE(BGPEXCT(X,1),U,1)=$PIECE($GET(^BGPGPDCT(X,N)),U,P)

                               SET $PIECE(BGPEXCT(X,1),U,3)=$SELECT($PIECE(BGPEXCT(X,1),U,2):(($PIECE(BGPEXCT(X,1),U,1)/$PIECE(BGPEXCT(X,1),U,2))*100),1:"")

 +6                            SET $PIECE(BGPEXCT(X,2),U,1)=$PIECE($GET(^BGPGPDPT(X,N)),U,P)

                               SET $PIECE(BGPEXCT(X,2),U,3)=$SELECT($PIECE(BGPEXCT(X,2),U,2):(($PIECE(BGPEXCT(X,2),U,1)/$PIECE(BGPEXCT(X,2),U,2))*100),1:"")

 +7                            SET $PIECE(BGPEXCT(X,3),U,1)=$PIECE($GET(^BGPGPDBT(X,N)),U,P)

                               SET $PIECE(BGPEXCT(X,3),U,3)=$SELECT($PIECE(BGPEXCT(X,3),U,2):(($PIECE(BGPEXCT(X,3),U,1)/$PIECE(BGPEXCT(X,3),U,2))*100),1:"")