Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BQITRCHR

BQITRCHR.m

Go to the documentation of this file. 
  1. BQITRCHR ;VNGT/HS/ALA-CVD Highest Risk Treatment Prompts ; 02 Sep 2008  11:52 AM
  1.  ;;2.1;ICARE MANAGEMENT SYSTEM;;Feb 07, 2011
  1.  ;
  1. EKGE(BQDFN) ;EP  CVD.TP-23 No EKG Ever
  1.  ; If no documented EKG ever
  1.  NEW MEET,DESC,RETURN
  1.  S MEET=0,DESC=""
  1.  S RETURN=$$EKG^BQITRUT1(BQDFN,"")
  1.  I $P(RETURN,U,1)=1 S MEET=1,DESC="Has not ever had an EKG procedure"
  1.  I $P(RETURN,U,1)=0 S MEET=0,DESC="Has had an EKG procedure"
  1.  Q MEET_U_DESC
  1.  ;
  1. EKG2(BQDFN) ;EP  CVD.TP-26 No Recent EKG
  1.  ; If no EKG documented in past 2 years
  1.  NEW MEET,DESC,RETURN
  1.  S MEET=0,DESC=""
  1.  S RETURN=$$EKG^BQITRUT1(BQDFN,"T-24M")
  1.  I $P(RETURN,U,1)=0 S MEET=0,DESC="Has had EKG procedure in past 2 years"
  1.  I $P(RETURN,U,1)=1 D
  1.  . S MEET=1,DESC="Has not had an EKG procedure in past 2 years"
  1.  . I $D(^BQIPAT(BQDFN,50,23)) S MEET=0
  1.  Q MEET_U_DESC
  1.  ;
  1. ASA(BQDFN) ;EP  CV.TP-15 No ASA/Antiplatelet
  1.  ; If age >30 AND NOT on ASA or Warfarin or other AntiPlatelet
  1.  ; Medication or NOT contraindicated
  1.  NEW CT,X,VISIT,VSDTM,MEET,DESC,TIEN,T2,PRGM,QFL,RESULT,TREF,GREF,IEN,ENDT,C
  1.  NEW BQGPRG,BGPDXBD,BGPDXED,AGE
  1.  S MEET=0,DESC=""
  1.  S AGE=$$AGE^BQIAGE(BQDFN),DESC="Patient's age is "_AGE_" and "
  1.  I AGE'>30 S DESC="Patient's age is "_AGE Q MEET_U_DESC
  1.  D
  1.  . S X=$$TAX^BQITRUTL("","DM AUDIT ASPIRIN DRUGS",1,BQDFN,9000010.14)
  1.  . ; if returns a found medication, check if it is an active medication
  1.  . I $P(X,U,1)=1 D
  1.  .. I $$ACTMED^BKMQQCR4($P(X,U,5)) Q
  1.  .. S $P(X,U,1)=0
  1.  . I $P(X,U,1)=1 S MEET=0,DESC=DESC_"On ASA Meds ("_$$FMTE^BQIUL1($P(X,U,2))_" "_$$GET1^DIQ(9000010.14,$P(X,U,5)_",",.01,"E")_")" Q
  1.  . I $P(X,U,1)=0 S MEET=1,DESC=DESC_"Not on ASA Meds; "
  1.  . S X=$$TAX^BQITRUTL("","BGP CMS WARFARIN MEDS",1,BQDFN,9000010.14)
  1.  . ; if returns a found medication, check if it is an active medication
  1.  . I $P(X,U,1)=1 D
  1.  .. I $$ACTMED^BKMQQCR4($P(X,U,5)) Q
  1.  .. S $P(X,U,1)=0
  1.  . I $P(X,U,1)=1 S MEET=0,DESC=DESC_"On Warfarin Meds ("_$$FMTE^BQIUL1($P(X,U,2))_" "_$$GET1^DIQ(9000010.14,$P(X,U,5)_",",.01,"E")_")" Q
  1.  . I $P(X,U,1)=0 S MEET=1,DESC=DESC_"Not on Warfarin Meds; "
  1.  . NEW TAX,TREF
  1.  . S TREF=$NA(^TMP("BQITAX",UID)) K @TREF
  1.  . F TAX="BGP CMS ANTI-PLATELET CLASS","BGP ANTI-PLATELET DRUGS" D BLD^BQITUTL(TAX,TREF)
  1.  . S X=$$TAX^BQITRUTL("","",1,BQDFN,9000010.14,"","",.TREF)
  1.  . ; if returns a found medication, check if it is an active medication
  1.  . I $P(X,U,1)=1 D
  1.  .. I $$ACTMED^BKMQQCR4($P(X,U,5)) Q
  1.  .. S $P(X,U,1)=0
  1.  . I $P(X,U,1)=1 S MEET=0,DESC=DESC_"On Anti-Platelet Meds ("_$$FMTE^BQIUL1($P(X,U,2))_" "_$$GET1^DIQ(9000010.14,$P(X,U,5)_",",.01,"E")_")"
  1.  . I $P(X,U,1)=0 S MEET=1,DESC=DESC_"Not on Anti-Platelet Meds"
  1.  . K @TREF
  1.  D
  1.  . S X=$$ASA^BQITRCON(BQDFN,$G(BDATE,""),$G(EDATE,""))
  1.  . I $P(X,U,1)=1 S MEET=0,DESC="Has a contraindication: "_$P(X,U,2) Q
  1.  . I $P(X,U,1)=0 S DESC=DESC_" and not contraindicated"
  1.  . S MEET=$S(MEET:0,1:1)
  1.  . S X=$$ASA^BQITRALG(BQDFN,$G(BDATE,""),$G(EDATE,""))
  1.  . I $P(X,U,1)=1 S MEET=0,DESC="Has an allergy: "_$P(X,U,2) Q
  1.  . S MEET=$S(MEET:0,1:1)
  1.  Q MEET_U_DESC
  1.  ;
  1. ACEI(BQDFN) ;EP  CVD.TP-17 No ACEI or ARB
  1.  ; If NOT on ACEI OR ARB, then check the patient for special conditions
  1.  NEW CT,X,VISIT,VSDTM,MEET,DESC,TIEN,T2,PRGM,QFL,RESULT,TREF,GREF
  1.  NEW IEN,ENDT,C,BQGPRG,BGPDXBD,BGPDXED,TAX,TREF
  1.  S MEET=0,DESC=""
  1.  S TREF=$NA(^TMP("BQITAX",UID)) K @TREF
  1.  F TAX="BGP CMS ACEI MEDS CLASS","BGP HEDIS ACEI MEDS","BGP HEDIS ACEI NDC" D BLD^BQITUTL(TAX,TREF)
  1.  S X=$$TAX^BQITRUTL("","",1,BQDFN,9000010.14,"","",.TREF)
  1.  ; if returns a found medication, check if it is an active medication
  1.  I $P(X,U,1)=1 D
  1.  . I $$ACTMED^BKMQQCR4($P(X,U,5)) Q
  1.  . S $P(X,U,1)=0
  1.  I $P(X,U,1)=1 S MEET=0,DESC=DESC_"On ACEI Meds ("_$$FMTE^BQIUL1($P(X,U,2))_" "_$$GET1^DIQ(9000010.14,$P(X,U,5)_",",.01,"E")_")"
  1.  I $P(X,U,1)=0 S MEET=1,DESC=DESC_"Not on ACEI Meds"
  1.  ;
  1.  K @TREF
  1.  I MEET D
  1.  . S DESC=""
  1.  . F TAX="BGP CMS ARB MEDS CLASS","BGP HEDIS ARB MEDS","BGP HEDIS ARB NDC" D BLD^BQITUTL(TAX,TREF)
  1.  . S X=$$TAX^BQITRUTL("","",1,BQDFN,9000010.14,"","",.TREF)
  1.  . ; if returns a found medication, check if it is an active medication
  1.  . I $P(X,U,1)=1 D
  1.  .. I $$ACTMED^BKMQQCR4($P(X,U,5)) Q
  1.  .. S $P(X,U,1)=0
  1.  . I $P(X,U,1)=1 S MEET=0,DESC=DESC_"On ARB Meds ("_$$FMTE^BQIUL1($P(X,U,2))_" "_$$GET1^DIQ(9000010.14,$P(X,U,5)_",",.01,"E")_")"
  1.  . I $P(X,U,1)=0 S MEET=1,DESC=DESC_"Not on ARB Meds"
  1.  . K @TREF
  1.  I 'MEET Q MEET_U_DESC
  1.  D
  1.  . S X=$$ACEI^BQITRCON(BQDFN,$G(BDATE,""),$G(EDATE,""))
  1.  . I $P(X,U,1)=1 S MEET=0,DESC="Has a contraindication: "_$P(X,U,2) Q
  1.  . S MEET=$S(MEET:0,1:1)
  1.  . S X=$$ACEI^BQITRALG(BQDFN,$G(BDATE,""),$G(EDATE,""))
  1.  . I $P(X,U,1)=1 S MEET=0,DESC="Has an allergy: "_$P(X,U,2) Q
  1.  . S MEET=$S(MEET:0,1:1)
  1.  I 'MEET Q 0_U_DESC
  1.  ;
  1.  ; Check for special conditions
  1.  S RETURN=$$ACB^BQITRACB(BQDFN,.BQRM)
  1.  ;
  1.  I $P(RETURN,U,1)=0 S DESC="Not on ACEI or ARB Meds but no conditions",MEET=0
  1.  I $P(RETURN,U,1)=1 S DESC=DESC_" with "_$P(RETURN,U,2)
  1.  Q MEET_U_DESC
  1.  ;
  1. HDL(BQDFN,TMFRAME) ;EP  CVD.TP-39 and CVD.TP-21 Low HDL
  1.  ; If most recent HDL <40
  1.  NEW MEET,DESC,X,TAX,TREF
  1.  S MEET=0,DESC=""
  1.  S TMFRAME=$G(TMFRAME,"")
  1.  S TREF=$NA(^TMP("BQITAX",UID)) K @TREF
  1.  F TAX="DM AUDIT HDL TAX","BGP HDL LOINC CODES" D BLD^BQITUTL(TAX,TREF)
  1.  S X=$$LAB^BQITRUTL("",1,BQDFN,"",40,"<","","",.TREF)
  1.  I $P(X,U,1)=1 S MEET=1,DESC="Most recent HDL is less than 40 ("_$$FMTE^BQIUL1($P(X,U,2))_" "_$P(X,U,3)_")"_U_$P(X,U,2,5)
  1.  I $P(X,U,1)=0 S MEET=0,DESC="Most recent HDL is greater than 40 ("_$$FMTE^BQIUL1($P(X,U,2))_" "_$P(X,U,3)_")"
  1.  K @TREF
  1.  Q MEET_U_DESC
  1.  ;
  1. HLNS(BQDFN) ;EP  CVD.TP-19 High LDL/No Statin
  1.  ; If most recent LDL >100 AND NOT on Statin
  1.  NEW MEET,DESC,X,TAX,TREF
  1.  S MEET=0,DESC=""
  1.  S TREF=$NA(^TMP("BQITAX",UID)) K @TREF
  1.  F TAX="DM AUDIT LDL CHOLESTEROL TAX","BGP LDL LOINC CODES" D BLD^BQITUTL(TAX,TREF)
  1.  S X=$$LAB^BQITRUTL("T-12M",1,BQDFN,"",100,">","","",.TREF)
  1.  I $P(X,U,1)=0 S MEET=0,DESC="Most recent LDL not greater than 100 ("_$$FMTE^BQIUL1($P(X,U,2))_" "_$P(X,U,3)_")" Q MEET_U_DESC
  1.  I $P(X,U,1)=1 S MEET=1,DESC="Most recent LDL greater than 100 ("_$$FMTE^BQIUL1($P(X,U,2))_" "_$P(X,U,3)_") and "_U_$P(X,U,2,5)
  1.  K @TREF
  1.  F TAX="BGP HEDIS STATIN MEDS","BGP HEDIS STATIN NDC" D BLD^BQITUTL(TAX,TREF)
  1.  S X=$$TAX^BQITRUTL("","",1,BQDFN,9000010.14,"","",.TREF)
  1.  ; if returns a found medication, check if it is an active medication
  1.  I $P(X,U,1)=1 D
  1.  . I $$ACTMED^BKMQQCR4($P(X,U,5)) Q
  1.  . S $P(X,U,1)=0
  1.  I $P(X,U,1)=1 S MEET=0,$P(DESC,U,1)=$P(DESC,U,1)_"and On Statin Meds ("_$$FMTE^BQIUL1($P(X,U,2))_" "_$$GET1^DIQ(9000010.14,$P(X,U,5)_",",.01,"E")_")"
  1.  I $P(X,U,1)=0 S MEET=1,$P(DESC,U,1)=$P(DESC,U,1)_"Not on Statin Meds"
  1.  K @TREF
  1.  Q MEET_U_DESC
  1.  ;
  1. HBP(BQDFN) ;EP  CVD.TP-16 High BP
  1.  ; If 2 of last 3 non-ER blood pressures in past 2 years are
  1.  ; Systolic >130 or Diastolic >80
  1.  NEW MEET,DESC,X,TEXT,BQI,QFL
  1.  S MEET=0,DESC="",TEXT=""
  1.  S X=$$BP^BQITRUTL("T-24M",BQDFN,130,80,">")
  1.  I $P(X,U,2)'="" D
  1.  . NEW NDATE
  1.  . S QFL=0
  1.  . F BQI=1:1:3 D  Q:QFL
  1.  .. I $P($P(X,U,2),";",BQI)="No BPs in timeframe" S TEXT=$P($P(X,U,2),";",BQI),QFL=1 Q
  1.  .. S NDATE=$$FMTE^BQIUL1($P($P(X,U,2),";",BQI))_"("_$P($P(X,U,5),";",BQI)_")",TEXT=TEXT_NDATE_";"
  1.  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
  1.  I $P(X,U,1)=1 S MEET=1,DESC=DESC_$$PBP^BQITRCKN(DESC,X)
  1.  Q MEET_U_DESC