BDMD316.m

BDMD316 ; IHS/CMI/LAB - 2003 DIABETES AUDIT ;

 ;;2.0;DIABETES MANAGEMENT SYSTEM;**2**;JUN 14, 2007

 ;

 ;cmi/anch/maw 9/10/2007 code set versioning in TOBACCO1

 ;

TBCODE(P,EDATE,R) ;EP

 NEW BDMJ,BDMI

 S BDMJ=""

 ;return computed TB Status Code

 S X=$$TBTX^BDMD312(P)

 I X]"",X["TX COMPLETE" Q 1

 I X]"" Q 2

 I $$PPD^BDMD318(P,EDATE)["POS" D  Q BDMJ

 .I $$TBTX^BDMD312(P)["TX COMPLETE" S BDMJ=1 Q

 .S BDMJ=2

 .Q

 I $$PPD^BDMD318(P,EDATE)["NEG" S BDMJ=4 D  Q BDMJ

 .I $$DODX(P,R,"I")="" S BDMJ=4 Q

 .S D=$$DODX(P,R,"I"),E=$$PPD^BDMD318(P,EDATE,"I") S BDMJ=$S(D>E:4,1:3)

 .Q

 S BDMJ=5

 Q BDMJ

 ;;

1 ;;PPD +, treatment complete

2 ;;PPD +, not treated/treatment incomplete or unknown treatment

3 ;;PPD -, up-to-date (placed after dm dx)

4 ;;PPD -, before DM dx or date unknown

5 ;;PPD Status unknown

BI() ;

 Q $S($O(^AUTTIMM(0))>100:1,1:0)

SYSMEAN(P,BDATE,EDATE) ;EP

 NEW X S X=$$BPS^BDMD313(P,BDATE,EDATE,"I")

 I X="" Q ""

 NEW Y,C S C=0 F Y=1:1:3 I $P(X,";",Y)]"" S C=C+1

 I C'=3 Q ""

 S C=0 F Y=1:1:3 S C=$P($P(X,";",Y),"/")+C

 Q C\3

 Q ""

DIAMEAN(P,BDATE,EDATE) ;EP

 NEW X S X=$$BPS^BDMD313(P,BDATE,EDATE,"I")

 I X="" Q ""

 NEW Y,C S C=0 F Y=1:1:3 I $P(X,";",Y)]"" S C=C+1

 I C'=3 Q ""

 S C=0 F Y=1:1:3 S C=$P($P(X,";",Y),"/",2)+C

 Q C\3

PPDDATE(P,EDATE) ;EP

 NEW X S X=$$LASTNP^BDMD318(P,EDATE)

 Q X

LIPID(P,BDATE,EDATE) ;EP

 NEW X,BDM,E,G,S,O

 S (S,O,G)="",X=P_"^MEDS [DM AUDIT LIPID LOWERING DRUGS"_";DURING "_BDATE_"-"_EDATE S E=$$START1^APCLDF(X,"BDM(")

 I $D(BDM(1)) S O=1

 K BDM

 S X=P_"^MEDS [DM AUDIT STATIN DRUGS"_";DURING "_BDATE_"-"_EDATE S E=$$START1^APCLDF(X,"BDM(")

 I $D(BDM(1)) S S=1

 I S,O Q "Both"

 I S Q "Statin"

 I O Q "Other"

 ;refusal of NMI

 S G=0

 NEW T S T=$O(^ATXAX("B","DM AUDIT LIPID LOWERING DRUGS",0))

 I 'T Q "None"

 S X=0 F  S X=$O(^ATXAX(T,21,X)) Q:X'=+X!(G)  S G=$$REFUSAL^BDMD317(P,50,$P(^ATXAX(T,21,X,0),U),BDATE,EDATE)

 I G,$P(G,U,2)'="N" Q "Refused"

 I G Q "None - Not Medically Indicated"

 NEW T S T=$O(^ATXAX("B","DM AUDIT STATIN DRUGS",0))

 I 'T Q "None"

 S (X,G)=0 F  S X=$O(^ATXAX(T,21,X)) Q:X'=+X!(G)  S G=$$REFUSAL^BDMD317(P,50,$P(^ATXAX(T,21,X,0),U),BDATE,EDATE)

 I G,$P(G,U,2)'="N" Q "Refused"

 I G Q "None - Not Medically Indicated"

 ;

 Q "None"

 ;

 ;

ACE(P,BDATE,EDATE) ;EP

 NEW X,BDM,E,X,Y,%DT,BD,G

 S X=P_"^MEDS [DM AUDIT ACE INHIBITORS"_";DURING "_BDATE_"-"_EDATE S E=$$START1^APCLDF(X,"BDM(")

 I $D(BDM(1)) Q "Yes"

 ;go through all v meds until 9999999-D and find all drugs with class CV800 or CV805

 NEW D,%DT K %DT S X=BDATE,%DT="P" D ^%DT S D=Y

 NEW V,I,%

 S %=""

 S I=0 F  S I=$O(^AUPNVMED("AA",P,I)) Q:I'=+I!(%)!(I>(9999999-D))  D

 .S V=0 F  S V=$O(^AUPNVMED("AA",P,I,V)) Q:V'=+V  S G=$P(^AUPNVMED(V,0),U) I $P($G(^PSDRUG(G,0)),U,2)="CV800"!($P($G(^PSDRUG(G,0)),U,2)="CV805") S %=$P($P(^AUPNVSIT($P(^AUPNVMED(V,0),U,3),0),U),".")

 I %]"" Q "Yes"

 ;refusals

 NEW T S T=$O(^ATXAX("B","DM AUDIT ACE INHIBITORS",0))

 I 'T Q "No"

 S (G,X)=0 F  S X=$O(^ATXAX(T,21,X)) Q:X'=+X!(G)  S G=$$REFUSAL^BDMD317(P,50,$P(^ATXAX(T,21,X,0),U),BDATE,EDATE)

 I G,$P(G,U,2)'="N" Q "Refused"

 Q "No"_$S(G:" - Not Medically Indicated",1:"")

 ;

SELF(P,BDATE,EDATE) ;EP

 NEW T,BDM,E,X,%DT,Y,ED,BD

 S X=EDATE,%DT="P" D ^%DT S ED=Y

 S X=BDATE,%DT="P" D ^%DT S BD=Y

 S E=$$LASTHF^BDMD319(P,"DIABETES SELF MONITORING",BD,ED,"F")

 I E]"" Q $S(E["YES":"Yes",E["NO":"No",E["REFUSED":"Refused",1:"")

 S X=P_"^MEDS [DM AUDIT SELF MONITOR DRUGS"_";DURING "_BDATE_"-"_EDATE S E=$$START1^APCLDF(X,"BDM(")

 I $D(BDM(1)) Q "Yes"

 Q "No"

SDM(P,BDATE,EDATE) ;EP

 NEW T,BDM,E,X,%DT,Y,ED,BD

 S X=EDATE,%DT="P" D ^%DT S ED=Y

 S X=BDATE,%DT="P" D ^%DT S BD=Y

 S E=$$LASTHF^BDMD319(P,"STAGED DIABETES MANAGEMENT",BD,ED)

 I E Q "Yes"

 S T=$O(^ATXAX("B","DM AUDIT SDM PROVIDERS",0))

 I 'T Q ""

 S %=P_"^ALL DX [SURVEILLANCE DIABETES;DURING "_BDATE_"-"_EDATE,E=$$START1^APCLDF(%,"BDM(")

 ;check to see if one of the providers was the primary prov

 NEW X,V,G,P,P1 S (G,X)=0 F  S X=$O(BDM(X)) Q:X'=+X!(G)  S V=$P(BDM(X),U,5) D

 .S P=0 F  S P=$O(^AUPNVPRV("AD",V,P)) Q:P'=+P!(G)  S P1=$P(^AUPNVPRV(P,0),U) I $D(^ATXAX(T,21,"B",P1)) S G=1

 .Q

 Q $S(G:"Yes",1:"No")

PERI(P,BDATE,EDATE) ;EP

 I '$G(P) Q ""

 NEW BDM,% S %=P_"^LAST ADA [DM AUDIT PERIDONTAL ADA CODES;DURING "_BDATE_"-"_EDATE,E=$$START1^APCLDF(%,"BDM(")

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

 K BDM

 S %=P_"^ALL VISITS;DURING "_BDATE_"-"_EDATE,E=$$START1^APCLDF(%,"BDM(")

 NEW X,Y S X=0,Y=0 F  S X=$O(BDM(X)) Q:X'=+X!(Y)  I $$CLINIC^APCLV($P(BDM(X),U,5),"C")=56 S Y=1

 I Y Q "Yes - clinic 56 visit"

 Q "No"

 ;

ASPIRIN(P,BDATE,EDATE) ;EP

 NEW X,BDM,E,A,N,G

 S (A,B,G,N)=""

 S X=P_"^MEDS [DM AUDIT ASPIRIN DRUGS"_";DURING "_BDATE_"-"_EDATE S E=$$START1^APCLDF(X,"BDM(")

 I $D(BDM(1)) S A=1

 K BDM S X=P_"^MEDS [DM AUDIT ANTI-PLATELET DRUGS"_";DURING "_BDATE_"-"_EDATE S E=$$START1^APCLDF(X,"BDM(")

 I $D(BDM(1)) S N=1

 I A+N=2 Q "Both"

 I A Q "Aspirin"

 I N Q "Other"

 ;refusal of NMI

 S G=0

 NEW T S T=$O(^ATXAX("B","DM AUDIT ASPIRIN DRUGS",0))

 I 'T Q "None"

 S X=0 F  S X=$O(^ATXAX(T,21,X)) Q:X'=+X!(G)  S G=$$REFUSAL^BDMD317(P,50,$P(^ATXAX(T,21,X,0),U),BDATE,EDATE)

 I G,$P(G,U,2)'="N" Q "Refused"

 I G Q "None - Not Medically Indicated"

 NEW T S T=$O(^ATXAX("B","DM AUDIT ANTI-PLATELET DRUGS",0))

 I 'T Q "None"

 S (X,G)=0 F  S X=$O(^ATXAX(T,21,X)) Q:X'=+X!(G)  S G=$$REFUSAL^BDMD317(P,50,$P(^ATXAX(T,21,X,0),U),BDATE,EDATE)

 I G,$P(G,U,2)'="N" Q "Refused"

 I G Q "None - Not Medically Indicated"

 ;

 Q "None"

 ;

TOBACCO(P,EDATE) ;EP

 I '$G(P) Q ""

 NEW BDMTOB,BDM,X,E

 D TOBACCO0

 I $D(BDMTOB) Q BDMTOB

 D TOBACCO3

 I $D(BDMTOB) Q BDMTOB

 D TOBACCO1 ;check Problem file for tobacco use

 I $D(BDMTOB) Q BDMTOB

 D TOBACCO2 ;check POVs for tobacco use

 I $D(BDMTOB) Q BDMTOB

 Q "3  Not Documented "

TOBACCO0 ;check for tobacco documented in health factors

 K BDM S X=P_"^LAST HEALTH [DM AUDIT TOBACCO HLTH FACTORS" S E=$$START1^APCLDF(X,"BDM(") Q:E  I $D(BDM(1)) D  ;S BDMTOBN=$O(BDMTOB("")),BDMTOB=BDMTOB(BDMTOBN)

 . I $P(BDM(1),U,3)["CURRENT" S BDMTOB="1  Current User" Q

 . S BDMTOB="2  Not a Current User "

 .Q

 Q

TOBACCO3 ;lookup in health status

 S %=$O(^ATXAX("B","DM AUDIT TOBACCO HLTH FACTORS",0))

 Q:'%

 S (X,Y)=0 F  S X=$O(^AUPNHF("AA",P,X)) Q:X'=+X!(Y)  I $D(^ATXAX(%,21,"B",X)) S Y=X

 Q:'Y

 S Y=$P(^AUTTHF(Y,0),U)

 S BDMTOB=Y

 I Y["CURRENT" S BDMTOB="1  Current User" Q

 S BDMTOB="2  Not a Current User"

 Q

TOBACCO1 ;check problem file for tobacco use

 K BDM S X=P_"^PROBLEMS [DM AUDIT PROBLEM SMOKING DXS" S E=$$START1^APCLDF(X,"BDM(") Q:E  I $D(BDM(1)) D

 . ;I $P(^ICD9($P(BDM(1),U,2),0),U,1)=305.13 S BDMTOB="2  Not a Current User"_" - "_$E($P(^AUTNPOV($P(^AUPNPROB(+$P(BDM(1),U,4),0),U,5),0),U),1,30) Q  ;cmi/anch/maw 9/10/2007 orig line

 . I $P($$ICDDX^ICDCODE($P(BDM(1),U,2)),U,2)=305.13 S BDMTOB="2  Not a Current User"_" - "_$E($P(^AUTNPOV($P(^AUPNPROB(+$P(BDM(1),U,4),0),U,5),0),U),1,30) Q  ;cmi/anch/maw 9/10/2007 csv

 . S BDMTOB="1  Current user - "_$E($P(^AUTNPOV($P(^AUPNPROB(+$P(BDM(1),U,4),0),U,5),0),U),1,30)

 .Q

 Q

TOBACCO2 ;check pov file for TOBACCO USE DOC

 NEW D,%DT

 S %DT="P",X=EDATE D ^%DT S D=Y

 NEW BDATE S BDATE=$$FMADD^XLFDT(D,-365),BDATE=$$FMTE^XLFDT(BDATE)

 K BDM S X=P_"^LAST DX [DM AUDIT SMOKING RELATED DXS;DURING "_BDATE_"-"_EDATE S E=$$START1^APCLDF(X,"BDM(") Q:E  I $D(BDM(1)) D

 . I $P(BDM(1),U,2)=305.13 S BDMTOB="2  Not a Current User"_" - "_$E($P(^AUTNPOV($P(^AUPNVPOV(+$P(BDM(1),U,4),0),U,4),0),U),1,30) Q

 . S BDMTOB="1  Current user"_" - "_$E($P(^AUTNPOV($P(^AUPNVPOV(+$P(BDM(1),U,4),0),U,4),0),U),1,30)

 .Q

 Q

 ;

THERAPY(P,BD,EDATE) ;EP - therapy code for epi

 I '$G(P) Q ""

 NEW STR,TNAME,X,Y,%DT

 S STR="",TNAME=""

 S X=$$INSULIN^BDMD312(P,BD,EDATE)

 I X]"" S STR=STR_"2"

 S X=$$SULF^BDMD312(P,BD,EDATE)

 I X]"" S STR=STR_3

 S X=$$MET^BDMD312(P,BD,EDATE)

 I X]"" S STR=STR_4

 S X=$$ACAR^BDMD312(P,BD,EDATE)

 I X]"" S STR=STR_5

 S X=$$TROG^BDMD312(P,BD,EDATE)

 I X]"" S STR=STR_"6"

 I STR]"" Q STR

 Q 1

 ;

TYPE(P,R,EDATE) ;EP return type 1 or 2 for epi file

 I '$G(P) Q ""

 NEW TYPE S TYPE=""

 I $G(R) S TYPE=$$CMSFDX^BDMD313(P,R,"DX")

 I TYPE="NIDDM" Q 2

 I TYPE["TYPE II" Q 2

 I TYPE="IDDM" Q 1

 I TYPE["2" Q 2

 I TYPE["1" Q 1

 S TYPE="" NEW X,I,C S X=$$PLDMDXS^BDMD313(P)

 F I=1:1 S C=$P(X,";",I) Q:C=""!(TYPE]"")  I $E(C,6)=0!($E(C,6)=2) S TYPE=2

 I TYPE]"" Q TYPE

 F I=1:1 S C=$P(X,";",I) Q:C=""!(TYPE]"")  I $E(C,6)=1!($E(C,6)=3) S TYPE=1

 I TYPE]"" Q TYPE

 S X=$$LASTDMDX^BDMD313(P,EDATE)

 I X[2 Q 2

 I X[1 Q 1

 Q ""

 ;

DURDM(P,R,EDATE) ;EP

 I '$G(P) Q ""

 NEW Y S Y=$$DODX(P,R,"I")

 I Y="" Q ""

 I Y>EDATE Q ""

 Q ($$FMDIFF^XLFDT(EDATE,Y,1)\365)

DODX(P,R,F) ;EP - date of dx for epi file

 I $G(F)="" S F="E"

 NEW DATE,EARLY

 S DATE="",EARLY=9999999

 I $G(R) S DATE=$$CMSFDX^BDMD313(P,R,"ID")

 I DATE]"" S EARLY=DATE

 S DATE=$$PLDMDOO^BDMD313(P,"I")

 I DATE]"",DATE<EARLY S EARLY=DATE

 I EARLY=9999999 S EARLY=""

 Q $S(F="I":EARLY,1:$$D(EARLY))

D(D) ;

 I D="" Q ""

 Q $S($E(D,4,5)="00":"07",1:$E(D,4,5))_"/"_$S($E(D,6,7)="00":"15",1:$E(D,6,7))_"/"_(1700+$E(D,1,3))

 ;

 ;;

BDMD316   ; IHS/CMI/LAB - 2003 DIABETES AUDIT ;

 +1       ;;2.0;DIABETES MANAGEMENT SYSTEM;**2**;JUN 14, 2007

 +2       ;

 +3       ;cmi/anch/maw 9/10/2007 code set versioning in TOBACCO1

 +4       ;

TBCODE(P,EDATE,R) ;EP

 +1        NEW BDMJ,BDMI

 +2        SET BDMJ=""

 +3       ;return computed TB Status Code

 +4        SET X=$$TBTX^BDMD312(P)

 +5        IF X]""

               IF X["TX COMPLETE"

                   QUIT 1

 +6        IF X]""

               QUIT 2

 +7        IF $$PPD^BDMD318(P,EDATE)["POS"

               Begin DoDot:1

 +8                IF $$TBTX^BDMD312(P)["TX COMPLETE"

                       SET BDMJ=1

                       QUIT 

 +9                SET BDMJ=2

 +10               QUIT 

               End DoDot:1

               QUIT BDMJ

 +11       IF $$PPD^BDMD318(P,EDATE)["NEG"

               SET BDMJ=4

               Begin DoDot:1

 +12               IF $$DODX(P,R,"I")=""

                       SET BDMJ=4

                       QUIT 

 +13               SET D=$$DODX(P,R,"I")

                   SET E=$$PPD^BDMD318(P,EDATE,"I")

                   SET BDMJ=$SELECT(D>E:4,1:3)

 +14               QUIT 

               End DoDot:1

               QUIT BDMJ

 +15       SET BDMJ=5

 +16       QUIT BDMJ

 +17      ;;

1         ;;PPD +, treatment complete

2         ;;PPD +, not treated/treatment incomplete or unknown treatment

3         ;;PPD -, up-to-date (placed after dm dx)

4         ;;PPD -, before DM dx or date unknown

5         ;;PPD Status unknown

BI()      ;

 +1        QUIT $SELECT($ORDER(^AUTTIMM(0))>100:1,1:0)

SYSMEAN(P,BDATE,EDATE) ;EP

 +1        NEW X

           SET X=$$BPS^BDMD313(P,BDATE,EDATE,"I")

 +2        IF X=""

               QUIT ""

 +3        NEW Y,C

           SET C=0

           FOR Y=1:1:3

               IF $PIECE(X,";",Y)]""

                   SET C=C+1

 +4        IF C'=3

               QUIT ""

 +5        SET C=0

           FOR Y=1:1:3

               SET C=$PIECE($PIECE(X,";",Y),"/")+C

 +6        QUIT C\3

 +7        QUIT ""

DIAMEAN(P,BDATE,EDATE) ;EP

 +1        NEW X

           SET X=$$BPS^BDMD313(P,BDATE,EDATE,"I")

 +2        IF X=""

               QUIT ""

 +3        NEW Y,C

           SET C=0

           FOR Y=1:1:3

               IF $PIECE(X,";",Y)]""

                   SET C=C+1

 +4        IF C'=3

               QUIT ""

 +5        SET C=0

           FOR Y=1:1:3

               SET C=$PIECE($PIECE(X,";",Y),"/",2)+C

 +6        QUIT C\3

PPDDATE(P,EDATE) ;EP

 +1        NEW X

           SET X=$$LASTNP^BDMD318(P,EDATE)

 +2        QUIT X

LIPID(P,BDATE,EDATE) ;EP

 +1        NEW X,BDM,E,G,S,O

 +2        SET (S,O,G)=""

           SET X=P_"^MEDS [DM AUDIT LIPID LOWERING DRUGS"_";DURING "_BDATE_"-"_EDATE

           SET E=$$START1^APCLDF(X,"BDM(")

 +3        IF $DATA(BDM(1))

               SET O=1

 +4        KILL BDM

 +5        SET X=P_"^MEDS [DM AUDIT STATIN DRUGS"_";DURING "_BDATE_"-"_EDATE

           SET E=$$START1^APCLDF(X,"BDM(")

 +6        IF $DATA(BDM(1))

               SET S=1

 +7        IF S

               IF O

                   QUIT "Both"

 +8        IF S

               QUIT "Statin"

 +9        IF O

               QUIT "Other"

 +10      ;refusal of NMI

 +11       SET G=0

 +12       NEW T

           SET T=$ORDER(^ATXAX("B","DM AUDIT LIPID LOWERING DRUGS",0))

 +13       IF 'T

               QUIT "None"

 +14       SET X=0

           FOR 

               SET X=$ORDER(^ATXAX(T,21,X))

               IF X'=+X!(G)

                   QUIT 

               SET G=$$REFUSAL^BDMD317(P,50,$PIECE(^ATXAX(T,21,X,0),U),BDATE,EDATE)

 +15       IF G

               IF $PIECE(G,U,2)'="N"

                   QUIT "Refused"

 +16       IF G

               QUIT "None - Not Medically Indicated"

 +17       NEW T

           SET T=$ORDER(^ATXAX("B","DM AUDIT STATIN DRUGS",0))

 +18       IF 'T

               QUIT "None"

 +19       SET (X,G)=0

           FOR 

               SET X=$ORDER(^ATXAX(T,21,X))

               IF X'=+X!(G)

                   QUIT 

               SET G=$$REFUSAL^BDMD317(P,50,$PIECE(^ATXAX(T,21,X,0),U),BDATE,EDATE)

 +20       IF G

               IF $PIECE(G,U,2)'="N"

                   QUIT "Refused"

 +21       IF G

               QUIT "None - Not Medically Indicated"

 +22      ;

 +23       QUIT "None"

 +24      ;

 +25      ;

ACE(P,BDATE,EDATE) ;EP

 +1        NEW X,BDM,E,X,Y,%DT,BD,G

 +2        SET X=P_"^MEDS [DM AUDIT ACE INHIBITORS"_";DURING "_BDATE_"-"_EDATE

           SET E=$$START1^APCLDF(X,"BDM(")

 +3        IF $DATA(BDM(1))

               QUIT "Yes"

 +4       ;go through all v meds until 9999999-D and find all drugs with class CV800 or CV805

 +5        NEW D,%DT

           KILL %DT

           SET X=BDATE

           SET %DT="P"

           DO ^%DT

           SET D=Y

 +6        NEW V,I,%

 +7        SET %=""

 +8        SET I=0

           FOR 

               SET I=$ORDER(^AUPNVMED("AA",P,I))

               IF I'=+I!(%)!(I>(9999999-D))

                   QUIT 

               Begin DoDot:1

 +9                SET V=0

                   FOR 

                       SET V=$ORDER(^AUPNVMED("AA",P,I,V))

                       IF V'=+V

                           QUIT 

                       SET G=$PIECE(^AUPNVMED(V,0),U)

                       IF $PIECE($GET(^PSDRUG(G,0)),U,2)="CV800"!($PIECE($GET(^PSDRUG(G,0)),U,2)="CV805")

                           SET %=$PIECE($PIECE(^AUPNVSIT($PIECE(^AUPNVMED(V,0),U,3),0),U),".")

               End DoDot:1

 +10       IF %]""

               QUIT "Yes"

 +11      ;refusals

 +12       NEW T

           SET T=$ORDER(^ATXAX("B","DM AUDIT ACE INHIBITORS",0))

 +13       IF 'T

               QUIT "No"

 +14       SET (G,X)=0

           FOR 

               SET X=$ORDER(^ATXAX(T,21,X))

               IF X'=+X!(G)

                   QUIT 

               SET G=$$REFUSAL^BDMD317(P,50,$PIECE(^ATXAX(T,21,X,0),U),BDATE,EDATE)

 +15       IF G

               IF $PIECE(G,U,2)'="N"

                   QUIT "Refused"

 +16       QUIT "No"_$SELECT(G:" - Not Medically Indicated",1:"")

 +17      ;

SELF(P,BDATE,EDATE) ;EP

 +1        NEW T,BDM,E,X,%DT,Y,ED,BD

 +2        SET X=EDATE

           SET %DT="P"

           DO ^%DT

           SET ED=Y

 +3        SET X=BDATE

           SET %DT="P"

           DO ^%DT

           SET BD=Y

 +4        SET E=$$LASTHF^BDMD319(P,"DIABETES SELF MONITORING",BD,ED,"F")

 +5        IF E]""

               QUIT $SELECT(E["YES":"Yes",E["NO":"No",E["REFUSED":"Refused",1:"")

 +6        SET X=P_"^MEDS [DM AUDIT SELF MONITOR DRUGS"_";DURING "_BDATE_"-"_EDATE

           SET E=$$START1^APCLDF(X,"BDM(")

 +7        IF $DATA(BDM(1))

               QUIT "Yes"

 +8        QUIT "No"

SDM(P,BDATE,EDATE) ;EP

 +1        NEW T,BDM,E,X,%DT,Y,ED,BD

 +2        SET X=EDATE

           SET %DT="P"

           DO ^%DT

           SET ED=Y

 +3        SET X=BDATE

           SET %DT="P"

           DO ^%DT

           SET BD=Y

 +4        SET E=$$LASTHF^BDMD319(P,"STAGED DIABETES MANAGEMENT",BD,ED)

 +5        IF E

               QUIT "Yes"

 +6        SET T=$ORDER(^ATXAX("B","DM AUDIT SDM PROVIDERS",0))

 +7        IF 'T

               QUIT ""

 +8        SET %=P_"^ALL DX [SURVEILLANCE DIABETES;DURING "_BDATE_"-"_EDATE

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

 +9       ;check to see if one of the providers was the primary prov

 +10       NEW X,V,G,P,P1

           SET (G,X)=0

           FOR 

               SET X=$ORDER(BDM(X))

               IF X'=+X!(G)

                   QUIT 

               SET V=$PIECE(BDM(X),U,5)

               Begin DoDot:1

 +11               SET P=0

                   FOR 

                       SET P=$ORDER(^AUPNVPRV("AD",V,P))

                       IF P'=+P!(G)

                           QUIT 

                       SET P1=$PIECE(^AUPNVPRV(P,0),U)

                       IF $DATA(^ATXAX(T,21,"B",P1))

                           SET G=1

 +12               QUIT 

               End DoDot:1

 +13       QUIT $SELECT(G:"Yes",1:"No")

PERI(P,BDATE,EDATE) ;EP

 +1        IF '$GET(P)

               QUIT ""

 +2        NEW BDM,%

           SET %=P_"^LAST ADA [DM AUDIT PERIDONTAL ADA CODES;DURING "_BDATE_"-"_EDATE

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

 +3        IF $DATA(BDM(1))

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

 +4        KILL BDM

 +5        SET %=P_"^ALL VISITS;DURING "_BDATE_"-"_EDATE

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

 +6        NEW X,Y

           SET X=0

           SET Y=0

           FOR 

               SET X=$ORDER(BDM(X))

               IF X'=+X!(Y)

                   QUIT 

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

                   SET Y=1

 +7        IF Y

               QUIT "Yes - clinic 56 visit"

 +8        QUIT "No"

 +9       ;

ASPIRIN(P,BDATE,EDATE) ;EP

 +1        NEW X,BDM,E,A,N,G

 +2        SET (A,B,G,N)=""

 +3        SET X=P_"^MEDS [DM AUDIT ASPIRIN DRUGS"_";DURING "_BDATE_"-"_EDATE

           SET E=$$START1^APCLDF(X,"BDM(")

 +4        IF $DATA(BDM(1))

               SET A=1

 +5        KILL BDM

           SET X=P_"^MEDS [DM AUDIT ANTI-PLATELET DRUGS"_";DURING "_BDATE_"-"_EDATE

           SET E=$$START1^APCLDF(X,"BDM(")

 +6        IF $DATA(BDM(1))

               SET N=1

 +7        IF A+N=2

               QUIT "Both"

 +8        IF A

               QUIT "Aspirin"

 +9        IF N

               QUIT "Other"

 +10      ;refusal of NMI

 +11       SET G=0

 +12       NEW T

           SET T=$ORDER(^ATXAX("B","DM AUDIT ASPIRIN DRUGS",0))

 +13       IF 'T

               QUIT "None"

 +14       SET X=0

           FOR 

               SET X=$ORDER(^ATXAX(T,21,X))

               IF X'=+X!(G)

                   QUIT 

               SET G=$$REFUSAL^BDMD317(P,50,$PIECE(^ATXAX(T,21,X,0),U),BDATE,EDATE)

 +15       IF G

               IF $PIECE(G,U,2)'="N"

                   QUIT "Refused"

 +16       IF G

               QUIT "None - Not Medically Indicated"