BGPDD ; IHS/CMI/LAB - indicator D ;
;;7.0;IHS CLINICAL REPORTING;;JAN 24, 2007
;
ID ;EP ;EP - indicator D
;Q:'$D(BGPIND(30))
Q:'$$DM^BGPD1(DFN,BGPEDATE)
S BGPP=$$EYE(DFN,BGPEDATE)
I BGPP]"" D S(BGPRPT,$S(BGPTIME=1:17,BGPTIME=0:47,BGPTIME=8:87,1:999),4,1)
I $D(BGPLIST(30)),BGPTIME=1 S ^XTMP("BGPD",BGPJ,BGPH,"LIST",30,$S($P($G(^AUPNPAT(DFN,11)),U,18)]"":$P(^AUPNPAT(DFN,11),U,18),1:"UNKNOWN"),$P(^DPT(DFN,0),U,2),BGPAGEE,DFN)=BGPP
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
;
REFR(V) ;
I '$G(V) Q ""
NEW D,N S D=$$PRIMPOV^APCLV(V,"C")
I D="367.89"!(D="367.9")!($E(D,1,5)=372.0)!($E(D,1,5)=372.1) Q 1
Q 0
DNKA(V) ;is this a DNKA visit?
I '$G(V) Q ""
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
EYE(P,EDATE) ;
NEW BDATE,BGPG,%,E,T,T1,T2,T3 K BGPG S BDATE=$$FMADD^XLFDT(EDATE,-365),%=P_"^LAST EXAM DIABETIC EYE EXAM;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(%,"BGPG(")
I $D(BGPG(1)) Q "Yes-Diabetic Eye Exam"
S BD=BDATE
S ED=EDATE
S T=+$$CODEN^ICPTCOD(92250),T1=+$$CODEN^ICPTCOD(92012),T2=+$$CODEN^ICPTCOD(92014),T3=+$$CODEN^ICPTCOD(92015)
I T,$D(^AUPNVCPT("AA",P,T)) S %="" D I %]"" Q %
.S E=0 F S E=$O(^AUPNVCPT("AA",P,T,E)) Q:E'=+E!(%]"") D
..S D=9999999-E ;date done
..I D>ED Q
..I D<BD Q
..S %="Yes-Fundus Photography"
..Q
.Q
I T1,$D(^AUPNVCPT("AA",P,T1)) S %="" D I %]"" Q %
.S E=0 F S E=$O(^AUPNVCPT("AA",P,T1,E)) Q:E'=+E!(%]"") D
..S D=9999999-E ;date done
..I D>ED Q
..I D<BD Q
..S %="Yes-Eye Exam/Est Pat"
..Q
.Q
I T2,$D(^AUPNVCPT("AA",P,T2)) S %="" D I %]"" Q %
.S E=0 F S E=$O(^AUPNVCPT("AA",P,T2,E)) Q:E'=+E!(%]"") D
..S D=9999999-E ;date done
..I D>ED Q
..I D<BD Q
..S %="Yes-Comp eye exam"
..Q
.Q
I T3,$D(^AUPNVCPT("AA",P,T3)) S %="" D I %]"" Q %
.S E=0 F S E=$O(^AUPNVCPT("AA",P,T3,E)) Q:E'=+E!(%]"") D
..S D=9999999-E ;date done
..I D>ED Q
..I D<BD Q
..S %="Yes-CPT 92015"
..Q
.Q
S %=P_"^ALL VISITS;DURING "_BDATE_"-"_EDATE,E=$$START1^APCLDF(%,"BGPG(")
NEW X,Y,R S (X,Y)=0 F S X=$O(BGPG(X)) Q:X'=+X!(Y) S R=$$PRIMPROV^APCLV($P(BGPG(X),U,5),"D") I (R=24!(R=79)!(R="08")),'$$DNKA($P(BGPG(X),U,5)) S Y=1
I Y Q "Yes-Optometrist/Opthamalogist Visit"
S X=0,Y=0 F S X=$O(BGPG(X)) Q:X'=+X!(Y) S R=$$CLINIC^APCLV($P(BGPG(X),U,5),"C") I (R=17!(R=18)!(R=64)!(R="A2")),'$$DNKA($P(BGPG(X),U,5)) S Y=1
I Y Q "Yes-Optometry/Opthamology Clinic"
Q ""
BGPDD ; IHS/CMI/LAB - indicator D ;
+1 ;;7.0;IHS CLINICAL REPORTING;;JAN 24, 2007
+2 ;
ID ;EP ;EP - indicator D
+1 ;Q:'$D(BGPIND(30))
+2 IF '$$DM^BGPD1(DFN,BGPEDATE)
QUIT
+3 SET BGPP=$$EYE(DFN,BGPEDATE)
+4 IF BGPP]""
DO S(BGPRPT,$SELECT(BGPTIME=1:17,BGPTIME=0:47,BGPTIME=8:87,1:999),4,1)
+5 IF $DATA(BGPLIST(30))
IF BGPTIME=1
SET ^XTMP("BGPD",BGPJ,BGPH,"LIST",30,$SELECT($PIECE($GET(^AUPNPAT(DFN,11)),U,18)]"":$PIECE(^AUPNPAT(DFN,11),U,18),1:"UNKNOWN"),$PIECE(^DPT(DFN,0),U,2),BGPAGEE,DFN)=BGPP
+6 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
+4 ;
REFR(V) ;
+1 IF '$GET(V)
QUIT ""
+2 NEW D,N
SET D=$$PRIMPOV^APCLV(V,"C")
+3 IF D="367.89"!(D="367.9")!($EXTRACT(D,1,5)=372.0)!($EXTRACT(D,1,5)=372.1)
QUIT 1
+4 QUIT 0
DNKA(V) ;is this a DNKA visit?
+1 IF '$GET(V)
QUIT ""
+2 NEW D,N
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
EYE(P,EDATE) ;
+1 NEW BDATE,BGPG,%,E,T,T1,T2,T3
KILL BGPG
SET BDATE=$$FMADD^XLFDT(EDATE,-365)
SET %=P_"^LAST EXAM DIABETIC EYE EXAM;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(%,"BGPG(")
+2 IF $DATA(BGPG(1))
QUIT "Yes-Diabetic Eye Exam"
+3 SET BD=BDATE
+4 SET ED=EDATE
+5 SET T=+$$CODEN^ICPTCOD(92250)
SET T1=+$$CODEN^ICPTCOD(92012)
SET T2=+$$CODEN^ICPTCOD(92014)
SET T3=+$$CODEN^ICPTCOD(92015)
+6 IF T
IF $DATA(^AUPNVCPT("AA",P,T))
SET %=""
Begin DoDot:1
+7 SET E=0
FOR
SET E=$ORDER(^AUPNVCPT("AA",P,T,E))
IF E'=+E!(%]"")
QUIT
Begin DoDot:2
+8 ;date done
SET D=9999999-E
+9 IF D>ED
QUIT
+10 IF D<BD
QUIT
+11 SET %="Yes-Fundus Photography"
+12 QUIT
End DoDot:2
+13 QUIT
End DoDot:1
IF %]""
QUIT %
+14 IF T1
IF $DATA(^AUPNVCPT("AA",P,T1))
SET %=""
Begin DoDot:1
+15 SET E=0
FOR
SET E=$ORDER(^AUPNVCPT("AA",P,T1,E))
IF E'=+E!(%]"")
QUIT
Begin DoDot:2
+16 ;date done
SET D=9999999-E
+17 IF D>ED
QUIT
+18 IF D<BD
QUIT
+19 SET %="Yes-Eye Exam/Est Pat"
+20 QUIT
End DoDot:2
+21 QUIT
End DoDot:1
IF %]""
QUIT %
+22 IF T2
IF $DATA(^AUPNVCPT("AA",P,T2))
SET %=""
Begin DoDot:1
+23 SET E=0
FOR
SET E=$ORDER(^AUPNVCPT("AA",P,T2,E))
IF E'=+E!(%]"")
QUIT
Begin DoDot:2
+24 ;date done
SET D=9999999-E
+25 IF D>ED
QUIT
+26 IF D<BD
QUIT
+27 SET %="Yes-Comp eye exam"
+28 QUIT
End DoDot:2
+29 QUIT
End DoDot:1
IF %]""
QUIT %
+30 IF T3
IF $DATA(^AUPNVCPT("AA",P,T3))
SET %=""
Begin DoDot:1
+31 SET E=0
FOR
SET E=$ORDER(^AUPNVCPT("AA",P,T3,E))
IF E'=+E!(%]"")
QUIT
Begin DoDot:2
+32 ;date done
SET D=9999999-E
+33 IF D>ED
QUIT
+34 IF D<BD
QUIT
+35 SET %="Yes-CPT 92015"
+36 QUIT
End DoDot:2
+37 QUIT
End DoDot:1
IF %]""
QUIT %
+38 SET %=P_"^ALL VISITS;DURING "_BDATE_"-"_EDATE
SET E=$$START1^APCLDF(%,"BGPG(")
+39 NEW X,Y,R
SET (X,Y)=0
FOR
SET X=$ORDER(BGPG(X))
IF X'=+X!(Y)
QUIT
SET R=$$PRIMPROV^APCLV($PIECE(BGPG(X),U,5),"D")
IF (R=24!(R=79)!(R="08"))
IF '$$DNKA($PIECE(BGPG(X),U,5))
SET Y=1
+40 IF Y
QUIT "Yes-Optometrist/Opthamalogist Visit"
+41 SET X=0
SET Y=0
FOR
SET X=$ORDER(BGPG(X))
IF X'=+X!(Y)
QUIT
SET R=$$CLINIC^APCLV($PIECE(BGPG(X),U,5),"C")
IF (R=17!(R=18)!(R=64)!(R="A2"))
IF '$$DNKA($PIECE(BGPG(X),U,5))
SET Y=1
+42 IF Y
QUIT "Yes-Optometry/Opthamology Clinic"
+43 QUIT ""
