- BGP1DPA4 ; IHS/CMI/LAB - COMP NATIONAL GPRA FOR PTS W/APPT 01 Oct 2009 2:53 PM ;
- ;;11.1;IHS CLINICAL REPORTING SYSTEM;;JUN 27, 2011;Build 33
- ;
- EYE(P,BDATE,EDATE,FORECAST) ;EP
- S BGPLEYE=""
- S FORECAST=$G(FORECAST)
- K BGPG S %=P_"^LAST EXAM DIABETIC EYE EXAM;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(%,"BGPG(")
- I $D(BGPG(1)) S BGPLEYE="1^"_$P(BGPG(1),U)_"^Diab Eye Ex"
- K ^TMP($J,"A")
- S A="^TMP($J,""A"","
- S %=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(%,A)
- S X=0,Y=0 F S X=$O(^TMP($J,"A",X)) Q:X'=+X!(Y) S R=$$CLINIC^APCLV($P(^TMP($J,"A",X),U,5),"C") I R="A2",'$$DNKA^BGP1D21($P(^TMP($J,"A",X),U,5)) S Y=1,D=$P(^TMP($J,"A",X),U)
- I Y,$P(BGPLEYE,U,2)<D S BGPLEYE=3_"^"_D_"^Cl: "_R
- S X=0,Y=0 F S X=$O(^TMP($J,"A",X)) Q:X'=+X!(Y) S R=$$CLINIC^APCLV($P(^TMP($J,"A",X),U,5),"C") I (R=17!(R=18)!(R=64)),'$$DNKA^BGP1D21($P(^TMP($J,"A",X),U,5)) S Y=1,D=$P(^TMP($J,"A",X),U)
- I Y,$P(BGPLEYE,U,2)<D S BGPLEYE=$S(R="A2":3,1:3)_"^"_D_"^Cl: "_R
- S (X,Y)=0,D="" F S X=$O(^TMP($J,"A",X)) Q:X'=+X!(Y) S R=$$PRIMPROV^APCLV($P(^TMP($J,"A",X),U,5),"D") I (R=24!(R=79)!(R="08")),'$$DNKA^BGP1D21($P(^TMP($J,"A",X),U,5)) S Y=1,D=$P(^TMP($J,"A",X),U)
- I Y,$P(BGPLEYE,U,2)<D S BGPLEYE="3^"_D_"^Prv: "_R
- ;
- K BGPG S %=P_"^LAST DX V72.0;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(%,"BGPG(")
- I $D(BGPG(1)),$P(BGPLEYE,U,2)<$P(BGPG(1),U) S BGPLEYE="3^"_$P(BGPG(1),U)_"^V72.0 POV"
- ;now check cpt taxonomies
- S T=$O(^ATXAX("B","BGP DM RETINAL EXAM CPTS",0))
- I T D I X]"",$P(BGPLEYE,U,2)<$P(X,U,1) S BGPLEYE=1_U_$P(X,U,1)_U_"CPT: "_$P(X,U,2)
- .S X=$$CPT^BGP1DU(P,BDATE,EDATE,T,5) I X]"" Q
- .S X=$$TRAN^BGP1DU(P,BDATE,EDATE,T,5)
- S T=$O(^ATXAX("B","BGP DM EYE EXAM CPTS",0))
- I T D I X]"",$P(BGPLEYE,U,2)<$P(X,U,1) S BGPLEYE=3_U_$P(X,U,1)_U_"CPT: "_$P(X,U,2)
- .S X=$$CPT^BGP1DU(P,BDATE,EDATE,T,5) I X]"" Q
- .S X=$$TRAN^BGP1DU(P,BDATE,EDATE,T,5)
- S X=$$LASTPRCI^BGP1UTL1(P,"95.02",BDATE,EDATE) I X]"",$P(BGPLEYE,U,2)<$P(X,U,1) S BGPLEYE=3_U_$P(X,U,3)_U_"PROC: 95.02"
- Q BGPLEYE
- EYEREF(P,BDATE,EDATE) ;EP
- S G=$$REFUSAL^BGP1UTL1(P,9999999.15,$O(^AUTTEXAM("B","DIABETIC EYE EXAM",0)),BDATE,EDATE)
- I $P(G,U)=1 Q "2^"_$P(G,U,2)_"^Refused"
- Q ""
- BGP1DPA4 ; IHS/CMI/LAB - COMP NATIONAL GPRA FOR PTS W/APPT 01 Oct 2009 2:53 PM ;
- +1 ;;11.1;IHS CLINICAL REPORTING SYSTEM;;JUN 27, 2011;Build 33
- +2 ;
- EYE(P,BDATE,EDATE,FORECAST) ;EP
- +1 SET BGPLEYE=""
- +2 SET FORECAST=$GET(FORECAST)
- +3 KILL BGPG
- SET %=P_"^LAST EXAM DIABETIC EYE EXAM;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
- SET E=$$START1^APCLDF(%,"BGPG(")
- +4 IF $DATA(BGPG(1))
- SET BGPLEYE="1^"_$PIECE(BGPG(1),U)_"^Diab Eye Ex"
- +5 KILL ^TMP($JOB,"A")
- +6 SET A="^TMP($J,""A"","
- +7 SET %=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
- SET E=$$START1^APCLDF(%,A)
- +8 SET X=0
- SET Y=0
- FOR
- SET X=$ORDER(^TMP($JOB,"A",X))
- IF X'=+X!(Y)
- QUIT
- SET R=$$CLINIC^APCLV($PIECE(^TMP($JOB,"A",X),U,5),"C")
- IF R="A2"
- IF '$$DNKA^BGP1D21($PIECE(^TMP($JOB,"A",X),U,5))
- SET Y=1
- SET D=$PIECE(^TMP($JOB,"A",X),U)
- +9 IF Y
- IF $PIECE(BGPLEYE,U,2)<D
- SET BGPLEYE=3_"^"_D_"^Cl: "_R
- +10 SET X=0
- SET Y=0
- FOR
- SET X=$ORDER(^TMP($JOB,"A",X))
- IF X'=+X!(Y)
- QUIT
- SET R=$$CLINIC^APCLV($PIECE(^TMP($JOB,"A",X),U,5),"C")
- IF (R=17!(R=18)!(R=64))
- IF '$$DNKA^BGP1D21($PIECE(^TMP($JOB,"A",X),U,5))
- SET Y=1
- SET D=$PIECE(^TMP($JOB,"A",X),U)
- +11 IF Y
- IF $PIECE(BGPLEYE,U,2)<D
- SET BGPLEYE=$SELECT(R="A2":3,1:3)_"^"_D_"^Cl: "_R
- +12 SET (X,Y)=0
- SET D=""
- FOR
- SET X=$ORDER(^TMP($JOB,"A",X))
- IF X'=+X!(Y)
- QUIT
- SET R=$$PRIMPROV^APCLV($PIECE(^TMP($JOB,"A",X),U,5),"D")
- IF (R=24!(R=79)!(R="08"))
- IF '$$DNKA^BGP1D21($PIECE(^TMP($JOB,"A",X),U,5))
- SET Y=1
- SET D=$PIECE(^TMP($JOB,"A",X),U)
- +13 IF Y
- IF $PIECE(BGPLEYE,U,2)<D
- SET BGPLEYE="3^"_D_"^Prv: "_R
- +14 ;
- +15 KILL BGPG
- SET %=P_"^LAST DX V72.0;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
- SET E=$$START1^APCLDF(%,"BGPG(")
- +16 IF $DATA(BGPG(1))
- IF $PIECE(BGPLEYE,U,2)<$PIECE(BGPG(1),U)
- SET BGPLEYE="3^"_$PIECE(BGPG(1),U)_"^V72.0 POV"
- +17 ;now check cpt taxonomies
- +18 SET T=$ORDER(^ATXAX("B","BGP DM RETINAL EXAM CPTS",0))
- +19 IF T
- Begin DoDot:1
- +20 SET X=$$CPT^BGP1DU(P,BDATE,EDATE,T,5)
- IF X]""
- QUIT
- +21 SET X=$$TRAN^BGP1DU(P,BDATE,EDATE,T,5)
- End DoDot:1
- IF X]""
- IF $PIECE(BGPLEYE,U,2)<$PIECE(X,U,1)
- SET BGPLEYE=1_U_$PIECE(X,U,1)_U_"CPT: "_$PIECE(X,U,2)
- +22 SET T=$ORDER(^ATXAX("B","BGP DM EYE EXAM CPTS",0))
- +23 IF T
- Begin DoDot:1
- +24 SET X=$$CPT^BGP1DU(P,BDATE,EDATE,T,5)
- IF X]""
- QUIT
- +25 SET X=$$TRAN^BGP1DU(P,BDATE,EDATE,T,5)
- End DoDot:1
- IF X]""
- IF $PIECE(BGPLEYE,U,2)<$PIECE(X,U,1)
- SET BGPLEYE=3_U_$PIECE(X,U,1)_U_"CPT: "_$PIECE(X,U,2)
- +26 SET X=$$LASTPRCI^BGP1UTL1(P,"95.02",BDATE,EDATE)
- IF X]""
- IF $PIECE(BGPLEYE,U,2)<$PIECE(X,U,1)
- SET BGPLEYE=3_U_$PIECE(X,U,3)_U_"PROC: 95.02"
- +27 QUIT BGPLEYE
- EYEREF(P,BDATE,EDATE) ;EP
- +1 SET G=$$REFUSAL^BGP1UTL1(P,9999999.15,$ORDER(^AUTTEXAM("B","DIABETIC EYE EXAM",0)),BDATE,EDATE)
- +2 IF $PIECE(G,U)=1
- QUIT "2^"_$PIECE(G,U,2)_"^Refused"
- +3 QUIT ""
