BGPD13.m

BGPD13 ; IHS/CMI/LAB - indicator 13 ;

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

 ;

I13 ;EP ;EP - indicator 13

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

 I BGPAGEB>5&(BGPAGEB<9) D

 .D S(BGPRPT,$S(BGPTIME=1:15,BGPTIME=0:45,BGPTIME=8:85,1:999),13,1)

 .S BGPP=$$DENTSEAL(DFN,BGPEDATE) ;sealant anytime in lifetime

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

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

 I BGPAGEB>13&(BGPAGEB<16) D

 .D S(BGPRPT,$S(BGPTIME=1:15,BGPTIME=0:45,BGPTIME=8:85,1:999),14,1)

 .S BGPP=$$DENTSEAL(DFN,BGPEDATE) ;sealant anytime in lifetime

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

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

 ;

DENTSEAL(P,EDATE) ;

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

 K BGPG

 S %=P_"^ALL ADA IH73;DURING "_$$FMTE^XLFDT($P(^DPT(P,0),U,3))_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(%,"BGPG(")

 I $D(BGPG(1)) Q $$FMTE^XLFDT($P(BGPG(1),U))

 S T=$O(^ATXAX("B","BGP DENTAL SEALANT OP SITES",0))

 I 'T Q ""

 K BGPG

 S %=P_"^ALL ADA 1351;DURING "_$$FMTE^XLFDT($P(^DPT(P,0),U,3))_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(%,"BGPG(")

 I '$D(BGPG(1)) Q ""

 S E=0,R=0 F  S R=$O(BGPG(R)) Q:R'=+R!(E)  D

 .S V=$P($P(BGPG(R),U,4),";")

 .S %=$P(^AUPNVDEN(V,0),U,5) Q:%=""

 .Q:'$D(^ATXAX(T,21,"B",%))

 .S E=1

 .I %="" Q

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

 ;

BGPD13    ; IHS/CMI/LAB - indicator 13 ;

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

 +2       ;

I13       ;EP ;EP - indicator 13

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

 +2        IF BGPAGEB>5&(BGPAGEB<9)

               Begin DoDot:1

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

 +4       ;sealant anytime in lifetime

                   SET BGPP=$$DENTSEAL(DFN,BGPEDATE)

 +5                IF BGPP]""

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

 +6                IF $DATA(BGPLIST(20))

                       IF BGPTIME=1

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

               End DoDot:1

 +7        IF BGPAGEB>13&(BGPAGEB<16)

               Begin DoDot:1

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

 +9       ;sealant anytime in lifetime

                   SET BGPP=$$DENTSEAL(DFN,BGPEDATE)

 +10               IF BGPP]""

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

 +11               IF $DATA(BGPLIST(20))

                       IF BGPTIME=1

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

               End DoDot:1

 +12       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       ;

DENTSEAL(P,EDATE) ;

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

 +2        KILL BGPG

 +3        SET %=P_"^ALL ADA IH73;DURING "_$$FMTE^XLFDT($PIECE(^DPT(P,0),U,3))_"-"_$$FMTE^XLFDT(EDATE)

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

 +4        IF $DATA(BGPG(1))

               QUIT $$FMTE^XLFDT($PIECE(BGPG(1),U))

 +5        SET T=$ORDER(^ATXAX("B","BGP DENTAL SEALANT OP SITES",0))

 +6        IF 'T

               QUIT ""

 +7        KILL BGPG

 +8        SET %=P_"^ALL ADA 1351;DURING "_$$FMTE^XLFDT($PIECE(^DPT(P,0),U,3))_"-"_$$FMTE^XLFDT(EDATE)

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

 +9        IF '$DATA(BGPG(1))

               QUIT ""

 +10       SET E=0

           SET R=0

           FOR 

               SET R=$ORDER(BGPG(R))

               IF R'=+R!(E)

                   QUIT 

               Begin DoDot:1

 +11               SET V=$PIECE($PIECE(BGPG(R),U,4),";")

 +12               SET %=$PIECE(^AUPNVDEN(V,0),U,5)

                   IF %=""

                       QUIT 

 +13               IF '$DATA(^ATXAX(T,21,"B",%))

                       QUIT 

 +14               SET E=1

 +15               IF %=""

                       QUIT 

               End DoDot:1

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

 +17      ;