BGPD2 ; IHS/CMI/LAB - indicator 2 ;
;;7.0;IHS CLINICAL REPORTING;;JAN 24, 2007
;
I2A ;EP ;EP - indicator 2a
;Q:'$D(BGPIND(3))
Q:'BGPDMPAT ;not in the simple population for denominator
S BGPLHGB=$$LASTHGB(DFN,BGPEDATE)
I BGPLHGB D S(BGPRPT,$S(BGPTIME=1:12,BGPTIME=0:42,BGPTIME=8:82,1:999),1,1) ;number with hgb a1c done result or not
S BGPHGBV=$$HGBA1C(DFN,BGPEDATE) ;get last HGB value in past year
;set value 2,3,4 piece and set list
I $P(BGPHGBV,U,2) D S(BGPRPT,$S(BGPTIME=1:12,BGPTIME=0:42,BGPTIME=8:82,1:999),$P(BGPHGBV,U,2),1) ;set piece 2,3,4
I $D(BGPLIST(3)),BGPTIME=1 S ^XTMP("BGPD",BGPJ,BGPH,"LIST",3,$S($P($G(^AUPNPAT(DFN,11)),U,18)]"":$P(^AUPNPAT(DFN,11),U,18),1:"UNKNOWN"),$P(^DPT(DFN,0),U,2),BGPAGEE,DFN)=$P(BGPHGBV,U)
Q
I2B ;EP
;Q:'$D(BGPIND(4))
Q:'BGPDMPAT ;not in the simple population for denominator
Q:'$$V2(DFN,$$FMADD^XLFDT(BGPEDATE,-365),BGPEDATE) ;quit if not 2 visits in past year
Q:'$$FIRSTDM(DFN,BGPEDATE)
S BGP2BD=1 D S(BGPRPT,$S(BGPTIME=1:12,BGPTIME=0:42,BGPTIME=8:82,1:999),5,1) ;set 2B denom
I BGPLHGB D S(BGPRPT,$S(BGPTIME=1:12,BGPTIME=0:42,BGPTIME=8:82,1:999),6,1) ;number with hgb a1c done result or not
;set value 2,3,4 piece and set list
I $P(BGPHGBV,U,2) D S(BGPRPT,$S(BGPTIME=1:12,BGPTIME=0:42,BGPTIME=8:82,1:999),$P(BGPHGBV,U,2)+5,1) ;set piece 2,3,4
I $D(BGPLIST(4)),BGPTIME=1 S ^XTMP("BGPD",BGPJ,BGPH,"LIST",4,$S($P($G(^AUPNPAT(DFN,11)),U,18)]"":$P(^AUPNPAT(DFN,11),U,18),1:"UNKNOWN"),$P(^DPT(DFN,0),U,2),BGPAGEE,DFN)=$P(BGPHGBV,U)
Q
I2C ;EP
;Q:'$D(BGPIND(5))
Q:'BGPDMPAT ;not in the simple population for denominator
Q:'$$V2DM(DFN,$P(^DPT(DFN,0),U,3),BGPEDATE) ;must have at least 2 visits W/ dm dx
Q:'$$V1DM(DFN,BGPEDATE) ;quit if not visit w dm pov and primary care provider
Q:$$AGE^AUPNPAT(DFN,BGPBDATE)<19 ;older than 18 at beg of tf
Q:'$$CREAT(DFN,BGPEDATE)
S BGP2CD=1 D S(BGPRPT,$S(BGPTIME=1:12,BGPTIME=0:42,BGPTIME=8:82,1:999),10,1) ;set 2C denom
I BGPLHGB D S(BGPRPT,$S(BGPTIME=1:12,BGPTIME=0:42,BGPTIME=8:82,1:999),11,1) ;number with hgb a1c done result or not
;set value 2,3,4 piece and set list
I $P(BGPHGBV,U,2) D S(BGPRPT,$S(BGPTIME=1:12,BGPTIME=0:42,BGPTIME=8:82,1:999),$P(BGPHGBV,U,2)+10,1) ;set piece 2,3,4
I $D(BGPLIST(5)),BGPTIME=1 S ^XTMP("BGPD",BGPJ,BGPH,"LIST",5,$S($P($G(^AUPNPAT(DFN,11)),U,18)]"":$P(^AUPNPAT(DFN,11),U,18),1:"UNKNOWN"),$P(^DPT(DFN,0),U,2),BGPAGEE,DFN)=$P(BGPHGBV,U)
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
LASTHGB(P,EDATE) ;
NEW BGPG,E,D,%
K BGPG
S D=$$FMADD^XLFDT(EDATE,-365)
S %=P_"^LAST LAB [DM AUDIT HGB A1C;DURING "_$$FMTE^XLFDT(D)_"-"_EDATE,E=$$START1^APCLDF(%,"BGPG(")
I '$D(BGPG(1)) Q ""
Q 1
HGBA1C(P,EDATE) ;EP
NEW BGPG,X,D,E,%,R
K BGPG
S D=$$FMADD^XLFDT(EDATE,-365)
S %=P_"^LAST LAB [DM AUDIT HGB A1C;DURING "_$$FMTE^XLFDT(D)_"-"_EDATE,E=$$START1^APCLDF(%,"BGPG(")
I '$D(BGPG(1)) S R="" D BS Q R
S X=$P(^AUPNVLAB(+$P(BGPG(1),U,4),0),U,4) ;get result
I $$UP^XLFSTR(X)="COMMENT" D BS Q R
I X[">" Q X_"^"_3
I X["<" Q X_"^"_2
I $E(X)'=+$E(X) D BS Q R
I +X'>7 Q X_"^"_2
I +X'<9.5 Q X_"^3"
;S X=""
Q X
BS ;EP
NEW BGPBS,A,B,C,T
K BGPBS
S A=P_"^LAST 3 LAB [DM AUDIT GLUCOSE TESTS TAX;DURING "_$$FMTE^XLFDT(D)_"-"_EDATE,B=$$START1^APCLDF(A,"BGPBS(")
I '$D(BGPBS(1)) K BGPBS S R="^4" Q
S (A,C,T)=0 F S A=$O(BGPBS(A)) Q:A'=+A S B=$P(^AUPNVLAB(+$P(BGPBS(A),U,4),0),U,4) I B=+B S C=C+1,T=T+B
I C<3 K BGPBS S R="^4" Q ;not 3 with numeric value
S B=T/3,A=$S(B'>150:2,B'<225:3,1:"")
S R=$J(B,5,1)_"^"_A
Q
;
V1DM(P,EDATE) ;
I '$G(P) Q ""
I '$D(^AUPNVSIT("AC",P)) Q ""
NEW A,B,E,V,X,G,D,T,PP,Y,PC
S PC=$O(^ATXAX("B","BGP PRIMARY CARE CLINICS",0))
I 'PC Q ""
S PP=$O(^ATXAX("B","BGP PRIMARY PROVIDER DISC",0))
I 'PP Q ""
S T=$O(^ATXAX("B","SURVEILLANCE DIABETES",0))
I 'T Q ""
S D=$$FMADD^XLFDT(EDATE,-365)
K ^TMP($J,"A")
S A="^TMP($J,""A"",",B=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(D)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(B,A)
I '$D(^TMP($J,"A",1)) Q ""
S (X,G)=0 F S X=$O(^TMP($J,"A",X)) Q:X'=+X!(G>2) S V=$P(^TMP($J,"A",X),U,5) D
.Q:'$D(^AUPNVSIT(V,0))
.Q:'$P(^AUPNVSIT(V,0),U,9)
.Q:$P(^AUPNVSIT(V,0),U,11)
.Q:"SAHO"'[$P(^AUPNVSIT(V,0),U,7)
.Q:'$D(^AUPNVPRV("AD",V))
.Q:$P(^AUPNVSIT(V,0),U,6)'=DUZ(2)
.Q:'$D(^AUPNVPOV("AD",V))
.S (D,Y)=0 F S Y=$O(^AUPNVPOV("AD",V,Y)) Q:Y'=+Y!(D) I $D(^AUPNVPOV(Y,0)) S %=$P(^AUPNVPOV(Y,0),U) I $$ICD^ATXCHK(%,T,9) S D=1
.Q:'D
.Q:"V"[$P(^AUPNVSIT(V,0),U,3)
.S Y=$$PRIMPROV^APCLV(V,"F")
.Q:'Y
.Q:'$D(^ATXAX(PP,21,"B",Y))
.S Y=$$CLINIC^APCLV(V,"I")
.Q:'Y
.Q:'$D(^ATXAX(PC,21,"B",Y))
.S G=G+1
.Q
Q $S(G<1:"",1:G)
;
V2(P,BDATE,EDATE) ;
I '$G(P) Q ""
I '$D(^AUPNVSIT("AC",P)) Q ""
NEW A,B,E,V,X,G
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)
I '$D(^TMP($J,"A",1)) Q ""
S (X,G)=0 F S X=$O(^TMP($J,"A",X)) Q:X'=+X!(G>2) S V=$P(^TMP($J,"A",X),U,5) D
.Q:'$D(^AUPNVSIT(V,0))
.Q:'$P(^AUPNVSIT(V,0),U,9)
.Q:$P(^AUPNVSIT(V,0),U,11)
.Q:"SAHO"'[$P(^AUPNVSIT(V,0),U,7)
.Q:"V"[$P(^AUPNVSIT(V,0),U,3)
.S G=G+1
.Q
Q $S(G<2:"",1:G)
;
V2DM(P,BDATE,EDATE) ;
I '$G(P) Q ""
I '$D(^AUPNVSIT("AC",P)) Q ""
NEW A,B,E,V,X,G,D,T,Y
S T=$O(^ATXAX("B","SURVEILLANCE DIABETES",0))
I 'T Q ""
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)
I '$D(^TMP($J,"A",1)) Q ""
S (X,G)=0 F S X=$O(^TMP($J,"A",X)) Q:X'=+X!(G>2) S V=$P(^TMP($J,"A",X),U,5) D
.Q:'$D(^AUPNVSIT(V,0))
.Q:'$P(^AUPNVSIT(V,0),U,9)
.Q:$P(^AUPNVSIT(V,0),U,11)
.Q:"SAHO"'[$P(^AUPNVSIT(V,0),U,7)
.Q:"V"[$P(^AUPNVSIT(V,0),U,3)
.S (D,Y)=0 F S Y=$O(^AUPNVPOV("AD",V,Y)) Q:Y'=+Y!(D) I $D(^AUPNVPOV(Y,0)) S %=$P(^AUPNVPOV(Y,0),U) I $$ICD^ATXCHK(%,T,9) S D=1
.Q:'D
.S G=G+1
.Q
Q $S(G<2:"",1:G)
;
FIRSTDM(P,EDATE) ;
I $G(P)="" Q ""
NEW X,E,BGPG,Y
K BGPG
S Y="BGPG("
S X=P_"^FIRST DX [SURVEILLANCE DIABETES" S E=$$START1^APCLDF(X,Y)
I '$D(BGPG(1)) Q ""
S X=$$FMDIFF^XLFDT(EDATE,$P(BGPG(1),U))
Q $S(X>365:1,1:"")
;
CREAT(P,EDATE) ;get all creatines all must be <5
NEW BGPG,X,%,E,R,V
K BGPG
S %=P_"^ALL LAB [DM AUDIT CREATININE TAX",E=$$START1^APCLDF(%,"BGPG(")
I '$D(BGPG(1)) Q 1 ;no creatinines 5 or greater
S X=0,E=1 F S X=$O(BGPG(X)) Q:X'=+X S R=$P(BGPG(X),U,2) I +R'<5 S E=""
Q E
BGPD2 ; IHS/CMI/LAB - indicator 2 ;
+1 ;;7.0;IHS CLINICAL REPORTING;;JAN 24, 2007
+2 ;
I2A ;EP ;EP - indicator 2a
+1 ;Q:'$D(BGPIND(3))
+2 ;not in the simple population for denominator
IF 'BGPDMPAT
QUIT
+3 SET BGPLHGB=$$LASTHGB(DFN,BGPEDATE)
+4 ;number with hgb a1c done result or not
IF BGPLHGB
DO S(BGPRPT,$SELECT(BGPTIME=1:12,BGPTIME=0:42,BGPTIME=8:82,1:999),1,1)
+5 ;get last HGB value in past year
SET BGPHGBV=$$HGBA1C(DFN,BGPEDATE)
+6 ;set value 2,3,4 piece and set list
+7 ;set piece 2,3,4
IF $PIECE(BGPHGBV,U,2)
DO S(BGPRPT,$SELECT(BGPTIME=1:12,BGPTIME=0:42,BGPTIME=8:82,1:999),$PIECE(BGPHGBV,U,2),1)
+8 IF $DATA(BGPLIST(3))
IF BGPTIME=1
SET ^XTMP("BGPD",BGPJ,BGPH,"LIST",3,$SELECT($PIECE($GET(^AUPNPAT(DFN,11)),U,18)]"":$PIECE(^AUPNPAT(DFN,11),U,18),1:"UNKNOWN"),$PIECE(^DPT(DFN,0),U,2),BGPAGEE,DFN)=$PIECE(BGPHGBV,U)
+9 QUIT
I2B ;EP
+1 ;Q:'$D(BGPIND(4))
+2 ;not in the simple population for denominator
IF 'BGPDMPAT
QUIT
+3 ;quit if not 2 visits in past year
IF '$$V2(DFN,$$FMADD^XLFDT(BGPEDATE,-365),BGPEDATE)
QUIT
+4 IF '$$FIRSTDM(DFN,BGPEDATE)
QUIT
+5 ;set 2B denom
SET BGP2BD=1
DO S(BGPRPT,$SELECT(BGPTIME=1:12,BGPTIME=0:42,BGPTIME=8:82,1:999),5,1)
+6 ;number with hgb a1c done result or not
IF BGPLHGB
DO S(BGPRPT,$SELECT(BGPTIME=1:12,BGPTIME=0:42,BGPTIME=8:82,1:999),6,1)
+7 ;set value 2,3,4 piece and set list
+8 ;set piece 2,3,4
IF $PIECE(BGPHGBV,U,2)
DO S(BGPRPT,$SELECT(BGPTIME=1:12,BGPTIME=0:42,BGPTIME=8:82,1:999),$PIECE(BGPHGBV,U,2)+5,1)
+9 IF $DATA(BGPLIST(4))
IF BGPTIME=1
SET ^XTMP("BGPD",BGPJ,BGPH,"LIST",4,$SELECT($PIECE($GET(^AUPNPAT(DFN,11)),U,18)]"":$PIECE(^AUPNPAT(DFN,11),U,18),1:"UNKNOWN"),$PIECE(^DPT(DFN,0),U,2),BGPAGEE,DFN)=$PIECE(BGPHGBV,U)
+10 QUIT
I2C ;EP
+1 ;Q:'$D(BGPIND(5))
+2 ;not in the simple population for denominator
IF 'BGPDMPAT
QUIT
+3 ;must have at least 2 visits W/ dm dx
IF '$$V2DM(DFN,$PIECE(^DPT(DFN,0),U,3),BGPEDATE)
QUIT
+4 ;quit if not visit w dm pov and primary care provider
IF '$$V1DM(DFN,BGPEDATE)
QUIT
+5 ;older than 18 at beg of tf
IF $$AGE^AUPNPAT(DFN,BGPBDATE)<19
QUIT
+6 IF '$$CREAT(DFN,BGPEDATE)
QUIT
+7 ;set 2C denom
SET BGP2CD=1
DO S(BGPRPT,$SELECT(BGPTIME=1:12,BGPTIME=0:42,BGPTIME=8:82,1:999),10,1)
+8 ;number with hgb a1c done result or not
IF BGPLHGB
DO S(BGPRPT,$SELECT(BGPTIME=1:12,BGPTIME=0:42,BGPTIME=8:82,1:999),11,1)
+9 ;set value 2,3,4 piece and set list
+10 ;set piece 2,3,4
IF $PIECE(BGPHGBV,U,2)
DO S(BGPRPT,$SELECT(BGPTIME=1:12,BGPTIME=0:42,BGPTIME=8:82,1:999),$PIECE(BGPHGBV,U,2)+10,1)
+11 IF $DATA(BGPLIST(5))
IF BGPTIME=1
SET ^XTMP("BGPD",BGPJ,BGPH,"LIST",5,$SELECT($PIECE($GET(^AUPNPAT(DFN,11)),U,18)]"":$PIECE(^AUPNPAT(DFN,11),U,18),1:"UNKNOWN"),$PIECE(^DPT(DFN,0),U,2),BGPAGEE,DFN)=$PIECE(BGPHGBV,U)
+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
LASTHGB(P,EDATE) ;
+1 NEW BGPG,E,D,%
+2 KILL BGPG
+3 SET D=$$FMADD^XLFDT(EDATE,-365)
+4 SET %=P_"^LAST LAB [DM AUDIT HGB A1C;DURING "_$$FMTE^XLFDT(D)_"-"_EDATE
SET E=$$START1^APCLDF(%,"BGPG(")
+5 IF '$DATA(BGPG(1))
QUIT ""
+6 QUIT 1
HGBA1C(P,EDATE) ;EP
+1 NEW BGPG,X,D,E,%,R
+2 KILL BGPG
+3 SET D=$$FMADD^XLFDT(EDATE,-365)
+4 SET %=P_"^LAST LAB [DM AUDIT HGB A1C;DURING "_$$FMTE^XLFDT(D)_"-"_EDATE
SET E=$$START1^APCLDF(%,"BGPG(")
+5 IF '$DATA(BGPG(1))
SET R=""
DO BS
QUIT R
+6 ;get result
SET X=$PIECE(^AUPNVLAB(+$PIECE(BGPG(1),U,4),0),U,4)
+7 IF $$UP^XLFSTR(X)="COMMENT"
DO BS
QUIT R
+8 IF X[">"
QUIT X_"^"_3
+9 IF X["<"
QUIT X_"^"_2
+10 IF $EXTRACT(X)'=+$EXTRACT(X)
DO BS
QUIT R
+11 IF +X'>7
QUIT X_"^"_2
+12 IF +X'<9.5
QUIT X_"^3"
+13 ;S X=""
+14 QUIT X
BS ;EP
+1 NEW BGPBS,A,B,C,T
+2 KILL BGPBS
+3 SET A=P_"^LAST 3 LAB [DM AUDIT GLUCOSE TESTS TAX;DURING "_$$FMTE^XLFDT(D)_"-"_EDATE
SET B=$$START1^APCLDF(A,"BGPBS(")
+4 IF '$DATA(BGPBS(1))
KILL BGPBS
SET R="^4"
QUIT
+5 SET (A,C,T)=0
FOR
SET A=$ORDER(BGPBS(A))
IF A'=+A
QUIT
SET B=$PIECE(^AUPNVLAB(+$PIECE(BGPBS(A),U,4),0),U,4)
IF B=+B
SET C=C+1
SET T=T+B
+6 ;not 3 with numeric value
IF C<3
KILL BGPBS
SET R="^4"
QUIT
+7 SET B=T/3
SET A=$SELECT(B'>150:2,B'<225:3,1:"")
+8 SET R=$JUSTIFY(B,5,1)_"^"_A
+9 QUIT
+10 ;
V1DM(P,EDATE) ;
+1 IF '$GET(P)
QUIT ""
+2 IF '$DATA(^AUPNVSIT("AC",P))
QUIT ""
+3 NEW A,B,E,V,X,G,D,T,PP,Y,PC
+4 SET PC=$ORDER(^ATXAX("B","BGP PRIMARY CARE CLINICS",0))
+5 IF 'PC
QUIT ""
+6 SET PP=$ORDER(^ATXAX("B","BGP PRIMARY PROVIDER DISC",0))
+7 IF 'PP
QUIT ""
+8 SET T=$ORDER(^ATXAX("B","SURVEILLANCE DIABETES",0))
+9 IF 'T
QUIT ""
+10 SET D=$$FMADD^XLFDT(EDATE,-365)
+11 KILL ^TMP($JOB,"A")
+12 SET A="^TMP($J,""A"","
SET B=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(D)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(B,A)
+13 IF '$DATA(^TMP($JOB,"A",1))
QUIT ""
+14 SET (X,G)=0
FOR
SET X=$ORDER(^TMP($JOB,"A",X))
IF X'=+X!(G>2)
QUIT
SET V=$PIECE(^TMP($JOB,"A",X),U,5)
Begin DoDot:1
+15 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+16 IF '$PIECE(^AUPNVSIT(V,0),U,9)
QUIT
+17 IF $PIECE(^AUPNVSIT(V,0),U,11)
QUIT
+18 IF "SAHO"'[$PIECE(^AUPNVSIT(V,0),U,7)
QUIT
+19 IF '$DATA(^AUPNVPRV("AD",V))
QUIT
+20 IF $PIECE(^AUPNVSIT(V,0),U,6)'=DUZ(2)
QUIT
+21 IF '$DATA(^AUPNVPOV("AD",V))
QUIT
+22 SET (D,Y)=0
FOR
SET Y=$ORDER(^AUPNVPOV("AD",V,Y))
IF Y'=+Y!(D)
QUIT
IF $DATA(^AUPNVPOV(Y,0))
SET %=$PIECE(^AUPNVPOV(Y,0),U)
IF $$ICD^ATXCHK(%,T,9)
SET D=1
+23 IF 'D
QUIT
+24 IF "V"[$PIECE(^AUPNVSIT(V,0),U,3)
QUIT
+25 SET Y=$$PRIMPROV^APCLV(V,"F")
+26 IF 'Y
QUIT
+27 IF '$DATA(^ATXAX(PP,21,"B",Y))
QUIT
+28 SET Y=$$CLINIC^APCLV(V,"I")
+29 IF 'Y
QUIT
+30 IF '$DATA(^ATXAX(PC,21,"B",Y))
QUIT
+31 SET G=G+1
+32 QUIT
End DoDot:1
+33 QUIT $SELECT(G<1:"",1:G)
+34 ;
V2(P,BDATE,EDATE) ;
+1 IF '$GET(P)
QUIT ""
+2 IF '$DATA(^AUPNVSIT("AC",P))
QUIT ""
+3 NEW A,B,E,V,X,G
+4 KILL ^TMP($JOB,"A")
+5 SET A="^TMP($J,""A"","
SET B=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(B,A)
+6 IF '$DATA(^TMP($JOB,"A",1))
QUIT ""
+7 SET (X,G)=0
FOR
SET X=$ORDER(^TMP($JOB,"A",X))
IF X'=+X!(G>2)
QUIT
SET V=$PIECE(^TMP($JOB,"A",X),U,5)
Begin DoDot:1
+8 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+9 IF '$PIECE(^AUPNVSIT(V,0),U,9)
QUIT
+10 IF $PIECE(^AUPNVSIT(V,0),U,11)
QUIT
+11 IF "SAHO"'[$PIECE(^AUPNVSIT(V,0),U,7)
QUIT
+12 IF "V"[$PIECE(^AUPNVSIT(V,0),U,3)
QUIT
+13 SET G=G+1
+14 QUIT
End DoDot:1
+15 QUIT $SELECT(G<2:"",1:G)
+16 ;
V2DM(P,BDATE,EDATE) ;
+1 IF '$GET(P)
QUIT ""
+2 IF '$DATA(^AUPNVSIT("AC",P))
QUIT ""
+3 NEW A,B,E,V,X,G,D,T,Y
+4 SET T=$ORDER(^ATXAX("B","SURVEILLANCE DIABETES",0))
+5 IF 'T
QUIT ""
+6 KILL ^TMP($JOB,"A")
+7 SET A="^TMP($J,""A"","
SET B=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(B,A)
+8 IF '$DATA(^TMP($JOB,"A",1))
QUIT ""
+9 SET (X,G)=0
FOR
SET X=$ORDER(^TMP($JOB,"A",X))
IF X'=+X!(G>2)
QUIT
SET V=$PIECE(^TMP($JOB,"A",X),U,5)
Begin DoDot:1
+10 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+11 IF '$PIECE(^AUPNVSIT(V,0),U,9)
QUIT
+12 IF $PIECE(^AUPNVSIT(V,0),U,11)
QUIT
+13 IF "SAHO"'[$PIECE(^AUPNVSIT(V,0),U,7)
QUIT
+14 IF "V"[$PIECE(^AUPNVSIT(V,0),U,3)
QUIT
+15 SET (D,Y)=0
FOR
SET Y=$ORDER(^AUPNVPOV("AD",V,Y))
IF Y'=+Y!(D)
QUIT
IF $DATA(^AUPNVPOV(Y,0))
SET %=$PIECE(^AUPNVPOV(Y,0),U)
IF $$ICD^ATXCHK(%,T,9)
SET D=1
+16 IF 'D
QUIT
+17 SET G=G+1
+18 QUIT
End DoDot:1
+19 QUIT $SELECT(G<2:"",1:G)
+20 ;
FIRSTDM(P,EDATE) ;
+1 IF $GET(P)=""
QUIT ""
+2 NEW X,E,BGPG,Y
+3 KILL BGPG
+4 SET Y="BGPG("
+5 SET X=P_"^FIRST DX [SURVEILLANCE DIABETES"
SET E=$$START1^APCLDF(X,Y)
+6 IF '$DATA(BGPG(1))
QUIT ""
+7 SET X=$$FMDIFF^XLFDT(EDATE,$PIECE(BGPG(1),U))
+8 QUIT $SELECT(X>365:1,1:"")
+9 ;
CREAT(P,EDATE) ;get all creatines all must be <5
+1 NEW BGPG,X,%,E,R,V
+2 KILL BGPG
+3 SET %=P_"^ALL LAB [DM AUDIT CREATININE TAX"
SET E=$$START1^APCLDF(%,"BGPG(")
+4 ;no creatinines 5 or greater
IF '$DATA(BGPG(1))
QUIT 1
+5 SET X=0
SET E=1
FOR
SET X=$ORDER(BGPG(X))
IF X'=+X
QUIT
SET R=$PIECE(BGPG(X),U,2)
IF +R'<5
SET E=""
+6 QUIT E
