BQITRCSG ;VNGT/HS/ALA-CVD Significant Risk Treatment Prompts ; 02 Sep 2008 11:52 AM
;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
;
HBP(BQDFN) ;EP CVD.TP-27 High BP
; If 2 of last 3 non-ER blood pressures in past 2 years are
; Systolic =>140 or Diastolic =>90
NEW X,MEET,DESC,TEXT,BQI,QFL
S MEET=0,DESC="",TEXT=""
S X=$$BP^BQITRUTL("T-24M",BQDFN,140,90,"'<")
I $P(X,U,2)'="" D
. NEW NDATE
. S QFL=0
. F BQI=1:1:3 D Q:QFL
.. I $P($P(X,U,2),";",BQI)="No BPs in timeframe" S TEXT=$P($P(X,U,2),";",BQI),QFL=1 Q
.. S NDATE=$$FMTE^BQIUL1($P($P(X,U,2),";",BQI))_"("_$P($P(X,U,5),";",BQI)_")",TEXT=TEXT_NDATE_";"
I $P(X,U,1)=0 S MEET=0,DESC="2 of last 3 non-ER BP are not valid values ["_TEXT_"]" Q MEET_U_DESC
I $P(X,U,1)=1 D
. S MEET=1,DESC=DESC_$$PBP^BQITRCKN(DESC,X)
Q MEET_U_DESC
;
TGR(BQDFN) ;EP CVD.TP-37 TG Recommendation
; If patient's most recent TG (within last 5 years) is >500
NEW MEET,DESC,X,TREF,TAX
S MEET=0,DESC=""
S TREF=$NA(^TMP("BQITAX",UID)) K @TREF
F TAX="DM AUDIT TRIGLYCERIDE TAX","BGP TRIGLYCERIDE LOINC CODES" D BLD^BQITUTL(TAX,TREF)
S X=$$LAB^BQITRUTL("T-60M",1,BQDFN,"",500,">","","",.TREF)
I $P(X,U,1)=1 S MEET=1,DESC="Most recent Triglyceride is greater than 500 ("_$$FMTE^BQIUL1($P(X,U,2))_" "_$P(X,U,3)_")"_U_$P(X,U,2,5)
I $P(X,U,1)=0 S MEET=0,DESC="Most recent Triglyceride is not greater than 500 ("_$$FMTE^BQIUL1($P(X,U,2))_" "_$P(X,U,3)_")"
K @TREF
Q MEET_U_DESC
;
TGRNG(BQDFN) ;EP CVD.TP-36 TG not at Goal
; If patient's most recent TG (within last 5 years) is 150-499
NEW MEET,DESC,X,TREF,TAX
S MEET=0,DESC=""
S TREF=$NA(^TMP("BQITAX",UID)) K @TREF
F TAX="DM AUDIT TRIGLYCERIDE TAX","BGP TRIGLYCERIDE LOINC CODES" D BLD^BQITUTL(TAX,TREF)
S X=$$LAB^BQITRUTL("T-60M",1,BQDFN,"",149,">",500,"<",.TREF)
I $P(X,U,1)=1 S MEET=1,DESC="Most recent Triglyceride is 150-499 ("_$$FMTE^BQIUL1($P(X,U,2))_" "_$P(X,U,3)_")"_U_$P(X,U,2,5)
I $P(X,U,1)=0 S MEET=0,DESC="Most recent Triglyceride is not between 150-499 ("_$$FMTE^BQIUL1($P(X,U,2))_" "_$P(X,U,3)_")"
K @TREF
Q MEET_U_DESC
;
HLDL(BQDFN) ;EP CVD-TP.38 High LDL
; If most recent LDL >160
NEW MEET,DESC,X,TREF,TAX
S MEET=0,DESC=""
S TREF=$NA(^TMP("BQITAX",UID)) K @TREF
F TAX="DM AUDIT LDL CHOLESTEROL TAX","BGP LDL LOINC CODES" D BLD^BQITUTL(TAX,TREF)
S X=$$LAB^BQITRUTL("",1,BQDFN,"",160,">","","",.TREF)
I $P(X,U,1)=1 S MEET=1,DESC="LDL greater than 160 ("_$$FMTE^BQIUL1($P(X,U,2))_" "_$P(X,U,3)_")"_U_$P(X,U,2,5)
I $P(X,U,1)=0 S MEET=0,DESC="LDL not greater than 160 ("_$$FMTE^BQIUL1($P(X,U,2))_" "_$P(X,U,3)_")"
K @TREF
Q MEET_U_DESC
;
LHDL(BQDFN) ;EP CVD-TP.39 Low HDL
; If LDL <=160 and if ON Statin or contraindicated AND HDL <40
NEW X,MEET,DESC,RETURN,TREF,TAX,DDESC
S MEET=0,DESC=""
S TREF=$NA(^TMP("BQITAX",UID)) K @TREF
F TAX="DM AUDIT LDL CHOLESTEROL TAX","BGP LDL LOINC CODES" D BLD^BQITUTL(TAX,TREF)
S X=$$LAB^BQITRUTL("",1,BQDFN,"",160,"'>","","",.TREF)
I $P(X,U,1)=1 S MEET=1,DESC=DESC_"LDL less than or equal to 160 ("_$$FMTE^BQIUL1($P(X,U,2))_" "_$P(X,U,3)_")"
I $P(X,U,1)=0 S MEET=0,DESC=DESC_"LDL greater than 160 ("_$$FMTE^BQIUL1($P(X,U,2))_" "_$P(X,U,3)_")"
I 'MEET Q MEET_U_DESC
S DDESC=DESC
S RETURN=$$STAT(BQDFN)
I $P(RETURN,U,1)=0 Q 0_U_DDESC_" and "_$P(RETURN,U,2)
I $P(RETURN,U,1)=1 S $P(DESC,U,1)=$P(DESC,U,1)_"; "_$P(RETURN,U,2)
S RETURN=$$HDL^BQITRCHR(BQDFN)
I $P(RETURN,U,1)=0 Q 0_U_$P(RETURN,U,2)
I $P(RETURN,U,1)=1 S $P(DESC,U,1)=$P(DESC,U,1)_"; "_$P(RETURN,U,2,6)
Q 1_U_DESC
;
STAT(BQDFN) ; EP CVD.TP-39 Not on Statin
NEW CT,X,VISIT,VSDTM,MEET,DESC,TIEN,T2,PRGM,QFL,RESULT,TREF,GREF,IEN,ENDT
NEW C,BQGPRG,BGPDXBD,BGPDXED,TAX,TREF
S MEET=0,DESC=""
S TREF=$NA(^TMP("BQITAX",UID)) K @TREF
F TAX="BGP HEDIS STATIN MEDS","BGP HEDIS STATIN NDC" D BLD^BQITUTL(TAX,TREF)
S X=$$TAX^BQITRUTL("","",1,BQDFN,9000010.14,"","",.TREF)
; if returns a found medication, check if it is an active medication
I $P(X,U,1)=1 D
. I $$ACTMED^BKMQQCR4($P(X,U,5)) Q
. S $P(X,U,1)=0
I $P(X,U,1)=1 S MEET=1,DESC=DESC_"On Statin Meds ("_$$FMTE^BQIUL1($P(X,U,2))_" "_$$GET1^DIQ(9000010.14,$P(X,U,5)_",",.01,"E")_")"
I $P(X,U,1)=0 S MEET=0,DESC=DESC_"Not on Statin Meds "
D
. S X=$$STAT^BQITRCON(BQDFN,$G(BDATE,""),$G(EDATE,""))
. I $P(X,U,1)=1 S MEET=0,DESC="Has a contraindication: "_$P(X,U,2) Q
. S MEET=$S(MEET:0,1:1)
. S X=$$STAT^BQITRALG(BQDFN,$G(BDATE,""),$G(EDATE,""))
. I $P(X,U,1)=1 S MEET=0,DESC="Has an allergy: "_$P(X,U,2) Q
. S MEET=$S(MEET:0,1:1)
Q MEET_U_DESC
BQITRCSG ;VNGT/HS/ALA-CVD Significant Risk Treatment Prompts ; 02 Sep 2008 11:52 AM
+1 ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
+2 ;
HBP(BQDFN) ;EP CVD.TP-27 High BP
+1 ; If 2 of last 3 non-ER blood pressures in past 2 years are
+2 ; Systolic =>140 or Diastolic =>90
+3 NEW X,MEET,DESC,TEXT,BQI,QFL
+4 SET MEET=0
SET DESC=""
SET TEXT=""
+5 SET X=$$BP^BQITRUTL("T-24M",BQDFN,140,90,"'<")
+6 IF $PIECE(X,U,2)'=""
Begin DoDot:1
+7 NEW NDATE
+8 SET QFL=0
+9 FOR BQI=1:1:3
Begin DoDot:2
+10 IF $PIECE($PIECE(X,U,2),";",BQI)="No BPs in timeframe"
SET TEXT=$PIECE($PIECE(X,U,2),";",BQI)
SET QFL=1
QUIT
+11 SET NDATE=$$FMTE^BQIUL1($PIECE($PIECE(X,U,2),";",BQI))_"("_$PIECE($PIECE(X,U,5),";",BQI)_")"
SET TEXT=TEXT_NDATE_";"
End DoDot:2
IF QFL
QUIT
End DoDot:1
+12 IF $PIECE(X,U,1)=0
SET MEET=0
SET DESC="2 of last 3 non-ER BP are not valid values ["_TEXT_"]"
QUIT MEET_U_DESC
+13 IF $PIECE(X,U,1)=1
Begin DoDot:1
+14 SET MEET=1
SET DESC=DESC_$$PBP^BQITRCKN(DESC,X)
End DoDot:1
+15 QUIT MEET_U_DESC
+16 ;
TGR(BQDFN) ;EP CVD.TP-37 TG Recommendation
+1 ; If patient's most recent TG (within last 5 years) is >500
+2 NEW MEET,DESC,X,TREF,TAX
+3 SET MEET=0
SET DESC=""
+4 SET TREF=$NAME(^TMP("BQITAX",UID))
KILL @TREF
+5 FOR TAX="DM AUDIT TRIGLYCERIDE TAX","BGP TRIGLYCERIDE LOINC CODES"
DO BLD^BQITUTL(TAX,TREF)
+6 SET X=$$LAB^BQITRUTL("T-60M",1,BQDFN,"",500,">","","",.TREF)
+7 IF $PIECE(X,U,1)=1
SET MEET=1
SET DESC="Most recent Triglyceride is greater than 500 ("_$$FMTE^BQIUL1($PIECE(X,U,2))_" "_$PIECE(X,U,3)_")"_U_$PIECE(X,U,2,5)
+8 IF $PIECE(X,U,1)=0
SET MEET=0
SET DESC="Most recent Triglyceride is not greater than 500 ("_$$FMTE^BQIUL1($PIECE(X,U,2))_" "_$PIECE(X,U,3)_")"
+9 KILL @TREF
+10 QUIT MEET_U_DESC
+11 ;
TGRNG(BQDFN) ;EP CVD.TP-36 TG not at Goal
+1 ; If patient's most recent TG (within last 5 years) is 150-499
+2 NEW MEET,DESC,X,TREF,TAX
+3 SET MEET=0
SET DESC=""
+4 SET TREF=$NAME(^TMP("BQITAX",UID))
KILL @TREF
+5 FOR TAX="DM AUDIT TRIGLYCERIDE TAX","BGP TRIGLYCERIDE LOINC CODES"
DO BLD^BQITUTL(TAX,TREF)
+6 SET X=$$LAB^BQITRUTL("T-60M",1,BQDFN,"",149,">",500,"<",.TREF)
+7 IF $PIECE(X,U,1)=1
SET MEET=1
SET DESC="Most recent Triglyceride is 150-499 ("_$$FMTE^BQIUL1($PIECE(X,U,2))_" "_$PIECE(X,U,3)_")"_U_$PIECE(X,U,2,5)
+8 IF $PIECE(X,U,1)=0
SET MEET=0
SET DESC="Most recent Triglyceride is not between 150-499 ("_$$FMTE^BQIUL1($PIECE(X,U,2))_" "_$PIECE(X,U,3)_")"
+9 KILL @TREF
+10 QUIT MEET_U_DESC
+11 ;
HLDL(BQDFN) ;EP CVD-TP.38 High LDL
+1 ; If most recent LDL >160
+2 NEW MEET,DESC,X,TREF,TAX
+3 SET MEET=0
SET DESC=""
+4 SET TREF=$NAME(^TMP("BQITAX",UID))
KILL @TREF
+5 FOR TAX="DM AUDIT LDL CHOLESTEROL TAX","BGP LDL LOINC CODES"
DO BLD^BQITUTL(TAX,TREF)
+6 SET X=$$LAB^BQITRUTL("",1,BQDFN,"",160,">","","",.TREF)
+7 IF $PIECE(X,U,1)=1
SET MEET=1
SET DESC="LDL greater than 160 ("_$$FMTE^BQIUL1($PIECE(X,U,2))_" "_$PIECE(X,U,3)_")"_U_$PIECE(X,U,2,5)
+8 IF $PIECE(X,U,1)=0
SET MEET=0
SET DESC="LDL not greater than 160 ("_$$FMTE^BQIUL1($PIECE(X,U,2))_" "_$PIECE(X,U,3)_")"
+9 KILL @TREF
+10 QUIT MEET_U_DESC
+11 ;
LHDL(BQDFN) ;EP CVD-TP.39 Low HDL
+1 ; If LDL <=160 and if ON Statin or contraindicated AND HDL <40
+2 NEW X,MEET,DESC,RETURN,TREF,TAX,DDESC
+3 SET MEET=0
SET DESC=""
+4 SET TREF=$NAME(^TMP("BQITAX",UID))
KILL @TREF
+5 FOR TAX="DM AUDIT LDL CHOLESTEROL TAX","BGP LDL LOINC CODES"
DO BLD^BQITUTL(TAX,TREF)
+6 SET X=$$LAB^BQITRUTL("",1,BQDFN,"",160,"'>","","",.TREF)
+7 IF $PIECE(X,U,1)=1
SET MEET=1
SET DESC=DESC_"LDL less than or equal to 160 ("_$$FMTE^BQIUL1($PIECE(X,U,2))_" "_$PIECE(X,U,3)_")"
+8 IF $PIECE(X,U,1)=0
SET MEET=0
SET DESC=DESC_"LDL greater than 160 ("_$$FMTE^BQIUL1($PIECE(X,U,2))_" "_$PIECE(X,U,3)_")"
+9 IF 'MEET
QUIT MEET_U_DESC
+10 SET DDESC=DESC
+11 SET RETURN=$$STAT(BQDFN)
+12 IF $PIECE(RETURN,U,1)=0
QUIT 0_U_DDESC_" and "_$PIECE(RETURN,U,2)
+13 IF $PIECE(RETURN,U,1)=1
SET $PIECE(DESC,U,1)=$PIECE(DESC,U,1)_"; "_$PIECE(RETURN,U,2)
+14 SET RETURN=$$HDL^BQITRCHR(BQDFN)
+15 IF $PIECE(RETURN,U,1)=0
QUIT 0_U_$PIECE(RETURN,U,2)
+16 IF $PIECE(RETURN,U,1)=1
SET $PIECE(DESC,U,1)=$PIECE(DESC,U,1)_"; "_$PIECE(RETURN,U,2,6)
+17 QUIT 1_U_DESC
+18 ;
STAT(BQDFN) ; EP CVD.TP-39 Not on Statin
+1 NEW CT,X,VISIT,VSDTM,MEET,DESC,TIEN,T2,PRGM,QFL,RESULT,TREF,GREF,IEN,ENDT
+2 NEW C,BQGPRG,BGPDXBD,BGPDXED,TAX,TREF
+3 SET MEET=0
SET DESC=""
+4 SET TREF=$NAME(^TMP("BQITAX",UID))
KILL @TREF
+5 FOR TAX="BGP HEDIS STATIN MEDS","BGP HEDIS STATIN NDC"
DO BLD^BQITUTL(TAX,TREF)
+6 SET X=$$TAX^BQITRUTL("","",1,BQDFN,9000010.14,"","",.TREF)
+7 ; if returns a found medication, check if it is an active medication
+8 IF $PIECE(X,U,1)=1
Begin DoDot:1
+9 IF $$ACTMED^BKMQQCR4($PIECE(X,U,5))
QUIT
+10 SET $PIECE(X,U,1)=0
End DoDot:1
+11 IF $PIECE(X,U,1)=1
SET MEET=1
SET DESC=DESC_"On Statin Meds ("_$$FMTE^BQIUL1($PIECE(X,U,2))_" "_$$GET1^DIQ(9000010.14,$PIECE(X,U,5)_",",.01,"E")_")"
+12 IF $PIECE(X,U,1)=0
SET MEET=0
SET DESC=DESC_"Not on Statin Meds "
+13 Begin DoDot:1
+14 SET X=$$STAT^BQITRCON(BQDFN,$GET(BDATE,""),$GET(EDATE,""))
+15 IF $PIECE(X,U,1)=1
SET MEET=0
SET DESC="Has a contraindication: "_$PIECE(X,U,2)
QUIT
+16 SET MEET=$SELECT(MEET:0,1:1)
+17 SET X=$$STAT^BQITRALG(BQDFN,$GET(BDATE,""),$GET(EDATE,""))
+18 IF $PIECE(X,U,1)=1
SET MEET=0
SET DESC="Has an allergy: "_$PIECE(X,U,2)
QUIT
+19 SET MEET=$SELECT(MEET:0,1:1)
End DoDot:1
+20 QUIT MEET_U_DESC
