Routine: BDMPD16

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

 ;;2.0;DIABETES MANAGEMENT SYSTEM;**9**;JUN 14, 2007;Build 78

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^BDMPD17(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^BDMPD17(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"

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^BDMPD17(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^BDMPD17(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"

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

 I '$G(P) Q ""

 NEW STR,TNAME,X,Y,%DT

 S STR="",TNAME=""

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

 I X]"" S STR=STR_5

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

 I X]"" S STR=STR_2

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

 I X]"" S STR=STR_3

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

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

 I STR]"" Q STR

Q 1

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

 +1       ;;2.0;DIABETES MANAGEMENT SYSTEM;**9**;JUN 14, 2007;Build 78

 +2       ;

 +3       ;

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^BDMPD17(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 ANTI-PLATELET 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^BDMPD17(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"

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^BDMPD17(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^BDMPD17(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      ;

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

 +1        IF '$GET(P)

               QUIT ""

 +2        NEW STR,TNAME,X,Y,%DT

 +3        SET STR=""

           SET TNAME=""

 +4        SET X=$$SULF^BDMDD12(P,BD,EDATE)

 +5        IF X]""

               SET STR=STR_5

 +6        SET X=$$MET^BDMDD12(P,BD,EDATE)

 +7        IF X]""

               SET STR=STR_2

 +8        SET X=$$ACAR^BDMDD12(P,BD,EDATE)

 +9        IF X]""

               SET STR=STR_3

 +10       SET X=$$TROG^BDMDD12(P,BD,EDATE)

 +11       IF X]""

               SET STR=STR_"4"

 +12       IF STR]""

               QUIT STR

 +13       QUIT 1

 +14      ;

BDMPD16.m