BQITRRSK ;PRXM/HC/ALA-Treatment Prompts Risk Factors ; 23 May 2007 3:20 PM
;;2.3;ICARE MANAGEMENT SYSTEM;**1,3,4**;Apr 18, 2012;Build 66
;
RSK(BQDFN,BQRM) ;EP - CVD.TP-32 Missing Risk factors
; Input
; BQDFN - Patient IEN
;If ANY of the following data is missing for the patient
NEW ACT,X,COND,BQI,QFL,BN,LBN,LAST,DDESC
S ACT=0,LCNT=0
; Tobacco Use Screen
D
. S X=$$TAX^BQITRUTL("T-12M","BGP GPRA SMOKING DXS",1,BQDFN,9000010.07)
. I $P(X,U,1)=1 Q
. S X=$$TAX^BQITRUTL("T-12M","BGP TOBACCO USER HLTH FACTORS",1,BQDFN,9000010.23)
. I $P(X,U,1)=1 Q
. S X=$$TAX^BQITRUTL("T-12M","BGP TOBACCO SCREEN CPTS",1,BQDFN,9000010.18)
. I $P(X,U,1)=1 Q
. S X=$$TAX^BQITRUTL("T-12M","BGP TOBACCO CESS DENTAL CODE",1,BQDFN,9000010.05)
. I $P(X,U,1)=1 Q
. S X=$$FED^BQITRUTL("T-12M",BQDFN,"TO-")
. I $P(X,U,1)=1 Q
. S X=$$CLN^BQITRUT1("T-12M",BQDFN,94)
. I $P(X,U,1)=1 Q
. S ACT=ACT+1,COND(ACT)="Tobacco Use Screen last year"
;
;Total Cholesterol
D
. S X=$$LAB^BQITRUTL("T-60M",0,BQDFN,"DM AUDIT CHOLESTEROL TAX",0,">")
. I $P(X,U,1)=1 Q
. S X=$$LAB^BQITRUTL("T-60M",0,BQDFN,"BGP TOTAL CHOLESTEROL LOINC",0,">")
. I $P(X,U,1)=1 Q
. S ACT=ACT+1,COND(ACT)="Total Cholesterol last 5 years"
;
;HDL in past 5 years
D
. S X=$$LAB^BQITRUTL("T-60M",0,BQDFN,"DM AUDIT HDL TAX",0,">")
. I $P(X,U,1)=1 Q
. S X=$$LAB^BQITRUTL("T-60M",0,BQDFN,"BGP HDL LOINC CODES",0,">")
. I $P(X,U,1)=1 Q
. S ACT=ACT+1,COND(ACT)="HDL last 5 years"
;
;LDL in past 5 years
D
. S X=$$LAB^BQITRUTL("T-60M",0,BQDFN,"DM AUDIT LDL CHOLESTEROL TAX",0,">")
. I $P(X,U,1)=1 Q
. S X=$$LAB^BQITRUTL("T-60M",0,BQDFN,"BGP LDL LOINC CODES",0,">")
. I $P(X,U,1)=1 Q
. S ACT=ACT+1,COND(ACT)="LDL last 5 years"
;
;BP last year
S X=$$BP(BQDFN,"T-12M")
I X=0 S ACT=ACT+1,COND(ACT)="BP last year"
;
;Update the remarks
I ACT=0 K BQRM Q 0_U_"Not missing data"
;
I ACT>0 D
. S BN=0,DDESC=""
. F S BN=$O(BQRM(BN)) Q:BN="" D
.. I BQRM(BN)["|" D
... S LBN=$O(BQRM(BN)) I LBN'="" S LAST=BQRM(LBN)
... S BI=0 F S BI=$O(COND(BI)) Q:BI="" D
.... S BQRM(BN)=$C(10)_" "_COND(BI),BN=BN+1,DDESC=DDESC_COND(BI)_"; "
. S BN=$O(BQRM(BN),-1)+1
. I $G(LAST)'="" S BQRM(BN)=LAST
Q 1_U_DDESC
;
HDL(BQDFN) ;EP - HDL Goal CVD.TP-35 HDL Not at Goal
; If patient's most recent HDL (within last 5 years) not at goal
; (=>40 for men and =>45 for women)
NEW SEX,VAL,Y,MEET,DESC,TAX,TREF
S MEET=0,DESC=""
S SEX=$$GET1^DIQ(2,BQDFN_",",.02,"I")
;
S TREF=$NA(^TMP("BQITAX",UID)) K @TREF
F TAX="DM AUDIT HDL TAX","BGP HDL LOINC CODES" D BLD^BQITUTL(TAX,TREF)
S X=$$LAB^BQITRUTL("T-60M",1,BQDFN,"",0,">","","",.TREF)
I 'X D
. 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)
I X D
. 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)
. 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)
Q MEET_U_DESC
;
BP(BDFN,TMFRAME) ;EP -- Blood Pressure for a single patient
; Get the Mean Blood Pressure value for a patient and a time frame
;Input
; BDFN - Patient IEN
; TMFRAME - Time frame in relative date format
;
; Get a list of all BP measures in the time frame
NEW BDATE,EDATE,BTYP,BCLN,DATE,QFL,RESULT
S BDATE=(9999999-DT),RESULT=0
S EDATE=(9999999-$$DATE^BQIUL1(TMFRAME))
;
S BTYP=$$FIND1^DIC(9999999.07,,"X","BP")
S BCLN=$$FIND1^DIC(40.7,"","Q","30","C","","ERROR")
S DATE=BDATE-.01,QFL=0
F S DATE=$O(^AUPNVMSR("AA",BDFN,BTYP,DATE)) Q:DATE=""!(DATE>EDATE) D Q:QFL
. S IEN=""
. F S IEN=$O(^AUPNVMSR("AA",BDFN,BTYP,DATE,IEN),-1) Q:IEN=""!(QFL) D
.. S VISIT=$P(^AUPNVMSR(IEN,0),U,3) I VISIT="" Q
.. ; if the new ENTERED IN ERROR field exists, exclude the record if it is marked as an error
.. I $$VFIELD^DILFD(9000010.01,2) Q:$$GET1^DIQ(9000010.01,IEN_",",2,"I")=1
.. I $P($G(^AUPNVSIT(VISIT,0)),U,8)=BCLN Q
.. I $P($G(^AUPNVSIT(VISIT,0)),U,11)=1 Q
.. S RESULT=1,QFL=1
Q RESULT
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
+2 ;
RSK(BQDFN,BQRM) ;EP - CVD.TP-32 Missing Risk factors
+1 ; Input
+2 ; BQDFN - Patient IEN
+3 ;If ANY of the following data is missing for the patient
+4 NEW ACT,X,COND,BQI,QFL,BN,LBN,LAST,DDESC
+5 SET ACT=0
SET LCNT=0
+6 ; Tobacco Use Screen
+7 Begin DoDot:1
+8 SET X=$$TAX^BQITRUTL("T-12M","BGP GPRA SMOKING DXS",1,BQDFN,9000010.07)
+9 IF $PIECE(X,U,1)=1
QUIT
+10 SET X=$$TAX^BQITRUTL("T-12M","BGP TOBACCO USER HLTH FACTORS",1,BQDFN,9000010.23)
+11 IF $PIECE(X,U,1)=1
QUIT
+12 SET X=$$TAX^BQITRUTL("T-12M","BGP TOBACCO SCREEN CPTS",1,BQDFN,9000010.18)
+13 IF $PIECE(X,U,1)=1
QUIT
+14 SET X=$$TAX^BQITRUTL("T-12M","BGP TOBACCO CESS DENTAL CODE",1,BQDFN,9000010.05)
+15 IF $PIECE(X,U,1)=1
QUIT
+16 SET X=$$FED^BQITRUTL("T-12M",BQDFN,"TO-")
+17 IF $PIECE(X,U,1)=1
QUIT
+18 SET X=$$CLN^BQITRUT1("T-12M",BQDFN,94)
+19 IF $PIECE(X,U,1)=1
QUIT
+20 SET ACT=ACT+1
SET COND(ACT)="Tobacco Use Screen last year"
End DoDot:1
+21 ;
+22 ;Total Cholesterol
+23 Begin DoDot:1
+24 SET X=$$LAB^BQITRUTL("T-60M",0,BQDFN,"DM AUDIT CHOLESTEROL TAX",0,">")
+25 IF $PIECE(X,U,1)=1
QUIT
+26 SET X=$$LAB^BQITRUTL("T-60M",0,BQDFN,"BGP TOTAL CHOLESTEROL LOINC",0,">")
+27 IF $PIECE(X,U,1)=1
QUIT
+28 SET ACT=ACT+1
SET COND(ACT)="Total Cholesterol last 5 years"
End DoDot:1
+29 ;
+30 ;HDL in past 5 years
+31 Begin DoDot:1
+32 SET X=$$LAB^BQITRUTL("T-60M",0,BQDFN,"DM AUDIT HDL TAX",0,">")
+33 IF $PIECE(X,U,1)=1
QUIT
+34 SET X=$$LAB^BQITRUTL("T-60M",0,BQDFN,"BGP HDL LOINC CODES",0,">")
+35 IF $PIECE(X,U,1)=1
QUIT
+36 SET ACT=ACT+1
SET COND(ACT)="HDL last 5 years"
End DoDot:1
+37 ;
+38 ;LDL in past 5 years
+39 Begin DoDot:1
+40 SET X=$$LAB^BQITRUTL("T-60M",0,BQDFN,"DM AUDIT LDL CHOLESTEROL TAX",0,">")
+41 IF $PIECE(X,U,1)=1
QUIT
+42 SET X=$$LAB^BQITRUTL("T-60M",0,BQDFN,"BGP LDL LOINC CODES",0,">")
+43 IF $PIECE(X,U,1)=1
QUIT
+44 SET ACT=ACT+1
SET COND(ACT)="LDL last 5 years"
End DoDot:1
+45 ;
+46 ;BP last year
+47 SET X=$$BP(BQDFN,"T-12M")
+48 IF X=0
SET ACT=ACT+1
SET COND(ACT)="BP last year"
+49 ;
+50 ;Update the remarks
+51 IF ACT=0
KILL BQRM
QUIT 0_U_"Not missing data"
+52 ;
+53 IF ACT>0
Begin DoDot:1
+54 SET BN=0
SET DDESC=""
+55 FOR
SET BN=$ORDER(BQRM(BN))
IF BN=""
QUIT
Begin DoDot:2
+56 IF BQRM(BN)["|"
Begin DoDot:3
+57 SET LBN=$ORDER(BQRM(BN))
IF LBN'=""
SET LAST=BQRM(LBN)
+58 SET BI=0
FOR
SET BI=$ORDER(COND(BI))
IF BI=""
QUIT
Begin DoDot:4
+59 SET BQRM(BN)=$CHAR(10)_" "_COND(BI)
SET BN=BN+1
SET DDESC=DDESC_COND(BI)_"; "
End DoDot:4
End DoDot:3
End DoDot:2
+60 SET BN=$ORDER(BQRM(BN),-1)+1
+61 IF $GET(LAST)'=""
SET BQRM(BN)=LAST
End DoDot:1
+62 QUIT 1_U_DDESC
+63 ;
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
+2 ; (=>40 for men and =>45 for women)
+3 NEW SEX,VAL,Y,MEET,DESC,TAX,TREF
+4 SET MEET=0
SET DESC=""
+5 SET SEX=$$GET1^DIQ(2,BQDFN_",",.02,"I")
+6 ;
+7 SET TREF=$NAME(^TMP("BQITAX",UID))
KILL @TREF
+8 FOR TAX="DM AUDIT HDL TAX","BGP HDL LOINC CODES"
DO BLD^BQITUTL(TAX,TREF)
+9 SET X=$$LAB^BQITRUTL("T-60M",1,BQDFN,"",0,">","","",.TREF)
+10 IF 'X
Begin DoDot:1
+11 SET MEET=0
SET DESC="Most recent HDL not at goal ("_$$FMTE^BQIUL1($PIECE(X,U,2))_" "_$PIECE(X,U,3)_")"_U_$PIECE(X,U,2,5)
End DoDot:1
+12 IF X
Begin DoDot:1
+13 IF SEX="M"!(SEX="U")
IF $PIECE(X,U,3)<40
SET MEET=1
SET DESC="Most recent HDL at goal ("_$$FMTE^BQIUL1($PIECE(X,U,2))_" "_$PIECE(X,U,3)_")"_U_$PIECE(X,U,2,5)
+14 IF SEX="F"
IF $PIECE(X,U,3)<45
SET MEET=1
SET DESC="Most recent HDL at goal ("_$$FMTE^BQIUL1($PIECE(X,U,2))_" "_$PIECE(X,U,3)_")"_U_$PIECE(X,U,2,5)
End DoDot:1
+15 QUIT MEET_U_DESC
+16 ;
BP(BDFN,TMFRAME) ;EP -- Blood Pressure for a single patient
+1 ; Get the Mean Blood Pressure value for a patient and a time frame
+2 ;Input
+3 ; BDFN - Patient IEN
+4 ; TMFRAME - Time frame in relative date format
+5 ;
+6 ; Get a list of all BP measures in the time frame
+7 NEW BDATE,EDATE,BTYP,BCLN,DATE,QFL,RESULT
+8 SET BDATE=(9999999-DT)
SET RESULT=0
+9 SET EDATE=(9999999-$$DATE^BQIUL1(TMFRAME))
+10 ;
+11 SET BTYP=$$FIND1^DIC(9999999.07,,"X","BP")
+12 SET BCLN=$$FIND1^DIC(40.7,"","Q","30","C","","ERROR")
+13 SET DATE=BDATE-.01
SET QFL=0
+14 FOR
SET DATE=$ORDER(^AUPNVMSR("AA",BDFN,BTYP,DATE))
IF DATE=""!(DATE>EDATE)
QUIT
Begin DoDot:1
+15 SET IEN=""
+16 FOR
SET IEN=$ORDER(^AUPNVMSR("AA",BDFN,BTYP,DATE,IEN),-1)
IF IEN=""!(QFL)
QUIT
Begin DoDot:2
+17 SET VISIT=$PIECE(^AUPNVMSR(IEN,0),U,3)
IF VISIT=""
QUIT
+18 ; if the new ENTERED IN ERROR field exists, exclude the record if it is marked as an error
+19 IF $$VFIELD^DILFD(9000010.01,2)
IF $$GET1^DIQ(9000010.01,IEN_",",2,"I")=1
QUIT
+20 IF $PIECE($GET(^AUPNVSIT(VISIT,0)),U,8)=BCLN
QUIT
+21 IF $PIECE($GET(^AUPNVSIT(VISIT,0)),U,11)=1
QUIT
+22 SET RESULT=1
SET QFL=1
End DoDot:2
End DoDot:1
IF QFL
QUIT
+23 QUIT RESULT
