BGPD6 ; IHS/CMI/LAB - indicator 6 ;
;;7.0;IHS CLINICAL REPORTING;;JAN 24, 2007
;
I6 ;EP ;EP - indicator 6
;Q:'$D(BGPIND(15))
Q:$P(^DPT(DFN,0),U,2)'="F"
Q:BGPAGEB<18
Q:BGPAGEB>70
Q:$$HYSTER(DFN,BGPEDATE)
D S(BGPRPT,$S(BGPTIME=1:15,BGPTIME=0:45,BGPTIME=8:85,1:999),5,1)
S BGPPAP=$$PAP(DFN,BGPEDATE,1)
I $E(BGPPAP)="Y" D S(BGPRPT,$S(BGPTIME=1:15,BGPTIME=0:45,BGPTIME=8:85,1:999),6,1)
I $D(BGPLIST(15)),BGPTIME=1 S ^XTMP("BGPD",BGPJ,BGPH,"LIST",15,$S($P($G(^AUPNPAT(DFN,11)),U,18)]"":$P(^AUPNPAT(DFN,11),U,18),1:"UNKNOWN"),$P(^DPT(DFN,0),U,2),BGPAGEE,DFN)=BGPPAP
Q
I6A ;EP
;Q:'$D(BGPIND(16))
Q:$P(^DPT(DFN,0),U,2)'="F"
Q:BGPAGEB<18
Q:BGPAGEB>70
Q:$$HYSTER(DFN,BGPEDATE)
S BGPPAP=$$PAP(DFN,BGPEDATE,3)
I $E(BGPPAP)="Y" D S(BGPRPT,$S(BGPTIME=1:15,BGPTIME=0:45,BGPTIME=8:85,1:999),7,1)
I $D(BGPLIST(16)),BGPTIME=1 S ^XTMP("BGPD",BGPJ,BGPH,"LIST",16,$S($P($G(^AUPNPAT(DFN,11)),U,18)]"":$P(^AUPNPAT(DFN,11),U,18),1:"UNKNOWN"),$P(^DPT(DFN,0),U,2),BGPAGEE,DFN)=BGPPAP
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
HYSTER(P,EDATE) ;EP has patient had hysterectomy?
I '$G(P) Q ""
I '$D(^AUPNVPRC("AC",P)) Q ""
NEW F,S,C,G S (F,S)=0 F S F=$O(^AUPNVPRC("AC",P,F)) Q:F'=+F!(S) S C=$P($$ICDOP^ICDCODE(+^AUPNVPRC(F,0)),U,2) D
.S G=0 S:C=68.3!(C=68.4)!(C=68.5)!(C=68.6)!(C=68.7)!(C=68.9) G=1
.Q:G=0
.S D=$P(^AUPNVPRC(F,0),U,6) I D="" S D=$P($P(^AUPNVSIT($P(^AUPNVPRC(F,0),U,3),0),U),".")
.I D>EDATE Q
.S S=1
Q S
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
PAP(P,EDATE,YEARS) ;
NEW BGP,%,E,BDATE S BDATE=$$FMADD^XLFDT(EDATE,-(365*YEARS)),%=P_"^LAST LAB PAP SMEAR;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(%,"BGP(")
I $D(BGP(1)) Q "Yes "_$$FMTE^XLFDT($P(BGP(1),U))
K BGP S %=P_"^LAST DX V76.2;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(%,"BGP(")
I $D(BGP(1)) Q "Yes "_$$FMTE^XLFDT($P(BGP(1),U))_" V76.2"
K BGP S %=P_"^LAST DX V72.3;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(%,"BGP(")
I $D(BGP(1)) Q "Yes "_$$FMTE^XLFDT($P(BGP(1),U))_" V72.3"
K BGP S %=P_"^LAST PROCEDURE 91.46;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(%,"BGP(")
I $D(BGP(1)) Q "Yes "_$$FMTE^XLFDT($P(BGP(1),U))_" 91.46"
S T=$O(^ATXAX("B","BGP CPT PAP",0))
I T D I X]"" Q "Yes "_X_" CPT"
.S X=$$CPT^BGPDU(P,,EDATE,T,4)
S T="PAP SMEAR",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,60,$O(^LAB(60,"B","PAP SMEAR",0)),$$FMADD^XLFDT(EDATE,-365),EDATE)
I T Q "Yes - Refused or NMI"
Q "No"
BGPD6 ; IHS/CMI/LAB - indicator 6 ;
+1 ;;7.0;IHS CLINICAL REPORTING;;JAN 24, 2007
+2 ;
I6 ;EP ;EP - indicator 6
+1 ;Q:'$D(BGPIND(15))
+2 IF $PIECE(^DPT(DFN,0),U,2)'="F"
QUIT
+3 IF BGPAGEB<18
QUIT
+4 IF BGPAGEB>70
QUIT
+5 IF $$HYSTER(DFN,BGPEDATE)
QUIT
+6 DO S(BGPRPT,$SELECT(BGPTIME=1:15,BGPTIME=0:45,BGPTIME=8:85,1:999),5,1)
+7 SET BGPPAP=$$PAP(DFN,BGPEDATE,1)
+8 IF $EXTRACT(BGPPAP)="Y"
DO S(BGPRPT,$SELECT(BGPTIME=1:15,BGPTIME=0:45,BGPTIME=8:85,1:999),6,1)
+9 IF $DATA(BGPLIST(15))
IF BGPTIME=1
SET ^XTMP("BGPD",BGPJ,BGPH,"LIST",15,$SELECT($PIECE($GET(^AUPNPAT(DFN,11)),U,18)]"":$PIECE(^AUPNPAT(DFN,11),U,18),1:"UNKNOWN"),$PIECE(^DPT(DFN,0),U,2),BGPAGEE,DFN)=BGPPAP
+10 QUIT
I6A ;EP
+1 ;Q:'$D(BGPIND(16))
+2 IF $PIECE(^DPT(DFN,0),U,2)'="F"
QUIT
+3 IF BGPAGEB<18
QUIT
+4 IF BGPAGEB>70
QUIT
+5 IF $$HYSTER(DFN,BGPEDATE)
QUIT
+6 SET BGPPAP=$$PAP(DFN,BGPEDATE,3)
+7 IF $EXTRACT(BGPPAP)="Y"
DO S(BGPRPT,$SELECT(BGPTIME=1:15,BGPTIME=0:45,BGPTIME=8:85,1:999),7,1)
+8 IF $DATA(BGPLIST(16))
IF BGPTIME=1
SET ^XTMP("BGPD",BGPJ,BGPH,"LIST",16,$SELECT($PIECE($GET(^AUPNPAT(DFN,11)),U,18)]"":$PIECE(^AUPNPAT(DFN,11),U,18),1:"UNKNOWN"),$PIECE(^DPT(DFN,0),U,2),BGPAGEE,DFN)=BGPPAP
+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
HYSTER(P,EDATE) ;EP has patient had hysterectomy?
+1 IF '$GET(P)
QUIT ""
+2 IF '$DATA(^AUPNVPRC("AC",P))
QUIT ""
+3 NEW F,S,C,G
SET (F,S)=0
FOR
SET F=$ORDER(^AUPNVPRC("AC",P,F))
IF F'=+F!(S)
QUIT
SET C=$PIECE($$ICDOP^ICDCODE(+^AUPNVPRC(F,0)),U,2)
Begin DoDot:1
+4 SET G=0
IF C=68.3!(C=68.4)!(C=68.5)!(C=68.6)!(C=68.7)!(C=68.9)
SET G=1
+5 IF G=0
QUIT
+6 SET D=$PIECE(^AUPNVPRC(F,0),U,6)
IF D=""
SET D=$PIECE($PIECE(^AUPNVSIT($PIECE(^AUPNVPRC(F,0),U,3),0),U),".")
+7 IF D>EDATE
QUIT
+8 SET S=1
End DoDot:1
+9 QUIT S
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
PAP(P,EDATE,YEARS) ;
+1 NEW BGP,%,E,BDATE
SET BDATE=$$FMADD^XLFDT(EDATE,-(365*YEARS))
SET %=P_"^LAST LAB PAP SMEAR;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(%,"BGP(")
+2 IF $DATA(BGP(1))
QUIT "Yes "_$$FMTE^XLFDT($PIECE(BGP(1),U))
+3 KILL BGP
SET %=P_"^LAST DX V76.2;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))_" V76.2"
+5 KILL BGP
SET %=P_"^LAST DX V72.3;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))_" V72.3"
+7 KILL BGP
SET %=P_"^LAST PROCEDURE 91.46;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))_" 91.46"
+9 SET T=$ORDER(^ATXAX("B","BGP CPT PAP",0))
+10 IF T
Begin DoDot:1
+11 SET X=$$CPT^BGPDU(P,,EDATE,T,4)
End DoDot:1
IF X]""
QUIT "Yes "_X_" CPT"
+12 SET T="PAP SMEAR"
SET T=$ORDER(^BWPN("B",T,0))
+13 IF T
Begin DoDot:1
+14 SET X=$$WH^BGPDU(P,,EDATE,T,4)
End DoDot:1
IF X]""
QUIT "Yes "_X_" WHTP"
+15 SET T=$$REFUSAL(P,60,$ORDER(^LAB(60,"B","PAP SMEAR",0)),$$FMADD^XLFDT(EDATE,-365),EDATE)
+16 IF T
QUIT "Yes - Refused or NMI"
+17 QUIT "No"
