- 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 ""
