BGPD14.m

BGPD14 ; IHS/CMI/LAB - indicator 14 ;

 ;;7.0;IHS CLINICAL REPORTING;;JAN 24, 2007

 ;

I14 ;EP ;EP - indicator 14

 ;Q:'$D(BGPIND(19))

 Q:'BGPDMPAT

 S BGPP=$$DENT00(DFN,BGPEDATE)

 I BGPP]"" D S(BGPRPT,$S(BGPTIME=1:15,BGPTIME=0:45,BGPTIME=8:85,1:999),17,1)

 I $D(BGPLIST(21)),BGPTIME=1 S ^XTMP("BGPD",BGPJ,BGPH,"LIST",21,$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

 ;

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

DENT00(P,EDATE) ;

 NEW BGPG,X,%,E,R,V,BDATE

 K BGPG

 S BDATE=$$FMADD^XLFDT(EDATE,-365)

 S %=P_"^LAST ADA 0000;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(%,"BGPG(")

 I $D(BGPG(1)) Q "Yes - "_$$FMTE^XLFDT($P(BGPG(1),U))

 ;look for dental clinic or dental provider visit date

 K BGPG

 K ^TMP($J,"A")

 S A="^TMP($J,""A"",",B=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(B,A)

 NEW X,Y S X=0,Y="" F  S X=$O(^TMP($J,"A",X)) Q:X'=+X!(Y]"")  I $$CLINIC^APCLV($P(^TMP($J,"A",X),U,5),"C")=56,'$$DNKA($P(^TMP($J,"A",X),U,5)) S Y="Yes - "_$$FMTE^XLFDT($P(^TMP($J,"A",X),U))

 I Y]"" Q Y

 S X=0,Y="" F  S X=$O(^TMP($J,"A",X)) Q:X'=+X!(Y]"")  I $$PRIMPROV^APCLV($P(^TMP($J,"A",X),U,5),"D")=52,'$$DNKA($P(^TMP($J,"A",X),U,5)) S Y="Yes - "_$$FMTE^XLFDT($P(^TMP($J,"A",X),U))

 Q Y

 Q ""

BGPD14    ; IHS/CMI/LAB - indicator 14 ;

 +1       ;;7.0;IHS CLINICAL REPORTING;;JAN 24, 2007

 +2       ;

I14       ;EP ;EP - indicator 14

 +1       ;Q:'$D(BGPIND(19))

 +2        IF 'BGPDMPAT

               QUIT 

 +3        SET BGPP=$$DENT00(DFN,BGPEDATE)

 +4        IF BGPP]""

               DO S(BGPRPT,$SELECT(BGPTIME=1:15,BGPTIME=0:45,BGPTIME=8:85,1:999),17,1)

 +5        IF $DATA(BGPLIST(21))

               IF BGPTIME=1

                   SET ^XTMP("BGPD",BGPJ,BGPH,"LIST",21,$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       ;

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

DENT00(P,EDATE) ;

 +1        NEW BGPG,X,%,E,R,V,BDATE

 +2        KILL BGPG

 +3        SET BDATE=$$FMADD^XLFDT(EDATE,-365)

 +4        SET %=P_"^LAST ADA 0000;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)

           SET E=$$START1^APCLDF(%,"BGPG(")

 +5        IF $DATA(BGPG(1))

               QUIT "Yes - "_$$FMTE^XLFDT($PIECE(BGPG(1),U))

 +6       ;look for dental clinic or dental provider visit date

 +7        KILL BGPG

 +8        KILL ^TMP($JOB,"A")

 +9        SET A="^TMP($J,""A"","

           SET B=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)

           SET E=$$START1^APCLDF(B,A)

 +10       NEW X,Y

           SET X=0

           SET Y=""

           FOR 

               SET X=$ORDER(^TMP($JOB,"A",X))

               IF X'=+X!(Y]"")

                   QUIT 

               IF $$CLINIC^APCLV($PIECE(^TMP($JOB,"A",X),U,5),"C")=56

                   IF '$$DNKA($PIECE(^TMP($JOB,"A",X),U,5))

                       SET Y="Yes - "_$$FMTE^XLFDT($PIECE(^TMP($JOB,"A",X),U))

 +11       IF Y]""

               QUIT Y

 +12       SET X=0

           SET Y=""

           FOR 

               SET X=$ORDER(^TMP($JOB,"A",X))

               IF X'=+X!(Y]"")

                   QUIT 

               IF $$PRIMPROV^APCLV($PIECE(^TMP($JOB,"A",X),U,5),"D")=52

                   IF '$$DNKA($PIECE(^TMP($JOB,"A",X),U,5))

                       SET Y="Yes - "_$$FMTE^XLFDT($PIECE(^TMP($JOB,"A",X),U))

 +13       QUIT Y

 +14       QUIT ""