Routine: BGPD2

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)

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)

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)

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

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

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

BGPD2.m