BQITRSK ;PRXM/HC/ALA-CVD Risk Factors ; 11 Apr 2006 4:25 PM
;;2.3;ICARE MANAGEMENT SYSTEM;**3,4**;Apr 18, 2012;Build 66
Q
;
EN(TGLOB) ;EP -- Entry point
; Input
; TGLOB - Global that final results will reside in
;
;Current Smoker
; at least 2 smoking POVs ever (not on the same date) or on the
; Active Problem List or most recent tobacco Health Factor
;
; Set up array from File 90506.2
S BQREF="BQIRY" K @BQREF
S TAX="Current Smoker"
D ARY^BQITUTL(TAX,BQREF)
NEW BQGLB1
S BQGLB1=$NA(^TMP("BQITMPR",UID))
K @BQGLB1
; Call generic program and return data in BQGLB1
D POP^BQITDGN(BQREF,BQGLB1)
; If data found, set the criteria
S TDFN="" F S TDFN=$O(@BQGLB1@(TDFN)) Q:TDFN="" D
. NEW TX
. S TX=$O(@BQGLB1@(TDFN,"CRITERIA",""))
. D STOR(TDFN,TX,BQGLB1)
K @BQGLB1,@BQREF
;S TDFN="" F S TDFN=$O(@TGLOB@(TDFN)) Q:TDFN="" S @TGLOB@(TDFN)=1
;
; Set up array from File 90506.2
S BQREF="BQIRY" K @BQREF
S TAX="PreDM Metabolic Syndrome"
D ARY^BQITUTL(TAX,BQREF)
; Set to primary and secondary instead of primary only
I $G(BQIRY(1))'="",$P(BQIRY(1),U,1)["DX" S $P(BQIRY(1),U,8)=0
NEW BQGLB1
S BQGLB1=$NA(^TMP("BQITMPS",UID))
K @BQGLB1
; Call generic program and return data in BQGLB1
D POP^BQITDGN(BQREF,BQGLB1)
; If data found, set the criteria
S TDFN="" F S TDFN=$O(@BQGLB1@(TDFN)) Q:TDFN="" D
. NEW TX
. S TX=$O(@BQGLB1@(TDFN,"CRITERIA",""))
. D STOR(TDFN,TX,BQGLB1)
K @BQGLB1,@BQREF,BQIRY
;
;Hypertension
; If documented as POV at least 3 times separated by 90 days,
; or on the Active problem list.
;
NEW MFL,TAX,NIT,FREF,GREF,TREF,EXDT,SERV,PRIM,TX,TIEN,DTDIF,IEN,VSERV
S TAX="BGP HYPERTENSION DXS",NIT=3,FREF=9000010.07,PLFLG=1
S GREF=$$ROOT^DILFD(FREF,"",1),TREF=$NA(^TMP("BQITAX",UID)),EXDT=""
S SERV="A;H",PRIM=0
S BQGLB1=$NA(^TMP("BQITMPY",UID))
S TX="Hypertension"
K @TREF,@BQGLB1
; Build taxonomy reference
D BLD^BQITUTL(TAX,TREF)
S TIEN=0 F S TIEN=$O(@TREF@(TIEN)) Q:'TIEN D
. S DTDIF=""
. D PRB^BQITD03(TIEN,BQGLB1)
S TIEN=0 F S TIEN=$O(@TREF@(TIEN)) Q:'TIEN D
. S IEN="" F S IEN=$O(@GREF@("B",TIEN,IEN),-1) Q:IEN="" D
.. I $G(@GREF@(IEN,0))="" Q
.. S DFN=$$GET1^DIQ(FREF,IEN,.02,"I") Q:DFN=""
.. ; If there are already 2 or more risk factors, then quit
.. I $G(@TGLOB@(DFN))'<2 Q
.. ; if there are more than 3 hypertension diagnoses, then quit
.. ;I $G(@BQGLB1@(DFN))>3 Q
.. S VISIT=$$GET1^DIQ(FREF,IEN,.03,"I") Q:VISIT=""
.. S VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1 Q:VSDTM=0
.. I $$GET1^DIQ(9000010,VISIT,.11,"I")=1 Q
.. ; check clinical ranking if diagnosis (9000010.07)
.. I FREF=9000010.07,PRIM I $P(@GREF@(IEN,0),U,12)'="P" S MFL=0 D Q:'MFL
... I $O(@GREF@("AD",VISIT,""))=IEN S MFL=1
.. ; if service categories, check the visit for the service category
.. S VSERV=$$GET1^DIQ(9000010,VISIT,.07,"I")
.. I $G(SERV)'="",SERV'[VSERV Q
.. S @BQGLB1@(DFN,VSDTM,TIEN)="V"_U_VISIT_U_EXDT_U_IEN_U_FREF
.. S @BQGLB1@(DFN)=$G(@BQGLB1@(DFN))+1
;
S DFN=""
F S DFN=$O(@BQGLB1@(DFN)) Q:DFN="" D
. D HYP(DFN,TGLOB,BQGLB1)
K @BQGLB1,@TREF
;
;Obese
NEW DXNN,TMFRAME,EXDT,DTDIF,ENDT,STDT,BMID,BMI,AGE,TX,VST,IEN,VSDTM
NEW DTDIF
S DXNN=$$GDXN^BQITUTL("Obese")
S TMPG=$NA(^TMP("BQIBMI",UID))
K @TMPG
S TMFRAME="T-60M",EXDT="",DTDIF=""
S ENDT=$$DATE^BQIUL1(TMFRAME),STDT=$$DT^XLFDT()
S DTDIF=$$FMDIFF^XLFDT(STDT,ENDT,1)
S TX="Obese"
D ABMI^BQITBMI(TMFRAME,.TMPG)
S BQGLB1=$NA(^TMP("BQITMPO",UID))
K @BQGLB1
S TDFN=0
F S TDFN=$O(@TMPG@(TDFN)) Q:'TDFN D
. S BMID=@TMPG@(TDFN)
. S BMI=$P(BMID,"^",1),AGE=$P(BMID,"^",2)
. I $$OB^BQITBMI(TDFN,BMI,AGE) D
.. F TX="BMI-Height","BMI-Weight" S VST="" D
... F S VST=$O(@TMPG@(TDFN,"CRITERIA",TX,"V",VST)) Q:VST="" D
.... S IEN="",FREF=9000010.01,EXDT=""
.... F S IEN=$O(@TMPG@(TDFN,"CRITERIA",TX,"V",VST,IEN)) Q:IEN="" D
..... S VSDTM=$P(@TMPG@(TDFN,"CRITERIA",TX,"V",VST,IEN),U,1)
..... I DTDIF'="" S EXDT=$$FMADD^XLFDT(VSDTM,DTDIF)
..... S $P(@BQGLB1@(TDFN,"CRITERIA","Obese","V",VST,IEN),U,1)=VSDTM_U_EXDT_U_IEN_U_FREF
.. D STOR(TDFN,"Obese",BQGLB1)
;
;High Blood Pressure
NEW BQGLB1
S BQGLB1=$NA(^TMP("BQITMPP",UID))
K @BQGLB1
NEW QFL
S BCLN=$$FIND1^DIC(40.7,"","Q","EMERGENCY","B","")
S BTYP=$$FIND1^DIC(9999999.07,,"X","BP")
S BDFN=0
F S BDFN=$O(^AUPNVMSR("AA",BDFN)) Q:BDFN="" D
. S RDT="",QFL=0
. F S RDT=$O(^AUPNVMSR("AA",BDFN,BTYP,RDT)) Q:RDT="" D Q:QFL
.. S CT=0,N=""
.. F S N=$O(^AUPNVMSR("AA",BDFN,BTYP,RDT,N)) Q:N="" D Q:QFL
... S VISIT=$P($G(^AUPNVMSR(N,0)),U,5) Q:VISIT=""
... ; 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,N_",",2,"I")=1
... I $P($G(^AUPNVSIT(VISIT,0)),U,8)=BCLN Q
... I $P($G(^AUPNVSIT(VISIT,0)),U,11)=1 Q
... S CT=CT+1 I CT>3 S QFL=1 Q
... S BP=$P($G(^AUPNVMSR(N,0)),U,4),SYS=$P(BP,"/",1),DIA=$P(BP,"/",2)
... I SYS=""!(DIA="") Q
... I SYS<140!(DIA<90) Q
... I $G(@BQGLB1@(BDFN))'<3 Q
... S @BQGLB1@(BDFN)=$G(@BQGLB1@(BDFN))+1,FREF=9000010.01
... S @BQGLB1@(BDFN,"CRITERIA","High BP","V",VISIT,N)=$P($G(^AUPNVSIT(VISIT,0)),U,1)_U_EXDT_U_N_U_FREF
;
S TX="High BP"
S BDFN="" F S BDFN=$O(@BQGLB1@(BDFN)) Q:BDFN="" D
. I $G(@TGLOB@(BDFN))'<2 Q
. I @BQGLB1@(BDFN)>1,'$D(@TGLOB@(BDFN,"CRITERIA","Hypertension")) D STOR(BDFN,"High BP",BQGLB1)
K @BQGLB1
;
;Most recent HDL Lab test
NEW HDATA
S HDATA=$NA(^TMP("BQIHDL",UID))
K @HDATA
S BQGLB1=$NA(^TMP("BQITMPL",UID))
K @BQGLB1
S FREF=9000010.09,GREF=$$ROOT^DILFD(FREF,"",1),TREF=$NA(^TMP("BQITAX",UID))
K @TREF
S TAX="DM AUDIT HDL TAX" D BLD^BQITUTL(TAX,TREF)
S TMFRAME="",ENDT=""
S TIEN=0 F S TIEN=$O(@TREF@(TIEN)) Q:'TIEN D
. S IEN=""
. F S IEN=$O(@GREF@("B",TIEN,IEN),-1) Q:IEN="" D
.. I $G(@GREF@(IEN,0))="" Q
.. S DFN=$$GET1^DIQ(FREF,IEN,.02,"I") Q:DFN=""
.. S SEX=$$GET1^DIQ(2,DFN,.02,"I")
.. S VISIT=$$GET1^DIQ(FREF,IEN,.03,"I") Q:VISIT=""
.. S RESULT=$$GET1^DIQ(FREF,IEN,.04,"E") Q:RESULT=""
.. S VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1 Q:'VSDTM
.. I $$GET1^DIQ(9000010,VISIT,.11,"I")=1 Q
.. I $G(TMFRAME)'="",VSDTM<ENDT Q
.. S @HDATA@(DFN,VSDTM)=RESULT_"^"_SEX_"^"_VISIT_"^"_IEN_"^"_FREF
;
NEW TREF1
S TREF1=$NA(^TMP("BQITAX1",UID)) K @TREF1
S TAX="BGP HDL LOINC CODES" D BLD^BQITUTL(TAX,TREF1)
S TIEN=0
F S TIEN=$O(@TREF1@(TIEN)) Q:TIEN="" I $D(@TREF@(TIEN)) K @TREF1@(TIEN)
S TIEN=0 F S TIEN=$O(@TREF1@(TIEN)) Q:'TIEN D
. S IEN=""
. F S IEN=$O(@GREF@("B",TIEN,IEN),-1) Q:IEN="" D
.. I $G(@GREF@(IEN,0))="" Q
.. S DFN=$$GET1^DIQ(FREF,IEN,.02,"I") Q:DFN=""
.. S SEX=$$GET1^DIQ(2,DFN,.02,"I")
.. S VISIT=$$GET1^DIQ(FREF,IEN,.03,"I") Q:VISIT=""
.. S RESULT=$$GET1^DIQ(FREF,IEN,.04,"E") Q:RESULT=""
.. S VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1 Q:'VSDTM
.. I $$GET1^DIQ(9000010,VISIT,.11,"I")=1 Q
.. I $G(TMFRAME)'="",VSDTM<ENDT Q
.. I '$D(@HDATA@(DFN,VSDTM)) S @HDATA@(DFN,VSDTM)=RESULT_"^"_SEX_"^"_VISIT_"^"_IEN_"^"_FREF
;
S DFN=""
F S DFN=$O(@HDATA@(DFN)) Q:DFN="" D
. S DATE="",DATE=$O(@HDATA@(DFN,DATE),-1)
. S RESULT=$P(@HDATA@(DFN,DATE),U,1)
. S SEX=$P(@HDATA@(DFN,DATE),U,2)
. S VISIT=$P(@HDATA@(DFN,DATE),U,3)
. S IEN=$P(@HDATA@(DFN,DATE),U,4)
. S FREF=$P(@HDATA@(DFN,DATE),U,5)
. I SEX="M"!(SEX="U"),RESULT<40 D Q
.. S @BQGLB1@(DFN,"CRITERIA","Risk Factor-HDL Lab Test","V",VISIT,IEN)=DATE_U_EXDT_U_IEN_U_FREF
.. D STOR(DFN,"Risk Factor-HDL Lab Test",BQGLB1)
. I SEX="F",RESULT<45 D
.. S @BQGLB1@(DFN,"CRITERIA","Risk Factor-HDL Lab Test","V",VISIT,IEN)=DATE_U_EXDT_U_IEN_U_FREF
.. D STOR(DFN,"Risk Factor-HDL Lab Test",BQGLB1)
K @HDATA,@BQGLB1
;
;Evidence of High Cholesterol
D DEF^BQITHCH(.TGLOB)
;
;Evidence of Nephropathy
D DEF^BQITNPH(.TGLOB)
;
K DATE,RESULT,SEX,DFN,TMFRAME,FREF,GREF,TREF,ENDT,VSDTM,TDFN
K @HDATA,@BQGLB1,SDFN,BCLN,BP,BTYP,CT,PLFLG,RDT,BMI
K AGE,SEX,RESULT,BDFN,BQREF,DATE2,DIA,N,NIT,SYS,TAX,TIEN,VISIT
K TMPG
Q
;
PRB(PVIEN,TPGLOB) ;EP - Check Problem File for all active instances by date
NEW IEN,PGREF,PFREF
S IEN=0,PGREF="^AUPNPROB",PFREF=9000011
F S IEN=$O(@PGREF@("B",PVIEN,IEN)) Q:'IEN D
. S DFN=$$GET1^DIQ(PFREF,IEN,.02,"I") I DFN="" Q
. I $G(@TPGLOB@(DFN))=1 Q
. I $$GET1^DIQ(PFREF,PVIEN,.12,"I")'="A" Q
. ; Check class - if Family ignore
. I $$GET1^DIQ(PFREF,PVIEN,.04,"I")="F" Q
. S VSDTM=$$PROB^BQIUL1(IEN)\1 Q:VSDTM=0
. I $G(TMFRAME)'="",VSDTM<ENDT Q
. I '$D(@BQGLB1@(DFN,VSDTM,PVIEN)) D
.. S @BQGLB1@(DFN,VSDTM,PVIEN)=$G(@TGLOB@(DFN,VSDTM,PVIEN))+1
.. S @BQGLB1@(DFN)=$G(@BQGLB1@(DFN))+1
.. S @BQGLB1@(DFN,"CRITERIA",""_TAX,"P",IEN)=VSDTM
Q
;
PPRB(DFN,BQGLB) ;EP - Check Problem File for instance of a specific patient
NEW PGREF,PFREF,PVIEN,VSDTM
S PGREF="^AUPNPROB",PFREF=9000011
S PVIEN=""
F S PVIEN=$O(@PGREF@("AC",DFN,PVIEN),-1) Q:'PVIEN D
. S TIEN=$$GET1^DIQ(PFREF,PVIEN,.01,"I") I TIEN="" Q
. I '$D(@TREF@(TIEN)) Q
. I $$GET1^DIQ(PFREF,PVIEN,.12,"I")'="A" Q
. ; Check class - if Family ignore
. I $$GET1^DIQ(PFREF,PVIEN,.04,"I")="F" Q
. S VSDTM=$$PROB^BQIUL1(PVIEN)\1
. I $G(TMFRAME)'="",VSDTM<ENDT Q
. ;
. I '$D(@BQGLB@(DFN,VSDTM,PVIEN)) D
.. S @BQGLB@(DFN,VSDTM,PVIEN)=$G(@BQGLB@(DFN,VSDTM,PVIEN))+1
.. S @BQGLB@(DFN,"CRITERIA",""_TAX,"P",PVIEN)=VSDTM
.. S @BQGLB@(DFN)=$G(@BQGLB@(DFN))+1
Q
;
STOR(SDFN,CRIT,BQGLB) ; Store the patient's met criteria
I $G(@TGLOB@(SDFN))'<2 Q
I $D(@TGLOB@(SDFN,"CRITERIA",CRIT))>0 Q
S @TGLOB@(SDFN)=$G(@TGLOB@(SDFN))+1
;S @TGLOB@(SDFN,"CRITERIA",CRIT)=""
I $D(@BQGLB@(SDFN,"CRITERIA",CRIT)) M @TGLOB@(SDFN,"CRITERIA",CRIT)=@BQGLB@(SDFN,"CRITERIA",CRIT)
Q
;
HYP(DFN,GLOB,TMREF) ; EP - Process Hypertension Risk Factor
;
; At least three hypertension diagnoses with at least 90 days
; between first and last diagnosis
; Input
; DFN - patient whose hypertension diagnoses are being examined
; GLOB - Global where data is to be stored
; Structure:
; GLOB(DFN,"CRITERIA",criteria or taxonomy,visit or problem ien)=date/time
; TMREF - Global used to temporarily store diagnoses that may meet the
; IHD logic and, if so, will be stored in GLOB
;
; Variables
; NOK - If set to '1', no diagnoses remaining that will meet the date logic
; LDX - Most recent diagnosis that meets the IHD criteria
; LDX1 - Next recent diagnosis that meets the IHD criteria
; FDX - Third diagnosis that must be compared to LDX to determine if they
; meet the date logic
; VTYP - Visit type - either 'V' for visit or 'P' for problem
N DXOK,NOK,LDX,LDX1,FDX,DX
I $G(@TMREF@(DFN))<3 K @TMREF@(DFN) Q
S DXOK=0,NOK=0
F D Q:DXOK!NOK K @TMREF@(DFN,LDX)
. S LDX=$O(@TMREF@(DFN,"A"),-1) I LDX="" S NOK=1 Q
. S LDX1=$O(@TMREF@(DFN,LDX),-1) I LDX1="" S NOK=1 Q
. ; Only one problem can be included
. I $$TYP^BQITD031(DFN,LDX,TMREF)="P",$$TYP^BQITD031(DFN,LDX1,TMREF)="P" D I LDX1="" S NOK=1 Q
.. F S LDX1=$O(@TMREF@(DFN,LDX1),-1) Q:LDX1="" I $$TYP^BQITD031(DFN,LDX1,TMREF)="V" Q
. S FDX=LDX1
. F S FDX=$O(@TMREF@(DFN,FDX),-1) Q:FDX="" D Q:DXOK
.. I $$TYP^BQITD031(DFN,LDX,TMREF)="P"!($$TYP^BQITD031(DFN,LDX1,TMREF)="P"),$$TYP^BQITD031(DFN,FDX,TMREF)="P" Q
.. I $$FMDIFF^XLFDT(LDX,FDX,1)>89 S DXOK=1 D Q
... ; Delete remaining entries from temporary file
... S DX=""
... F S DX=$O(@TMREF@(DFN,DX)) Q:DX="" I DX'=LDX,DX'=LDX1,DX'=FDX K @TMREF@(DFN,DX)
I DXOK D
.S @GLOB@(DFN)=$G(@GLOB@(DFN))+1
.;S @GLOB@(DFN,"CRITERIA","Hypertension")=""
. NEW IEN,FREF,EXDT,VSDT,TIEN,VISIT,VTYP,FREF
. S VSDT="",EXDT=""
. F S VSDT=$O(@TMREF@(DFN,VSDT)) Q:VSDT="" D
.. S TIEN="" F S TIEN=$O(@TMREF@(DFN,VSDT,TIEN)) Q:TIEN="" D
... S VISIT=$P(@TMREF@(DFN,VSDT,TIEN),U,2),VTYP=$P(@TMREF@(DFN,VSDT,TIEN),U,1)
... S IEN=$P(@TMREF@(DFN,VSDT,TIEN),U,4),FREF=$P(@TMREF@(DFN,VSDT,TIEN),U,5)
... I VTYP="V" S @GLOB@(DFN,"CRITERIA",TAX,VTYP,VISIT,IEN)=VSDT_U_EXDT_U_IEN_U_FREF
... I VTYP="P" S @GLOB@(DFN,"CRITERIA",TAX,VTYP,VISIT)=VSDT_U_EXDT
Q
BQITRSK ;PRXM/HC/ALA-CVD Risk Factors ; 11 Apr 2006 4:25 PM
+1 ;;2.3;ICARE MANAGEMENT SYSTEM;**3,4**;Apr 18, 2012;Build 66
+2 QUIT
+3 ;
EN(TGLOB) ;EP -- Entry point
+1 ; Input
+2 ; TGLOB - Global that final results will reside in
+3 ;
+4 ;Current Smoker
+5 ; at least 2 smoking POVs ever (not on the same date) or on the
+6 ; Active Problem List or most recent tobacco Health Factor
+7 ;
+8 ; Set up array from File 90506.2
+9 SET BQREF="BQIRY"
KILL @BQREF
+10 SET TAX="Current Smoker"
+11 DO ARY^BQITUTL(TAX,BQREF)
+12 NEW BQGLB1
+13 SET BQGLB1=$NAME(^TMP("BQITMPR",UID))
+14 KILL @BQGLB1
+15 ; Call generic program and return data in BQGLB1
+16 DO POP^BQITDGN(BQREF,BQGLB1)
+17 ; If data found, set the criteria
+18 SET TDFN=""
FOR
SET TDFN=$ORDER(@BQGLB1@(TDFN))
IF TDFN=""
QUIT
Begin DoDot:1
+19 NEW TX
+20 SET TX=$ORDER(@BQGLB1@(TDFN,"CRITERIA",""))
+21 DO STOR(TDFN,TX,BQGLB1)
End DoDot:1
+22 KILL @BQGLB1,@BQREF
+23 ;S TDFN="" F S TDFN=$O(@TGLOB@(TDFN)) Q:TDFN="" S @TGLOB@(TDFN)=1
+24 ;
+25 ; Set up array from File 90506.2
+26 SET BQREF="BQIRY"
KILL @BQREF
+27 SET TAX="PreDM Metabolic Syndrome"
+28 DO ARY^BQITUTL(TAX,BQREF)
+29 ; Set to primary and secondary instead of primary only
+30 IF $GET(BQIRY(1))'=""
IF $PIECE(BQIRY(1),U,1)["DX"
SET $PIECE(BQIRY(1),U,8)=0
+31 NEW BQGLB1
+32 SET BQGLB1=$NAME(^TMP("BQITMPS",UID))
+33 KILL @BQGLB1
+34 ; Call generic program and return data in BQGLB1
+35 DO POP^BQITDGN(BQREF,BQGLB1)
+36 ; If data found, set the criteria
+37 SET TDFN=""
FOR
SET TDFN=$ORDER(@BQGLB1@(TDFN))
IF TDFN=""
QUIT
Begin DoDot:1
+38 NEW TX
+39 SET TX=$ORDER(@BQGLB1@(TDFN,"CRITERIA",""))
+40 DO STOR(TDFN,TX,BQGLB1)
End DoDot:1
+41 KILL @BQGLB1,@BQREF,BQIRY
+42 ;
+43 ;Hypertension
+44 ; If documented as POV at least 3 times separated by 90 days,
+45 ; or on the Active problem list.
+46 ;
+47 NEW MFL,TAX,NIT,FREF,GREF,TREF,EXDT,SERV,PRIM,TX,TIEN,DTDIF,IEN,VSERV
+48 SET TAX="BGP HYPERTENSION DXS"
SET NIT=3
SET FREF=9000010.07
SET PLFLG=1
+49 SET GREF=$$ROOT^DILFD(FREF,"",1)
SET TREF=$NAME(^TMP("BQITAX",UID))
SET EXDT=""
+50 SET SERV="A;H"
SET PRIM=0
+51 SET BQGLB1=$NAME(^TMP("BQITMPY",UID))
+52 SET TX="Hypertension"
+53 KILL @TREF,@BQGLB1
+54 ; Build taxonomy reference
+55 DO BLD^BQITUTL(TAX,TREF)
+56 SET TIEN=0
FOR
SET TIEN=$ORDER(@TREF@(TIEN))
IF 'TIEN
QUIT
Begin DoDot:1
+57 SET DTDIF=""
+58 DO PRB^BQITD03(TIEN,BQGLB1)
End DoDot:1
+59 SET TIEN=0
FOR
SET TIEN=$ORDER(@TREF@(TIEN))
IF 'TIEN
QUIT
Begin DoDot:1
+60 SET IEN=""
FOR
SET IEN=$ORDER(@GREF@("B",TIEN,IEN),-1)
IF IEN=""
QUIT
Begin DoDot:2
+61 IF $GET(@GREF@(IEN,0))=""
QUIT
+62 SET DFN=$$GET1^DIQ(FREF,IEN,.02,"I")
IF DFN=""
QUIT
+63 ; If there are already 2 or more risk factors, then quit
+64 IF $GET(@TGLOB@(DFN))'<2
QUIT
+65 ; if there are more than 3 hypertension diagnoses, then quit
+66 ;I $G(@BQGLB1@(DFN))>3 Q
+67 SET VISIT=$$GET1^DIQ(FREF,IEN,.03,"I")
IF VISIT=""
QUIT
+68 SET VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1
IF VSDTM=0
QUIT
+69 IF $$GET1^DIQ(9000010,VISIT,.11,"I")=1
QUIT
+70 ; check clinical ranking if diagnosis (9000010.07)
+71 IF FREF=9000010.07
IF PRIM
IF $PIECE(@GREF@(IEN,0),U,12)'="P"
SET MFL=0
Begin DoDot:3
+72 IF $ORDER(@GREF@("AD",VISIT,""))=IEN
SET MFL=1
End DoDot:3
IF 'MFL
QUIT
+73 ; if service categories, check the visit for the service category
+74 SET VSERV=$$GET1^DIQ(9000010,VISIT,.07,"I")
+75 IF $GET(SERV)'=""
IF SERV'[VSERV
QUIT
+76 SET @BQGLB1@(DFN,VSDTM,TIEN)="V"_U_VISIT_U_EXDT_U_IEN_U_FREF
+77 SET @BQGLB1@(DFN)=$GET(@BQGLB1@(DFN))+1
End DoDot:2
End DoDot:1
+78 ;
+79 SET DFN=""
+80 FOR
SET DFN=$ORDER(@BQGLB1@(DFN))
IF DFN=""
QUIT
Begin DoDot:1
+81 DO HYP(DFN,TGLOB,BQGLB1)
End DoDot:1
+82 KILL @BQGLB1,@TREF
+83 ;
+84 ;Obese
+85 NEW DXNN,TMFRAME,EXDT,DTDIF,ENDT,STDT,BMID,BMI,AGE,TX,VST,IEN,VSDTM
+86 NEW DTDIF
+87 SET DXNN=$$GDXN^BQITUTL("Obese")
+88 SET TMPG=$NAME(^TMP("BQIBMI",UID))
+89 KILL @TMPG
+90 SET TMFRAME="T-60M"
SET EXDT=""
SET DTDIF=""
+91 SET ENDT=$$DATE^BQIUL1(TMFRAME)
SET STDT=$$DT^XLFDT()
+92 SET DTDIF=$$FMDIFF^XLFDT(STDT,ENDT,1)
+93 SET TX="Obese"
+94 DO ABMI^BQITBMI(TMFRAME,.TMPG)
+95 SET BQGLB1=$NAME(^TMP("BQITMPO",UID))
+96 KILL @BQGLB1
+97 SET TDFN=0
+98 FOR
SET TDFN=$ORDER(@TMPG@(TDFN))
IF 'TDFN
QUIT
Begin DoDot:1
+99 SET BMID=@TMPG@(TDFN)
+100 SET BMI=$PIECE(BMID,"^",1)
SET AGE=$PIECE(BMID,"^",2)
+101 IF $$OB^BQITBMI(TDFN,BMI,AGE)
Begin DoDot:2
+102 FOR TX="BMI-Height","BMI-Weight"
SET VST=""
Begin DoDot:3
+103 FOR
SET VST=$ORDER(@TMPG@(TDFN,"CRITERIA",TX,"V",VST))
IF VST=""
QUIT
Begin DoDot:4
+104 SET IEN=""
SET FREF=9000010.01
SET EXDT=""
+105 FOR
SET IEN=$ORDER(@TMPG@(TDFN,"CRITERIA",TX,"V",VST,IEN))
IF IEN=""
QUIT
Begin DoDot:5
+106 SET VSDTM=$PIECE(@TMPG@(TDFN,"CRITERIA",TX,"V",VST,IEN),U,1)
+107 IF DTDIF'=""
SET EXDT=$$FMADD^XLFDT(VSDTM,DTDIF)
+108 SET $PIECE(@BQGLB1@(TDFN,"CRITERIA","Obese","V",VST,IEN),U,1)=VSDTM_U_EXDT_U_IEN_U_FREF
End DoDot:5
End DoDot:4
End DoDot:3
+109 DO STOR(TDFN,"Obese",BQGLB1)
End DoDot:2
End DoDot:1
+110 ;
+111 ;High Blood Pressure
+112 NEW BQGLB1
+113 SET BQGLB1=$NAME(^TMP("BQITMPP",UID))
+114 KILL @BQGLB1
+115 NEW QFL
+116 SET BCLN=$$FIND1^DIC(40.7,"","Q","EMERGENCY","B","")
+117 SET BTYP=$$FIND1^DIC(9999999.07,,"X","BP")
+118 SET BDFN=0
+119 FOR
SET BDFN=$ORDER(^AUPNVMSR("AA",BDFN))
IF BDFN=""
QUIT
Begin DoDot:1
+120 SET RDT=""
SET QFL=0
+121 FOR
SET RDT=$ORDER(^AUPNVMSR("AA",BDFN,BTYP,RDT))
IF RDT=""
QUIT
Begin DoDot:2
+122 SET CT=0
SET N=""
+123 FOR
SET N=$ORDER(^AUPNVMSR("AA",BDFN,BTYP,RDT,N))
IF N=""
QUIT
Begin DoDot:3
+124 SET VISIT=$PIECE($GET(^AUPNVMSR(N,0)),U,5)
IF VISIT=""
QUIT
+125 ; if the new ENTERED IN ERROR field exists, exclude the record if it is marked as an error
+126 IF $$VFIELD^DILFD(9000010.01,2)
IF $$GET1^DIQ(9000010.01,N_",",2,"I")=1
QUIT
+127 IF $PIECE($GET(^AUPNVSIT(VISIT,0)),U,8)=BCLN
QUIT
+128 IF $PIECE($GET(^AUPNVSIT(VISIT,0)),U,11)=1
QUIT
+129 SET CT=CT+1
IF CT>3
SET QFL=1
QUIT
+130 SET BP=$PIECE($GET(^AUPNVMSR(N,0)),U,4)
SET SYS=$PIECE(BP,"/",1)
SET DIA=$PIECE(BP,"/",2)
+131 IF SYS=""!(DIA="")
QUIT
+132 IF SYS<140!(DIA<90)
QUIT
+133 IF $GET(@BQGLB1@(BDFN))'<3
QUIT
+134 SET @BQGLB1@(BDFN)=$GET(@BQGLB1@(BDFN))+1
SET FREF=9000010.01
+135 SET @BQGLB1@(BDFN,"CRITERIA","High BP","V",VISIT,N)=$PIECE($GET(^AUPNVSIT(VISIT,0)),U,1)_U_EXDT_U_N_U_FREF
End DoDot:3
IF QFL
QUIT
End DoDot:2
IF QFL
QUIT
End DoDot:1
+136 ;
+137 SET TX="High BP"
+138 SET BDFN=""
FOR
SET BDFN=$ORDER(@BQGLB1@(BDFN))
IF BDFN=""
QUIT
Begin DoDot:1
+139 IF $GET(@TGLOB@(BDFN))'<2
QUIT
+140 IF @BQGLB1@(BDFN)>1
IF '$DATA(@TGLOB@(BDFN,"CRITERIA","Hypertension"))
DO STOR(BDFN,"High BP",BQGLB1)
End DoDot:1
+141 KILL @BQGLB1
+142 ;
+143 ;Most recent HDL Lab test
+144 NEW HDATA
+145 SET HDATA=$NAME(^TMP("BQIHDL",UID))
+146 KILL @HDATA
+147 SET BQGLB1=$NAME(^TMP("BQITMPL",UID))
+148 KILL @BQGLB1
+149 SET FREF=9000010.09
SET GREF=$$ROOT^DILFD(FREF,"",1)
SET TREF=$NAME(^TMP("BQITAX",UID))
+150 KILL @TREF
+151 SET TAX="DM AUDIT HDL TAX"
DO BLD^BQITUTL(TAX,TREF)
+152 SET TMFRAME=""
SET ENDT=""
+153 SET TIEN=0
FOR
SET TIEN=$ORDER(@TREF@(TIEN))
IF 'TIEN
QUIT
Begin DoDot:1
+154 SET IEN=""
+155 FOR
SET IEN=$ORDER(@GREF@("B",TIEN,IEN),-1)
IF IEN=""
QUIT
Begin DoDot:2
+156 IF $GET(@GREF@(IEN,0))=""
QUIT
+157 SET DFN=$$GET1^DIQ(FREF,IEN,.02,"I")
IF DFN=""
QUIT
+158 SET SEX=$$GET1^DIQ(2,DFN,.02,"I")
+159 SET VISIT=$$GET1^DIQ(FREF,IEN,.03,"I")
IF VISIT=""
QUIT
+160 SET RESULT=$$GET1^DIQ(FREF,IEN,.04,"E")
IF RESULT=""
QUIT
+161 SET VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1
IF 'VSDTM
QUIT
+162 IF $$GET1^DIQ(9000010,VISIT,.11,"I")=1
QUIT
+163 IF $GET(TMFRAME)'=""
IF VSDTM<ENDT
QUIT
+164 SET @HDATA@(DFN,VSDTM)=RESULT_"^"_SEX_"^"_VISIT_"^"_IEN_"^"_FREF
End DoDot:2
End DoDot:1
+165 ;
+166 NEW TREF1
+167 SET TREF1=$NAME(^TMP("BQITAX1",UID))
KILL @TREF1
+168 SET TAX="BGP HDL LOINC CODES"
DO BLD^BQITUTL(TAX,TREF1)
+169 SET TIEN=0
+170 FOR
SET TIEN=$ORDER(@TREF1@(TIEN))
IF TIEN=""
QUIT
IF $DATA(@TREF@(TIEN))
KILL @TREF1@(TIEN)
+171 SET TIEN=0
FOR
SET TIEN=$ORDER(@TREF1@(TIEN))
IF 'TIEN
QUIT
Begin DoDot:1
+172 SET IEN=""
+173 FOR
SET IEN=$ORDER(@GREF@("B",TIEN,IEN),-1)
IF IEN=""
QUIT
Begin DoDot:2
+174 IF $GET(@GREF@(IEN,0))=""
QUIT
+175 SET DFN=$$GET1^DIQ(FREF,IEN,.02,"I")
IF DFN=""
QUIT
+176 SET SEX=$$GET1^DIQ(2,DFN,.02,"I")
+177 SET VISIT=$$GET1^DIQ(FREF,IEN,.03,"I")
IF VISIT=""
QUIT
+178 SET RESULT=$$GET1^DIQ(FREF,IEN,.04,"E")
IF RESULT=""
QUIT
+179 SET VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1
IF 'VSDTM
QUIT
+180 IF $$GET1^DIQ(9000010,VISIT,.11,"I")=1
QUIT
+181 IF $GET(TMFRAME)'=""
IF VSDTM<ENDT
QUIT
+182 IF '$DATA(@HDATA@(DFN,VSDTM))
SET @HDATA@(DFN,VSDTM)=RESULT_"^"_SEX_"^"_VISIT_"^"_IEN_"^"_FREF
End DoDot:2
End DoDot:1
+183 ;
+184 SET DFN=""
+185 FOR
SET DFN=$ORDER(@HDATA@(DFN))
IF DFN=""
QUIT
Begin DoDot:1
+186 SET DATE=""
SET DATE=$ORDER(@HDATA@(DFN,DATE),-1)
+187 SET RESULT=$PIECE(@HDATA@(DFN,DATE),U,1)
+188 SET SEX=$PIECE(@HDATA@(DFN,DATE),U,2)
+189 SET VISIT=$PIECE(@HDATA@(DFN,DATE),U,3)
+190 SET IEN=$PIECE(@HDATA@(DFN,DATE),U,4)
+191 SET FREF=$PIECE(@HDATA@(DFN,DATE),U,5)
+192 IF SEX="M"!(SEX="U")
IF RESULT<40
Begin DoDot:2
+193 SET @BQGLB1@(DFN,"CRITERIA","Risk Factor-HDL Lab Test","V",VISIT,IEN)=DATE_U_EXDT_U_IEN_U_FREF
+194 DO STOR(DFN,"Risk Factor-HDL Lab Test",BQGLB1)
End DoDot:2
QUIT
+195 IF SEX="F"
IF RESULT<45
Begin DoDot:2
+196 SET @BQGLB1@(DFN,"CRITERIA","Risk Factor-HDL Lab Test","V",VISIT,IEN)=DATE_U_EXDT_U_IEN_U_FREF
+197 DO STOR(DFN,"Risk Factor-HDL Lab Test",BQGLB1)
End DoDot:2
End DoDot:1
+198 KILL @HDATA,@BQGLB1
+199 ;
+200 ;Evidence of High Cholesterol
+201 DO DEF^BQITHCH(.TGLOB)
+202 ;
+203 ;Evidence of Nephropathy
+204 DO DEF^BQITNPH(.TGLOB)
+205 ;
+206 KILL DATE,RESULT,SEX,DFN,TMFRAME,FREF,GREF,TREF,ENDT,VSDTM,TDFN
+207 KILL @HDATA,@BQGLB1,SDFN,BCLN,BP,BTYP,CT,PLFLG,RDT,BMI
+208 KILL AGE,SEX,RESULT,BDFN,BQREF,DATE2,DIA,N,NIT,SYS,TAX,TIEN,VISIT
+209 KILL TMPG
+210 QUIT
+211 ;
PRB(PVIEN,TPGLOB) ;EP - Check Problem File for all active instances by date
+1 NEW IEN,PGREF,PFREF
+2 SET IEN=0
SET PGREF="^AUPNPROB"
SET PFREF=9000011
+3 FOR
SET IEN=$ORDER(@PGREF@("B",PVIEN,IEN))
IF 'IEN
QUIT
Begin DoDot:1
+4 SET DFN=$$GET1^DIQ(PFREF,IEN,.02,"I")
IF DFN=""
QUIT
+5 IF $GET(@TPGLOB@(DFN))=1
QUIT
+6 IF $$GET1^DIQ(PFREF,PVIEN,.12,"I")'="A"
QUIT
+7 ; Check class - if Family ignore
+8 IF $$GET1^DIQ(PFREF,PVIEN,.04,"I")="F"
QUIT
+9 SET VSDTM=$$PROB^BQIUL1(IEN)\1
IF VSDTM=0
QUIT
+10 IF $GET(TMFRAME)'=""
IF VSDTM<ENDT
QUIT
+11 IF '$DATA(@BQGLB1@(DFN,VSDTM,PVIEN))
Begin DoDot:2
+12 SET @BQGLB1@(DFN,VSDTM,PVIEN)=$GET(@TGLOB@(DFN,VSDTM,PVIEN))+1
+13 SET @BQGLB1@(DFN)=$GET(@BQGLB1@(DFN))+1
+14 SET @BQGLB1@(DFN,"CRITERIA",""_TAX,"P",IEN)=VSDTM
End DoDot:2
End DoDot:1
+15 QUIT
+16 ;
PPRB(DFN,BQGLB) ;EP - Check Problem File for instance of a specific patient
+1 NEW PGREF,PFREF,PVIEN,VSDTM
+2 SET PGREF="^AUPNPROB"
SET PFREF=9000011
+3 SET PVIEN=""
+4 FOR
SET PVIEN=$ORDER(@PGREF@("AC",DFN,PVIEN),-1)
IF 'PVIEN
QUIT
Begin DoDot:1
+5 SET TIEN=$$GET1^DIQ(PFREF,PVIEN,.01,"I")
IF TIEN=""
QUIT
+6 IF '$DATA(@TREF@(TIEN))
QUIT
+7 IF $$GET1^DIQ(PFREF,PVIEN,.12,"I")'="A"
QUIT
+8 ; Check class - if Family ignore
+9 IF $$GET1^DIQ(PFREF,PVIEN,.04,"I")="F"
QUIT
+10 SET VSDTM=$$PROB^BQIUL1(PVIEN)\1
+11 IF $GET(TMFRAME)'=""
IF VSDTM<ENDT
QUIT
+12 ;
+13 IF '$DATA(@BQGLB@(DFN,VSDTM,PVIEN))
Begin DoDot:2
+14 SET @BQGLB@(DFN,VSDTM,PVIEN)=$GET(@BQGLB@(DFN,VSDTM,PVIEN))+1
+15 SET @BQGLB@(DFN,"CRITERIA",""_TAX,"P",PVIEN)=VSDTM
+16 SET @BQGLB@(DFN)=$GET(@BQGLB@(DFN))+1
End DoDot:2
End DoDot:1
+17 QUIT
+18 ;
STOR(SDFN,CRIT,BQGLB) ; Store the patient's met criteria
+1 IF $GET(@TGLOB@(SDFN))'<2
QUIT
+2 IF $DATA(@TGLOB@(SDFN,"CRITERIA",CRIT))>0
QUIT
+3 SET @TGLOB@(SDFN)=$GET(@TGLOB@(SDFN))+1
+4 ;S @TGLOB@(SDFN,"CRITERIA",CRIT)=""
+5 IF $DATA(@BQGLB@(SDFN,"CRITERIA",CRIT))
MERGE @TGLOB@(SDFN,"CRITERIA",CRIT)=@BQGLB@(SDFN,"CRITERIA",CRIT)
+6 QUIT
+7 ;
HYP(DFN,GLOB,TMREF) ; EP - Process Hypertension Risk Factor
+1 ;
+2 ; At least three hypertension diagnoses with at least 90 days
+3 ; between first and last diagnosis
+4 ; Input
+5 ; DFN - patient whose hypertension diagnoses are being examined
+6 ; GLOB - Global where data is to be stored
+7 ; Structure:
+8 ; GLOB(DFN,"CRITERIA",criteria or taxonomy,visit or problem ien)=date/time
+9 ; TMREF - Global used to temporarily store diagnoses that may meet the
+10 ; IHD logic and, if so, will be stored in GLOB
+11 ;
+12 ; Variables
+13 ; NOK - If set to '1', no diagnoses remaining that will meet the date logic
+14 ; LDX - Most recent diagnosis that meets the IHD criteria
+15 ; LDX1 - Next recent diagnosis that meets the IHD criteria
+16 ; FDX - Third diagnosis that must be compared to LDX to determine if they
+17 ; meet the date logic
+18 ; VTYP - Visit type - either 'V' for visit or 'P' for problem
+19 NEW DXOK,NOK,LDX,LDX1,FDX,DX
+20 IF $GET(@TMREF@(DFN))<3
KILL @TMREF@(DFN)
QUIT
+21 SET DXOK=0
SET NOK=0
+22 FOR
Begin DoDot:1
+23 SET LDX=$ORDER(@TMREF@(DFN,"A"),-1)
IF LDX=""
SET NOK=1
QUIT
+24 SET LDX1=$ORDER(@TMREF@(DFN,LDX),-1)
IF LDX1=""
SET NOK=1
QUIT
+25 ; Only one problem can be included
+26 IF $$TYP^BQITD031(DFN,LDX,TMREF)="P"
IF $$TYP^BQITD031(DFN,LDX1,TMREF)="P"
Begin DoDot:2
+27 FOR
SET LDX1=$ORDER(@TMREF@(DFN,LDX1),-1)
IF LDX1=""
QUIT
IF $$TYP^BQITD031(DFN,LDX1,TMREF)="V"
QUIT
End DoDot:2
IF LDX1=""
SET NOK=1
QUIT
+28 SET FDX=LDX1
+29 FOR
SET FDX=$ORDER(@TMREF@(DFN,FDX),-1)
IF FDX=""
QUIT
Begin DoDot:2
+30 IF $$TYP^BQITD031(DFN,LDX,TMREF)="P"!($$TYP^BQITD031(DFN,LDX1,TMREF)="P")
IF $$TYP^BQITD031(DFN,FDX,TMREF)="P"
QUIT
+31 IF $$FMDIFF^XLFDT(LDX,FDX,1)>89
SET DXOK=1
Begin DoDot:3
+32 ; Delete remaining entries from temporary file
+33 SET DX=""
+34 FOR
SET DX=$ORDER(@TMREF@(DFN,DX))
IF DX=""
QUIT
IF DX'=LDX
IF DX'=LDX1
IF DX'=FDX
KILL @TMREF@(DFN,DX)
End DoDot:3
QUIT
End DoDot:2
IF DXOK
QUIT
End DoDot:1
IF DXOK!NOK
QUIT
KILL @TMREF@(DFN,LDX)
+35 IF DXOK
Begin DoDot:1
+36 SET @GLOB@(DFN)=$GET(@GLOB@(DFN))+1
+37 ;S @GLOB@(DFN,"CRITERIA","Hypertension")=""
+38 NEW IEN,FREF,EXDT,VSDT,TIEN,VISIT,VTYP,FREF
+39 SET VSDT=""
SET EXDT=""
+40 FOR
SET VSDT=$ORDER(@TMREF@(DFN,VSDT))
IF VSDT=""
QUIT
Begin DoDot:2
+41 SET TIEN=""
FOR
SET TIEN=$ORDER(@TMREF@(DFN,VSDT,TIEN))
IF TIEN=""
QUIT
Begin DoDot:3
+42 SET VISIT=$PIECE(@TMREF@(DFN,VSDT,TIEN),U,2)
SET VTYP=$PIECE(@TMREF@(DFN,VSDT,TIEN),U,1)
+43 SET IEN=$PIECE(@TMREF@(DFN,VSDT,TIEN),U,4)
SET FREF=$PIECE(@TMREF@(DFN,VSDT,TIEN),U,5)
+44 IF VTYP="V"
SET @GLOB@(DFN,"CRITERIA",TAX,VTYP,VISIT,IEN)=VSDT_U_EXDT_U_IEN_U_FREF
+45 IF VTYP="P"
SET @GLOB@(DFN,"CRITERIA",TAX,VTYP,VISIT)=VSDT_U_EXDT
End DoDot:3
End DoDot:2
End DoDot:1
+46 QUIT
