BGPDPB ; IHS/CMI/LAB - IHS gpra print ;
;;7.0;IHS CLINICAL REPORTING;;JAN 24, 2007
;
;
IB ;EP
D HEADER^BGPDPH Q:BGPQUIT
W !,"Indicator B: Reduce the Colorectal Cancer Rate."
W !,"Increase the proportion of AI/AN who have had screening and early detection.",!
W !,"Denominator is all active patients over the age of 50.",!
D H1^BGPDPH
S BGPCYD=$P($$V(BGPRPT,15,19),"!",1)+$P($$V(BGPRPT,15,19),"!",2),BGPCYN=$P($$V(BGPRPT,15,20),"!",1)+$P($$V(BGPRPT,15,20),"!",2),BGPCYP=$S(BGPCYD:((BGPCYN/BGPCYD)*100),1:"")
S BGP98D=$P($$V(BGPRPT,85,19),"!",1)+$P($$V(BGPRPT,85,19),"!",2),BGP98N=$P($$V(BGPRPT,85,20),"!",1)+$P($$V(BGPRPT,85,20),"!",2),BGP98P=$S(BGP98D:((BGP98N/BGP98D)*100),1:"")
S BGPPRD=$P($$V(BGPRPT,45,19),"!",1)+$P($$V(BGPRPT,45,19),"!",2),BGPPRN=$P($$V(BGPRPT,45,20),"!",1)+$P($$V(BGPRPT,45,20),"!",2),BGPPRP=$S(BGPPRD:((BGPPRN/BGPPRD)*100),1:"")
W !,"# patients over 50",?22,$$C(BGP98D,0,8),?37,$$C(BGPPRD,0,8),?52,$$C(BGPCYD,0,8)
W !!,"# w/FOB test",!?2,"recorded w/in 1 yr of",!?2,"end of time period"
D H2^BGPDPH
I $Y>(IOSL-5) D HEADER^BGPDPH Q:BGPQUIT W !,"Colorectal Cancer Screening",! D H1^BGPDPH
S BGPCYD=$P($$V(BGPRPT,15,19),"!",1)+$P($$V(BGPRPT,15,19),"!",2),BGPCYN=$P($$V(BGPRPT,15,23),"!",1)+$P($$V(BGPRPT,15,23),"!",2),BGPCYP=$S(BGPCYD:((BGPCYN/BGPCYD)*100),1:"")
S BGP98D=$P($$V(BGPRPT,85,19),"!",1)+$P($$V(BGPRPT,85,19),"!",2),BGP98N=$P($$V(BGPRPT,85,23),"!",1)+$P($$V(BGPRPT,85,23),"!",2),BGP98P=$S(BGP98D:((BGP98N/BGP98D)*100),1:"")
S BGPPRD=$P($$V(BGPRPT,45,19),"!",1)+$P($$V(BGPRPT,45,19),"!",2),BGPPRN=$P($$V(BGPRPT,45,23),"!",1)+$P($$V(BGPRPT,45,23),"!",2),BGPPRP=$S(BGPPRD:((BGPPRN/BGPPRD)*100),1:"")
W !!,"# w/DRE or Rectal Exam",!?2,"recorded w/in 1 yr of",!?2,"end of time period"
D H2^BGPDPH
I $Y>(IOSL-5) D HEADER^BGPDPH Q:BGPQUIT W !,"Colorectal Cancer Screening",! D H1^BGPDPH
S BGPCYD=$P($$V(BGPRPT,15,19),"!",1)+$P($$V(BGPRPT,15,19),"!",2),BGPCYN=$P($$V(BGPRPT,15,21),"!",1)+$P($$V(BGPRPT,15,21),"!",2),BGPCYP=$S(BGPCYD:((BGPCYN/BGPCYD)*100),1:"")
S BGP98D=$P($$V(BGPRPT,85,19),"!",1)+$P($$V(BGPRPT,85,19),"!",2),BGP98N=$P($$V(BGPRPT,85,21),"!",1)+$P($$V(BGPRPT,85,21),"!",2),BGP98P=$S(BGP98D:((BGP98N/BGP98D)*100),1:"")
S BGPPRD=$P($$V(BGPRPT,45,19),"!",1)+$P($$V(BGPRPT,45,19),"!",2),BGPPRN=$P($$V(BGPRPT,45,21),"!",1)+$P($$V(BGPRPT,45,21),"!",2),BGPPRP=$S(BGPPRD:((BGPPRN/BGPPRD)*100),1:"")
W !!,"# w/DRE and SIG",!?2,"recorded w/in 5 yrs of",!?2,"end of time period"
D H2^BGPDPH
I $Y>(IOSL-5) D HEADER^BGPDPH Q:BGPQUIT W !,"Colorectal Cancer Screening",! D H1^BGPDPH
S BGPCYD=$P($$V(BGPRPT,15,19),"!",1)+$P($$V(BGPRPT,15,19),"!",2),BGPCYN=$P($$V(BGPRPT,15,22),"!",1)+$P($$V(BGPRPT,15,22),"!",2),BGPCYP=$S(BGPCYD:((BGPCYN/BGPCYD)*100),1:"")
S BGP98D=$P($$V(BGPRPT,85,19),"!",1)+$P($$V(BGPRPT,85,19),"!",2),BGP98N=$P($$V(BGPRPT,85,22),"!",1)+$P($$V(BGPRPT,85,22),"!",2),BGP98P=$S(BGP98D:((BGP98N/BGP98D)*100),1:"")
S BGPPRD=$P($$V(BGPRPT,45,19),"!",1)+$P($$V(BGPRPT,45,19),"!",2),BGPPRN=$P($$V(BGPRPT,45,22),"!",1)+$P($$V(BGPRPT,45,22),"!",2),BGPPRP=$S(BGPPRD:((BGPPRN/BGPPRD)*100),1:"")
W !!,"# w/DRE & Colonoscopy test",!?2,"recorded w/in 5 yrs of",!?2,"end of time period"
D H2^BGPDPH
MALES ;
D HEADER^BGPDPH Q:BGPQUIT
W !,"Indicator B: Reduce the Colorectal Cancer Rate."
W !,"Increase the proportion of AI/AN who have had screening and early detection.",!
W !,"Denominator is all MALE active patients over the age of 50.",!
D H1^BGPDPH
S BGPCYD=$P($$V(BGPRPT,15,19),"!",1),BGPCYN=$P($$V(BGPRPT,15,20),"!",1),BGPCYP=$S(BGPCYD:((BGPCYN/BGPCYD)*100),1:"")
S BGP98D=$P($$V(BGPRPT,85,19),"!",1),BGP98N=$P($$V(BGPRPT,85,20),"!",1),BGP98P=$S(BGP98D:((BGP98N/BGP98D)*100),1:"")
S BGPPRD=$P($$V(BGPRPT,45,19),"!",1),BGPPRN=$P($$V(BGPRPT,45,20),"!",1),BGPPRP=$S(BGPPRD:((BGPPRN/BGPPRD)*100),1:"")
W !!!,"# MALES over 50 ",?22,$$C(BGP98D,0,8),?37,$$C(BGPPRD,0,8),?52,$$C(BGPCYD,0,8)
W !!,"w/FOB test",!?2,"recorded w/in 1 yr of",!?2,"end of time period"
D H2^BGPDPH
I $Y>(IOSL-5) D HEADER^BGPDPH Q:BGPQUIT W !,"Colorectal Cancer Screening",! D H1^BGPDPH
S BGPCYD=$P($$V(BGPRPT,15,19),"!",1),BGPCYN=$P($$V(BGPRPT,15,23),"!",1),BGPCYP=$S(BGPCYD:((BGPCYN/BGPCYD)*100),1:"")
S BGP98D=$P($$V(BGPRPT,85,19),"!",1),BGP98N=$P($$V(BGPRPT,85,23),"!",1),BGP98P=$S(BGP98D:((BGP98N/BGP98D)*100),1:"")
S BGPPRD=$P($$V(BGPRPT,45,19),"!",1),BGPPRN=$P($$V(BGPRPT,45,23),"!",1),BGPPRP=$S(BGPPRD:((BGPPRN/BGPPRD)*100),1:"")
W !!,"w/DRE or Rectal Exam",!?2,"recorded w/in 1 yr of",!?2,"end of time period"
D H2^BGPDPH
I $Y>(IOSL-5) D HEADER^BGPDPH Q:BGPQUIT W !,"Colorectal Cancer Screening",! D H1^BGPDPH
S BGPCYD=$P($$V(BGPRPT,15,19),"!",1),BGPCYN=$P($$V(BGPRPT,15,21),"!",1),BGPCYP=$S(BGPCYD:((BGPCYN/BGPCYD)*100),1:"")
S BGP98D=$P($$V(BGPRPT,85,19),"!",1),BGP98N=$P($$V(BGPRPT,85,21),"!",1),BGP98P=$S(BGP98D:((BGP98N/BGP98D)*100),1:"")
S BGPPRD=$P($$V(BGPRPT,45,19),"!",1),BGPPRN=$P($$V(BGPRPT,45,21),"!",1),BGPPRP=$S(BGPPRD:((BGPPRN/BGPPRD)*100),1:"")
W !!,"w/DRE & SIG test",!?2,"recorded w/in 5 yr of",!?2,"end of time period"
D H2^BGPDPH
I $Y>(IOSL-5) D HEADER^BGPDPH Q:BGPQUIT W !,"Colorectal Cancer Screening",! D H1^BGPDPH
S BGPCYD=$P($$V(BGPRPT,15,19),"!",1),BGPCYN=$P($$V(BGPRPT,15,22),"!",1),BGPCYP=$S(BGPCYD:((BGPCYN/BGPCYD)*100),1:"")
S BGP98D=$P($$V(BGPRPT,85,19),"!",1),BGP98N=$P($$V(BGPRPT,85,22),"!",1),BGP98P=$S(BGP98D:((BGP98N/BGP98D)*100),1:"")
S BGPPRD=$P($$V(BGPRPT,45,19),"!",1),BGPPRN=$P($$V(BGPRPT,45,22),"!",1),BGPPRP=$S(BGPPRD:((BGPPRN/BGPPRD)*100),1:"")
W !!,"w/DRE & Colonoscopy test",!?2,"recorded w/in 5 yr of",!?2,"end of time period"
D H2^BGPDPH
FEMALES ;
D HEADER^BGPDPH Q:BGPQUIT
W !,"Indicator B: Reduce the Colorectal Cancer Rate."
W !,"Increase the proportion of AI/AN who have had screening and early detection.",!
W !,"Denominator is all FEMALE active patients over the age of 50.",!
D H1^BGPDPH
S BGPCYD=$P($$V(BGPRPT,15,19),"!",2),BGPCYN=$P($$V(BGPRPT,15,20),"!",2),BGPCYP=$S(BGPCYD:((BGPCYN/BGPCYD)*100),1:"")
S BGP98D=$P($$V(BGPRPT,85,19),"!",2),BGP98N=$P($$V(BGPRPT,85,20),"!",2),BGP98P=$S(BGP98D:((BGP98N/BGP98D)*100),1:"")
S BGPPRD=$P($$V(BGPRPT,45,19),"!",2),BGPPRN=$P($$V(BGPRPT,45,20),"!",2),BGPPRP=$S(BGPPRD:((BGPPRN/BGPPRD)*100),1:"")
W !!!,"# FEMALES over 50 ",?22,$$C(BGP98D,0,8),?37,$$C(BGPPRD,0,8),?52,$$C(BGPCYD,0,8)
W !!,"w/FOB test",!?2,"recorded w/in 1 yr of",!?2,"end of time period"
D H2^BGPDPH
I $Y>(IOSL-5) D HEADER^BGPDPH Q:BGPQUIT W !,"Colorectal Cancer Screening",! D H1^BGPDPH
S BGPCYD=$P($$V(BGPRPT,15,19),"!",2),BGPCYN=$P($$V(BGPRPT,15,23),"!",2),BGPCYP=$S(BGPCYD:((BGPCYN/BGPCYD)*100),1:"")
S BGP98D=$P($$V(BGPRPT,85,19),"!",2),BGP98N=$P($$V(BGPRPT,85,23),"!",2),BGP98P=$S(BGP98D:((BGP98N/BGP98D)*100),1:"")
S BGPPRD=$P($$V(BGPRPT,45,19),"!",2),BGPPRN=$P($$V(BGPRPT,45,23),"!",2),BGPPRP=$S(BGPPRD:((BGPPRN/BGPPRD)*100),1:"")
W !!,"w/DRE or Rectal Exam",!?2,"recorded w/in 1 yr of",!?2,"end of time period"
D H2^BGPDPH
I $Y>(IOSL-5) D HEADER^BGPDPH Q:BGPQUIT W !,"Colorectal Cancer Screening",! D H1^BGPDPH
S BGPCYD=$P($$V(BGPRPT,15,19),"!",2),BGPCYN=$P($$V(BGPRPT,15,21),"!",2),BGPCYP=$S(BGPCYD:((BGPCYN/BGPCYD)*100),1:"")
S BGP98D=$P($$V(BGPRPT,85,19),"!",2),BGP98N=$P($$V(BGPRPT,85,21),"!",2),BGP98P=$S(BGP98D:((BGP98N/BGP98D)*100),1:"")
S BGPPRD=$P($$V(BGPRPT,45,19),"!",2),BGPPRN=$P($$V(BGPRPT,45,21),"!",2),BGPPRP=$S(BGPPRD:((BGPPRN/BGPPRD)*100),1:"")
W !!,"w/DRE & SIG test",!?2,"recorded w/in 5 yr of",!?2,"end of time period"
D H2^BGPDPH
I $Y>(IOSL-5) D HEADER^BGPDPH Q:BGPQUIT W !,"Colorectal Cancer Screening",! D H1^BGPDPH
S BGPCYD=$P($$V(BGPRPT,15,19),"!",2),BGPCYN=$P($$V(BGPRPT,15,22),"!",2),BGPCYP=$S(BGPCYD:((BGPCYN/BGPCYD)*100),1:"")
S BGP98D=$P($$V(BGPRPT,85,19),"!",2),BGP98N=$P($$V(BGPRPT,85,22),"!",2),BGP98P=$S(BGP98D:((BGP98N/BGP98D)*100),1:"")
S BGPPRD=$P($$V(BGPRPT,45,19),"!",2),BGPPRN=$P($$V(BGPRPT,45,22),"!",2),BGPPRP=$S(BGPPRD:((BGPPRN/BGPPRD)*100),1:"")
W !!,"w/DRE & Colonoscopy test",!?2,"recorded w/in 5 yr of",!?2,"end of time period"
D H2^BGPDPH
Q
CALC(N,O) ;ENTRY POINT
;N is new
;O is old
NEW Z
I O=0!(N=0)!(O="")!(N="") Q "**"
NEW X,X2,X3
S X=N,X2=1,X3=0 D COMMA^%DTC S N=X
S X=O,X2=1,X3=0 D COMMA^%DTC S O=X
I +O=0 Q "**"
S Z=(((N-O)/O)*100),Z=$FN(Z,"+,",1)
Q Z
H ;write header
W !?44,"% CHANGE",?62,"% CHANGE",!?44,"FROM BASE YR",?62,"FROM PREV YR"
Q
V(R,N,P) ;
NEW Y
I $G(BGPAREAA),'$G(BGPSUMR) G VA
Q $P($G(^BGPD(R,N)),U,P)
VA ;
NEW X,C,V,MT,FT,M,F,B S X=0,C="" F S X=$O(BGPSUL(X)) Q:X'=+X D
.S V=$P($G(^BGPD(X,N)),U,P)
.I C="" S C=V Q
.S MT=$P(C,"!"),FT=$P(C,"!",2),M=$P(V,"!"),F=$P(V,"!",2)
.F B=1:1:6 S $P(MT,"~",B)=$P(MT,"~",B)+$P(M,"~",B)
.F B=1:1:6 S $P(FT,"~",B)=$P(FT,"~",B)+$P(F,"~",B)
.S C=MT_"!"_FT
.Q
Q C
C(X,X2,X3) ;
D COMMA^%DTC
Q X
;
BGPDPB ; IHS/CMI/LAB - IHS gpra print ;
+1 ;;7.0;IHS CLINICAL REPORTING;;JAN 24, 2007
+2 ;
+3 ;
IB ;EP
+1 DO HEADER^BGPDPH
IF BGPQUIT
QUIT
+2 WRITE !,"Indicator B: Reduce the Colorectal Cancer Rate."
+3 WRITE !,"Increase the proportion of AI/AN who have had screening and early detection.",!
+4 WRITE !,"Denominator is all active patients over the age of 50.",!
+5 DO H1^BGPDPH
+6 SET BGPCYD=$PIECE($$V(BGPRPT,15,19),"!",1)+$PIECE($$V(BGPRPT,15,19),"!",2)
SET BGPCYN=$PIECE($$V(BGPRPT,15,20),"!",1)+$PIECE($$V(BGPRPT,15,20),"!",2)
SET BGPCYP=$SELECT(BGPCYD:((BGPCYN/BGPCYD)*100),1:"")
+7 SET BGP98D=$PIECE($$V(BGPRPT,85,19),"!",1)+$PIECE($$V(BGPRPT,85,19),"!",2)
SET BGP98N=$PIECE($$V(BGPRPT,85,20),"!",1)+$PIECE($$V(BGPRPT,85,20),"!",2)
SET BGP98P=$SELECT(BGP98D:((BGP98N/BGP98D)*100),1:"")
+8 SET BGPPRD=$PIECE($$V(BGPRPT,45,19),"!",1)+$PIECE($$V(BGPRPT,45,19),"!",2)
SET BGPPRN=$PIECE($$V(BGPRPT,45,20),"!",1)+$PIECE($$V(BGPRPT,45,20),"!",2)
SET BGPPRP=$SELECT(BGPPRD:((BGPPRN/BGPPRD)*100),1:"")
+9 WRITE !,"# patients over 50",?22,$$C(BGP98D,0,8),?37,$$C(BGPPRD,0,8),?52,$$C(BGPCYD,0,8)
+10 WRITE !!,"# w/FOB test",!?2,"recorded w/in 1 yr of",!?2,"end of time period"
+11 DO H2^BGPDPH
+12 IF $Y>(IOSL-5)
DO HEADER^BGPDPH
IF BGPQUIT
QUIT
WRITE !,"Colorectal Cancer Screening",!
DO H1^BGPDPH
+13 SET BGPCYD=$PIECE($$V(BGPRPT,15,19),"!",1)+$PIECE($$V(BGPRPT,15,19),"!",2)
SET BGPCYN=$PIECE($$V(BGPRPT,15,23),"!",1)+$PIECE($$V(BGPRPT,15,23),"!",2)
SET BGPCYP=$SELECT(BGPCYD:((BGPCYN/BGPCYD)*100),1:"")
+14 SET BGP98D=$PIECE($$V(BGPRPT,85,19),"!",1)+$PIECE($$V(BGPRPT,85,19),"!",2)
SET BGP98N=$PIECE($$V(BGPRPT,85,23),"!",1)+$PIECE($$V(BGPRPT,85,23),"!",2)
SET BGP98P=$SELECT(BGP98D:((BGP98N/BGP98D)*100),1:"")
+15 SET BGPPRD=$PIECE($$V(BGPRPT,45,19),"!",1)+$PIECE($$V(BGPRPT,45,19),"!",2)
SET BGPPRN=$PIECE($$V(BGPRPT,45,23),"!",1)+$PIECE($$V(BGPRPT,45,23),"!",2)
SET BGPPRP=$SELECT(BGPPRD:((BGPPRN/BGPPRD)*100),1:"")
+16 WRITE !!,"# w/DRE or Rectal Exam",!?2,"recorded w/in 1 yr of",!?2,"end of time period"
+17 DO H2^BGPDPH
+18 IF $Y>(IOSL-5)
DO HEADER^BGPDPH
IF BGPQUIT
QUIT
WRITE !,"Colorectal Cancer Screening",!
DO H1^BGPDPH
+19 SET BGPCYD=$PIECE($$V(BGPRPT,15,19),"!",1)+$PIECE($$V(BGPRPT,15,19),"!",2)
SET BGPCYN=$PIECE($$V(BGPRPT,15,21),"!",1)+$PIECE($$V(BGPRPT,15,21),"!",2)
SET BGPCYP=$SELECT(BGPCYD:((BGPCYN/BGPCYD)*100),1:"")
+20 SET BGP98D=$PIECE($$V(BGPRPT,85,19),"!",1)+$PIECE($$V(BGPRPT,85,19),"!",2)
SET BGP98N=$PIECE($$V(BGPRPT,85,21),"!",1)+$PIECE($$V(BGPRPT,85,21),"!",2)
SET BGP98P=$SELECT(BGP98D:((BGP98N/BGP98D)*100),1:"")
+21 SET BGPPRD=$PIECE($$V(BGPRPT,45,19),"!",1)+$PIECE($$V(BGPRPT,45,19),"!",2)
SET BGPPRN=$PIECE($$V(BGPRPT,45,21),"!",1)+$PIECE($$V(BGPRPT,45,21),"!",2)
SET BGPPRP=$SELECT(BGPPRD:((BGPPRN/BGPPRD)*100),1:"")
+22 WRITE !!,"# w/DRE and SIG",!?2,"recorded w/in 5 yrs of",!?2,"end of time period"
+23 DO H2^BGPDPH
+24 IF $Y>(IOSL-5)
DO HEADER^BGPDPH
IF BGPQUIT
QUIT
WRITE !,"Colorectal Cancer Screening",!
DO H1^BGPDPH
+25 SET BGPCYD=$PIECE($$V(BGPRPT,15,19),"!",1)+$PIECE($$V(BGPRPT,15,19),"!",2)
SET BGPCYN=$PIECE($$V(BGPRPT,15,22),"!",1)+$PIECE($$V(BGPRPT,15,22),"!",2)
SET BGPCYP=$SELECT(BGPCYD:((BGPCYN/BGPCYD)*100),1:"")
+26 SET BGP98D=$PIECE($$V(BGPRPT,85,19),"!",1)+$PIECE($$V(BGPRPT,85,19),"!",2)
SET BGP98N=$PIECE($$V(BGPRPT,85,22),"!",1)+$PIECE($$V(BGPRPT,85,22),"!",2)
SET BGP98P=$SELECT(BGP98D:((BGP98N/BGP98D)*100),1:"")
+27 SET BGPPRD=$PIECE($$V(BGPRPT,45,19),"!",1)+$PIECE($$V(BGPRPT,45,19),"!",2)
SET BGPPRN=$PIECE($$V(BGPRPT,45,22),"!",1)+$PIECE($$V(BGPRPT,45,22),"!",2)
SET BGPPRP=$SELECT(BGPPRD:((BGPPRN/BGPPRD)*100),1:"")
+28 WRITE !!,"# w/DRE & Colonoscopy test",!?2,"recorded w/in 5 yrs of",!?2,"end of time period"
+29 DO H2^BGPDPH
MALES ;
+1 DO HEADER^BGPDPH
IF BGPQUIT
QUIT
+2 WRITE !,"Indicator B: Reduce the Colorectal Cancer Rate."
+3 WRITE !,"Increase the proportion of AI/AN who have had screening and early detection.",!
+4 WRITE !,"Denominator is all MALE active patients over the age of 50.",!
+5 DO H1^BGPDPH
+6 SET BGPCYD=$PIECE($$V(BGPRPT,15,19),"!",1)
SET BGPCYN=$PIECE($$V(BGPRPT,15,20),"!",1)
SET BGPCYP=$SELECT(BGPCYD:((BGPCYN/BGPCYD)*100),1:"")
+7 SET BGP98D=$PIECE($$V(BGPRPT,85,19),"!",1)
SET BGP98N=$PIECE($$V(BGPRPT,85,20),"!",1)
SET BGP98P=$SELECT(BGP98D:((BGP98N/BGP98D)*100),1:"")
+8 SET BGPPRD=$PIECE($$V(BGPRPT,45,19),"!",1)
SET BGPPRN=$PIECE($$V(BGPRPT,45,20),"!",1)
SET BGPPRP=$SELECT(BGPPRD:((BGPPRN/BGPPRD)*100),1:"")
+9 WRITE !!!,"# MALES over 50 ",?22,$$C(BGP98D,0,8),?37,$$C(BGPPRD,0,8),?52,$$C(BGPCYD,0,8)
+10 WRITE !!,"w/FOB test",!?2,"recorded w/in 1 yr of",!?2,"end of time period"
+11 DO H2^BGPDPH
+12 IF $Y>(IOSL-5)
DO HEADER^BGPDPH
IF BGPQUIT
QUIT
WRITE !,"Colorectal Cancer Screening",!
DO H1^BGPDPH
+13 SET BGPCYD=$PIECE($$V(BGPRPT,15,19),"!",1)
SET BGPCYN=$PIECE($$V(BGPRPT,15,23),"!",1)
SET BGPCYP=$SELECT(BGPCYD:((BGPCYN/BGPCYD)*100),1:"")
+14 SET BGP98D=$PIECE($$V(BGPRPT,85,19),"!",1)
SET BGP98N=$PIECE($$V(BGPRPT,85,23),"!",1)
SET BGP98P=$SELECT(BGP98D:((BGP98N/BGP98D)*100),1:"")
+15 SET BGPPRD=$PIECE($$V(BGPRPT,45,19),"!",1)
SET BGPPRN=$PIECE($$V(BGPRPT,45,23),"!",1)
SET BGPPRP=$SELECT(BGPPRD:((BGPPRN/BGPPRD)*100),1:"")
+16 WRITE !!,"w/DRE or Rectal Exam",!?2,"recorded w/in 1 yr of",!?2,"end of time period"
+17 DO H2^BGPDPH
+18 IF $Y>(IOSL-5)
DO HEADER^BGPDPH
IF BGPQUIT
QUIT
WRITE !,"Colorectal Cancer Screening",!
DO H1^BGPDPH
+19 SET BGPCYD=$PIECE($$V(BGPRPT,15,19),"!",1)
SET BGPCYN=$PIECE($$V(BGPRPT,15,21),"!",1)
SET BGPCYP=$SELECT(BGPCYD:((BGPCYN/BGPCYD)*100),1:"")
+20 SET BGP98D=$PIECE($$V(BGPRPT,85,19),"!",1)
SET BGP98N=$PIECE($$V(BGPRPT,85,21),"!",1)
SET BGP98P=$SELECT(BGP98D:((BGP98N/BGP98D)*100),1:"")
+21 SET BGPPRD=$PIECE($$V(BGPRPT,45,19),"!",1)
SET BGPPRN=$PIECE($$V(BGPRPT,45,21),"!",1)
SET BGPPRP=$SELECT(BGPPRD:((BGPPRN/BGPPRD)*100),1:"")
+22 WRITE !!,"w/DRE & SIG test",!?2,"recorded w/in 5 yr of",!?2,"end of time period"
+23 DO H2^BGPDPH
+24 IF $Y>(IOSL-5)
DO HEADER^BGPDPH
IF BGPQUIT
QUIT
WRITE !,"Colorectal Cancer Screening",!
DO H1^BGPDPH
+25 SET BGPCYD=$PIECE($$V(BGPRPT,15,19),"!",1)
SET BGPCYN=$PIECE($$V(BGPRPT,15,22),"!",1)
SET BGPCYP=$SELECT(BGPCYD:((BGPCYN/BGPCYD)*100),1:"")
+26 SET BGP98D=$PIECE($$V(BGPRPT,85,19),"!",1)
SET BGP98N=$PIECE($$V(BGPRPT,85,22),"!",1)
SET BGP98P=$SELECT(BGP98D:((BGP98N/BGP98D)*100),1:"")
+27 SET BGPPRD=$PIECE($$V(BGPRPT,45,19),"!",1)
SET BGPPRN=$PIECE($$V(BGPRPT,45,22),"!",1)
SET BGPPRP=$SELECT(BGPPRD:((BGPPRN/BGPPRD)*100),1:"")
+28 WRITE !!,"w/DRE & Colonoscopy test",!?2,"recorded w/in 5 yr of",!?2,"end of time period"
+29 DO H2^BGPDPH
FEMALES ;
+1 DO HEADER^BGPDPH
IF BGPQUIT
QUIT
+2 WRITE !,"Indicator B: Reduce the Colorectal Cancer Rate."
+3 WRITE !,"Increase the proportion of AI/AN who have had screening and early detection.",!
+4 WRITE !,"Denominator is all FEMALE active patients over the age of 50.",!
+5 DO H1^BGPDPH
+6 SET BGPCYD=$PIECE($$V(BGPRPT,15,19),"!",2)
SET BGPCYN=$PIECE($$V(BGPRPT,15,20),"!",2)
SET BGPCYP=$SELECT(BGPCYD:((BGPCYN/BGPCYD)*100),1:"")
+7 SET BGP98D=$PIECE($$V(BGPRPT,85,19),"!",2)
SET BGP98N=$PIECE($$V(BGPRPT,85,20),"!",2)
SET BGP98P=$SELECT(BGP98D:((BGP98N/BGP98D)*100),1:"")
+8 SET BGPPRD=$PIECE($$V(BGPRPT,45,19),"!",2)
SET BGPPRN=$PIECE($$V(BGPRPT,45,20),"!",2)
SET BGPPRP=$SELECT(BGPPRD:((BGPPRN/BGPPRD)*100),1:"")
+9 WRITE !!!,"# FEMALES over 50 ",?22,$$C(BGP98D,0,8),?37,$$C(BGPPRD,0,8),?52,$$C(BGPCYD,0,8)
+10 WRITE !!,"w/FOB test",!?2,"recorded w/in 1 yr of",!?2,"end of time period"
+11 DO H2^BGPDPH
+12 IF $Y>(IOSL-5)
DO HEADER^BGPDPH
IF BGPQUIT
QUIT
WRITE !,"Colorectal Cancer Screening",!
DO H1^BGPDPH
+13 SET BGPCYD=$PIECE($$V(BGPRPT,15,19),"!",2)
SET BGPCYN=$PIECE($$V(BGPRPT,15,23),"!",2)
SET BGPCYP=$SELECT(BGPCYD:((BGPCYN/BGPCYD)*100),1:"")
+14 SET BGP98D=$PIECE($$V(BGPRPT,85,19),"!",2)
SET BGP98N=$PIECE($$V(BGPRPT,85,23),"!",2)
SET BGP98P=$SELECT(BGP98D:((BGP98N/BGP98D)*100),1:"")
+15 SET BGPPRD=$PIECE($$V(BGPRPT,45,19),"!",2)
SET BGPPRN=$PIECE($$V(BGPRPT,45,23),"!",2)
SET BGPPRP=$SELECT(BGPPRD:((BGPPRN/BGPPRD)*100),1:"")
+16 WRITE !!,"w/DRE or Rectal Exam",!?2,"recorded w/in 1 yr of",!?2,"end of time period"
+17 DO H2^BGPDPH
+18 IF $Y>(IOSL-5)
DO HEADER^BGPDPH
IF BGPQUIT
QUIT
WRITE !,"Colorectal Cancer Screening",!
DO H1^BGPDPH
+19 SET BGPCYD=$PIECE($$V(BGPRPT,15,19),"!",2)
SET BGPCYN=$PIECE($$V(BGPRPT,15,21),"!",2)
SET BGPCYP=$SELECT(BGPCYD:((BGPCYN/BGPCYD)*100),1:"")
+20 SET BGP98D=$PIECE($$V(BGPRPT,85,19),"!",2)
SET BGP98N=$PIECE($$V(BGPRPT,85,21),"!",2)
SET BGP98P=$SELECT(BGP98D:((BGP98N/BGP98D)*100),1:"")
+21 SET BGPPRD=$PIECE($$V(BGPRPT,45,19),"!",2)
SET BGPPRN=$PIECE($$V(BGPRPT,45,21),"!",2)
SET BGPPRP=$SELECT(BGPPRD:((BGPPRN/BGPPRD)*100),1:"")
+22 WRITE !!,"w/DRE & SIG test",!?2,"recorded w/in 5 yr of",!?2,"end of time period"
+23 DO H2^BGPDPH
+24 IF $Y>(IOSL-5)
DO HEADER^BGPDPH
IF BGPQUIT
QUIT
WRITE !,"Colorectal Cancer Screening",!
DO H1^BGPDPH
+25 SET BGPCYD=$PIECE($$V(BGPRPT,15,19),"!",2)
SET BGPCYN=$PIECE($$V(BGPRPT,15,22),"!",2)
SET BGPCYP=$SELECT(BGPCYD:((BGPCYN/BGPCYD)*100),1:"")
+26 SET BGP98D=$PIECE($$V(BGPRPT,85,19),"!",2)
SET BGP98N=$PIECE($$V(BGPRPT,85,22),"!",2)
SET BGP98P=$SELECT(BGP98D:((BGP98N/BGP98D)*100),1:"")
+27 SET BGPPRD=$PIECE($$V(BGPRPT,45,19),"!",2)
SET BGPPRN=$PIECE($$V(BGPRPT,45,22),"!",2)
SET BGPPRP=$SELECT(BGPPRD:((BGPPRN/BGPPRD)*100),1:"")
+28 WRITE !!,"w/DRE & Colonoscopy test",!?2,"recorded w/in 5 yr of",!?2,"end of time period"
+29 DO H2^BGPDPH
+30 QUIT
CALC(N,O) ;ENTRY POINT
+1 ;N is new
+2 ;O is old
+3 NEW Z
+4 IF O=0!(N=0)!(O="")!(N="")
QUIT "**"
+5 NEW X,X2,X3
+6 SET X=N
SET X2=1
SET X3=0
DO COMMA^%DTC
SET N=X
+7 SET X=O
SET X2=1
SET X3=0
DO COMMA^%DTC
SET O=X
+8 IF +O=0
QUIT "**"
+9 SET Z=(((N-O)/O)*100)
SET Z=$FNUMBER(Z,"+,",1)
+10 QUIT Z
H ;write header
+1 WRITE !?44,"% CHANGE",?62,"% CHANGE",!?44,"FROM BASE YR",?62,"FROM PREV YR"
+2 QUIT
V(R,N,P) ;
+1 NEW Y
+2 IF $GET(BGPAREAA)
IF '$GET(BGPSUMR)
GOTO VA
+3 QUIT $PIECE($GET(^BGPD(R,N)),U,P)
VA ;
+1 NEW X,C,V,MT,FT,M,F,B
SET X=0
SET C=""
FOR
SET X=$ORDER(BGPSUL(X))
IF X'=+X
QUIT
Begin DoDot:1
+2 SET V=$PIECE($GET(^BGPD(X,N)),U,P)
+3 IF C=""
SET C=V
QUIT
+4 SET MT=$PIECE(C,"!")
SET FT=$PIECE(C,"!",2)
SET M=$PIECE(V,"!")
SET F=$PIECE(V,"!",2)
+5 FOR B=1:1:6
SET $PIECE(MT,"~",B)=$PIECE(MT,"~",B)+$PIECE(M,"~",B)
+6 FOR B=1:1:6
SET $PIECE(FT,"~",B)=$PIECE(FT,"~",B)+$PIECE(F,"~",B)
+7 SET C=MT_"!"_FT
+8 QUIT
End DoDot:1
+9 QUIT C
C(X,X2,X3) ;
+1 DO COMMA^%DTC
+2 QUIT X
+3 ;
