BQITD05 ;PRXM/HC/ALA-CVD Significant Risk ; 02 Mar 2006 1:17 PM
;;2.3;ICARE MANAGEMENT SYSTEM;**1,3,4**;Apr 18, 2012;Build 66
Q
;
POP(BQARY,TGLOB) ; EP -- By population
;
;Description
; Finds all patients who meet the criteria for CVD Significant Risk
;Input
; BQARY - Array of taxonomies and other information
; TGLOB - Global where data is to be stored and passed back
; to calling routine
; Structure:
; TGLOB(DFN,"CRITERIA",criteria or taxonomy,visit or problem ien)=date/time
;Variables
; TAX - Taxonomy name
; NIT - Number of iterations
; TMFRAME - Time frame of check
; FREF - File Number reference
; PLFLG - Problem File flag
; GREF - Global reference
; TREF - Taxonomy temp reference
;
; Clean up all current entries
NEW DXNN,TDFN,DA,DIK,TMGLB,SEX,AGE,TXDXCN,TXDXCT
NEW SERV,VSERV,PRIM,MFL
;
S TMGLBB=$NA(^TMP("BQICHRF",UID)) K @TMGLBB
D EN^BQITRSK(.TMGLBB)
S TDFN=""
F S TDFN=$O(@TMGLBB@(TDFN)) Q:TDFN="" D
. S SEX=$$GET1^DIQ(2,TDFN,.02,"I")
. S AGE=$$AGE^BQIAGE(TDFN)
. I SEX="M"!(SEX="U") D
.. ; If males are less than 19 years old, kill risk factors and quit
.. I AGE<19 K @TMGLBB@(TDFN) Q
.. ; If males are 19-44 and have less than 2 risk factors, kill risk factors and quit
.. I AGE>18,AGE<45,@TMGLBB@(TDFN)<2 K @TMGLBB@(TDFN)
.. ; Assumes that left over data meets criteria of
.. ; AGE=19-44 and at least 2 risk factors
.. ; AGE>=45 and at least 1 risk factor
. I SEX="F" D
.. ; If females are less than 19 years old, kill risk factors and quit
.. I AGE<19 K @TMGLBB@(TDFN) Q
.. ; If females are 19-54 and have less than 2 risk factors, kill risk factors and quit
.. I AGE>18,AGE<55,@TMGLBB@(TDFN)<2 K @TMGLBB@(TDFN)
.. ; Assumes that left over data meets criteria of
.. ; AGE=19-54 and at least 2 risk factors
.. ; AGE>=55 and at least 1 risk factor
;
; Even if they meet the criteria, they cannot also have been
; identified as CVD Known or CVD Highest Risk. If they are,
; kill their entry.
S TDFN=""
F S TDFN=$O(@TMGLBB@(TDFN)) Q:TDFN="" D
. F TXDXCT="CVD Known","CVD Highest Risk" D
.. ; If the person has an active tag at a higher level
.. I $$ATAG^BQITDUTL(TDFN,TXDXCT) K @TMGLBB@(TDFN)
;
S TDFN=""
F S TDFN=$O(@TMGLBB@(TDFN)) Q:TDFN="" M @TGLOB@(TDFN)=@TMGLBB@(TDFN)
K @TMGLBB,TMGLBB
Q
;
PAT(DEF,BTGLOB,BDFN) ; EP -- By patient
NEW DXOK,BQDXN,TMGLB,TX,BQREF,TAX,GREF,TREF,FREF,NIT,PLFLG,BQGLB
NEW IEN,TIEN,VISIT,VSDTM,DXNN,BMID,VIENS,TDXNCN,ENDT,STDT,DTDIF,QFL
NEW SERV,VSERV,PRIM,MFL
S DXOK=0
; if the person has already been identified as CVD Known OR CVD Highest Risk
S QFL=0 F TDXNCN="CVD Highest Risk","CVD Known" D Q:QFL
. I $$ATAG^BQITDUTL(BDFN,TDXNCN) S QFL=1
I QFL Q DXOK
;
S TMGLB=$NA(^TMP("BQICHR",UID)) K @TMGLB
S DXOK=0
S BQDXN=$$GDXN^BQITUTL("Current Smoker")
S BQREF="BQIRY"
D GDF^BQITUTL(BQDXN,BQREF)
I $$PAT^BQITDGN(BQREF,TMGLB,BDFN) D
. S TX=$O(@TMGLB@(BDFN,"CRITERIA",""))
. D STOR(BDFN,TX,TMGLB)
K @TMGLB
;
S BQDXN=$$GDXN^BQITUTL("PreDM Metabolic Syndrome")
S BQREF="BQIRY"
D GDF^BQITUTL(BQDXN,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
I $$PAT^BQITDGN(BQREF,TMGLB,BDFN) D
. S TX=$O(@TMGLB@(BDFN,"CRITERIA",""))
. D STOR(BDFN,TX,TMGLB)
K @TMGLB
;
S TAX="BGP HYPERTENSION DXS",NIT=3,FREF=9000010.07,PLFLG=1,ENDT=""
S GREF=$$ROOT^DILFD(FREF,"",1),TREF=$NA(^TMP("BQITAX",UID))
S SERV="A;H",PRIM=0,EXDT=""
S BQGLB=$NA(^TMP("BQITMP",UID))
K @TREF,@BQGLB
D BLD^BQITUTL(TAX,TREF)
;D PPRB^BQITRSK(BDFN)
D PPRB^BQITD03(BDFN,BQGLB)
S IEN="",EXDT=""
F S IEN=$O(@GREF@("AC",BDFN,IEN),-1) Q:IEN="" D
. S TIEN=$$GET1^DIQ(FREF,IEN,.01,"I") I TIEN="" Q
. I '$D(@TREF@(TIEN)) Q
. I $G(@BTGLOB@(BDFN))'<2 Q
. ;I $G(@BQGLB@(BDFN))>NIT Q
. S VISIT=$$GET1^DIQ(FREF,IEN,.03,"I") Q:VISIT=""
. 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 VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1 Q:VSDTM=0
. S @BQGLB@(BDFN,VSDTM,TIEN)="V"_U_VISIT_U_EXDT_U_IEN_U_FREF
. S @BQGLB@(BDFN)=$G(@BQGLB@(BDFN))+1
;
D HYP^BQITRSK(BDFN,TMGLB,BQGLB)
I $D(@TMGLB)>0 D STOR(BDFN,TAX,TMGLB)
K @BQGLB,@TREF
;
NEW DXNN,AGE,BMI,MIENS
S BMID=$$OBMI^BQITBMI(BDFN,"T-60M")
S BMI=$P(BMID,"^",1),AGE=$P(BMID,"^",2),VIENS=$P(BMID,"^",3),MIENS=$P(BMID,"^",4)
I BMI'="",$$OB^BQITBMI(BDFN,BMI,AGE) D
. F I=1:1 S VST=$P(VIENS,",",I) Q:VST="" D
.. NEW IEN
.. S IEN=$P(MIENS,",",I),FREF=9000010.01
.. S @TMGLB@(BDFN,"CRITERIA","Risk Factor-Obese BMI","V",VST,IEN)=$P($G(^AUPNVSIT(VST,0)),U,1)_U_EXDT_U_IEN_U_FREF
. D STOR(BDFN,"Risk Factor-Obese BMI",TMGLB)
K @TMGLB
;
NEW BCLN,BTYP,RDT,CT,N,BP,SYS,DIA,RESULT,HDATA
S BQGLB1=$NA(^TMP("BQITMP",UID))
K @BQGLB1
S BCLN=$$FIND1^DIC(40.7,"","Q","EMERGENCY","B","","ERROR")
S BTYP=$$FIND1^DIC(9999999.07,,"X","BP")
S RDT=""
F S RDT=$O(^AUPNVMSR("AA",BDFN,BTYP,RDT)) Q:RDT="" D
. S CT=0,N=""
. F S N=$O(^AUPNVMSR("AA",BDFN,BTYP,RDT,N)) Q:N=""!(CT>3) D
.. 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,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 CT=CT+1
.. 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
.. S @BQGLB1@(BDFN)=$G(@BQGLB1@(BDFN))+1,FREF=9000010.01
.. S @BQGLB1@(BDFN,"CRITERIA","Risk Factor-High Blood Pressure","V",VISIT,N)=$P($G(^AUPNVSIT(VISIT,0)),U,1)_U_EXDT_U_N_U_FREF
I $G(@BQGLB1@(BDFN))>1 D STOR(BDFN,"Risk Factor-High Blood Pressure",TMGLB)
K @BQGLB1
;
S HDATA=$NA(^TMP("BQIHDL",UID)),TMFRAME="",ENDT=""
K @HDATA
S FREF=9000010.09,GREF=$$ROOT^DILFD(FREF,"",1),TREF=$NA(^TMP("BQITAX",UID)) K @TREF
F TAX="BGP HDL LOINC CODES","DM AUDIT HDL TAX" D BLD^BQITUTL(TAX,TREF)
S IEN=""
F S IEN=$O(@GREF@("AC",BDFN,IEN),-1) Q:IEN="" D
. S TIEN=$$GET1^DIQ(FREF,IEN,.01,"I") I TIEN="" Q
. I '$D(@TREF@(TIEN)) Q
. S SEX=$$GET1^DIQ(2,BDFN,.02,"I")
. S VISIT=$$GET1^DIQ(FREF,IEN,.03,"I") Q:VISIT=""
. I $$GET1^DIQ(9000010,VISIT,.11,"I")=1 Q
. S RESULT=$$GET1^DIQ(FREF,IEN,.04,"E") Q:RESULT=""
. S VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1 Q:'VSDTM
. I $G(TMFRAME)'="",VSDTM<ENDT Q
. S @HDATA@(BDFN,VSDTM)=RESULT_"^"_SEX_"^"_VISIT_"^"_IEN_"^"_FREF
S DATE="",DATE=$O(@HDATA@(BDFN,DATE),-1)
I DATE'="" D
. S RESULT=$P(@HDATA@(BDFN,DATE),"^",1)
. S SEX=$P(@HDATA@(BDFN,DATE),"^",2)
. S VISIT=$P(@HDATA@(BDFN,DATE),"^",3)
. S IEN=$P(@HDATA@(BDFN,DATE),"^",4)
. S FREF=$P(@HDATA@(BDFN,DATE),"^",5)
. K @TMGLB
. I SEX="M"!(SEX="U"),RESULT<40 D
.. S @TMGLB@(BDFN,"CRITERIA","Risk Factor-HDL Lab Test","V",VISIT,IEN)=VSDTM_U_EXDT_U_IEN_U_FREF
.. D STOR(BDFN,"Risk Factor-HDL Lab Test",TMGLB)
. I SEX="F",RESULT<45 D
.. S @TMGLB@(BDFN,"CRITERIA","Risk Factor-HDL Lab Test","V",VISIT,IEN)=VSDTM_U_EXDT_U_IEN_U_FREF
.. D STOR(BDFN,"Risk Factor-HDL Lab Test",TMGLB)
K @HDATA
;
;High Cholesterol
D PAT^BQITHCH(BDFN,.BTGLOB)
;
;Nephropathy
D PAT^BQITNPH(BDFN,.BTGLOB)
;
S DXOK=0
S SEX=$$GET1^DIQ(2,BDFN,.02,"I")
S AGE=$$AGE^BQIAGE(BDFN)
I SEX="M"!(SEX="U") D
. I AGE<19 K @BTGLOB@(BDFN) Q
. I AGE>18,AGE<45,$G(@BTGLOB@(BDFN))<2 Q
. I +$G(@BTGLOB@(BDFN))=0 Q
. S DXOK=1
I SEX="F" D
. I AGE<19 K @BTGLOB@(BDFN) Q
. I AGE>18,AGE<55,$G(@BTGLOB@(BDFN))<2 Q
. I +$G(@BTGLOB@(BDFN))=0 Q
. S DXOK=1
;
Q DXOK
;
STOR(SDFN,CRIT,BQQGLB) ;EP - Store the patient's met criteria
I $G(@BTGLOB@(SDFN))'<2 Q
I $D(@BTGLOB@(SDFN,"CRITERIA",CRIT))>0 Q
S @BTGLOB@(SDFN)=$G(@BTGLOB@(SDFN))+1
;S @BTGLOB@(SDFN,"CRITERIA",CRIT)=""
I $D(@BQQGLB@(SDFN)) M @BTGLOB@(SDFN,"CRITERIA")=@BQQGLB@(SDFN,"CRITERIA")
Q
BQITD05 ;PRXM/HC/ALA-CVD Significant Risk ; 02 Mar 2006 1:17 PM
+1 ;;2.3;ICARE MANAGEMENT SYSTEM;**1,3,4**;Apr 18, 2012;Build 66
+2 QUIT
+3 ;
POP(BQARY,TGLOB) ; EP -- By population
+1 ;
+2 ;Description
+3 ; Finds all patients who meet the criteria for CVD Significant Risk
+4 ;Input
+5 ; BQARY - Array of taxonomies and other information
+6 ; TGLOB - Global where data is to be stored and passed back
+7 ; to calling routine
+8 ; Structure:
+9 ; TGLOB(DFN,"CRITERIA",criteria or taxonomy,visit or problem ien)=date/time
+10 ;Variables
+11 ; TAX - Taxonomy name
+12 ; NIT - Number of iterations
+13 ; TMFRAME - Time frame of check
+14 ; FREF - File Number reference
+15 ; PLFLG - Problem File flag
+16 ; GREF - Global reference
+17 ; TREF - Taxonomy temp reference
+18 ;
+19 ; Clean up all current entries
+20 NEW DXNN,TDFN,DA,DIK,TMGLB,SEX,AGE,TXDXCN,TXDXCT
+21 NEW SERV,VSERV,PRIM,MFL
+22 ;
+23 SET TMGLBB=$NAME(^TMP("BQICHRF",UID))
KILL @TMGLBB
+24 DO EN^BQITRSK(.TMGLBB)
+25 SET TDFN=""
+26 FOR
SET TDFN=$ORDER(@TMGLBB@(TDFN))
IF TDFN=""
QUIT
Begin DoDot:1
+27 SET SEX=$$GET1^DIQ(2,TDFN,.02,"I")
+28 SET AGE=$$AGE^BQIAGE(TDFN)
+29 IF SEX="M"!(SEX="U")
Begin DoDot:2
+30 ; If males are less than 19 years old, kill risk factors and quit
+31 IF AGE<19
KILL @TMGLBB@(TDFN)
QUIT
+32 ; If males are 19-44 and have less than 2 risk factors, kill risk factors and quit
+33 IF AGE>18
IF AGE<45
IF @TMGLBB@(TDFN)<2
KILL @TMGLBB@(TDFN)
+34 ; Assumes that left over data meets criteria of
+35 ; AGE=19-44 and at least 2 risk factors
+36 ; AGE>=45 and at least 1 risk factor
End DoDot:2
+37 IF SEX="F"
Begin DoDot:2
+38 ; If females are less than 19 years old, kill risk factors and quit
+39 IF AGE<19
KILL @TMGLBB@(TDFN)
QUIT
+40 ; If females are 19-54 and have less than 2 risk factors, kill risk factors and quit
+41 IF AGE>18
IF AGE<55
IF @TMGLBB@(TDFN)<2
KILL @TMGLBB@(TDFN)
+42 ; Assumes that left over data meets criteria of
+43 ; AGE=19-54 and at least 2 risk factors
+44 ; AGE>=55 and at least 1 risk factor
End DoDot:2
End DoDot:1
+45 ;
+46 ; Even if they meet the criteria, they cannot also have been
+47 ; identified as CVD Known or CVD Highest Risk. If they are,
+48 ; kill their entry.
+49 SET TDFN=""
+50 FOR
SET TDFN=$ORDER(@TMGLBB@(TDFN))
IF TDFN=""
QUIT
Begin DoDot:1
+51 FOR TXDXCT="CVD Known","CVD Highest Risk"
Begin DoDot:2
+52 ; If the person has an active tag at a higher level
+53 IF $$ATAG^BQITDUTL(TDFN,TXDXCT)
KILL @TMGLBB@(TDFN)
End DoDot:2
End DoDot:1
+54 ;
+55 SET TDFN=""
+56 FOR
SET TDFN=$ORDER(@TMGLBB@(TDFN))
IF TDFN=""
QUIT
MERGE @TGLOB@(TDFN)=@TMGLBB@(TDFN)
+57 KILL @TMGLBB,TMGLBB
+58 QUIT
+59 ;
PAT(DEF,BTGLOB,BDFN) ; EP -- By patient
+1 NEW DXOK,BQDXN,TMGLB,TX,BQREF,TAX,GREF,TREF,FREF,NIT,PLFLG,BQGLB
+2 NEW IEN,TIEN,VISIT,VSDTM,DXNN,BMID,VIENS,TDXNCN,ENDT,STDT,DTDIF,QFL
+3 NEW SERV,VSERV,PRIM,MFL
+4 SET DXOK=0
+5 ; if the person has already been identified as CVD Known OR CVD Highest Risk
+6 SET QFL=0
FOR TDXNCN="CVD Highest Risk","CVD Known"
Begin DoDot:1
+7 IF $$ATAG^BQITDUTL(BDFN,TDXNCN)
SET QFL=1
End DoDot:1
IF QFL
QUIT
+8 IF QFL
QUIT DXOK
+9 ;
+10 SET TMGLB=$NAME(^TMP("BQICHR",UID))
KILL @TMGLB
+11 SET DXOK=0
+12 SET BQDXN=$$GDXN^BQITUTL("Current Smoker")
+13 SET BQREF="BQIRY"
+14 DO GDF^BQITUTL(BQDXN,BQREF)
+15 IF $$PAT^BQITDGN(BQREF,TMGLB,BDFN)
Begin DoDot:1
+16 SET TX=$ORDER(@TMGLB@(BDFN,"CRITERIA",""))
+17 DO STOR(BDFN,TX,TMGLB)
End DoDot:1
+18 KILL @TMGLB
+19 ;
+20 SET BQDXN=$$GDXN^BQITUTL("PreDM Metabolic Syndrome")
+21 SET BQREF="BQIRY"
+22 DO GDF^BQITUTL(BQDXN,BQREF)
+23 ; Set to primary and secondary instead of primary only
+24 IF $GET(BQIRY(1))'=""
IF $PIECE(BQIRY(1),U,1)["DX"
SET $PIECE(BQIRY(1),U,8)=0
+25 IF $$PAT^BQITDGN(BQREF,TMGLB,BDFN)
Begin DoDot:1
+26 SET TX=$ORDER(@TMGLB@(BDFN,"CRITERIA",""))
+27 DO STOR(BDFN,TX,TMGLB)
End DoDot:1
+28 KILL @TMGLB
+29 ;
+30 SET TAX="BGP HYPERTENSION DXS"
SET NIT=3
SET FREF=9000010.07
SET PLFLG=1
SET ENDT=""
+31 SET GREF=$$ROOT^DILFD(FREF,"",1)
SET TREF=$NAME(^TMP("BQITAX",UID))
+32 SET SERV="A;H"
SET PRIM=0
SET EXDT=""
+33 SET BQGLB=$NAME(^TMP("BQITMP",UID))
+34 KILL @TREF,@BQGLB
+35 DO BLD^BQITUTL(TAX,TREF)
+36 ;D PPRB^BQITRSK(BDFN)
+37 DO PPRB^BQITD03(BDFN,BQGLB)
+38 SET IEN=""
SET EXDT=""
+39 FOR
SET IEN=$ORDER(@GREF@("AC",BDFN,IEN),-1)
IF IEN=""
QUIT
Begin DoDot:1
+40 SET TIEN=$$GET1^DIQ(FREF,IEN,.01,"I")
IF TIEN=""
QUIT
+41 IF '$DATA(@TREF@(TIEN))
QUIT
+42 IF $GET(@BTGLOB@(BDFN))'<2
QUIT
+43 ;I $G(@BQGLB@(BDFN))>NIT Q
+44 SET VISIT=$$GET1^DIQ(FREF,IEN,.03,"I")
IF VISIT=""
QUIT
+45 IF $$GET1^DIQ(9000010,VISIT,.11,"I")=1
QUIT
+46 ; check clinical ranking if diagnosis (9000010.07)
+47 IF FREF=9000010.07
IF PRIM
IF $PIECE(@GREF@(IEN,0),U,12)'="P"
SET MFL=0
Begin DoDot:2
+48 IF $ORDER(@GREF@("AD",VISIT,""))=IEN
SET MFL=1
End DoDot:2
IF 'MFL
QUIT
+49 ; if service categories, check the visit for the service category
+50 SET VSERV=$$GET1^DIQ(9000010,VISIT,.07,"I")
+51 IF $GET(SERV)'=""
IF SERV'[VSERV
QUIT
+52 SET VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1
IF VSDTM=0
QUIT
+53 SET @BQGLB@(BDFN,VSDTM,TIEN)="V"_U_VISIT_U_EXDT_U_IEN_U_FREF
+54 SET @BQGLB@(BDFN)=$GET(@BQGLB@(BDFN))+1
End DoDot:1
+55 ;
+56 DO HYP^BQITRSK(BDFN,TMGLB,BQGLB)
+57 IF $DATA(@TMGLB)>0
DO STOR(BDFN,TAX,TMGLB)
+58 KILL @BQGLB,@TREF
+59 ;
+60 NEW DXNN,AGE,BMI,MIENS
+61 SET BMID=$$OBMI^BQITBMI(BDFN,"T-60M")
+62 SET BMI=$PIECE(BMID,"^",1)
SET AGE=$PIECE(BMID,"^",2)
SET VIENS=$PIECE(BMID,"^",3)
SET MIENS=$PIECE(BMID,"^",4)
+63 IF BMI'=""
IF $$OB^BQITBMI(BDFN,BMI,AGE)
Begin DoDot:1
+64 FOR I=1:1
SET VST=$PIECE(VIENS,",",I)
IF VST=""
QUIT
Begin DoDot:2
+65 NEW IEN
+66 SET IEN=$PIECE(MIENS,",",I)
SET FREF=9000010.01
+67 SET @TMGLB@(BDFN,"CRITERIA","Risk Factor-Obese BMI","V",VST,IEN)=$PIECE($GET(^AUPNVSIT(VST,0)),U,1)_U_EXDT_U_IEN_U_FREF
End DoDot:2
+68 DO STOR(BDFN,"Risk Factor-Obese BMI",TMGLB)
End DoDot:1
+69 KILL @TMGLB
+70 ;
+71 NEW BCLN,BTYP,RDT,CT,N,BP,SYS,DIA,RESULT,HDATA
+72 SET BQGLB1=$NAME(^TMP("BQITMP",UID))
+73 KILL @BQGLB1
+74 SET BCLN=$$FIND1^DIC(40.7,"","Q","EMERGENCY","B","","ERROR")
+75 SET BTYP=$$FIND1^DIC(9999999.07,,"X","BP")
+76 SET RDT=""
+77 FOR
SET RDT=$ORDER(^AUPNVMSR("AA",BDFN,BTYP,RDT))
IF RDT=""
QUIT
Begin DoDot:1
+78 SET CT=0
SET N=""
+79 FOR
SET N=$ORDER(^AUPNVMSR("AA",BDFN,BTYP,RDT,N))
IF N=""!(CT>3)
QUIT
Begin DoDot:2
+80 SET VISIT=$PIECE($GET(^AUPNVMSR(N,0)),U,5)
IF VISIT=""
QUIT
+81 ; if the new ENTERED IN ERROR field exists, exclude the record if it is marked as an error
+82 IF $$VFIELD^DILFD(9000010.01,2)
IF $$GET1^DIQ(9000010.01,IEN_",",2,"I")=1
QUIT
+83 IF $PIECE($GET(^AUPNVSIT(VISIT,0)),U,8)=BCLN
QUIT
+84 IF $PIECE($GET(^AUPNVSIT(VISIT,0)),U,11)=1
QUIT
+85 SET CT=CT+1
+86 SET BP=$PIECE($GET(^AUPNVMSR(N,0)),U,4)
SET SYS=$PIECE(BP,"/",1)
SET DIA=$PIECE(BP,"/",2)
+87 IF SYS=""!(DIA="")
QUIT
+88 IF SYS<140!(DIA<90)
QUIT
+89 SET @BQGLB1@(BDFN)=$GET(@BQGLB1@(BDFN))+1
SET FREF=9000010.01
+90 SET @BQGLB1@(BDFN,"CRITERIA","Risk Factor-High Blood Pressure","V",VISIT,N)=$PIECE($GET(^AUPNVSIT(VISIT,0)),U,1)_U_EXDT_U_N_U_FREF
End DoDot:2
End DoDot:1
+91 IF $GET(@BQGLB1@(BDFN))>1
DO STOR(BDFN,"Risk Factor-High Blood Pressure",TMGLB)
+92 KILL @BQGLB1
+93 ;
+94 SET HDATA=$NAME(^TMP("BQIHDL",UID))
SET TMFRAME=""
SET ENDT=""
+95 KILL @HDATA
+96 SET FREF=9000010.09
SET GREF=$$ROOT^DILFD(FREF,"",1)
SET TREF=$NAME(^TMP("BQITAX",UID))
KILL @TREF
+97 FOR TAX="BGP HDL LOINC CODES","DM AUDIT HDL TAX"
DO BLD^BQITUTL(TAX,TREF)
+98 SET IEN=""
+99 FOR
SET IEN=$ORDER(@GREF@("AC",BDFN,IEN),-1)
IF IEN=""
QUIT
Begin DoDot:1
+100 SET TIEN=$$GET1^DIQ(FREF,IEN,.01,"I")
IF TIEN=""
QUIT
+101 IF '$DATA(@TREF@(TIEN))
QUIT
+102 SET SEX=$$GET1^DIQ(2,BDFN,.02,"I")
+103 SET VISIT=$$GET1^DIQ(FREF,IEN,.03,"I")
IF VISIT=""
QUIT
+104 IF $$GET1^DIQ(9000010,VISIT,.11,"I")=1
QUIT
+105 SET RESULT=$$GET1^DIQ(FREF,IEN,.04,"E")
IF RESULT=""
QUIT
+106 SET VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1
IF 'VSDTM
QUIT
+107 IF $GET(TMFRAME)'=""
IF VSDTM<ENDT
QUIT
+108 SET @HDATA@(BDFN,VSDTM)=RESULT_"^"_SEX_"^"_VISIT_"^"_IEN_"^"_FREF
End DoDot:1
+109 SET DATE=""
SET DATE=$ORDER(@HDATA@(BDFN,DATE),-1)
+110 IF DATE'=""
Begin DoDot:1
+111 SET RESULT=$PIECE(@HDATA@(BDFN,DATE),"^",1)
+112 SET SEX=$PIECE(@HDATA@(BDFN,DATE),"^",2)
+113 SET VISIT=$PIECE(@HDATA@(BDFN,DATE),"^",3)
+114 SET IEN=$PIECE(@HDATA@(BDFN,DATE),"^",4)
+115 SET FREF=$PIECE(@HDATA@(BDFN,DATE),"^",5)
+116 KILL @TMGLB
+117 IF SEX="M"!(SEX="U")
IF RESULT<40
Begin DoDot:2
+118 SET @TMGLB@(BDFN,"CRITERIA","Risk Factor-HDL Lab Test","V",VISIT,IEN)=VSDTM_U_EXDT_U_IEN_U_FREF
+119 DO STOR(BDFN,"Risk Factor-HDL Lab Test",TMGLB)
End DoDot:2
+120 IF SEX="F"
IF RESULT<45
Begin DoDot:2
+121 SET @TMGLB@(BDFN,"CRITERIA","Risk Factor-HDL Lab Test","V",VISIT,IEN)=VSDTM_U_EXDT_U_IEN_U_FREF
+122 DO STOR(BDFN,"Risk Factor-HDL Lab Test",TMGLB)
End DoDot:2
End DoDot:1
+123 KILL @HDATA
+124 ;
+125 ;High Cholesterol
+126 DO PAT^BQITHCH(BDFN,.BTGLOB)
+127 ;
+128 ;Nephropathy
+129 DO PAT^BQITNPH(BDFN,.BTGLOB)
+130 ;
+131 SET DXOK=0
+132 SET SEX=$$GET1^DIQ(2,BDFN,.02,"I")
+133 SET AGE=$$AGE^BQIAGE(BDFN)
+134 IF SEX="M"!(SEX="U")
Begin DoDot:1
+135 IF AGE<19
KILL @BTGLOB@(BDFN)
QUIT
+136 IF AGE>18
IF AGE<45
IF $GET(@BTGLOB@(BDFN))<2
QUIT
+137 IF +$GET(@BTGLOB@(BDFN))=0
QUIT
+138 SET DXOK=1
End DoDot:1
+139 IF SEX="F"
Begin DoDot:1
+140 IF AGE<19
KILL @BTGLOB@(BDFN)
QUIT
+141 IF AGE>18
IF AGE<55
IF $GET(@BTGLOB@(BDFN))<2
QUIT
+142 IF +$GET(@BTGLOB@(BDFN))=0
QUIT
+143 SET DXOK=1
End DoDot:1
+144 ;
+145 QUIT DXOK
+146 ;
STOR(SDFN,CRIT,BQQGLB) ;EP - Store the patient's met criteria
+1 IF $GET(@BTGLOB@(SDFN))'<2
QUIT
+2 IF $DATA(@BTGLOB@(SDFN,"CRITERIA",CRIT))>0
QUIT
+3 SET @BTGLOB@(SDFN)=$GET(@BTGLOB@(SDFN))+1
+4 ;S @BTGLOB@(SDFN,"CRITERIA",CRIT)=""
+5 IF $DATA(@BQQGLB@(SDFN))
MERGE @BTGLOB@(SDFN,"CRITERIA")=@BQQGLB@(SDFN,"CRITERIA")
+6 QUIT
