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

BQITRRSK.m

Go to the documentation of this file. 
  1. BQITRRSK ;PRXM/HC/ALA-Treatment Prompts Risk Factors ; 23 May 2007  3:20 PM
  1.  ;;2.3;ICARE MANAGEMENT SYSTEM;**1,3,4**;Apr 18, 2012;Build 66
  1.  ;
  1. RSK(BQDFN,BQRM) ;EP - CVD.TP-32 Missing Risk factors
  1.  ; Input
  1.  ;   BQDFN - Patient IEN
  1.  ;If ANY of the following data is missing for the patient
  1.  NEW ACT,X,COND,BQI,QFL,BN,LBN,LAST,DDESC
  1.  S ACT=0,LCNT=0
  1.  ; Tobacco Use Screen
  1.  D
  1.  . S X=$$TAX^BQITRUTL("T-12M","BGP GPRA SMOKING DXS",1,BQDFN,9000010.07)
  1.  . I $P(X,U,1)=1 Q
  1.  . S X=$$TAX^BQITRUTL("T-12M","BGP TOBACCO USER HLTH FACTORS",1,BQDFN,9000010.23)
  1.  . I $P(X,U,1)=1 Q
  1.  . S X=$$TAX^BQITRUTL("T-12M","BGP TOBACCO SCREEN CPTS",1,BQDFN,9000010.18)
  1.  . I $P(X,U,1)=1 Q
  1.  . S X=$$TAX^BQITRUTL("T-12M","BGP TOBACCO CESS DENTAL CODE",1,BQDFN,9000010.05)
  1.  . I $P(X,U,1)=1 Q
  1.  . S X=$$FED^BQITRUTL("T-12M",BQDFN,"TO-")
  1.  . I $P(X,U,1)=1 Q
  1.  . S X=$$CLN^BQITRUT1("T-12M",BQDFN,94)
  1.  . I $P(X,U,1)=1 Q
  1.  . S ACT=ACT+1,COND(ACT)="Tobacco Use Screen last year"
  1.  ;
  1.  ;Total Cholesterol
  1.  D
  1.  . S X=$$LAB^BQITRUTL("T-60M",0,BQDFN,"DM AUDIT CHOLESTEROL TAX",0,">")
  1.  . I $P(X,U,1)=1 Q
  1.  . S X=$$LAB^BQITRUTL("T-60M",0,BQDFN,"BGP TOTAL CHOLESTEROL LOINC",0,">")
  1.  . I $P(X,U,1)=1 Q
  1.  . S ACT=ACT+1,COND(ACT)="Total Cholesterol last 5 years"
  1.  ;
  1.  ;HDL in past 5 years
  1.  D
  1.  . S X=$$LAB^BQITRUTL("T-60M",0,BQDFN,"DM AUDIT HDL TAX",0,">")
  1.  . I $P(X,U,1)=1 Q
  1.  . S X=$$LAB^BQITRUTL("T-60M",0,BQDFN,"BGP HDL LOINC CODES",0,">")
  1.  . I $P(X,U,1)=1 Q
  1.  . S ACT=ACT+1,COND(ACT)="HDL last 5 years"
  1.  ;
  1.  ;LDL in past 5 years
  1.  D
  1.  . S X=$$LAB^BQITRUTL("T-60M",0,BQDFN,"DM AUDIT LDL CHOLESTEROL TAX",0,">")
  1.  . I $P(X,U,1)=1 Q
  1.  . S X=$$LAB^BQITRUTL("T-60M",0,BQDFN,"BGP LDL LOINC CODES",0,">")
  1.  . I $P(X,U,1)=1 Q
  1.  . S ACT=ACT+1,COND(ACT)="LDL last 5 years"
  1.  ;
  1.  ;BP last year
  1.  S X=$$BP(BQDFN,"T-12M")
  1.  I X=0 S ACT=ACT+1,COND(ACT)="BP last year"
  1.  ;
  1.  ;Update the remarks
  1.  I ACT=0 K BQRM Q 0_U_"Not missing data"
  1.  ;
  1.  I ACT>0 D
  1.  . S BN=0,DDESC=""
  1.  . F  S BN=$O(BQRM(BN)) Q:BN=""  D
  1.  .. I BQRM(BN)["|" D
  1.  ... S LBN=$O(BQRM(BN)) I LBN'="" S LAST=BQRM(LBN)
  1.  ... S BI=0 F  S BI=$O(COND(BI)) Q:BI=""  D
  1.  .... S BQRM(BN)=$C(10)_"   "_COND(BI),BN=BN+1,DDESC=DDESC_COND(BI)_"; "
  1.  . S BN=$O(BQRM(BN),-1)+1
  1.  . I $G(LAST)'="" S BQRM(BN)=LAST
  1.  Q 1_U_DDESC
  1.  ;
  1. HDL(BQDFN) ;EP - HDL Goal CVD.TP-35 HDL Not at Goal
  1.  ; If patient's most recent HDL (within last 5 years) not at goal
  1.  ; (=>40 for men and =>45 for women)
  1.  NEW SEX,VAL,Y,MEET,DESC,TAX,TREF
  1.  S MEET=0,DESC=""
  1.  S SEX=$$GET1^DIQ(2,BQDFN_",",.02,"I")
  1.  ;
  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("T-60M",1,BQDFN,"",0,">","","",.TREF)
  1.  I 'X D
  1.  . S MEET=0,DESC="Most recent HDL not at goal ("_$$FMTE^BQIUL1($P(X,U,2))_" "_$P(X,U,3)_")"_U_$P(X,U,2,5)
  1.  I X D
  1.  . I SEX="M"!(SEX="U"),$P(X,U,3)<40 S MEET=1,DESC="Most recent HDL at goal ("_$$FMTE^BQIUL1($P(X,U,2))_" "_$P(X,U,3)_")"_U_$P(X,U,2,5)
  1.  . I SEX="F",$P(X,U,3)<45 S MEET=1,DESC="Most recent HDL at goal ("_$$FMTE^BQIUL1($P(X,U,2))_" "_$P(X,U,3)_")"_U_$P(X,U,2,5)
  1.  Q MEET_U_DESC
  1.  ;
  1. BP(BDFN,TMFRAME) ;EP -- Blood Pressure for a single patient
  1.  ;  Get the Mean Blood Pressure value for a patient and a time frame
  1.  ;Input
  1.  ;  BDFN - Patient IEN
  1.  ;  TMFRAME - Time frame in relative date format
  1.  ;
  1.  ;  Get a list of all BP measures in the time frame
  1.  NEW BDATE,EDATE,BTYP,BCLN,DATE,QFL,RESULT
  1.  S BDATE=(9999999-DT),RESULT=0
  1.  S EDATE=(9999999-$$DATE^BQIUL1(TMFRAME))
  1.  ;
  1.  S BTYP=$$FIND1^DIC(9999999.07,,"X","BP")
  1.  S BCLN=$$FIND1^DIC(40.7,"","Q","30","C","","ERROR")
  1.  S DATE=BDATE-.01,QFL=0
  1.  F  S DATE=$O(^AUPNVMSR("AA",BDFN,BTYP,DATE)) Q:DATE=""!(DATE>EDATE)  D  Q:QFL
  1.  . S IEN=""
  1.  . F  S IEN=$O(^AUPNVMSR("AA",BDFN,BTYP,DATE,IEN),-1) Q:IEN=""!(QFL)  D
  1.  .. S VISIT=$P(^AUPNVMSR(IEN,0),U,3) I VISIT="" Q
  1.  .. ; if the new ENTERED IN ERROR field exists, exclude the record if it is marked as an error
  1.  .. I $$VFIELD^DILFD(9000010.01,2) Q:$$GET1^DIQ(9000010.01,IEN_",",2,"I")=1
  1.  .. I $P($G(^AUPNVSIT(VISIT,0)),U,8)=BCLN Q
  1.  .. I $P($G(^AUPNVSIT(VISIT,0)),U,11)=1 Q
  1.  .. S RESULT=1,QFL=1
  1.  Q RESULT