- 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"
