BGP1D211 ; IHS/CMI/LAB - measure 6 ;
;;11.1;IHS CLINICAL REPORTING SYSTEM;;JUN 27, 2011;Build 33
;
DNKA(V) ;EP
NEW D,N
S D=$$PRIMPOV^APCLV(V,"C")
I D=".0860" Q 1
S N=$$PRIMPOV^APCLV(V,"N")
I $E(D)="V",N["DNKA" Q 1
I $E(D)="V",N["DID NOT KEEP APPOINTMENT" Q 1
I $E(D)="V",N["DID NOT KEEP APPT" Q 1
Q 0
GFR(P,BDATE,EDATE) ;EP
S BGPC=""
S T=$O(^LAB(60,"B","ESTIMATED GFR",0))
S T1=$O(^ATXLAB("B","BGP GPRA ESTIMATED GFR TAX",0))
S T2=$O(^ATXAX("B","BGP ESTIMATED GFR LOINC",0))
S B=9999999-BDATE,E=9999999-EDATE S D=E-1 F S D=$O(^AUPNVLAB("AE",P,D)) Q:D'=+D!(D>B)!(BGPC]"") D
.S L=0 F S L=$O(^AUPNVLAB("AE",P,D,L)) Q:L'=+L!(BGPC]"") D
..S X=0 F S X=$O(^AUPNVLAB("AE",P,D,L,X)) Q:X'=+X!(BGPC]"") D
...Q:'$D(^AUPNVLAB(X,0))
...Q:$P(^AUPNVLAB(X,0),U,4)=""
...I T,$P(^AUPNVLAB(X,0),U)=T S BGPC=1_U_(9999999-D) Q
...I T1,$D(^ATXLAB(T1,21,"B",$P(^AUPNVLAB(X,0),U))) S BGPC=1_U_(9999999-D) Q
...Q:'T2
...S J=$P($G(^AUPNVLAB(X,11)),U,13) Q:J=""
...Q:'$$LOINC(J,T2)
...S BGPC=1_U_(9999999-D)
...Q
Q BGPC
QUANTUP(P,BDATE,EDATE) ;EP
K BGPC,BGPX,BGP1
S BGPC="",BGPLC=""
K BGPG S %=P_"^LAST LAB [BGP QUANT URINE PROTEIN;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(%,"BGPG(")
I $D(BGPG(1)) S BGPLC=1_"^"_$P(BGPG(1),U,3)_"^"_$P(BGPG(1),U)
S T=$O(^ATXAX("B","BGP QUANT URINE PROT LOINC",0))
S B=9999999-BDATE,E=9999999-EDATE S D=E-1 F S D=$O(^AUPNVLAB("AE",P,D)) Q:D'=+D!(D>B)!(BGPC]"") D
.S L=0 F S L=$O(^AUPNVLAB("AE",P,D,L)) Q:L'=+L!(BGPC]"") D
..S X=0 F S X=$O(^AUPNVLAB("AE",P,D,L,X)) Q:X'=+X!(BGPC]"") D
...Q:'T
...S J=$P($G(^AUPNVLAB(X,11)),U,13) Q:J=""
...Q:'$$LOINC(J,T)
...S %=$$VAL^XBDIQ1(9000010.09,X,.01) ;$P(^AUPNVLAB(X,0),U,4)
...I $P(BGPLC,U,3)<(9999999-D) S BGPLC=1_U_%_U_(9999999-D)
S %="",E=+$$CODEN^ICPTCOD(82043),%=$$CPTI^BGP1DU(P,BDATE,EDATE,E)
I %]"",$P(BGPLC,U,3)<$P(%,U,2) S BGPLC="1^CPT 82043^"_$P(%,U,2)
S %="",E=+$$CODEN^ICPTCOD(82042),%=$$CPTI^BGP1DU(P,BDATE,EDATE,E)
I %]"",$P(BGPLC,U,3)<$P(%,U,2) S BGPLC="1^CPT 82042^"_$P(%,U,2)
S %="",E=+$$CODEN^ICPTCOD(84156),%=$$CPTI^BGP1DU(P,BDATE,EDATE,E)
I %]"",$P(BGPLC,U,3)<$P(%,U,2) S BGPLC="1^CPT 84156^"_$P(%,U,2)
S %="",E=+$$CODEN^ICPTCOD(82043),%=$$TRANI^BGP1DU(P,BDATE,EDATE,E)
I %]"",$P(BGPLC,U,3)<$P(%,U,2) S BGPLC="1^CPT 84023^"_$P(%,U,2)
S %="",E=+$$CODEN^ICPTCOD(82042),%=$$TRANI^BGP1DU(P,BDATE,EDATE,E)
I %]"",$P(BGPLC,U,3)<$P(%,U,2) S BGPLC="1^CPT 82042^"_$P(%,U,2)
S %="",E=+$$CODEN^ICPTCOD(84156),%=$$TRANI^BGP1DU(P,BDATE,EDATE,E)
I %]"",$P(BGPLC,U,3)<$P(%,U,2) S BGPLC="1^CPT 84156^"_$P(%,U,2)
Q BGPLC
LOINC(A,B) ;EP
NEW %
S %=$P($G(^LAB(95.3,A,9999999)),U,2)
I %]"",$D(^ATXAX(B,21,"B",%)) Q 1
S %=$P($G(^LAB(95.3,A,0)),U)_"-"_$P($G(^LAB(95.3,A,0)),U,15)
I $D(^ATXAX(B,21,"B",%)) Q 1
Q ""
ESRD(P,BDATE,EDATE) ;EP
;K BGPG S %=P_"^LAST DX 585.5;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(%,"BGPG(")
;I $D(BGPG(1)) Q "1^ESRD 585.5^"_$P(BGPG(1),U)
;K BGPG S %=P_"^LAST DX 585.6;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(%,"BGPG(")
;I $D(BGPG(1)) Q "1^ESRD 585.6^"_$P(BGPG(1),U)
;K BGPG S %=P_"^LAST DX V45.1;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(%,"BGPG(")
;I $D(BGPG(1)) Q "1^ESRD V45.1^"_$P(BGPG(1),U)
S X=$$LASTDX^BGP1UTL1(P,"BGP ESRD PMS DXS",BDATE,EDATE)
I X Q 1_U_$P(X,U,2)_U_$P(X,U,3)
S T=$O(^ATXAX("B","BGP ESRD CPTS",0))
I T D I X]"" Q 1_U_$P(X,U,2)_U_$P(X,U,1)
.S X=$$CPT^BGP1DU(P,$$DOB^AUPNPAT(P),EDATE,T,5) I X]"" Q
.S X=$$TRAN^BGP1DU(P,$$DOB^AUPNPAT(P),EDATE,T,5)
S X=$$LASTPRC^BGP1UTL1(P,"BGP ESRD PROCS",BDATE,EDATE)
I X Q 1_U_$P(X,U,2)_U_$P(X,U,3)
Q 0
IGOAL ;EP
I '$D(^AUPNVPED("AC",DFN)) S BGPSTOP=1 ;no education so don't bother
I 'BGPACTUP S BGPSTOP=1 Q ;no user pop
S (BGPD1,BGPN1,BGPN2)=0
NEW BGPALLED,BGPEDPRV S BGPVALUE=""
NEW BGPPROVS,BGPFYCT,Y,X,D,G,T,BGPLEVEL,R,BGPEDD
S BGPFYCT=$O(^BGPCTRL("B",2011,0))
S Y="BGPALLED("
S X=DFN_"^ALL EDUC;DURING "_$$FMTE^XLFDT(BGPBDATE)_"-"_$$FMTE^XLFDT(BGPEDATE) S E=$$START1^APCLDF(X,Y)
I '$D(BGPALLED(1)) Q
S (X,D,G)=0,%="",T="" F S X=$O(BGPALLED(X)) Q:X'=+X D
.S Y=+$P(BGPALLED(X),U,4)
.S T=$P(^AUPNVPED(+$P(BGPALLED(X),U,4),0),U)
.Q:'T
.Q:'$D(^AUTTEDT(T,0))
.S T=$P(^AUTTEDT(T,0),U,2)
.I T="" Q
.Q:'$$EDUALLOW^BGP1DPE1(BGPFYCT,T)
.S G=1
.S BGPLEVEL=$P(^AUPNVPED(Y,0),U,13)
.Q:BGPLEVEL=""
.S BGPPROVS(BGPLEVEL)=$G(BGPPROVS(BGPLEVEL))+1,$P(BGPEDD(BGPLEVEL),U,BGPPROVS(BGPLEVEL))=$P(BGPALLED(X),U,1) ;count up
.;get provider
.S R="",R=$P(^AUPNVPED(Y,0),U,5) D
..Q:R]""
..S R=$P($G(^AUPNVPED(Y,12)),U,4)
..Q:R]""
..S R=$P($G(^AUPNVPED(Y,12)),U,2)
..Q:R]""
..S R=$$PRIMPROV^APCLV($P(^AUPNVPED(Y,0),U,3),"I")
.I R D
..S D=$$VALI^XBDIQ1(200,R,53.5)
..S D=$S(D:$$VAL^XBDIQ1(7,D,9999999.01),1:"")
..I D="" S D="??"
..S BGPPROVS(BGPLEVEL,"PROVS")=$G(BGPPROVS(BGPLEVEL,"PROVS"))_U_D
S BGPVALUE=""
I 'G S BGPD1=0,BGPN1=0,BGPN2=0 Q ;no allowable topics so not in denominator
S BGPD1=1 ;in denominator
I '$D(BGPPROVS) S BGPN1=0
I $G(BGPPROVS("GS")) S BGPVALUE="GS: ",BGPN1=1 F X=1:1 S Y=$P(BGPEDD("GS"),U,X) Q:Y="" S BGPVALUE=BGPVALUE_$S(X=1:"",1:", ") S BGPVALUE=BGPVALUE_$$DATE^BGP1UTL(Y)
;I $G(BGPPROVS("GNS")),'$G(BGPPROVS("GS")) S BGPVALUE=BGPVALUE_$S(BGPVALUE]"":", ",1:"")_"GNS"_$G(BGPPROVS("GNS","PROVS"))
I $G(BGPPROVS("GM")) S BGPVALUE=BGPVALUE_$S(BGPVALUE]"":", GM: ",1:"GM: "),BGPN2=1 F X=1:1 S Y=$P(BGPEDD("GM"),U,X) Q:Y="" S BGPVALUE=BGPVALUE_$S(X=1:"",1:", ") S BGPVALUE=BGPVALUE_$$DATE^BGP1UTL(Y)
;I $G(BGPPROVS("GNM")),'$G(BGPPROVS("GM")) S BGPVALUE=BGPVALUE_$S(BGPVALUE]"":", ",1:"")_"GNM"_$G(BGPPROVS("GNM","PROVS"))
S BGPVALUE="UP w/Educ|||"_BGPVALUE
Q
;
AWV ;EP
S (BGPD1,BGPD2,BGPD3,BGPD4,BGPD5,BGPD6,BGPN1)=0
S BGPVALUE=""
I 'BGPACTCL S BGPSTOP=1 Q ;not active clinical
I BGPAGEB<65 S BGPSTOP=1 Q ;not over 65
S BGPD1=1
I $P(^DPT(DFN,0),U,2)="M" S BGPD2=1
I $P(^DPT(DFN,0),U,2)="F" S BGPD3=1
I BGPAGEB>64,BGPAGEB<75 S BGPD4=1
I BGPAGEB>74,BGPAGEB<85 S BGPD5=1
I BGPAGEB>84 S BGPD6=1
S BGPVAL=$$AWV1(DFN,$$FMADD^XLFDT(BGPEDATE,-(15*30.5)),BGPEDATE) ;return #visits^list string
S BGPN1=$P(BGPVAL,U)
S BGPVALUE="AC >65|||"_$$DATE^BGP1UTL($P(BGPVAL,U,2))_" "_$P(BGPVAL,U,3)
K BGPVAL
Q
;
AWV1(P,BDATE,EDATE) ;EP
NEW T,X
S T=$O(^ATXAX("B","BGP ANNUAL WELLNESS CPTS",0))
I 'T Q ""
S X=$$CPT^BGP1DU(P,BDATE,EDATE,T,6)
I 'X S X=$$TRAN^BGP1DU(P,BDATE,EDATE,T,6)
Q X
BGP1D211 ; IHS/CMI/LAB - measure 6 ;
+1 ;;11.1;IHS CLINICAL REPORTING SYSTEM;;JUN 27, 2011;Build 33
+2 ;
DNKA(V) ;EP
+1 NEW D,N
+2 SET D=$$PRIMPOV^APCLV(V,"C")
+3 IF D=".0860"
QUIT 1
+4 SET N=$$PRIMPOV^APCLV(V,"N")
+5 IF $EXTRACT(D)="V"
IF N["DNKA"
QUIT 1
+6 IF $EXTRACT(D)="V"
IF N["DID NOT KEEP APPOINTMENT"
QUIT 1
+7 IF $EXTRACT(D)="V"
IF N["DID NOT KEEP APPT"
QUIT 1
+8 QUIT 0
GFR(P,BDATE,EDATE) ;EP
+1 SET BGPC=""
+2 SET T=$ORDER(^LAB(60,"B","ESTIMATED GFR",0))
+3 SET T1=$ORDER(^ATXLAB("B","BGP GPRA ESTIMATED GFR TAX",0))
+4 SET T2=$ORDER(^ATXAX("B","BGP ESTIMATED GFR LOINC",0))
+5 SET B=9999999-BDATE
SET E=9999999-EDATE
SET D=E-1
FOR
SET D=$ORDER(^AUPNVLAB("AE",P,D))
IF D'=+D!(D>B)!(BGPC]"")
QUIT
Begin DoDot:1
+6 SET L=0
FOR
SET L=$ORDER(^AUPNVLAB("AE",P,D,L))
IF L'=+L!(BGPC]"")
QUIT
Begin DoDot:2
+7 SET X=0
FOR
SET X=$ORDER(^AUPNVLAB("AE",P,D,L,X))
IF X'=+X!(BGPC]"")
QUIT
Begin DoDot:3
+8 IF '$DATA(^AUPNVLAB(X,0))
QUIT
+9 IF $PIECE(^AUPNVLAB(X,0),U,4)=""
QUIT
+10 IF T
IF $PIECE(^AUPNVLAB(X,0),U)=T
SET BGPC=1_U_(9999999-D)
QUIT
+11 IF T1
IF $DATA(^ATXLAB(T1,21,"B",$PIECE(^AUPNVLAB(X,0),U)))
SET BGPC=1_U_(9999999-D)
QUIT
+12 IF 'T2
QUIT
+13 SET J=$PIECE($GET(^AUPNVLAB(X,11)),U,13)
IF J=""
QUIT
+14 IF '$$LOINC(J,T2)
QUIT
+15 SET BGPC=1_U_(9999999-D)
+16 QUIT
End DoDot:3
End DoDot:2
End DoDot:1
+17 QUIT BGPC
QUANTUP(P,BDATE,EDATE) ;EP
+1 KILL BGPC,BGPX,BGP1
+2 SET BGPC=""
SET BGPLC=""
+3 KILL BGPG
SET %=P_"^LAST LAB [BGP QUANT URINE PROTEIN;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(%,"BGPG(")
+4 IF $DATA(BGPG(1))
SET BGPLC=1_"^"_$PIECE(BGPG(1),U,3)_"^"_$PIECE(BGPG(1),U)
+5 SET T=$ORDER(^ATXAX("B","BGP QUANT URINE PROT LOINC",0))
+6 SET B=9999999-BDATE
SET E=9999999-EDATE
SET D=E-1
FOR
SET D=$ORDER(^AUPNVLAB("AE",P,D))
IF D'=+D!(D>B)!(BGPC]"")
QUIT
Begin DoDot:1
+7 SET L=0
FOR
SET L=$ORDER(^AUPNVLAB("AE",P,D,L))
IF L'=+L!(BGPC]"")
QUIT
Begin DoDot:2
+8 SET X=0
FOR
SET X=$ORDER(^AUPNVLAB("AE",P,D,L,X))
IF X'=+X!(BGPC]"")
QUIT
Begin DoDot:3
+9 IF 'T
QUIT
+10 SET J=$PIECE($GET(^AUPNVLAB(X,11)),U,13)
IF J=""
QUIT
+11 IF '$$LOINC(J,T)
QUIT
+12 ;$P(^AUPNVLAB(X,0),U,4)
SET %=$$VAL^XBDIQ1(9000010.09,X,.01)
+13 IF $PIECE(BGPLC,U,3)<(9999999-D)
SET BGPLC=1_U_%_U_(9999999-D)
End DoDot:3
End DoDot:2
End DoDot:1
+14 SET %=""
SET E=+$$CODEN^ICPTCOD(82043)
SET %=$$CPTI^BGP1DU(P,BDATE,EDATE,E)
+15 IF %]""
IF $PIECE(BGPLC,U,3)<$PIECE(%,U,2)
SET BGPLC="1^CPT 82043^"_$PIECE(%,U,2)
+16 SET %=""
SET E=+$$CODEN^ICPTCOD(82042)
SET %=$$CPTI^BGP1DU(P,BDATE,EDATE,E)
+17 IF %]""
IF $PIECE(BGPLC,U,3)<$PIECE(%,U,2)
SET BGPLC="1^CPT 82042^"_$PIECE(%,U,2)
+18 SET %=""
SET E=+$$CODEN^ICPTCOD(84156)
SET %=$$CPTI^BGP1DU(P,BDATE,EDATE,E)
+19 IF %]""
IF $PIECE(BGPLC,U,3)<$PIECE(%,U,2)
SET BGPLC="1^CPT 84156^"_$PIECE(%,U,2)
+20 SET %=""
SET E=+$$CODEN^ICPTCOD(82043)
SET %=$$TRANI^BGP1DU(P,BDATE,EDATE,E)
+21 IF %]""
IF $PIECE(BGPLC,U,3)<$PIECE(%,U,2)
SET BGPLC="1^CPT 84023^"_$PIECE(%,U,2)
+22 SET %=""
SET E=+$$CODEN^ICPTCOD(82042)
SET %=$$TRANI^BGP1DU(P,BDATE,EDATE,E)
+23 IF %]""
IF $PIECE(BGPLC,U,3)<$PIECE(%,U,2)
SET BGPLC="1^CPT 82042^"_$PIECE(%,U,2)
+24 SET %=""
SET E=+$$CODEN^ICPTCOD(84156)
SET %=$$TRANI^BGP1DU(P,BDATE,EDATE,E)
+25 IF %]""
IF $PIECE(BGPLC,U,3)<$PIECE(%,U,2)
SET BGPLC="1^CPT 84156^"_$PIECE(%,U,2)
+26 QUIT BGPLC
LOINC(A,B) ;EP
+1 NEW %
+2 SET %=$PIECE($GET(^LAB(95.3,A,9999999)),U,2)
+3 IF %]""
IF $DATA(^ATXAX(B,21,"B",%))
QUIT 1
+4 SET %=$PIECE($GET(^LAB(95.3,A,0)),U)_"-"_$PIECE($GET(^LAB(95.3,A,0)),U,15)
+5 IF $DATA(^ATXAX(B,21,"B",%))
QUIT 1
+6 QUIT ""
ESRD(P,BDATE,EDATE) ;EP
+1 ;K BGPG S %=P_"^LAST DX 585.5;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(%,"BGPG(")
+2 ;I $D(BGPG(1)) Q "1^ESRD 585.5^"_$P(BGPG(1),U)
+3 ;K BGPG S %=P_"^LAST DX 585.6;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(%,"BGPG(")
+4 ;I $D(BGPG(1)) Q "1^ESRD 585.6^"_$P(BGPG(1),U)
+5 ;K BGPG S %=P_"^LAST DX V45.1;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(%,"BGPG(")
+6 ;I $D(BGPG(1)) Q "1^ESRD V45.1^"_$P(BGPG(1),U)
+7 SET X=$$LASTDX^BGP1UTL1(P,"BGP ESRD PMS DXS",BDATE,EDATE)
+8 IF X
QUIT 1_U_$PIECE(X,U,2)_U_$PIECE(X,U,3)
+9 SET T=$ORDER(^ATXAX("B","BGP ESRD CPTS",0))
+10 IF T
Begin DoDot:1
+11 SET X=$$CPT^BGP1DU(P,$$DOB^AUPNPAT(P),EDATE,T,5)
IF X]""
QUIT
+12 SET X=$$TRAN^BGP1DU(P,$$DOB^AUPNPAT(P),EDATE,T,5)
End DoDot:1
IF X]""
QUIT 1_U_$PIECE(X,U,2)_U_$PIECE(X,U,1)
+13 SET X=$$LASTPRC^BGP1UTL1(P,"BGP ESRD PROCS",BDATE,EDATE)
+14 IF X
QUIT 1_U_$PIECE(X,U,2)_U_$PIECE(X,U,3)
+15 QUIT 0
IGOAL ;EP
+1 ;no education so don't bother
IF '$DATA(^AUPNVPED("AC",DFN))
SET BGPSTOP=1
+2 ;no user pop
IF 'BGPACTUP
SET BGPSTOP=1
QUIT
+3 SET (BGPD1,BGPN1,BGPN2)=0
+4 NEW BGPALLED,BGPEDPRV
SET BGPVALUE=""
+5 NEW BGPPROVS,BGPFYCT,Y,X,D,G,T,BGPLEVEL,R,BGPEDD
+6 SET BGPFYCT=$ORDER(^BGPCTRL("B",2011,0))
+7 SET Y="BGPALLED("
+8 SET X=DFN_"^ALL EDUC;DURING "_$$FMTE^XLFDT(BGPBDATE)_"-"_$$FMTE^XLFDT(BGPEDATE)
SET E=$$START1^APCLDF(X,Y)
+9 IF '$DATA(BGPALLED(1))
QUIT
+10 SET (X,D,G)=0
SET %=""
SET T=""
FOR
SET X=$ORDER(BGPALLED(X))
IF X'=+X
QUIT
Begin DoDot:1
+11 SET Y=+$PIECE(BGPALLED(X),U,4)
+12 SET T=$PIECE(^AUPNVPED(+$PIECE(BGPALLED(X),U,4),0),U)
+13 IF 'T
QUIT
+14 IF '$DATA(^AUTTEDT(T,0))
QUIT
+15 SET T=$PIECE(^AUTTEDT(T,0),U,2)
+16 IF T=""
QUIT
+17 IF '$$EDUALLOW^BGP1DPE1(BGPFYCT,T)
QUIT
+18 SET G=1
+19 SET BGPLEVEL=$PIECE(^AUPNVPED(Y,0),U,13)
+20 IF BGPLEVEL=""
QUIT
+21 ;count up
SET BGPPROVS(BGPLEVEL)=$GET(BGPPROVS(BGPLEVEL))+1
SET $PIECE(BGPEDD(BGPLEVEL),U,BGPPROVS(BGPLEVEL))=$PIECE(BGPALLED(X),U,1)
+22 ;get provider
+23 SET R=""
SET R=$PIECE(^AUPNVPED(Y,0),U,5)
Begin DoDot:2
+24 IF R]""
QUIT
+25 SET R=$PIECE($GET(^AUPNVPED(Y,12)),U,4)
+26 IF R]""
QUIT
+27 SET R=$PIECE($GET(^AUPNVPED(Y,12)),U,2)
+28 IF R]""
QUIT
+29 SET R=$$PRIMPROV^APCLV($PIECE(^AUPNVPED(Y,0),U,3),"I")
End DoDot:2
+30 IF R
Begin DoDot:2
+31 SET D=$$VALI^XBDIQ1(200,R,53.5)
+32 SET D=$SELECT(D:$$VAL^XBDIQ1(7,D,9999999.01),1:"")
+33 IF D=""
SET D="??"
+34 SET BGPPROVS(BGPLEVEL,"PROVS")=$GET(BGPPROVS(BGPLEVEL,"PROVS"))_U_D
End DoDot:2
End DoDot:1
+35 SET BGPVALUE=""
+36 ;no allowable topics so not in denominator
IF 'G
SET BGPD1=0
SET BGPN1=0
SET BGPN2=0
QUIT
+37 ;in denominator
SET BGPD1=1
+38 IF '$DATA(BGPPROVS)
SET BGPN1=0
+39 IF $GET(BGPPROVS("GS"))
SET BGPVALUE="GS: "
SET BGPN1=1
FOR X=1:1
SET Y=$PIECE(BGPEDD("GS"),U,X)
IF Y=""
QUIT
SET BGPVALUE=BGPVALUE_$SELECT(X=1:"",1:", ")
SET BGPVALUE=BGPVALUE_$$DATE^BGP1UTL(Y)
+40 ;I $G(BGPPROVS("GNS")),'$G(BGPPROVS("GS")) S BGPVALUE=BGPVALUE_$S(BGPVALUE]"":", ",1:"")_"GNS"_$G(BGPPROVS("GNS","PROVS"))
+41 IF $GET(BGPPROVS("GM"))
SET BGPVALUE=BGPVALUE_$SELECT(BGPVALUE]"":", GM: ",1:"GM: ")
SET BGPN2=1
FOR X=1:1
SET Y=$PIECE(BGPEDD("GM"),U,X)
IF Y=""
QUIT
SET BGPVALUE=BGPVALUE_$SELECT(X=1:"",1:", ")
SET BGPVALUE=BGPVALUE_$$DATE^BGP1UTL(Y)
+42 ;I $G(BGPPROVS("GNM")),'$G(BGPPROVS("GM")) S BGPVALUE=BGPVALUE_$S(BGPVALUE]"":", ",1:"")_"GNM"_$G(BGPPROVS("GNM","PROVS"))
+43 SET BGPVALUE="UP w/Educ|||"_BGPVALUE
+44 QUIT
+45 ;
AWV ;EP
+1 SET (BGPD1,BGPD2,BGPD3,BGPD4,BGPD5,BGPD6,BGPN1)=0
+2 SET BGPVALUE=""
+3 ;not active clinical
IF 'BGPACTCL
SET BGPSTOP=1
QUIT
+4 ;not over 65
IF BGPAGEB<65
SET BGPSTOP=1
QUIT
+5 SET BGPD1=1
+6 IF $PIECE(^DPT(DFN,0),U,2)="M"
SET BGPD2=1
+7 IF $PIECE(^DPT(DFN,0),U,2)="F"
SET BGPD3=1
+8 IF BGPAGEB>64
IF BGPAGEB<75
SET BGPD4=1
+9 IF BGPAGEB>74
IF BGPAGEB<85
SET BGPD5=1
+10 IF BGPAGEB>84
SET BGPD6=1
+11 ;return #visits^list string
SET BGPVAL=$$AWV1(DFN,$$FMADD^XLFDT(BGPEDATE,-(15*30.5)),BGPEDATE)
+12 SET BGPN1=$PIECE(BGPVAL,U)
+13 SET BGPVALUE="AC >65|||"_$$DATE^BGP1UTL($PIECE(BGPVAL,U,2))_" "_$PIECE(BGPVAL,U,3)
+14 KILL BGPVAL
+15 QUIT
+16 ;
AWV1(P,BDATE,EDATE) ;EP
+1 NEW T,X
+2 SET T=$ORDER(^ATXAX("B","BGP ANNUAL WELLNESS CPTS",0))
+3 IF 'T
QUIT ""
+4 SET X=$$CPT^BGP1DU(P,BDATE,EDATE,T,6)
+5 IF 'X
SET X=$$TRAN^BGP1DU(P,BDATE,EDATE,T,6)
+6 QUIT X
