BGPD7 ; IHS/CMI/LAB - indicator 7 ;
;;7.0;IHS CLINICAL REPORTING;;JAN 24, 2007
;
I7 ;EP ;EP - indicator 7
;Q:'$D(BGPIND(17))
Q:$P(^DPT(DFN,0),U,2)'="F"
Q:BGPAGEB<40
Q:BGPAGEB>69
D S(BGPRPT,$S(BGPTIME=1:15,BGPTIME=0:45,BGPTIME=8:85,1:999),8,1)
S BGPMAM=$$MAMMOG(DFN,BGPEDATE,2)
I $E(BGPMAM)="Y" D S(BGPRPT,$S(BGPTIME=1:15,BGPTIME=0:45,BGPTIME=8:85,1:999),9,1)
I $D(BGPLIST(17)),BGPTIME=1 S ^XTMP("BGPD",BGPJ,BGPH,"LIST",17,$S($P($G(^AUPNPAT(DFN,11)),U,18)]"":$P(^AUPNPAT(DFN,11),U,18),1:"UNKNOWN"),$P(^DPT(DFN,0),U,2),BGPAGEE,DFN)=BGPMAM
Q
S(R,N,P,V) ;
I 'V Q ;no value to add
S $P(^BGPD(R,N),U,P)=$P($G(^BGPD(R,N)),U,P)+V
Q
REFUSAL(P,F,I,B,E) ;EP
I '$G(P) Q ""
I '$G(F) Q ""
I '$G(I) Q ""
I $G(B)="" Q ""
I $G(E)="" Q ""
NEW G,X
S (X,G)=0 F S X=$O(^AUPNPREF("AA",P,F,I,X)) Q:X'=+X!(G) S Y=0 F S Y=$O(^AUPNPREF("AA",P,F,I,X,Y)) Q:Y'=+Y S D=$P(^AUPNPREF(Y,0),U,3) I D'<B&(D'>E) S G=1
Q G
MAMMOG(P,EDATE,YEARS) ;
NEW BGP,%,E,BDATE S BDATE=$$FMADD^XLFDT(EDATE,-(365*YEARS))
I '$G(P) Q ""
S %=P_"^LAST RAD 76091;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(%,"BGP(")
I $D(BGP(1)) Q "Yes "_$$FMTE^XLFDT($P(BGP(1),U))_" 76091"
K BGP S %=P_"^LAST RAD 76092;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(%,"BGP(")
I $D(BGP(1)) Q "Yes "_$$FMTE^XLFDT($P(BGP(1),U))_" 76092"
K BGP S %=P_"^LAST RAD 76090;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(%,"BGP(")
I $D(BGP(1)) Q "Yes "_$$FMTE^XLFDT($P(BGP(1),U))_" 76090"
K BGP S %=P_"^LAST DX V76.11;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(%,"BGP(")
I $D(BGP(1)) Q "Yes "_$$FMTE^XLFDT($P(BGP(1),U))_" V76.11"
K BGP S %=P_"^LAST DX V76.12;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(%,"BGP(")
I $D(BGP(1)) Q "Yes "_$$FMTE^XLFDT($P(BGP(1),U))_" V76.12"
K BGP S %=P_"^LAST PROCEDURE 87.37;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(%,"BGP(")
I $D(BGP(1)) Q "Yes "_$$FMTE^XLFDT($P(BGP(1),U))_" Pr 87.37"
K BGP S %=P_"^LAST PROCEDURE 87.36;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(%,"BGP(")
I $D(BGP(1)) Q "Yes "_$$FMTE^XLFDT($P(BGP(1),U))_" Pr 87.36"
S T=$O(^ATXAX("B","BGP CPT MAMMOGRAM",0))
I T D I X]"" Q "Yes "_$$FMTE^XLFDT(X)_" CPT"
.S X=$$CPT^BGPDU(P,,EDATE,T,3)
S T="MAMMOGRAM SCREENING",T=$O(^BWPN("B",T,0))
I T D I X]"" Q "Yes "_X_" WHTP"
.S X=$$WH^BGPDU(P,,EDATE,T,4)
S T="MAMMOGRAM DX BILAT",T=$O(^BWPN("B",T,0))
I T D I X]"" Q "Yes "_X_" WHTP"
.S X=$$WH^BGPDU(P,,EDATE,T,4)
S T="MAMMOGRAM DX UNILAT",T=$O(^BWPN("B",T,0))
I T D I X]"" Q "Yes "_X_" WHTP"
.S X=$$WH^BGPDU(P,,EDATE,T,4)
S T=$$REFUSAL(P,71,$O(^RAMIS(71,"D",76091,0)),$$FMADD^XLFDT(EDATE,-365),EDATE)
I T Q "Yes - Refused or NMI"
S T=$$REFUSAL(P,71,$O(^RAMIS(71,"D",76092,0)),$$FMADD^XLFDT(EDATE,-365),EDATE)
I T Q "Yes - Refused or NMI"
S T=$$REFUSAL(P,71,$O(^RAMIS(71,"D",76090,0)),$$FMADD^XLFDT(EDATE,-365),EDATE)
I T Q "Yes - Refused or NMI"
Q "No"
BGPD7 ; IHS/CMI/LAB - indicator 7 ;
+1 ;;7.0;IHS CLINICAL REPORTING;;JAN 24, 2007
+2 ;
I7 ;EP ;EP - indicator 7
+1 ;Q:'$D(BGPIND(17))
+2 IF $PIECE(^DPT(DFN,0),U,2)'="F"
QUIT
+3 IF BGPAGEB<40
QUIT
+4 IF BGPAGEB>69
QUIT
+5 DO S(BGPRPT,$SELECT(BGPTIME=1:15,BGPTIME=0:45,BGPTIME=8:85,1:999),8,1)
+6 SET BGPMAM=$$MAMMOG(DFN,BGPEDATE,2)
+7 IF $EXTRACT(BGPMAM)="Y"
DO S(BGPRPT,$SELECT(BGPTIME=1:15,BGPTIME=0:45,BGPTIME=8:85,1:999),9,1)
+8 IF $DATA(BGPLIST(17))
IF BGPTIME=1
SET ^XTMP("BGPD",BGPJ,BGPH,"LIST",17,$SELECT($PIECE($GET(^AUPNPAT(DFN,11)),U,18)]"":$PIECE(^AUPNPAT(DFN,11),U,18),1:"UNKNOWN"),$PIECE(^DPT(DFN,0),U,2),BGPAGEE,DFN)=BGPMAM
+9 QUIT
S(R,N,P,V) ;
+1 ;no value to add
IF 'V
QUIT
+2 SET $PIECE(^BGPD(R,N),U,P)=$PIECE($GET(^BGPD(R,N)),U,P)+V
+3 QUIT
REFUSAL(P,F,I,B,E) ;EP
+1 IF '$GET(P)
QUIT ""
+2 IF '$GET(F)
QUIT ""
+3 IF '$GET(I)
QUIT ""
+4 IF $GET(B)=""
QUIT ""
+5 IF $GET(E)=""
QUIT ""
+6 NEW G,X
+7 SET (X,G)=0
FOR
SET X=$ORDER(^AUPNPREF("AA",P,F,I,X))
IF X'=+X!(G)
QUIT
SET Y=0
FOR
SET Y=$ORDER(^AUPNPREF("AA",P,F,I,X,Y))
IF Y'=+Y
QUIT
SET D=$PIECE(^AUPNPREF(Y,0),U,3)
IF D'<B&(D'>E)
SET G=1
+8 QUIT G
MAMMOG(P,EDATE,YEARS) ;
+1 NEW BGP,%,E,BDATE
SET BDATE=$$FMADD^XLFDT(EDATE,-(365*YEARS))
+2 IF '$GET(P)
QUIT ""
+3 SET %=P_"^LAST RAD 76091;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(%,"BGP(")
+4 IF $DATA(BGP(1))
QUIT "Yes "_$$FMTE^XLFDT($PIECE(BGP(1),U))_" 76091"
+5 KILL BGP
SET %=P_"^LAST RAD 76092;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(%,"BGP(")
+6 IF $DATA(BGP(1))
QUIT "Yes "_$$FMTE^XLFDT($PIECE(BGP(1),U))_" 76092"
+7 KILL BGP
SET %=P_"^LAST RAD 76090;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(%,"BGP(")
+8 IF $DATA(BGP(1))
QUIT "Yes "_$$FMTE^XLFDT($PIECE(BGP(1),U))_" 76090"
+9 KILL BGP
SET %=P_"^LAST DX V76.11;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(%,"BGP(")
+10 IF $DATA(BGP(1))
QUIT "Yes "_$$FMTE^XLFDT($PIECE(BGP(1),U))_" V76.11"
+11 KILL BGP
SET %=P_"^LAST DX V76.12;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(%,"BGP(")
+12 IF $DATA(BGP(1))
QUIT "Yes "_$$FMTE^XLFDT($PIECE(BGP(1),U))_" V76.12"
+13 KILL BGP
SET %=P_"^LAST PROCEDURE 87.37;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(%,"BGP(")
+14 IF $DATA(BGP(1))
QUIT "Yes "_$$FMTE^XLFDT($PIECE(BGP(1),U))_" Pr 87.37"
+15 KILL BGP
SET %=P_"^LAST PROCEDURE 87.36;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(%,"BGP(")
+16 IF $DATA(BGP(1))
QUIT "Yes "_$$FMTE^XLFDT($PIECE(BGP(1),U))_" Pr 87.36"
+17 SET T=$ORDER(^ATXAX("B","BGP CPT MAMMOGRAM",0))
+18 IF T
Begin DoDot:1
+19 SET X=$$CPT^BGPDU(P,,EDATE,T,3)
End DoDot:1
IF X]""
QUIT "Yes "_$$FMTE^XLFDT(X)_" CPT"
+20 SET T="MAMMOGRAM SCREENING"
SET T=$ORDER(^BWPN("B",T,0))
+21 IF T
Begin DoDot:1
+22 SET X=$$WH^BGPDU(P,,EDATE,T,4)
End DoDot:1
IF X]""
QUIT "Yes "_X_" WHTP"
+23 SET T="MAMMOGRAM DX BILAT"
SET T=$ORDER(^BWPN("B",T,0))
+24 IF T
Begin DoDot:1
+25 SET X=$$WH^BGPDU(P,,EDATE,T,4)
End DoDot:1
IF X]""
QUIT "Yes "_X_" WHTP"
+26 SET T="MAMMOGRAM DX UNILAT"
SET T=$ORDER(^BWPN("B",T,0))
+27 IF T
Begin DoDot:1
+28 SET X=$$WH^BGPDU(P,,EDATE,T,4)
End DoDot:1
IF X]""
QUIT "Yes "_X_" WHTP"
+29 SET T=$$REFUSAL(P,71,$ORDER(^RAMIS(71,"D",76091,0)),$$FMADD^XLFDT(EDATE,-365),EDATE)
+30 IF T
QUIT "Yes - Refused or NMI"
+31 SET T=$$REFUSAL(P,71,$ORDER(^RAMIS(71,"D",76092,0)),$$FMADD^XLFDT(EDATE,-365),EDATE)
+32 IF T
QUIT "Yes - Refused or NMI"
+33 SET T=$$REFUSAL(P,71,$ORDER(^RAMIS(71,"D",76090,0)),$$FMADD^XLFDT(EDATE,-365),EDATE)
+34 IF T
QUIT "Yes - Refused or NMI"
+35 QUIT "No"
