BDMPG16 ; IHS/CMI/LAB - 2003 DIABETES AUDIT ;
;;2.0;IHS DIABETES SYSTEM;**12**;JUN 14, 2007;Build 51
;
;
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^BDMPG17(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^BDMPG17(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^BDMPG17(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^BDMPG17(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^BDMDG12(P,BD,EDATE)
I X]"" S STR=STR_5
S X=$$MET^BDMDG12(P,BD,EDATE)
I X]"" S STR=STR_2
S X=$$ACAR^BDMDG12(P,BD,EDATE)
I X]"" S STR=STR_3
S X=$$TROG^BDMDG12(P,BD,EDATE)
I X]"" S STR=STR_"4"
I STR]"" Q STR
Q 1
;
BDMPG16 ; IHS/CMI/LAB - 2003 DIABETES AUDIT ;
+1 ;;2.0;IHS DIABETES SYSTEM;**12**;JUN 14, 2007;Build 51
+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^BDMPG17(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^BDMPG17(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^BDMPG17(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^BDMPG17(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^BDMDG12(P,BD,EDATE)
+5 IF X]""
SET STR=STR_5
+6 SET X=$$MET^BDMDG12(P,BD,EDATE)
+7 IF X]""
SET STR=STR_2
+8 SET X=$$ACAR^BDMDG12(P,BD,EDATE)
+9 IF X]""
SET STR=STR_3
+10 SET X=$$TROG^BDMDG12(P,BD,EDATE)
+11 IF X]""
SET STR=STR_"4"
+12 IF STR]""
QUIT STR
+13 QUIT 1
+14 ;
