BGP4DPA4 ; IHS/CMI/LAB - COMP NATIONAL GPRA FOR PTS W/APPT 01 Oct 2009 2:53 PM ;
;;14.1;IHS CLINICAL REPORTING;;MAY 29, 2014;Build 114
;
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^BGP4D21($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^BGP4D21($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^BGP4D21($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 [BGP EYE EXAM DXS;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)_"^"_$P(BGPG(1),U,2)_" POV" -LORI V13
;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^BGP4DU(P,BDATE,EDATE,T,5) I X]"" Q
.S X=$$TRAN^BGP4DU(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^BGP4DU(P,BDATE,EDATE,T,5) I X]"" Q
.S X=$$TRAN^BGP4DU(P,BDATE,EDATE,T,5)
;;S X=$$LASTPRC^BGP4UTL1(P,"BGP EYE EXAM PROCS",BDATE,EDATE) I X]"",$P(BGPLEYE,U,2)<$P(X,U,3) S BGPLEYE=3_U_$P(X,U,3)_U_"Proc "_$P(X,U,2)
Q BGPLEYE
EYEREF(P,BDATE,EDATE) ;EP
S G=$$REFUSAL^BGP4UTL1(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 ""
BGP4DPA4 ; IHS/CMI/LAB - COMP NATIONAL GPRA FOR PTS W/APPT 01 Oct 2009 2:53 PM ;
+1 ;;14.1;IHS CLINICAL REPORTING;;MAY 29, 2014;Build 114
+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^BGP4D21($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^BGP4D21($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^BGP4D21($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 ;K BGPG S %=P_"^LAST DX [BGP EYE EXAM DXS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(%,"BGPG(")
+16 ;I $D(BGPG(1)),$P(BGPLEYE,U,2)<$P(BGPG(1),U) S BGPLEYE="3^"_$P(BGPG(1),U)_"^"_$P(BGPG(1),U,2)_" POV" -LORI V13
+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^BGP4DU(P,BDATE,EDATE,T,5)
IF X]""
QUIT
+21 SET X=$$TRAN^BGP4DU(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^BGP4DU(P,BDATE,EDATE,T,5)
IF X]""
QUIT
+25 SET X=$$TRAN^BGP4DU(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 ;;S X=$$LASTPRC^BGP4UTL1(P,"BGP EYE EXAM PROCS",BDATE,EDATE) I X]"",$P(BGPLEYE,U,2)<$P(X,U,3) S BGPLEYE=3_U_$P(X,U,3)_U_"Proc "_$P(X,U,2)
+27 QUIT BGPLEYE
EYEREF(P,BDATE,EDATE) ;EP
+1 SET G=$$REFUSAL^BGP4UTL1(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 ""
