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

BQITD05.m

Go to the documentation of this file. 
  1. 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
  1.  Q
  1.  ;
  1. POP(BQARY,TGLOB) ; EP -- By population
  1.  ;
  1.  ;Description
  1.  ;  Finds all patients who meet the criteria for CVD Significant Risk
  1.  ;Input
  1.  ;  BQARY - Array of taxonomies and other information
  1.  ;  TGLOB - Global where data is to be stored and passed back
  1.  ;          to calling routine
  1.  ;          Structure:
  1.  ;          TGLOB(DFN,"CRITERIA",criteria or taxonomy,visit or problem ien)=date/time
  1.  ;Variables
  1.  ;  TAX - Taxonomy name
  1.  ;  NIT - Number of iterations
  1.  ;  TMFRAME - Time frame of check
  1.  ;  FREF - File Number reference
  1.  ;  PLFLG - Problem File flag
  1.  ;  GREF - Global reference
  1.  ;  TREF - Taxonomy temp reference
  1.  ;
  1.  ;  Clean up all current entries
  1.  NEW DXNN,TDFN,DA,DIK,TMGLB,SEX,AGE,TXDXCN,TXDXCT
  1.  NEW SERV,VSERV,PRIM,MFL
  1.  ;
  1.  S TMGLBB=$NA(^TMP("BQICHRF",UID)) K @TMGLBB
  1.  D EN^BQITRSK(.TMGLBB)
  1.  S TDFN=""
  1.  F  S TDFN=$O(@TMGLBB@(TDFN)) Q:TDFN=""  D
  1.  . S SEX=$$GET1^DIQ(2,TDFN,.02,"I")
  1.  . S AGE=$$AGE^BQIAGE(TDFN)
  1.  . I SEX="M"!(SEX="U") D
  1.  .. ; If males are less than 19 years old, kill risk factors and quit
  1.  .. I AGE<19 K @TMGLBB@(TDFN) Q
  1.  .. ; If males are 19-44 and have less than 2 risk factors, kill risk factors and quit
  1.  .. I AGE>18,AGE<45,@TMGLBB@(TDFN)<2 K @TMGLBB@(TDFN)
  1.  .. ;  Assumes that left over data meets criteria of
  1.  .. ;      AGE=19-44 and at least 2 risk factors
  1.  .. ;      AGE>=45 and at least 1 risk factor
  1.  . I SEX="F" D
  1.  .. ;  If females are less than 19 years old, kill risk factors and quit  
  1.  .. I AGE<19 K @TMGLBB@(TDFN) Q
  1.  .. ;  If females are 19-54 and have less than 2 risk factors, kill risk factors and quit
  1.  .. I AGE>18,AGE<55,@TMGLBB@(TDFN)<2 K @TMGLBB@(TDFN)
  1.  .. ;  Assumes that left over data meets criteria of
  1.  .. ;      AGE=19-54 and at least 2 risk factors
  1.  .. ;      AGE>=55 and at least 1 risk factor
  1.  ;
  1.  ;  Even if they meet the criteria, they cannot also have been
  1.  ;  identified as CVD Known or CVD Highest Risk.  If they are,
  1.  ;  kill their entry.
  1.  S TDFN=""
  1.  F  S TDFN=$O(@TMGLBB@(TDFN)) Q:TDFN=""  D
  1.  . F TXDXCT="CVD Known","CVD Highest Risk" D
  1.  .. ; If the person has an active tag at a higher level
  1.  .. I $$ATAG^BQITDUTL(TDFN,TXDXCT) K @TMGLBB@(TDFN)
  1.  ;
  1.  S TDFN=""
  1.  F  S TDFN=$O(@TMGLBB@(TDFN)) Q:TDFN=""  M @TGLOB@(TDFN)=@TMGLBB@(TDFN)
  1.  K @TMGLBB,TMGLBB
  1.  Q
  1.  ;
  1. PAT(DEF,BTGLOB,BDFN) ; EP -- By patient
  1.  NEW DXOK,BQDXN,TMGLB,TX,BQREF,TAX,GREF,TREF,FREF,NIT,PLFLG,BQGLB
  1.  NEW IEN,TIEN,VISIT,VSDTM,DXNN,BMID,VIENS,TDXNCN,ENDT,STDT,DTDIF,QFL
  1.  NEW SERV,VSERV,PRIM,MFL
  1.  S DXOK=0
  1.  ; if the person has already been identified as CVD Known OR CVD Highest Risk
  1.  S QFL=0 F TDXNCN="CVD Highest Risk","CVD Known" D  Q:QFL
  1.  . I $$ATAG^BQITDUTL(BDFN,TDXNCN) S QFL=1
  1.  I QFL Q DXOK
  1.  ;
  1.  S TMGLB=$NA(^TMP("BQICHR",UID)) K @TMGLB
  1.  S DXOK=0
  1.  S BQDXN=$$GDXN^BQITUTL("Current Smoker")
  1.  S BQREF="BQIRY"
  1.  D GDF^BQITUTL(BQDXN,BQREF)
  1.  I $$PAT^BQITDGN(BQREF,TMGLB,BDFN) D
  1.  . S TX=$O(@TMGLB@(BDFN,"CRITERIA",""))
  1.  . D STOR(BDFN,TX,TMGLB)
  1.  K @TMGLB
  1.  ;
  1.  S BQDXN=$$GDXN^BQITUTL("PreDM Metabolic Syndrome")
  1.  S BQREF="BQIRY"
  1.  D GDF^BQITUTL(BQDXN,BQREF)
  1.  ; Set to primary and secondary instead of primary only
  1.  I $G(BQIRY(1))'="",$P(BQIRY(1),U,1)["DX" S $P(BQIRY(1),U,8)=0
  1.  I $$PAT^BQITDGN(BQREF,TMGLB,BDFN) D
  1.  . S TX=$O(@TMGLB@(BDFN,"CRITERIA",""))
  1.  . D STOR(BDFN,TX,TMGLB)
  1.  K @TMGLB
  1.  ;
  1.  S TAX="BGP HYPERTENSION DXS",NIT=3,FREF=9000010.07,PLFLG=1,ENDT=""
  1.  S GREF=$$ROOT^DILFD(FREF,"",1),TREF=$NA(^TMP("BQITAX",UID))
  1.  S SERV="A;H",PRIM=0,EXDT=""
  1.  S BQGLB=$NA(^TMP("BQITMP",UID))
  1.  K @TREF,@BQGLB
  1.  D BLD^BQITUTL(TAX,TREF)
  1.  ;D PPRB^BQITRSK(BDFN)
  1.  D PPRB^BQITD03(BDFN,BQGLB)
  1.  S IEN="",EXDT=""
  1.  F  S IEN=$O(@GREF@("AC",BDFN,IEN),-1) Q:IEN=""  D
  1.  . S TIEN=$$GET1^DIQ(FREF,IEN,.01,"I") I TIEN="" Q
  1.  . I '$D(@TREF@(TIEN)) Q
  1.  . I $G(@BTGLOB@(BDFN))'<2 Q
  1.  . ;I $G(@BQGLB@(BDFN))>NIT Q
  1.  . S VISIT=$$GET1^DIQ(FREF,IEN,.03,"I") Q:VISIT=""
  1.  . I $$GET1^DIQ(9000010,VISIT,.11,"I")=1 Q
  1.  . ;  check clinical ranking if diagnosis (9000010.07)
  1.  . I FREF=9000010.07,PRIM I $P(@GREF@(IEN,0),U,12)'="P" S MFL=0 D  Q:'MFL
  1.  .. I $O(@GREF@("AD",VISIT,""))=IEN S MFL=1
  1.  . ;  if service categories, check the visit for the service category
  1.  . S VSERV=$$GET1^DIQ(9000010,VISIT,.07,"I")
  1.  . I $G(SERV)'="",SERV'[VSERV Q
  1.  . S VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1 Q:VSDTM=0
  1.  . S @BQGLB@(BDFN,VSDTM,TIEN)="V"_U_VISIT_U_EXDT_U_IEN_U_FREF
  1.  . S @BQGLB@(BDFN)=$G(@BQGLB@(BDFN))+1
  1.  ;
  1.  D HYP^BQITRSK(BDFN,TMGLB,BQGLB)
  1.  I $D(@TMGLB)>0 D STOR(BDFN,TAX,TMGLB)
  1.  K @BQGLB,@TREF
  1.  ;
  1.  NEW DXNN,AGE,BMI,MIENS
  1.  S BMID=$$OBMI^BQITBMI(BDFN,"T-60M")
  1.  S BMI=$P(BMID,"^",1),AGE=$P(BMID,"^",2),VIENS=$P(BMID,"^",3),MIENS=$P(BMID,"^",4)
  1.  I BMI'="",$$OB^BQITBMI(BDFN,BMI,AGE) D
  1.  . F I=1:1 S VST=$P(VIENS,",",I) Q:VST=""  D
  1.  .. NEW IEN
  1.  .. S IEN=$P(MIENS,",",I),FREF=9000010.01
  1.  .. S @TMGLB@(BDFN,"CRITERIA","Risk Factor-Obese BMI","V",VST,IEN)=$P($G(^AUPNVSIT(VST,0)),U,1)_U_EXDT_U_IEN_U_FREF
  1.  . D STOR(BDFN,"Risk Factor-Obese BMI",TMGLB)
  1.  K @TMGLB
  1.  ;
  1.  NEW BCLN,BTYP,RDT,CT,N,BP,SYS,DIA,RESULT,HDATA
  1.  S BQGLB1=$NA(^TMP("BQITMP",UID))
  1.  K @BQGLB1
  1.  S BCLN=$$FIND1^DIC(40.7,"","Q","EMERGENCY","B","","ERROR")
  1.  S BTYP=$$FIND1^DIC(9999999.07,,"X","BP")
  1.  S RDT=""
  1.  F  S RDT=$O(^AUPNVMSR("AA",BDFN,BTYP,RDT)) Q:RDT=""  D
  1.  . S CT=0,N=""
  1.  . F  S N=$O(^AUPNVMSR("AA",BDFN,BTYP,RDT,N)) Q:N=""!(CT>3)  D
  1.  .. S VISIT=$P($G(^AUPNVMSR(N,0)),U,5) Q:VISIT=""
  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 CT=CT+1
  1.  .. S BP=$P($G(^AUPNVMSR(N,0)),U,4),SYS=$P(BP,"/",1),DIA=$P(BP,"/",2)
  1.  .. I SYS=""!(DIA="") Q
  1.  .. I SYS<140!(DIA<90) Q
  1.  .. S @BQGLB1@(BDFN)=$G(@BQGLB1@(BDFN))+1,FREF=9000010.01
  1.  .. 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
  1.  I $G(@BQGLB1@(BDFN))>1 D STOR(BDFN,"Risk Factor-High Blood Pressure",TMGLB)
  1.  K @BQGLB1
  1.  ;
  1.  S HDATA=$NA(^TMP("BQIHDL",UID)),TMFRAME="",ENDT=""
  1.  K @HDATA
  1.  S FREF=9000010.09,GREF=$$ROOT^DILFD(FREF,"",1),TREF=$NA(^TMP("BQITAX",UID)) K @TREF
  1.  F TAX="BGP HDL LOINC CODES","DM AUDIT HDL TAX" D BLD^BQITUTL(TAX,TREF)
  1.  S IEN=""
  1.  F  S IEN=$O(@GREF@("AC",BDFN,IEN),-1) Q:IEN=""  D
  1.  . S TIEN=$$GET1^DIQ(FREF,IEN,.01,"I") I TIEN="" Q
  1.  . I '$D(@TREF@(TIEN)) Q
  1.  . S SEX=$$GET1^DIQ(2,BDFN,.02,"I")
  1.  . S VISIT=$$GET1^DIQ(FREF,IEN,.03,"I") Q:VISIT=""
  1.  . I $$GET1^DIQ(9000010,VISIT,.11,"I")=1 Q
  1.  . S RESULT=$$GET1^DIQ(FREF,IEN,.04,"E") Q:RESULT=""
  1.  . S VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1 Q:'VSDTM
  1.  . I $G(TMFRAME)'="",VSDTM<ENDT Q
  1.  . S @HDATA@(BDFN,VSDTM)=RESULT_"^"_SEX_"^"_VISIT_"^"_IEN_"^"_FREF
  1.  S DATE="",DATE=$O(@HDATA@(BDFN,DATE),-1)
  1.  I DATE'="" D
  1.  . S RESULT=$P(@HDATA@(BDFN,DATE),"^",1)
  1.  . S SEX=$P(@HDATA@(BDFN,DATE),"^",2)
  1.  . S VISIT=$P(@HDATA@(BDFN,DATE),"^",3)
  1.  . S IEN=$P(@HDATA@(BDFN,DATE),"^",4)
  1.  . S FREF=$P(@HDATA@(BDFN,DATE),"^",5)
  1.  . K @TMGLB
  1.  . I SEX="M"!(SEX="U"),RESULT<40 D
  1.  .. S @TMGLB@(BDFN,"CRITERIA","Risk Factor-HDL Lab Test","V",VISIT,IEN)=VSDTM_U_EXDT_U_IEN_U_FREF
  1.  .. D STOR(BDFN,"Risk Factor-HDL Lab Test",TMGLB)
  1.  . I SEX="F",RESULT<45 D
  1.  .. S @TMGLB@(BDFN,"CRITERIA","Risk Factor-HDL Lab Test","V",VISIT,IEN)=VSDTM_U_EXDT_U_IEN_U_FREF
  1.  .. D STOR(BDFN,"Risk Factor-HDL Lab Test",TMGLB)
  1.  K @HDATA
  1.  ;
  1.  ;High Cholesterol
  1.  D PAT^BQITHCH(BDFN,.BTGLOB)
  1.  ;
  1.  ;Nephropathy
  1.  D PAT^BQITNPH(BDFN,.BTGLOB)
  1.  ;
  1.  S DXOK=0
  1.  S SEX=$$GET1^DIQ(2,BDFN,.02,"I")
  1.  S AGE=$$AGE^BQIAGE(BDFN)
  1.  I SEX="M"!(SEX="U") D
  1.  . I AGE<19 K @BTGLOB@(BDFN) Q
  1.  . I AGE>18,AGE<45,$G(@BTGLOB@(BDFN))<2 Q
  1.  . I +$G(@BTGLOB@(BDFN))=0 Q
  1.  . S DXOK=1
  1.  I SEX="F" D
  1.  . I AGE<19 K @BTGLOB@(BDFN) Q
  1.  . I AGE>18,AGE<55,$G(@BTGLOB@(BDFN))<2 Q
  1.  . I +$G(@BTGLOB@(BDFN))=0 Q
  1.  . S DXOK=1
  1.  ;
  1.  Q DXOK
  1.  ;
  1. STOR(SDFN,CRIT,BQQGLB) ;EP - Store the patient's met criteria
  1.  I $G(@BTGLOB@(SDFN))'<2 Q
  1.  I $D(@BTGLOB@(SDFN,"CRITERIA",CRIT))>0 Q
  1.  S @BTGLOB@(SDFN)=$G(@BTGLOB@(SDFN))+1
  1.  ;S @BTGLOB@(SDFN,"CRITERIA",CRIT)=""
  1.  I $D(@BQQGLB@(SDFN)) M @BTGLOB@(SDFN,"CRITERIA")=@BQQGLB@(SDFN,"CRITERIA")
  1.  Q