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