BQITRSK.m

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