BQITD11 ;PRXM/HC/ALA-PreDM Metabolic Syndrome ; 10 Apr 2006 6:48 PM
;;2.4;ICARE MANAGEMENT SYSTEM;;Apr 01, 2015;Build 41
Q
;
POP(BQARY,TGLOB) ; EP -- By population
;
;Description
; Finds all patients who meet the criteria for PreDM Metabolic Syndrome
;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
;
; Clean up all current entries
NEW DXNN,TDFN,DA,DIK,CIRCUM
;
; Check for 2 diagnoses ever of DX.13 or on Active Problem List
I $D(@BQARY) D
. S TMGLB=$NA(^TMP("BQITD11",UID))
. D POP^BQITDGN(BQARY,TMGLB)
;
; Check if any of the defined pre-DM patients have already been identified a diabetic
S TXDXCN=$$GDXN^BQITUTL("Diabetes")
S TDFN=""
F S TDFN=$O(@TMGLB@(TDFN)) Q:'TDFN D
. I '$$ATAG^BQITDUTL(TDFN,"Diabetes") M @TGLOB@(TDFN)=@TMGLB@(TDFN)
K @TMGLB
;
; Any three or more of the following in the past year:
NEW TMFRAME
S TMFRAME="T-12M",EXDT="",DTDIF=""
S TMGLB1=$NA(^TMP("BQITD11A",UID))
I $G(TMFRAME)'="" D
. S ENDT=$$DATE^BQIUL1(TMFRAME),STDT=$$DT^XLFDT()
. S DTDIF=$$FMDIFF^XLFDT(STDT,ENDT,1)
;
; Triglyceride test value
S FREF=9000010.09,GREF=$$ROOT^DILFD(FREF,"",1),TREF=$NA(^TMP("BQITAX",UID)) K @TREF
S TAX="DM AUDIT TRIGLYCERIDE TAX" D BLD^BQITUTL(TAX,TREF,"L")
S TAX="BGP TRIGLYCERIDE LOINC CODES" D BLD^BQITUTL(TAX,TREF)
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=""
.. I $$ATAG^BQITDUTL(DFN,"Diabetes") Q
.. S VISIT=$$GET1^DIQ(FREF,IEN,.03,"I") Q:VISIT=""
.. I $$GET1^DIQ(9000010,VISIT,.11,"I")=1 Q
.. S VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1 Q:'VSDTM
.. I $G(TMFRAME)'="",VSDTM<ENDT Q
.. S RESULT=$$GET1^DIQ(FREF,IEN,.04,"E")
.. I RESULT="" Q
.. I RESULT'>149 Q
.. D STOR(DFN,"Triglyceride Test Value",VISIT,IEN)
;
; HDL test value
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,"L")
S TAX="BGP HDL LOINC CODES" D BLD^BQITUTL(TAX,TREF)
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=""
.. I $$ATAG^BQITDUTL(DFN,"Diabetes") Q
.. S SEX=$$GET1^DIQ(2,DFN,.02,"I")
.. S VISIT=$$GET1^DIQ(FREF,IEN,.03,"I") Q:VISIT=""
.. I $$GET1^DIQ(9000010,VISIT,.11,"I")=1 Q
.. S VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1 Q:'VSDTM
.. I $G(TMFRAME)'="",VSDTM<ENDT Q
.. S RESULT=$$GET1^DIQ(FREF,IEN,.04,"E")
.. I RESULT="" Q
.. I SEX="M"!(SEX="U"),RESULT<40 D STOR(DFN,"HDL Test Value",VISIT,IEN) Q
.. I SEX="F",RESULT<50 D STOR(DFN,"HDL Test Value",VISIT,IEN)
;
; Fasting Glucose test value
S FREF=9000010.09,GREF=$$ROOT^DILFD(FREF,"",1),TREF=$NA(^TMP("BQITAX",UID)) K @TREF
S TAX="DM AUDIT FASTING GLUCOSE TESTS" D BLD^BQITUTL(TAX,TREF,"L")
S TAX="DM AUDIT FASTING GLUC LOINC" D BLD^BQITUTL(TAX,TREF)
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
.. S DFN=$$GET1^DIQ(FREF,IEN,.02,"I") Q:DFN=""
.. I $$ATAG^BQITDUTL(DFN,"Diabetes") Q
.. S SEX=$$GET1^DIQ(2,DFN,.02,"I")
.. S VISIT=$$GET1^DIQ(FREF,IEN,.03,"I") Q:VISIT=""
.. I $$GET1^DIQ(9000010,VISIT,.11,"I")=1 Q
.. S VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1 Q:'VSDTM
.. I $G(TMFRAME)'="",VSDTM<ENDT Q
.. S RESULT=$$GET1^DIQ(FREF,IEN,.04,"E")
.. I RESULT="" Q
.. I RESULT<100!(RESULT'<126) Q
.. D STOR(DFN,"Fasting Glucose Test Value",VISIT,IEN)
;
S FREF=9000010.07,GREF=$$ROOT^DILFD(FREF,"",1),TREF=$NA(^TMP("BQITAX",UID)) K @TREF
S TAX="BGP IMPAIRED FASTING GLUCOSE" D BLD^BQITUTL(TAX,.TREF)
;D BLDSV^BQITUTL(80,790.21,TREF)
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=""
.. I $$ATAG^BQITDUTL(DFN,"Diabetes") Q
.. S VISIT=$$GET1^DIQ(FREF,IEN,.03,"I") Q:VISIT=""
.. S VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1 Q:'VSDTM
.. I $G(TMFRAME)'="",VSDTM<ENDT Q
.. D STOR(DFN,"Fasting Glucose Test Value",VISIT,IEN)
;
; Patients diagnosed with hypertension
S TDXN=$$GDXN^BQITUTL("Hypertension")
S BQDREF="BQIREF" K @BQDREF
D ARY^BQITUTL(TDXN,BQDREF)
S $P(BQIREF(1),U,4)="T-12M",TAX=$P(BQIREF(1),U,1)
S TMGLB2=$NA(^TMP("BQITD11B",UID)) K @TMGLB2
D POP^BQITDGN(.BQDREF,.TMGLB2,1)
S TDFN=""
F S TDFN=$O(@TMGLB2@(TDFN)) Q:TDFN="" D
. I $$ATAG^BQITDUTL(TDFN,"Diabetes") Q
. I $G(@TMGLB1@(TDFN))>3 Q
. I $D(@TMGLB1@(TDFN,"CRITERIA",TAX))>0 Q
. S @TMGLB1@(TDFN)=$G(@TMGLB1@(TDFN))+1
. M @TMGLB1@(TDFN)=@TMGLB2@(TDFN)
K BQIREF
;
; Patients with mean Blood Pressure value
S TMPG=$NA(^TMP("BQIBP",UID)),FREF="9000010.01"
K @TMPG
D ABP^BQITBMI(TMFRAME,.TMPG)
S TDFN=0
F S TDFN=$O(@TMPG@(TDFN)) Q:'TDFN D
. I $$ATAG^BQITDUTL(TDFN,"Diabetes") Q
. S TBP=@TMPG@(TDFN)
. S SYS=$P(TBP,U,1),DIA=$P(TBP,U,2),VISITS=$P(TBP,U,3),IIENS=$P(TBP,U,4)
. I SYS'<130!(DIA'<85) D
.. I '$D(@TMGLB2@(TDFN)) D STOR(TDFN,"Mean BP Value",VISITS,IIENS)
K @TMGLB2,TMGLB2
;
S TMPG=$NA(^TMP("BQIBMI",UID))
K @TMPG
D ABMI^BQITBMI(TMFRAME,.TMPG)
S TDFN=0
F S TDFN=$O(@TMPG@(TDFN)) Q:'TDFN D
. I $$ATAG^BQITDUTL(TDFN,"Diabetes") Q
. S BMI=$P(@TMPG@(TDFN),"^",1)
. I BMI'<30 D
.. S @TMGLB1@(TDFN)=$G(@TMGLB1@(TDFN))+1
.. 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(@TMGLB1@(TDFN,"CRITERIA","BMI =>30","V",VST,IEN),U,1)=VSDTM_U_EXDT_U_IEN_U_FREF
.. D STOR(TDFN,"BMI =>30")
K @TMPG
;
S TMPG=$NA(^TMP("BQIWST",UID))
K @TMPG
D AWC^BQITDWC(TMFRAME,.TMPG)
S TDFN=0
F S TDFN=$O(@TMPG@(TDFN)) Q:'TDFN D
. I $$ATAG^BQITDUTL(TDFN,"Diabetes") Q
. S SEX=$$GET1^DIQ(2,TDFN,.02,"I")
. S DATE="",QFL=0
. F S DATE=$O(@TMPG@(TDFN,DATE),-1) Q:DATE="" D Q:QFL
.. ; check if Waist Circumference is M>40 or F>35
.. S CIRCUM=$P(@TMPG@(TDFN,DATE),"^",1)
.. S VISIT=$P(@TMPG@(TDFN,DATE),"^",2)
.. S IEN=$P(@TMPG@(TDFN,DATE),"^",3)
.. S FREF=$P(@TMPG@(TDFN,DATE),"^",4)
.. I SEX="M",CIRCUM>40 D STOR(TDFN,"Waist Circumference",VISIT,IEN) S QFL=1 Q
.. I SEX="F"!(SEX="U"),CIRCUM>35 D STOR(TDFN,"Waist Circumference",VISIT,IEN) S QFL=1
K @TMPG,TMPG
;
S TDFN=""
F S TDFN=$O(@TMGLB1@(TDFN)) Q:TDFN="" I @TMGLB1@(TDFN)<3 K @TMGLB1@(TDFN)
;
; Finish with all the logic and have a list of patients to file from TGLOB
S TDFN=""
F S TDFN=$O(@TMGLB1@(TDFN)) Q:TDFN="" D
. I '$$ATAG^BQITDUTL(TDFN,"Diabetes") M @TGLOB@(TDFN)=@TMGLB1@(TDFN)
;
K @TMGLB,@TMGLB1,@TREF
K TDFN,SYS,DIA,TBP,TDXN,RESULT,VSDTM,VISIT,SEX,DFN,IEN,TIEN
K TAX,GREF,FREF,TREF,TX,SDFN,PC,TMGLB,TMGLB1,TXDXCN,TMPG
Q
;
PAT(DEF,TGLOB,PDFN) ; EP -- By patient
;Description
; Checks if a patient meets the criteria for PreDM Metabolic Syndrome
;Input
; BQARY - Array of taxonomies and other information
; DFN - patient internal entry number
;
NEW DXOK,TMFRAME,ENDT,TMGLB1,FREF,GREF,TREF,TAX,GLOBAL,PC,IEN,TIEN,VISIT,VSDTM
NEW SYS,DIA,TBP,SEX,BQARY,VISITS,TXDXCN,BMID,VIENS,HYOK,IIENS,BDT,EDT
;
I $$ATAG^BQITDUTL(PDFN,"Diabetes") Q 0
;
S BQDXN=$$GDXN^BQITUTL(DEF)
S BQARY="BQIRY"
D GDF^BQITUTL(BQDXN,BQARY)
S DXOK=0
S DXOK=$$PAT^BQITDGN(BQARY,TGLOB,PDFN) I DXOK Q DXOK
;
S TMFRAME="T-12M",EXDT="",DTDIF="",BDT=$$DATE^BQIUL1(TMFRAME),EDT=DT
S TMGLB1=$NA(^TMP("BQITD11A",UID))
K @TMGLB1
I $G(TMFRAME)'="" D
. S ENDT=$$DATE^BQIUL1(TMFRAME),STDT=$$DT^XLFDT()
. S DTDIF=$$FMDIFF^XLFDT(STDT,ENDT,1)
;
S FREF=9000010.09,GREF=$$ROOT^DILFD(FREF,"",1),TREF=$NA(^TMP("BQITAX",UID))
K @TREF
S TAX="DM AUDIT TRIGLYCERIDE TAX" D BLD^BQITUTL(TAX,TREF,"L")
S TAX="BGP TRIGLYCERIDE LOINC CODES" D BLD^BQITUTL(TAX,TREF)
D
. S IEN="",QFL=0
. F S IEN=$O(@GREF@("AC",PDFN,IEN),-1) Q:IEN="" D Q:QFL
.. S TIEN=$$GET1^DIQ(FREF,IEN,.01,"I") Q:TIEN=""
.. I '$D(@TREF@(TIEN)) Q
.. S VISIT=$$GET1^DIQ(FREF,IEN,.03,"I") Q:VISIT=""
.. I $$GET1^DIQ(9000010,VISIT,.11,"I")=1 Q
.. S VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1 Q:'VSDTM
.. I $G(TMFRAME)'="",VSDTM<ENDT Q
.. S RESULT=$$GET1^DIQ(FREF,IEN,.04,"E")
.. I RESULT="" Q
.. I RESULT'>149 Q
.. D STOR(PDFN,"Triglyceride Test Value",VISIT,IEN)
.. S QFL=1
;
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,"L")
S TAX="BGP HDL LOINC CODES" D BLD^BQITUTL(TAX,TREF)
D
. S IEN="",QFL=0
. F S IEN=$O(@GREF@("AC",PDFN,IEN),-1) Q:IEN="" D Q:QFL
.. S TIEN=$$GET1^DIQ(FREF,IEN,.01,"I") Q:TIEN=""
.. I '$D(@TREF@(TIEN)) Q
.. S SEX=$$GET1^DIQ(2,PDFN,.02,"I")
.. S VISIT=$$GET1^DIQ(FREF,IEN,.03,"I") Q:VISIT=""
.. I $$GET1^DIQ(9000010,VISIT,.11,"I")=1 Q
.. S VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1 Q:'VSDTM
.. I $G(TMFRAME)'="",VSDTM<ENDT Q
.. S RESULT=$$GET1^DIQ(FREF,IEN,.04,"E")
.. I RESULT="" Q
.. I SEX="M"!(SEX="U"),RESULT<40 D STOR(PDFN,"HDL Test Value",VISIT,IEN) S QFL=1 Q
.. I SEX="F",RESULT<50 D STOR(PDFN,"HDL Test Value",VISIT,IEN) S QFL=1
;
S FREF=9000010.09,GREF=$$ROOT^DILFD(FREF,"",1),TREF=$NA(^TMP("BQITAX",UID))
K @TREF
S TAX="DM AUDIT FASTING GLUCOSE TESTS" D BLD^BQITUTL(TAX,TREF,"L")
S TAX="DM AUDIT FASTING GLUC LOINC" D BLD^BQITUTL(TAX,TREF)
D
. S IEN="",QFL=0
. F S IEN=$O(@GREF@("AC",PDFN,IEN),-1) Q:IEN="" D Q:QFL
.. S TIEN=$$GET1^DIQ(FREF,IEN,.01,"I") Q:TIEN=""
.. I '$D(@TREF@(TIEN)) Q
.. S SEX=$$GET1^DIQ(2,PDFN,.02,"I")
.. S VISIT=$$GET1^DIQ(FREF,IEN,.03,"I") Q:VISIT=""
.. I $$GET1^DIQ(9000010,VISIT,.11,"I")=1 Q
.. S VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1 Q:'VSDTM
.. I $G(TMFRAME)'="",VSDTM<ENDT Q
.. S RESULT=$$GET1^DIQ(FREF,IEN,.04,"E")
.. I RESULT="" Q
.. I RESULT<100!(RESULT'<126) Q
.. D STOR(PDFN,"Fasting Glucose Test Value",VISIT,IEN)
.. S QFL=1
;
S FREF=9000010.07,GREF=$$ROOT^DILFD(FREF,"",1),TREF=$NA(^TMP("BQITAX",UID)) K @TREF
S TAX="BGP IMPAIRED FASTING GLUCOSE" D BLD^BQITUTL(TAX,.TREF)
;D BLDSV^BQITUTL(80,790.21,TREF)
S IEN="",QFL=0
F S IEN=$O(@GREF@("AC",PDFN,IEN),-1) Q:IEN="" D Q:QFL
. S TIEN=$$GET1^DIQ(FREF,IEN,.01,"I") Q:TIEN=""
. I '$D(@TREF@(TIEN)) Q
. S VISIT=$$GET1^DIQ(FREF,IEN,.03,"I") Q:VISIT=""
. I $$GET1^DIQ(9000010,VISIT,.11,"I")=1 Q
. S VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1 Q:'VSDTM
. I $G(TMFRAME)'="",VSDTM<ENDT Q
. S RESULT=$$GET1^DIQ(FREF,IEN,.04,"E")
. I RESULT="" Q
. I RESULT<100!(RESULT'<126) Q
. D STOR(PDFN,"Fasting Glucose Test Value",VISIT,IEN)
. S QFL=1
;
S BQDXN=$$GDXN^BQITUTL("Hypertension")
S BQARY="BQIRY"
D GDF^BQITUTL(BQDXN,BQARY)
S $P(BQIRY(1),U,4)="T-12M",TAX=$P(BQIRY(1),U,1)
S TMGLB2=$NA(^TMP("BQITD11B",UID)) K @TMGLB2
S DXOK=0,HYOK=0
S DXOK=$$PAT^BQITDGN(BQARY,TMGLB2,PDFN)
I DXOK D
. I $G(@TMGLB1@(PDFN))>3 Q
. I $D(@TMGLB1@(PDFN,"CRITERIA",TAX))>0 Q
. M @TMGLB1@(PDFN,"CRITERIA")=@TMGLB2@(PDFN,"CRITERIA")
. S @TMGLB1@(PDFN)=$G(@TMGLB1@(PDFN))+1,HYOK=1,DXOK=0
K @TMGLB2
;
S FREF="9000010.01"
S TBP=$$BP^BQITBMI(PDFN,TMFRAME)
S SYS=$P(TBP,U,1),DIA=$P(TBP,U,2),VISITS=$P(TBP,U,3),IIENS=$P(TBP,U,4)
I SYS'<130!(DIA'<85) I 'HYOK D STOR(PDFN,"Mean BP Value",VISITS,IIENS)
;
;S BMID=$$OBMI^BQITBMI(PDFN,TMFRAME)
NEW BV,BMI,BMR,QFL
S BMID=$$PBMI^APCLV(PDFN,DT)
S BMI=$P(BMID,"^",1)
I BMI'="" D
. I $P(BMID,"^",3)<BDT!($P(BMID,"^",3)>EDT)!($P(BMID,"^",6)<BDT)!($P(BMID,"^",7)>EDT) S BMI="" Q
. S VIENS=$P(BMID,"^",4)_","_$P(BMID,"^",7),IIENS=$P(BMID,"^",10)
. I IIENS="" S QFL=0 D
.. I $P(BMID,"^",4)=$P(BMID,"^",7) D Q:QFL
... S BV=$P(BMID,"^",4),BVI="",BMR=$$FIND1^DIC(9999999.07,,"MX","BMI")
... F S BVI=$O(^AUPNVMSR("AD",BV,BVI)) Q:BVI="" I $P(^AUPNVMSR(BVI,0),"^",1)=BMR S IIENS=BVI,QFL=1
.. S BV=$P(BMID,"^",4),BVI="",BMR=$$FIND1^DIC(9999999.07,,"MX","HEIGHT")
.. F S BVI=$O(^AUPNVMSR("AD",BV,BVI)) Q:BVI="" I $P(^AUPNVMSR(BVI,0),"^",1)=BMR S IIENS=BVI_","
.. S BV=$P(BMID,"^",7),BVI="",BMR=$$FIND1^DIC(9999999.07,,"MX","WEIGHT")
.. F S BVI=$O(^AUPNVMSR("AD",BV,BVI)) Q:BVI="" I $P(^AUPNVMSR(BVI,0),"^",1)=BMR S IIENS=IIENS_BVI
I BMI'<30 D STOR(PDFN,"BMI =>30",VIENS,IIENS)
;
NEW VALUE
S VALUE=$$WC^BQITDWC(PDFN,TMFRAME)
S CIRCUM=$P(VALUE,U,1),VISIT=$P(VALUE,U,2),IEN=$P(VALUE,U,3)
S SEX=$$GET1^DIQ(2,PDFN,.02,"I")
I SEX="M",CIRCUM>40 I '$D(@TMGLB1@(PDFN,"CRITERIA","BMI =>30")) D STOR(PDFN,"Waist Circumference",VISIT,IEN)
I SEX="F"!(SEX="U"),CIRCUM>35 I '$D(@TMGLB1@(PDFN,"CRITERIA","BMI =>30")) D STOR(PDFN,"Waist Circumference",VISIT,IEN)
;
I $G(@TMGLB1@(PDFN))<3 S DXOK=$S(DXOK=1:1,1:0)
I $G(@TMGLB1@(PDFN))'<3 S DXOK=1
;
I DXOK M @TGLOB@(PDFN)=@TMGLB1@(PDFN)
K @TMGLB1
Q DXOK
;
STOR(SDFN,CRIT,VIENS,IENS) ; Store the patient's met criteria
NEW VST,I,VSDTM,IIEN
I $G(@TMGLB1@(SDFN))>3 Q
;I $D(@TMGLB1@(SDFN,"CRITERIA",CRIT))>0 Q
S @TMGLB1@(SDFN)=$G(@TMGLB1@(SDFN))+1
S @TMGLB1@(SDFN,"CRITERIA",CRIT)=""
I $G(VIENS)["," D Q
. F I=1:1 S VST=$P(VIENS,",",I) Q:VST="" D
.. I IENS["," S IIEN=$P(IENS,",",I)
.. I IENS'["," S IIEN=IENS
.. S VSDTM=$$GET1^DIQ(9000010,VST_",",.01,"I") Q:'VSDTM
.. I DTDIF'="" S EXDT=$$FMADD^XLFDT(VSDTM,DTDIF)
.. S @TMGLB1@(SDFN,"CRITERIA",CRIT,"V",VST,IIEN)=VSDTM_U_U_IIEN_U_FREF
.. I EXDT'="" S $P(@TMGLB1@(SDFN,"CRITERIA",CRIT,"V",VST,IIEN),U,2)=EXDT
I $G(VIENS)'="" D
. S VSDTM=$$GET1^DIQ(9000010,VIENS_",",.01,"I") Q:'VSDTM
. I DTDIF'="" S EXDT=$$FMADD^XLFDT(VSDTM,DTDIF)
. S @TMGLB1@(SDFN,"CRITERIA",CRIT,"V",VIENS,IENS)=VSDTM_U_U_IENS_U_FREF
. I EXDT'="" S $P(@TMGLB1@(SDFN,"CRITERIA",CRIT,"V",VIENS,IENS),U,2)=EXDT
Q
BQITD11 ;PRXM/HC/ALA-PreDM Metabolic Syndrome ; 10 Apr 2006 6:48 PM
+1 ;;2.4;ICARE MANAGEMENT SYSTEM;;Apr 01, 2015;Build 41
+2 QUIT
+3 ;
POP(BQARY,TGLOB) ; EP -- By population
+1 ;
+2 ;Description
+3 ; Finds all patients who meet the criteria for PreDM Metabolic Syndrome
+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 ;
+15 ; Clean up all current entries
+16 NEW DXNN,TDFN,DA,DIK,CIRCUM
+17 ;
+18 ; Check for 2 diagnoses ever of DX.13 or on Active Problem List
+19 IF $DATA(@BQARY)
Begin DoDot:1
+20 SET TMGLB=$NAME(^TMP("BQITD11",UID))
+21 DO POP^BQITDGN(BQARY,TMGLB)
End DoDot:1
+22 ;
+23 ; Check if any of the defined pre-DM patients have already been identified a diabetic
+24 SET TXDXCN=$$GDXN^BQITUTL("Diabetes")
+25 SET TDFN=""
+26 FOR
SET TDFN=$ORDER(@TMGLB@(TDFN))
IF 'TDFN
QUIT
Begin DoDot:1
+27 IF '$$ATAG^BQITDUTL(TDFN,"Diabetes")
MERGE @TGLOB@(TDFN)=@TMGLB@(TDFN)
End DoDot:1
+28 KILL @TMGLB
+29 ;
+30 ; Any three or more of the following in the past year:
+31 NEW TMFRAME
+32 SET TMFRAME="T-12M"
SET EXDT=""
SET DTDIF=""
+33 SET TMGLB1=$NAME(^TMP("BQITD11A",UID))
+34 IF $GET(TMFRAME)'=""
Begin DoDot:1
+35 SET ENDT=$$DATE^BQIUL1(TMFRAME)
SET STDT=$$DT^XLFDT()
+36 SET DTDIF=$$FMDIFF^XLFDT(STDT,ENDT,1)
End DoDot:1
+37 ;
+38 ; Triglyceride test value
+39 SET FREF=9000010.09
SET GREF=$$ROOT^DILFD(FREF,"",1)
SET TREF=$NAME(^TMP("BQITAX",UID))
KILL @TREF
+40 SET TAX="DM AUDIT TRIGLYCERIDE TAX"
DO BLD^BQITUTL(TAX,TREF,"L")
+41 SET TAX="BGP TRIGLYCERIDE LOINC CODES"
DO BLD^BQITUTL(TAX,TREF)
+42 SET TIEN=0
FOR
SET TIEN=$ORDER(@TREF@(TIEN))
IF 'TIEN
QUIT
Begin DoDot:1
+43 SET IEN=""
+44 FOR
SET IEN=$ORDER(@GREF@("B",TIEN,IEN),-1)
IF IEN=""
QUIT
Begin DoDot:2
+45 IF $GET(@GREF@(IEN,0))=""
QUIT
+46 SET DFN=$$GET1^DIQ(FREF,IEN,.02,"I")
IF DFN=""
QUIT
+47 IF $$ATAG^BQITDUTL(DFN,"Diabetes")
QUIT
+48 SET VISIT=$$GET1^DIQ(FREF,IEN,.03,"I")
IF VISIT=""
QUIT
+49 IF $$GET1^DIQ(9000010,VISIT,.11,"I")=1
QUIT
+50 SET VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1
IF 'VSDTM
QUIT
+51 IF $GET(TMFRAME)'=""
IF VSDTM<ENDT
QUIT
+52 SET RESULT=$$GET1^DIQ(FREF,IEN,.04,"E")
+53 IF RESULT=""
QUIT
+54 IF RESULT'>149
QUIT
+55 DO STOR(DFN,"Triglyceride Test Value",VISIT,IEN)
End DoDot:2
End DoDot:1
+56 ;
+57 ; HDL test value
+58 SET FREF=9000010.09
SET GREF=$$ROOT^DILFD(FREF,"",1)
SET TREF=$NAME(^TMP("BQITAX",UID))
KILL @TREF
+59 SET TAX="DM AUDIT HDL TAX"
DO BLD^BQITUTL(TAX,TREF,"L")
+60 SET TAX="BGP HDL LOINC CODES"
DO BLD^BQITUTL(TAX,TREF)
+61 SET TIEN=0
FOR
SET TIEN=$ORDER(@TREF@(TIEN))
IF 'TIEN
QUIT
Begin DoDot:1
+62 SET IEN=""
+63 FOR
SET IEN=$ORDER(@GREF@("B",TIEN,IEN),-1)
IF IEN=""
QUIT
Begin DoDot:2
+64 IF $GET(@GREF@(IEN,0))=""
QUIT
+65 SET DFN=$$GET1^DIQ(FREF,IEN,.02,"I")
IF DFN=""
QUIT
+66 IF $$ATAG^BQITDUTL(DFN,"Diabetes")
QUIT
+67 SET SEX=$$GET1^DIQ(2,DFN,.02,"I")
+68 SET VISIT=$$GET1^DIQ(FREF,IEN,.03,"I")
IF VISIT=""
QUIT
+69 IF $$GET1^DIQ(9000010,VISIT,.11,"I")=1
QUIT
+70 SET VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1
IF 'VSDTM
QUIT
+71 IF $GET(TMFRAME)'=""
IF VSDTM<ENDT
QUIT
+72 SET RESULT=$$GET1^DIQ(FREF,IEN,.04,"E")
+73 IF RESULT=""
QUIT
+74 IF SEX="M"!(SEX="U")
IF RESULT<40
DO STOR(DFN,"HDL Test Value",VISIT,IEN)
QUIT
+75 IF SEX="F"
IF RESULT<50
DO STOR(DFN,"HDL Test Value",VISIT,IEN)
End DoDot:2
End DoDot:1
+76 ;
+77 ; Fasting Glucose test value
+78 SET FREF=9000010.09
SET GREF=$$ROOT^DILFD(FREF,"",1)
SET TREF=$NAME(^TMP("BQITAX",UID))
KILL @TREF
+79 SET TAX="DM AUDIT FASTING GLUCOSE TESTS"
DO BLD^BQITUTL(TAX,TREF,"L")
+80 SET TAX="DM AUDIT FASTING GLUC LOINC"
DO BLD^BQITUTL(TAX,TREF)
+81 SET TIEN=0
FOR
SET TIEN=$ORDER(@TREF@(TIEN))
IF 'TIEN
QUIT
Begin DoDot:1
+82 SET IEN=""
+83 FOR
SET IEN=$ORDER(@GREF@("B",TIEN,IEN),-1)
IF IEN=""
QUIT
Begin DoDot:2
+84 SET DFN=$$GET1^DIQ(FREF,IEN,.02,"I")
IF DFN=""
QUIT
+85 IF $$ATAG^BQITDUTL(DFN,"Diabetes")
QUIT
+86 SET SEX=$$GET1^DIQ(2,DFN,.02,"I")
+87 SET VISIT=$$GET1^DIQ(FREF,IEN,.03,"I")
IF VISIT=""
QUIT
+88 IF $$GET1^DIQ(9000010,VISIT,.11,"I")=1
QUIT
+89 SET VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1
IF 'VSDTM
QUIT
+90 IF $GET(TMFRAME)'=""
IF VSDTM<ENDT
QUIT
+91 SET RESULT=$$GET1^DIQ(FREF,IEN,.04,"E")
+92 IF RESULT=""
QUIT
+93 IF RESULT<100!(RESULT'<126)
QUIT
+94 DO STOR(DFN,"Fasting Glucose Test Value",VISIT,IEN)
End DoDot:2
End DoDot:1
+95 ;
+96 SET FREF=9000010.07
SET GREF=$$ROOT^DILFD(FREF,"",1)
SET TREF=$NAME(^TMP("BQITAX",UID))
KILL @TREF
+97 SET TAX="BGP IMPAIRED FASTING GLUCOSE"
DO BLD^BQITUTL(TAX,.TREF)
+98 ;D BLDSV^BQITUTL(80,790.21,TREF)
+99 SET TIEN=0
FOR
SET TIEN=$ORDER(@TREF@(TIEN))
IF 'TIEN
QUIT
Begin DoDot:1
+100 SET IEN=""
+101 FOR
SET IEN=$ORDER(@GREF@("B",TIEN,IEN),-1)
IF IEN=""
QUIT
Begin DoDot:2
+102 IF $GET(@GREF@(IEN,0))=""
QUIT
+103 SET DFN=$$GET1^DIQ(FREF,IEN,.02,"I")
IF DFN=""
QUIT
+104 IF $$ATAG^BQITDUTL(DFN,"Diabetes")
QUIT
+105 SET VISIT=$$GET1^DIQ(FREF,IEN,.03,"I")
IF VISIT=""
QUIT
+106 SET VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1
IF 'VSDTM
QUIT
+107 IF $GET(TMFRAME)'=""
IF VSDTM<ENDT
QUIT
+108 DO STOR(DFN,"Fasting Glucose Test Value",VISIT,IEN)
End DoDot:2
End DoDot:1
+109 ;
+110 ; Patients diagnosed with hypertension
+111 SET TDXN=$$GDXN^BQITUTL("Hypertension")
+112 SET BQDREF="BQIREF"
KILL @BQDREF
+113 DO ARY^BQITUTL(TDXN,BQDREF)
+114 SET $PIECE(BQIREF(1),U,4)="T-12M"
SET TAX=$PIECE(BQIREF(1),U,1)
+115 SET TMGLB2=$NAME(^TMP("BQITD11B",UID))
KILL @TMGLB2
+116 DO POP^BQITDGN(.BQDREF,.TMGLB2,1)
+117 SET TDFN=""
+118 FOR
SET TDFN=$ORDER(@TMGLB2@(TDFN))
IF TDFN=""
QUIT
Begin DoDot:1
+119 IF $$ATAG^BQITDUTL(TDFN,"Diabetes")
QUIT
+120 IF $GET(@TMGLB1@(TDFN))>3
QUIT
+121 IF $DATA(@TMGLB1@(TDFN,"CRITERIA",TAX))>0
QUIT
+122 SET @TMGLB1@(TDFN)=$GET(@TMGLB1@(TDFN))+1
+123 MERGE @TMGLB1@(TDFN)=@TMGLB2@(TDFN)
End DoDot:1
+124 KILL BQIREF
+125 ;
+126 ; Patients with mean Blood Pressure value
+127 SET TMPG=$NAME(^TMP("BQIBP",UID))
SET FREF="9000010.01"
+128 KILL @TMPG
+129 DO ABP^BQITBMI(TMFRAME,.TMPG)
+130 SET TDFN=0
+131 FOR
SET TDFN=$ORDER(@TMPG@(TDFN))
IF 'TDFN
QUIT
Begin DoDot:1
+132 IF $$ATAG^BQITDUTL(TDFN,"Diabetes")
QUIT
+133 SET TBP=@TMPG@(TDFN)
+134 SET SYS=$PIECE(TBP,U,1)
SET DIA=$PIECE(TBP,U,2)
SET VISITS=$PIECE(TBP,U,3)
SET IIENS=$PIECE(TBP,U,4)
+135 IF SYS'<130!(DIA'<85)
Begin DoDot:2
+136 IF '$DATA(@TMGLB2@(TDFN))
DO STOR(TDFN,"Mean BP Value",VISITS,IIENS)
End DoDot:2
End DoDot:1
+137 KILL @TMGLB2,TMGLB2
+138 ;
+139 SET TMPG=$NAME(^TMP("BQIBMI",UID))
+140 KILL @TMPG
+141 DO ABMI^BQITBMI(TMFRAME,.TMPG)
+142 SET TDFN=0
+143 FOR
SET TDFN=$ORDER(@TMPG@(TDFN))
IF 'TDFN
QUIT
Begin DoDot:1
+144 IF $$ATAG^BQITDUTL(TDFN,"Diabetes")
QUIT
+145 SET BMI=$PIECE(@TMPG@(TDFN),"^",1)
+146 IF BMI'<30
Begin DoDot:2
+147 SET @TMGLB1@(TDFN)=$GET(@TMGLB1@(TDFN))+1
+148 FOR TX="BMI-Height","BMI-Weight"
SET VST=""
Begin DoDot:3
+149 FOR
SET VST=$ORDER(@TMPG@(TDFN,"CRITERIA",TX,"V",VST))
IF VST=""
QUIT
Begin DoDot:4
+150 SET IEN=""
SET FREF=9000010.01
SET EXDT=""
+151 FOR
SET IEN=$ORDER(@TMPG@(TDFN,"CRITERIA",TX,"V",VST,IEN))
IF IEN=""
QUIT
Begin DoDot:5
+152 SET VSDTM=$PIECE(@TMPG@(TDFN,"CRITERIA",TX,"V",VST,IEN),U,1)
+153 IF DTDIF'=""
SET EXDT=$$FMADD^XLFDT(VSDTM,DTDIF)
+154 SET $PIECE(@TMGLB1@(TDFN,"CRITERIA","BMI =>30","V",VST,IEN),U,1)=VSDTM_U_EXDT_U_IEN_U_FREF
End DoDot:5
End DoDot:4
End DoDot:3
+155 DO STOR(TDFN,"BMI =>30")
End DoDot:2
End DoDot:1
+156 KILL @TMPG
+157 ;
+158 SET TMPG=$NAME(^TMP("BQIWST",UID))
+159 KILL @TMPG
+160 DO AWC^BQITDWC(TMFRAME,.TMPG)
+161 SET TDFN=0
+162 FOR
SET TDFN=$ORDER(@TMPG@(TDFN))
IF 'TDFN
QUIT
Begin DoDot:1
+163 IF $$ATAG^BQITDUTL(TDFN,"Diabetes")
QUIT
+164 SET SEX=$$GET1^DIQ(2,TDFN,.02,"I")
+165 SET DATE=""
SET QFL=0
+166 FOR
SET DATE=$ORDER(@TMPG@(TDFN,DATE),-1)
IF DATE=""
QUIT
Begin DoDot:2
+167 ; check if Waist Circumference is M>40 or F>35
+168 SET CIRCUM=$PIECE(@TMPG@(TDFN,DATE),"^",1)
+169 SET VISIT=$PIECE(@TMPG@(TDFN,DATE),"^",2)
+170 SET IEN=$PIECE(@TMPG@(TDFN,DATE),"^",3)
+171 SET FREF=$PIECE(@TMPG@(TDFN,DATE),"^",4)
+172 IF SEX="M"
IF CIRCUM>40
DO STOR(TDFN,"Waist Circumference",VISIT,IEN)
SET QFL=1
QUIT
+173 IF SEX="F"!(SEX="U")
IF CIRCUM>35
DO STOR(TDFN,"Waist Circumference",VISIT,IEN)
SET QFL=1
End DoDot:2
IF QFL
QUIT
End DoDot:1
+174 KILL @TMPG,TMPG
+175 ;
+176 SET TDFN=""
+177 FOR
SET TDFN=$ORDER(@TMGLB1@(TDFN))
IF TDFN=""
QUIT
IF @TMGLB1@(TDFN)<3
KILL @TMGLB1@(TDFN)
+178 ;
+179 ; Finish with all the logic and have a list of patients to file from TGLOB
+180 SET TDFN=""
+181 FOR
SET TDFN=$ORDER(@TMGLB1@(TDFN))
IF TDFN=""
QUIT
Begin DoDot:1
+182 IF '$$ATAG^BQITDUTL(TDFN,"Diabetes")
MERGE @TGLOB@(TDFN)=@TMGLB1@(TDFN)
End DoDot:1
+183 ;
+184 KILL @TMGLB,@TMGLB1,@TREF
+185 KILL TDFN,SYS,DIA,TBP,TDXN,RESULT,VSDTM,VISIT,SEX,DFN,IEN,TIEN
+186 KILL TAX,GREF,FREF,TREF,TX,SDFN,PC,TMGLB,TMGLB1,TXDXCN,TMPG
+187 QUIT
+188 ;
PAT(DEF,TGLOB,PDFN) ; EP -- By patient
+1 ;Description
+2 ; Checks if a patient meets the criteria for PreDM Metabolic Syndrome
+3 ;Input
+4 ; BQARY - Array of taxonomies and other information
+5 ; DFN - patient internal entry number
+6 ;
+7 NEW DXOK,TMFRAME,ENDT,TMGLB1,FREF,GREF,TREF,TAX,GLOBAL,PC,IEN,TIEN,VISIT,VSDTM
+8 NEW SYS,DIA,TBP,SEX,BQARY,VISITS,TXDXCN,BMID,VIENS,HYOK,IIENS,BDT,EDT
+9 ;
+10 IF $$ATAG^BQITDUTL(PDFN,"Diabetes")
QUIT 0
+11 ;
+12 SET BQDXN=$$GDXN^BQITUTL(DEF)
+13 SET BQARY="BQIRY"
+14 DO GDF^BQITUTL(BQDXN,BQARY)
+15 SET DXOK=0
+16 SET DXOK=$$PAT^BQITDGN(BQARY,TGLOB,PDFN)
IF DXOK
QUIT DXOK
+17 ;
+18 SET TMFRAME="T-12M"
SET EXDT=""
SET DTDIF=""
SET BDT=$$DATE^BQIUL1(TMFRAME)
SET EDT=DT
+19 SET TMGLB1=$NAME(^TMP("BQITD11A",UID))
+20 KILL @TMGLB1
+21 IF $GET(TMFRAME)'=""
Begin DoDot:1
+22 SET ENDT=$$DATE^BQIUL1(TMFRAME)
SET STDT=$$DT^XLFDT()
+23 SET DTDIF=$$FMDIFF^XLFDT(STDT,ENDT,1)
End DoDot:1
+24 ;
+25 SET FREF=9000010.09
SET GREF=$$ROOT^DILFD(FREF,"",1)
SET TREF=$NAME(^TMP("BQITAX",UID))
+26 KILL @TREF
+27 SET TAX="DM AUDIT TRIGLYCERIDE TAX"
DO BLD^BQITUTL(TAX,TREF,"L")
+28 SET TAX="BGP TRIGLYCERIDE LOINC CODES"
DO BLD^BQITUTL(TAX,TREF)
+29 Begin DoDot:1
+30 SET IEN=""
SET QFL=0
+31 FOR
SET IEN=$ORDER(@GREF@("AC",PDFN,IEN),-1)
IF IEN=""
QUIT
Begin DoDot:2
+32 SET TIEN=$$GET1^DIQ(FREF,IEN,.01,"I")
IF TIEN=""
QUIT
+33 IF '$DATA(@TREF@(TIEN))
QUIT
+34 SET VISIT=$$GET1^DIQ(FREF,IEN,.03,"I")
IF VISIT=""
QUIT
+35 IF $$GET1^DIQ(9000010,VISIT,.11,"I")=1
QUIT
+36 SET VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1
IF 'VSDTM
QUIT
+37 IF $GET(TMFRAME)'=""
IF VSDTM<ENDT
QUIT
+38 SET RESULT=$$GET1^DIQ(FREF,IEN,.04,"E")
+39 IF RESULT=""
QUIT
+40 IF RESULT'>149
QUIT
+41 DO STOR(PDFN,"Triglyceride Test Value",VISIT,IEN)
+42 SET QFL=1
End DoDot:2
IF QFL
QUIT
End DoDot:1
+43 ;
+44 SET FREF=9000010.09
SET GREF=$$ROOT^DILFD(FREF,"",1)
SET TREF=$NAME(^TMP("BQITAX",UID))
+45 KILL @TREF
+46 SET TAX="DM AUDIT HDL TAX"
DO BLD^BQITUTL(TAX,TREF,"L")
+47 SET TAX="BGP HDL LOINC CODES"
DO BLD^BQITUTL(TAX,TREF)
+48 Begin DoDot:1
+49 SET IEN=""
SET QFL=0
+50 FOR
SET IEN=$ORDER(@GREF@("AC",PDFN,IEN),-1)
IF IEN=""
QUIT
Begin DoDot:2
+51 SET TIEN=$$GET1^DIQ(FREF,IEN,.01,"I")
IF TIEN=""
QUIT
+52 IF '$DATA(@TREF@(TIEN))
QUIT
+53 SET SEX=$$GET1^DIQ(2,PDFN,.02,"I")
+54 SET VISIT=$$GET1^DIQ(FREF,IEN,.03,"I")
IF VISIT=""
QUIT
+55 IF $$GET1^DIQ(9000010,VISIT,.11,"I")=1
QUIT
+56 SET VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1
IF 'VSDTM
QUIT
+57 IF $GET(TMFRAME)'=""
IF VSDTM<ENDT
QUIT
+58 SET RESULT=$$GET1^DIQ(FREF,IEN,.04,"E")
+59 IF RESULT=""
QUIT
+60 IF SEX="M"!(SEX="U")
IF RESULT<40
DO STOR(PDFN,"HDL Test Value",VISIT,IEN)
SET QFL=1
QUIT
+61 IF SEX="F"
IF RESULT<50
DO STOR(PDFN,"HDL Test Value",VISIT,IEN)
SET QFL=1
End DoDot:2
IF QFL
QUIT
End DoDot:1
+62 ;
+63 SET FREF=9000010.09
SET GREF=$$ROOT^DILFD(FREF,"",1)
SET TREF=$NAME(^TMP("BQITAX",UID))
+64 KILL @TREF
+65 SET TAX="DM AUDIT FASTING GLUCOSE TESTS"
DO BLD^BQITUTL(TAX,TREF,"L")
+66 SET TAX="DM AUDIT FASTING GLUC LOINC"
DO BLD^BQITUTL(TAX,TREF)
+67 Begin DoDot:1
+68 SET IEN=""
SET QFL=0
+69 FOR
SET IEN=$ORDER(@GREF@("AC",PDFN,IEN),-1)
IF IEN=""
QUIT
Begin DoDot:2
+70 SET TIEN=$$GET1^DIQ(FREF,IEN,.01,"I")
IF TIEN=""
QUIT
+71 IF '$DATA(@TREF@(TIEN))
QUIT
+72 SET SEX=$$GET1^DIQ(2,PDFN,.02,"I")
+73 SET VISIT=$$GET1^DIQ(FREF,IEN,.03,"I")
IF VISIT=""
QUIT
+74 IF $$GET1^DIQ(9000010,VISIT,.11,"I")=1
QUIT
+75 SET VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1
IF 'VSDTM
QUIT
+76 IF $GET(TMFRAME)'=""
IF VSDTM<ENDT
QUIT
+77 SET RESULT=$$GET1^DIQ(FREF,IEN,.04,"E")
+78 IF RESULT=""
QUIT
+79 IF RESULT<100!(RESULT'<126)
QUIT
+80 DO STOR(PDFN,"Fasting Glucose Test Value",VISIT,IEN)
+81 SET QFL=1
End DoDot:2
IF QFL
QUIT
End DoDot:1
+82 ;
+83 SET FREF=9000010.07
SET GREF=$$ROOT^DILFD(FREF,"",1)
SET TREF=$NAME(^TMP("BQITAX",UID))
KILL @TREF
+84 SET TAX="BGP IMPAIRED FASTING GLUCOSE"
DO BLD^BQITUTL(TAX,.TREF)
+85 ;D BLDSV^BQITUTL(80,790.21,TREF)
+86 SET IEN=""
SET QFL=0
+87 FOR
SET IEN=$ORDER(@GREF@("AC",PDFN,IEN),-1)
IF IEN=""
QUIT
Begin DoDot:1
+88 SET TIEN=$$GET1^DIQ(FREF,IEN,.01,"I")
IF TIEN=""
QUIT
+89 IF '$DATA(@TREF@(TIEN))
QUIT
+90 SET VISIT=$$GET1^DIQ(FREF,IEN,.03,"I")
IF VISIT=""
QUIT
+91 IF $$GET1^DIQ(9000010,VISIT,.11,"I")=1
QUIT
+92 SET VSDTM=$$GET1^DIQ(9000010,VISIT,.01,"I")\1
IF 'VSDTM
QUIT
+93 IF $GET(TMFRAME)'=""
IF VSDTM<ENDT
QUIT
+94 SET RESULT=$$GET1^DIQ(FREF,IEN,.04,"E")
+95 IF RESULT=""
QUIT
+96 IF RESULT<100!(RESULT'<126)
QUIT
+97 DO STOR(PDFN,"Fasting Glucose Test Value",VISIT,IEN)
+98 SET QFL=1
End DoDot:1
IF QFL
QUIT
+99 ;
+100 SET BQDXN=$$GDXN^BQITUTL("Hypertension")
+101 SET BQARY="BQIRY"
+102 DO GDF^BQITUTL(BQDXN,BQARY)
+103 SET $PIECE(BQIRY(1),U,4)="T-12M"
SET TAX=$PIECE(BQIRY(1),U,1)
+104 SET TMGLB2=$NAME(^TMP("BQITD11B",UID))
KILL @TMGLB2
+105 SET DXOK=0
SET HYOK=0
+106 SET DXOK=$$PAT^BQITDGN(BQARY,TMGLB2,PDFN)
+107 IF DXOK
Begin DoDot:1
+108 IF $GET(@TMGLB1@(PDFN))>3
QUIT
+109 IF $DATA(@TMGLB1@(PDFN,"CRITERIA",TAX))>0
QUIT
+110 MERGE @TMGLB1@(PDFN,"CRITERIA")=@TMGLB2@(PDFN,"CRITERIA")
+111 SET @TMGLB1@(PDFN)=$GET(@TMGLB1@(PDFN))+1
SET HYOK=1
SET DXOK=0
End DoDot:1
+112 KILL @TMGLB2
+113 ;
+114 SET FREF="9000010.01"
+115 SET TBP=$$BP^BQITBMI(PDFN,TMFRAME)
+116 SET SYS=$PIECE(TBP,U,1)
SET DIA=$PIECE(TBP,U,2)
SET VISITS=$PIECE(TBP,U,3)
SET IIENS=$PIECE(TBP,U,4)
+117 IF SYS'<130!(DIA'<85)
IF 'HYOK
DO STOR(PDFN,"Mean BP Value",VISITS,IIENS)
+118 ;
+119 ;S BMID=$$OBMI^BQITBMI(PDFN,TMFRAME)
+120 NEW BV,BMI,BMR,QFL
+121 SET BMID=$$PBMI^APCLV(PDFN,DT)
+122 SET BMI=$PIECE(BMID,"^",1)
+123 IF BMI'=""
Begin DoDot:1
+124 IF $PIECE(BMID,"^",3)<BDT!($PIECE(BMID,"^",3)>EDT)!($PIECE(BMID,"^",6)<BDT)!($PIECE(BMID,"^",7)>EDT)
SET BMI=""
QUIT
+125 SET VIENS=$PIECE(BMID,"^",4)_","_$PIECE(BMID,"^",7)
SET IIENS=$PIECE(BMID,"^",10)
+126 IF IIENS=""
SET QFL=0
Begin DoDot:2
+127 IF $PIECE(BMID,"^",4)=$PIECE(BMID,"^",7)
Begin DoDot:3
+128 SET BV=$PIECE(BMID,"^",4)
SET BVI=""
SET BMR=$$FIND1^DIC(9999999.07,,"MX","BMI")
+129 FOR
SET BVI=$ORDER(^AUPNVMSR("AD",BV,BVI))
IF BVI=""
QUIT
IF $PIECE(^AUPNVMSR(BVI,0),"^",1)=BMR
SET IIENS=BVI
SET QFL=1
End DoDot:3
IF QFL
QUIT
+130 SET BV=$PIECE(BMID,"^",4)
SET BVI=""
SET BMR=$$FIND1^DIC(9999999.07,,"MX","HEIGHT")
+131 FOR
SET BVI=$ORDER(^AUPNVMSR("AD",BV,BVI))
IF BVI=""
QUIT
IF $PIECE(^AUPNVMSR(BVI,0),"^",1)=BMR
SET IIENS=BVI_","
+132 SET BV=$PIECE(BMID,"^",7)
SET BVI=""
SET BMR=$$FIND1^DIC(9999999.07,,"MX","WEIGHT")
+133 FOR
SET BVI=$ORDER(^AUPNVMSR("AD",BV,BVI))
IF BVI=""
QUIT
IF $PIECE(^AUPNVMSR(BVI,0),"^",1)=BMR
SET IIENS=IIENS_BVI
End DoDot:2
End DoDot:1
+134 IF BMI'<30
DO STOR(PDFN,"BMI =>30",VIENS,IIENS)
+135 ;
+136 NEW VALUE
+137 SET VALUE=$$WC^BQITDWC(PDFN,TMFRAME)
+138 SET CIRCUM=$PIECE(VALUE,U,1)
SET VISIT=$PIECE(VALUE,U,2)
SET IEN=$PIECE(VALUE,U,3)
+139 SET SEX=$$GET1^DIQ(2,PDFN,.02,"I")
+140 IF SEX="M"
IF CIRCUM>40
IF '$DATA(@TMGLB1@(PDFN,"CRITERIA","BMI =>30"))
DO STOR(PDFN,"Waist Circumference",VISIT,IEN)
+141 IF SEX="F"!(SEX="U")
IF CIRCUM>35
IF '$DATA(@TMGLB1@(PDFN,"CRITERIA","BMI =>30"))
DO STOR(PDFN,"Waist Circumference",VISIT,IEN)
+142 ;
+143 IF $GET(@TMGLB1@(PDFN))<3
SET DXOK=$SELECT(DXOK=1:1,1:0)
+144 IF $GET(@TMGLB1@(PDFN))'<3
SET DXOK=1
+145 ;
+146 IF DXOK
MERGE @TGLOB@(PDFN)=@TMGLB1@(PDFN)
+147 KILL @TMGLB1
+148 QUIT DXOK
+149 ;
STOR(SDFN,CRIT,VIENS,IENS) ; Store the patient's met criteria
+1 NEW VST,I,VSDTM,IIEN
+2 IF $GET(@TMGLB1@(SDFN))>3
QUIT
+3 ;I $D(@TMGLB1@(SDFN,"CRITERIA",CRIT))>0 Q
+4 SET @TMGLB1@(SDFN)=$GET(@TMGLB1@(SDFN))+1
+5 SET @TMGLB1@(SDFN,"CRITERIA",CRIT)=""
+6 IF $GET(VIENS)[","
Begin DoDot:1
+7 FOR I=1:1
SET VST=$PIECE(VIENS,",",I)
IF VST=""
QUIT
Begin DoDot:2
+8 IF IENS[","
SET IIEN=$PIECE(IENS,",",I)
+9 IF IENS'[","
SET IIEN=IENS
+10 SET VSDTM=$$GET1^DIQ(9000010,VST_",",.01,"I")
IF 'VSDTM
QUIT
+11 IF DTDIF'=""
SET EXDT=$$FMADD^XLFDT(VSDTM,DTDIF)
+12 SET @TMGLB1@(SDFN,"CRITERIA",CRIT,"V",VST,IIEN)=VSDTM_U_U_IIEN_U_FREF
+13 IF EXDT'=""
SET $PIECE(@TMGLB1@(SDFN,"CRITERIA",CRIT,"V",VST,IIEN),U,2)=EXDT
End DoDot:2
End DoDot:1
QUIT
+14 IF $GET(VIENS)'=""
Begin DoDot:1
+15 SET VSDTM=$$GET1^DIQ(9000010,VIENS_",",.01,"I")
IF 'VSDTM
QUIT
+16 IF DTDIF'=""
SET EXDT=$$FMADD^XLFDT(VSDTM,DTDIF)
+17 SET @TMGLB1@(SDFN,"CRITERIA",CRIT,"V",VIENS,IENS)=VSDTM_U_U_IENS_U_FREF
+18 IF EXDT'=""
SET $PIECE(@TMGLB1@(SDFN,"CRITERIA",CRIT,"V",VIENS,IENS),U,2)=EXDT
End DoDot:1
+19 QUIT
