BQIRGASU ;VNGT/HS/ALA-Asthma Utilities ; 09 Jan 2009 5:01 PM
;;2.4;ICARE MANAGEMENT SYSTEM;;Apr 01, 2015;Build 41
;
;
AQC(BQDFN) ;EP - Asthma Quality of Care
NEW RESULT,DATE
;
S RESULT="N/A",DATE=$$DATE^BQIUL1("T-12M")
; Active Asthma Tag
I '$$ATAG^BQITDUTL(BQDFN,"Asthma") Q RESULT
S RESULT="NO"
;
; Severity value ever
I $$LASTSEV^APCHSAST(BQDFN,1)="" Q RESULT_U_"No severity"
; Control document in past year
I $$VERSION^XPDUTL("BJPC")>1.0,$$LASTACON^APCHSMAS(BQDFN,2)<DATE Q RESULT_U_"No control documented"
; Peak Flow or FEV1 or FEV1/FVC documented in past year
S QFL=0 D I QFL Q RESULT_U_"No peak flow"
. I $P($$MEAS^BQIDCUTL(BQDFN,"PF"),U,6)<DATE S QFL=1 Q
. I $P($$MEAS^BQIDCUTL(BQDFN,"FVFC"),U,6)<DATE S QFL=1 Q
; Asthma Action Plan in the past year
S Y=$$LASTITEM^APCHSMU(BQDFN,"ASM-SMP","EDUCATION") I Y<DATE Q RESULT_U_"No Asthma Action Plan"
; Flu Shot document in past year (Health Maintenance Reminder)
;S HIEN=$$FIND1^DIC(9001018,"","Q","ASTHMA PATIENT-FLU SHOT","B","","ERROR")
;I 'HIEN Q RESULT
;S X=$$GVHMR^APCHSMU(BQDFN,HIEN)
;I X'="" Q RESULT
I $$LASTFLU^APCLAPI4(BQDFN)<DATE Q RESULT_U_"No flu shot in past year"
; Severity 2,3, or 4 AND any current controllers prescription
I $$LASTSEV^APCHSAST(BQDFN,1)<2 Q RESULT_U_"Severity less than 2"
I '$$CNTRL(BQDFN) Q RESULT_U_"No controller meds"
Q "YES"
;
CNTRL(BQDFN) ; EP - Controller Medications
NEW TAX,TREF,DESC,MEET,X,RESULT,OTHER,VISIT
I $G(UID)="" S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DESC=""
S TREF=$NA(^TMP("BQITAX",UID)) K @TREF
F TAX="BAT ASTHMA CONTROLLER MEDS","BAT ASTHMA CONTROLLER NDC","BAT ASTHMA INHALED STEROIDS","BAT ASTHMA INHLD STEROIDS NDC","BAT ASTHMA LEUKOTRIENE MEDS","BAT ASTHMA LEUKOTRIENE NDC" D BLD^BQITUTL(TAX,TREF)
S X=$$TAX^BQITRUTL("","",1,BQDFN,9000010.14,"","",.TREF)
; if returns a found medication, check if it is an active medication
I $P(X,U,1)=1 D
. I $$ACTMED^BKMQQCR4($P(X,U,5)) Q
. S $P(X,U,1)=0
I $P(X,U,1)=1 S MEET=1,DESC=DESC_"On Asthma Controller Meds ("_$$FMTE^BQIUL1($P(X,U,2))_" "_$$GET1^DIQ(9000010.14,$P(X,U,5)_",",.01,"E")_")"
I $P(X,U,1)=0 S MEET=0,DESC=DESC_"Not on Asthma Controller Meds"
K @TREF
S RESULT="N/A",OTHER="",VISIT=""
I $$ATAG^BQITDUTL(BQDFN,"Asthma") D
. I 'MEET S RESULT="NO" Q
. S RESULT="YES",OTHER=$$FMTE^BQIUL1($P(X,U,2)),VISIT="9000010:"_$P(X,U,4)
Q RESULT_U_OTHER_U_VISIT
;
RLVR(BQDFN) ; EP - Reliever Medications
NEW TAX,TREF,DESC,MEET,X,RESULT,OTHER,VISIT
I $G(UID)="" S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DESC=""
S TREF=$NA(^TMP("BQITAX",UID)) K @TREF
F TAX="BAT ASTHMA SHRT ACT RELV MEDS","BAT ASTHMA SHRT ACT RELV NDC","BAT ASTHMA SHRT ACT INHLR MEDS","BAT ASTHMA SHRT ACT INHLR NDC" D BLD^BQITUTL(TAX,TREF)
S X=$$TAX^BQITRUTL("","",1,BQDFN,9000010.14,"","",.TREF)
; if returns a found medication, check if it is an active medication
I $P(X,U,1)=1 D
. I $$ACTMED^BKMQQCR4($P(X,U,5)) Q
. S $P(X,U,1)=0
I $P(X,U,1)=1 S MEET=1,DESC=DESC_"On Asthma Reliever Meds ("_$$FMTE^BQIUL1($P(X,U,2))_" "_$$GET1^DIQ(9000010.14,$P(X,U,5)_",",.01,"E")_")"
I $P(X,U,1)=0 S MEET=0,DESC=DESC_"Not on Asthma Reliever Meds"
K @TREF
S RESULT="N/A",OTHER="",VISIT=""
I $$ATAG^BQITDUTL(BQDFN,"Asthma") D
. I 'MEET S RESULT="NO" Q
. S RESULT="YES",OTHER=$$FMTE^BQIUL1($P(X,U,2)),VISIT="9000010:"_$P(X,U,4)
Q RESULT_U_OTHER_U_VISIT
;
INHST(BQDFN) ; EP - Inhaled Steroids
NEW TAX,TREF,DESC,MEET,X,RESULT,OTHER,VISIT
I $G(UID)="" S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DESC=""
S TREF=$NA(^TMP("BQITAX",UID)) K @TREF
F TAX="BAT ASTHMA INHALED STEROIDS","BAT ASTHMA INHALED STEROIDS NDC" D BLD^BQITUTL(TAX,TREF)
S X=$$TAX^BQITRUTL("","",1,BQDFN,9000010.14,"","",.TREF)
; if returns a found medication, check if it is an active medication
I $P(X,U,1)=1 D
. I $$ACTMED^BKMQQCR4($P(X,U,5)) Q
. S $P(X,U,1)=0
I $P(X,U,1)=1 S MEET=1,DESC=DESC_"On Asthma Inhaled Steroid Meds ("_$$FMTE^BQIUL1($P(X,U,2))_" "_$$GET1^DIQ(9000010.14,$P(X,U,5)_",",.01,"E")_")"
I $P(X,U,1)=0 S MEET=0,DESC=DESC_"Not on Asthma Inhaled Steroid Meds"
K @TREF
S RESULT="N/A",OTHER="",VISIT=""
I $$ATAG^BQITDUTL(BQDFN,"Asthma") D
. I 'MEET S RESULT="NO" Q
. S RESULT="YES",OTHER=$$FMTE^BQIUL1($P(X,U,2)),VISIT="9000010:"_$P(X,U,4)
Q RESULT_U_OTHER_U_VISIT
;
ASFHX(BQDFN) ; EP - Family History of Asthma
NEW APCHTFH,I,TLTIP
I $$VERSION^XPDUTL("BJPC")>1.0 D FMH^APCHSAS1(BQDFN,.APCHTFH)
I '$D(APCHTFH) Q ""
S TLTIP="",I=0 F S I=$O(APCHTFH(I)) Q:I="" S TLTIP=TLTIP_$C(10)_APCHTFH(I)
Q "YES"_U_U_TLTIP
;
LHOSV(BQDFN) ; EP - Last Hospital Visit
; TXNMY - List of taxonomies applicable to the visit
NEW TEMP,TXNMY,IEN,VSDTM,VISIT
S TXNMY("BGP ASTHMA DXS")=""
D VISIT^BQIDCUTL(BQDFN,9000010.07,.TXNMY,"H","",1,.TEMP)
S VSDTM=$O(TEMP(""),-1) I VSDTM="" Q ""
S IEN=$O(TEMP(VSDTM,""),-1) I IEN="" Q ""
S VISIT=TEMP(VSDTM,IEN)
Q $$FMTE^BQIUL1(VSDTM)_U_"9000010:"_VISIT
;
LERUC(BQDFN) ; EP - Last ER/UC Visit
; TXNMY - List of taxonomies applicable to the visit
; CLNY - List of locations applicable to the visit
NEW TEMP,TXNMY,IEN,VSDTM,VISIT,CLNY
S TXNMY("BGP ASTHMA DXS")=""
S CLNY(30)="",CLNY(80)=""
D VISIT^BQIDCUTL(BQDFN,9000010.07,.TXNMY,"",.CLNY,1,.TEMP)
S VSDTM=$O(TEMP(""),-1) I VSDTM="" Q ""
S IEN=$O(TEMP(VSDTM,""),-1) I IEN="" Q ""
S VISIT=TEMP(VSDTM,IEN)
Q $$FMTE^BQIUL1(VSDTM)_U_"9000010:"_VISIT
;
ASTRIG(BQDFN) ; EP - Asthma Triggers
NEW ASTRIG,APCHC,APCHF,ATRDT,HIEN,VISIT,VSDTM,HFNM,VALUE,HOVER,ADATA,RESULT
K ASTRIG
S APCHC=$O(^AUTTHF("B","ASTHMA TRIGGERS",0))
S APCHF="",RESULT=""
F S APCHF=$O(^AUTTHF("AC",APCHC,APCHF)) Q:APCHF="" D
. Q:'$D(^AUPNVHF("AA",BQDFN,APCHF))
. S ATRDT=$O(^AUPNVHF("AA",BQDFN,APCHF,""))
. S HIEN=$O(^AUPNVHF("AA",BQDFN,APCHF,ATRDT,""))
. S VISIT=$P(^AUPNVHF(HIEN,0),U,3) I VISIT="" Q
. S VSDTM=$P(^AUPNVSIT(VISIT,0),U,1)\1 I VSDTM=0 Q
. S HFNM=$P(^AUTTHF(APCHF,0),U,1)
. I HFNM["-" S HFNM=$P(HFNM,"-",2)
. S ASTRIG(HFNM)=VSDTM_U_VISIT_U_HIEN
;
S HFNM="",VALUE="",HOVER="",ADATA=""
F S HFNM=$O(ASTRIG(HFNM)) Q:HFNM="" D
. S VALUE=VALUE_HFNM_"; "
. S HOVER=HOVER_HFNM_" ("_$$FMTE^BQIUL1($P(ASTRIG(HFNM),U,1))_"); "
. ;S ADATA=ADATA_$P(ASTRIG(HFNM),U,1)_"|"_$P(ASTRIG(HFNM),U,2)_"; "
S VALUE=$$TKO^BQIUL1(VALUE,"; ")
S HOVER=$$TKO^BQIUL1(HOVER,"; ")
S ADATA=$$TKO^BQIUL1(ADATA,"; ")
I VALUE'="" S RESULT=VALUE_U_HOVER
Q RESULT
;
TOB(BQDFN) ; EP - Last Tobacco Health Factors
NEW ASTOB,APCHC,APCHF,ATRDT,HIEN,VISIT,VSDTM,VALUE,HOVER,HVISIT
S APCHC=$O(^AUTTHF("B","TOBACCO",0))
S APCHF=""
F S APCHF=$O(^AUTTHF("AC",APCHC,APCHF)) Q:APCHF="" D
. Q:'$D(^AUPNVHF("AA",BQDFN,APCHF))
. S ATRDT=$O(^AUPNVHF("AA",BQDFN,APCHF,""))
. S HIEN=$O(^AUPNVHF("AA",BQDFN,APCHF,ATRDT,""))
. S VISIT=$P(^AUPNVHF(HIEN,0),U,3) I VISIT="" Q
. S VSDTM=$P(^AUPNVSIT(VISIT,0),U,1)\1 I VSDTM=0 Q
. S ASTOB(VSDTM,VISIT,HIEN)=$P(^AUTTHF(APCHF,0),U,1)
;
S VSDTM=$O(ASTOB(""),-1),VALUE="",HOVER=""
I VSDTM="" Q VALUE
;
S VISIT=""
F S VISIT=$O(ASTOB(VSDTM,VISIT)) Q:VISIT="" D
. S HIEN=""
. F S HIEN=$O(ASTOB(VSDTM,VISIT,HIEN)) Q:HIEN="" D
.. S VALUE=VALUE_ASTOB(VSDTM,VISIT,HIEN)_"; "
.. S HOVER=$$FMTE^BQIUL1(VSDTM),HVISIT="9000010:"_VISIT
S VALUE=$$TKO^BQIUL1(VALUE,"; ")
Q VALUE_U_HOVER_U_HVISIT
;
ASVIS(BQDFN) ; EP - Last Asthma Visit
NEW MEAS,VALUE,VTMP,AVALUE,IEN,QFL,VISIT,DTM,CLSN,TXIEN,DATM,BQI,FREF
NEW GREF,ENDT,RESULT,TEMP,TIEN,TXNMY,TYP,VSDTM
; Check for measurements
F MEAS="ADM","ASFD" D
. S VALUE=$$MEAS^BQIDCUTL(BQDFN,MEAS)
. I VALUE S VTMP($P(VALUE,U,6),$P(VALUE,U,4),"V")=""
;
; Check for Asthma Triggers
S VALUE=$$ASTRIG(BQDFN)
I $P(VALUE,U,3)'="" D
. F BQI=1:1 S AVALUE=$P($P(VALUE,U,3),"; ",BQI) Q:AVALUE="" D
.. S VTMP($P(AVALUE,"|",1),$P(AVALUE,"|",2),"V")=""
;
; Check for Asthma Patient Education
S VALUE=$$FED^BQITRUTL("",BQDFN,"ASM-")
I VALUE S VTMP($P(VALUE,U,2),$P(VALUE,U,4),"V")=""
S VALUE=$$FED^BQITRUTL("",BQDFN,"493")
I VALUE S VTMP($P(VALUE,U,2),$P(VALUE,U,4),"V")=""
;
; Check for Asthma Control
S IEN=""
F S IEN=$O(^AUPNVAST("AC",BQDFN,IEN)) Q:IEN="" D
. I $P(^AUPNVAST(IEN,0),U,14)="" Q
. S VISIT=$P(^AUPNVAST(IEN,0),U,3) I VISIT="" Q
. S DTM=$P($G(^AUPNVSIT(VISIT,0)),U,1)\1 I DTM=0 Q
. S VTMP(DTM,VISIT,"V")=""
;
; Check Problem List for addition/modification for Asthma Severity Classification
S CLSN=$O(^APCDPLCL("B","ASTHMA SEVERITY","")) I CLSN'="" D
. S TXIEN=$P(^APCDPLCL(CLSN,0),U,2),TXNMY($P(^ATXAX(TXIEN,0),U,1))=""
. D PROB^BQIDCUTL(BQDFN,.TXNMY,.TEMP)
. S DTM="",QFL=0
. F S DTM=$O(TEMP(DTM),-1) Q:DTM="" D Q:QFL
.. S IEN=""
.. F S IEN=$O(TEMP(DTM,IEN),-1) Q:IEN="" D Q:QFL
... I $P(^AUPNPROB(IEN,0),U,15)="" Q
... S QFL=1,VTMP(DTM,IEN,"P")=""
;
S DATM=$O(VTMP(""),-1)
I DATM="" Q ""
S IEN=$O(VTMP(DATM,""),-1),TYP=$O(VTMP(DATM,IEN,""))
S TYP=$S("P":9000011,1:9000010)
Q DATM_U_TYP_":"_IEN
;
DSP(ASDFN,ASIEN) ; EP - Display Care Mgmt field
NEW CODE,VALUE,RESULT,ASPIEN,CRIEN,CMSN,LINK
S CODE=$P($G(^BQI(90506.1,ASIEN,0)),U,1) I CODE="" Q ""
S CMSN=$P($G(^BQI(90506.1,ASIEN,3)),U,1) I CMSN="" Q ""
S CRIEN=$O(^BQIPAT(ASDFN,60,"B",CMSN,"")) I CRIEN="" Q ""
S ASPIEN="",VALUE="",HOVER="",LINK="",RESULT=""
F S ASPIEN=$O(^BQIPAT(ASDFN,60,CRIEN,1,"B",CODE,ASPIEN)) Q:ASPIEN="" D
. S VALUE=$P($G(^BQIPAT(ASDFN,60,CRIEN,1,ASPIEN,0)),U,2)
. S HOVER=$P($G(^BQIPAT(ASDFN,60,CRIEN,1,ASPIEN,0)),U,5)
. S LINK=$P($G(^BQIPAT(ASDFN,60,CRIEN,1,ASPIEN,0)),U,4)
;I VALUE'="" S RESULT=VALUE_$C(26)_HOVER_$C(26)_LINK
I VALUE'="",HOVER'="" S RESULT=VALUE_$C(26)_HOVER_$C(26)_LINK
E S RESULT=VALUE
Q RESULT
BQIRGASU ;VNGT/HS/ALA-Asthma Utilities ; 09 Jan 2009 5:01 PM
+1 ;;2.4;ICARE MANAGEMENT SYSTEM;;Apr 01, 2015;Build 41
+2 ;
+3 ;
AQC(BQDFN) ;EP - Asthma Quality of Care
+1 NEW RESULT,DATE
+2 ;
+3 SET RESULT="N/A"
SET DATE=$$DATE^BQIUL1("T-12M")
+4 ; Active Asthma Tag
+5 IF '$$ATAG^BQITDUTL(BQDFN,"Asthma")
QUIT RESULT
+6 SET RESULT="NO"
+7 ;
+8 ; Severity value ever
+9 IF $$LASTSEV^APCHSAST(BQDFN,1)=""
QUIT RESULT_U_"No severity"
+10 ; Control document in past year
+11 IF $$VERSION^XPDUTL("BJPC")>1.0
IF $$LASTACON^APCHSMAS(BQDFN,2)<DATE
QUIT RESULT_U_"No control documented"
+12 ; Peak Flow or FEV1 or FEV1/FVC documented in past year
+13 SET QFL=0
Begin DoDot:1
+14 IF $PIECE($$MEAS^BQIDCUTL(BQDFN,"PF"),U,6)<DATE
SET QFL=1
QUIT
+15 IF $PIECE($$MEAS^BQIDCUTL(BQDFN,"FVFC"),U,6)<DATE
SET QFL=1
QUIT
End DoDot:1
IF QFL
QUIT RESULT_U_"No peak flow"
+16 ; Asthma Action Plan in the past year
+17 SET Y=$$LASTITEM^APCHSMU(BQDFN,"ASM-SMP","EDUCATION")
IF Y<DATE
QUIT RESULT_U_"No Asthma Action Plan"
+18 ; Flu Shot document in past year (Health Maintenance Reminder)
+19 ;S HIEN=$$FIND1^DIC(9001018,"","Q","ASTHMA PATIENT-FLU SHOT","B","","ERROR")
+20 ;I 'HIEN Q RESULT
+21 ;S X=$$GVHMR^APCHSMU(BQDFN,HIEN)
+22 ;I X'="" Q RESULT
+23 IF $$LASTFLU^APCLAPI4(BQDFN)<DATE
QUIT RESULT_U_"No flu shot in past year"
+24 ; Severity 2,3, or 4 AND any current controllers prescription
+25 IF $$LASTSEV^APCHSAST(BQDFN,1)<2
QUIT RESULT_U_"Severity less than 2"
+26 IF '$$CNTRL(BQDFN)
QUIT RESULT_U_"No controller meds"
+27 QUIT "YES"
+28 ;
CNTRL(BQDFN) ; EP - Controller Medications
+1 NEW TAX,TREF,DESC,MEET,X,RESULT,OTHER,VISIT
+2 IF $GET(UID)=""
SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 SET DESC=""
+4 SET TREF=$NAME(^TMP("BQITAX",UID))
KILL @TREF
+5 FOR TAX="BAT ASTHMA CONTROLLER MEDS","BAT ASTHMA CONTROLLER NDC","BAT ASTHMA INHALED STEROIDS","BAT ASTHMA INHLD STEROIDS NDC","BAT ASTHMA LEUKOTRIENE MEDS","BAT ASTHMA LEUKOTRIENE NDC"
DO BLD^BQITUTL(TAX,TREF)
+6 SET X=$$TAX^BQITRUTL("","",1,BQDFN,9000010.14,"","",.TREF)
+7 ; if returns a found medication, check if it is an active medication
+8 IF $PIECE(X,U,1)=1
Begin DoDot:1
+9 IF $$ACTMED^BKMQQCR4($PIECE(X,U,5))
QUIT
+10 SET $PIECE(X,U,1)=0
End DoDot:1
+11 IF $PIECE(X,U,1)=1
SET MEET=1
SET DESC=DESC_"On Asthma Controller Meds ("_$$FMTE^BQIUL1($PIECE(X,U,2))_" "_$$GET1^DIQ(9000010.14,$PIECE(X,U,5)_",",.01,"E")_")"
+12 IF $PIECE(X,U,1)=0
SET MEET=0
SET DESC=DESC_"Not on Asthma Controller Meds"
+13 KILL @TREF
+14 SET RESULT="N/A"
SET OTHER=""
SET VISIT=""
+15 IF $$ATAG^BQITDUTL(BQDFN,"Asthma")
Begin DoDot:1
+16 IF 'MEET
SET RESULT="NO"
QUIT
+17 SET RESULT="YES"
SET OTHER=$$FMTE^BQIUL1($PIECE(X,U,2))
SET VISIT="9000010:"_$PIECE(X,U,4)
End DoDot:1
+18 QUIT RESULT_U_OTHER_U_VISIT
+19 ;
RLVR(BQDFN) ; EP - Reliever Medications
+1 NEW TAX,TREF,DESC,MEET,X,RESULT,OTHER,VISIT
+2 IF $GET(UID)=""
SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 SET DESC=""
+4 SET TREF=$NAME(^TMP("BQITAX",UID))
KILL @TREF
+5 FOR TAX="BAT ASTHMA SHRT ACT RELV MEDS","BAT ASTHMA SHRT ACT RELV NDC","BAT ASTHMA SHRT ACT INHLR MEDS","BAT ASTHMA SHRT ACT INHLR NDC"
DO BLD^BQITUTL(TAX,TREF)
+6 SET X=$$TAX^BQITRUTL("","",1,BQDFN,9000010.14,"","",.TREF)
+7 ; if returns a found medication, check if it is an active medication
+8 IF $PIECE(X,U,1)=1
Begin DoDot:1
+9 IF $$ACTMED^BKMQQCR4($PIECE(X,U,5))
QUIT
+10 SET $PIECE(X,U,1)=0
End DoDot:1
+11 IF $PIECE(X,U,1)=1
SET MEET=1
SET DESC=DESC_"On Asthma Reliever Meds ("_$$FMTE^BQIUL1($PIECE(X,U,2))_" "_$$GET1^DIQ(9000010.14,$PIECE(X,U,5)_",",.01,"E")_")"
+12 IF $PIECE(X,U,1)=0
SET MEET=0
SET DESC=DESC_"Not on Asthma Reliever Meds"
+13 KILL @TREF
+14 SET RESULT="N/A"
SET OTHER=""
SET VISIT=""
+15 IF $$ATAG^BQITDUTL(BQDFN,"Asthma")
Begin DoDot:1
+16 IF 'MEET
SET RESULT="NO"
QUIT
+17 SET RESULT="YES"
SET OTHER=$$FMTE^BQIUL1($PIECE(X,U,2))
SET VISIT="9000010:"_$PIECE(X,U,4)
End DoDot:1
+18 QUIT RESULT_U_OTHER_U_VISIT
+19 ;
INHST(BQDFN) ; EP - Inhaled Steroids
+1 NEW TAX,TREF,DESC,MEET,X,RESULT,OTHER,VISIT
+2 IF $GET(UID)=""
SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+3 SET DESC=""
+4 SET TREF=$NAME(^TMP("BQITAX",UID))
KILL @TREF
+5 FOR TAX="BAT ASTHMA INHALED STEROIDS","BAT ASTHMA INHALED STEROIDS NDC"
DO BLD^BQITUTL(TAX,TREF)
+6 SET X=$$TAX^BQITRUTL("","",1,BQDFN,9000010.14,"","",.TREF)
+7 ; if returns a found medication, check if it is an active medication
+8 IF $PIECE(X,U,1)=1
Begin DoDot:1
+9 IF $$ACTMED^BKMQQCR4($PIECE(X,U,5))
QUIT
+10 SET $PIECE(X,U,1)=0
End DoDot:1
+11 IF $PIECE(X,U,1)=1
SET MEET=1
SET DESC=DESC_"On Asthma Inhaled Steroid Meds ("_$$FMTE^BQIUL1($PIECE(X,U,2))_" "_$$GET1^DIQ(9000010.14,$PIECE(X,U,5)_",",.01,"E")_")"
+12 IF $PIECE(X,U,1)=0
SET MEET=0
SET DESC=DESC_"Not on Asthma Inhaled Steroid Meds"
+13 KILL @TREF
+14 SET RESULT="N/A"
SET OTHER=""
SET VISIT=""
+15 IF $$ATAG^BQITDUTL(BQDFN,"Asthma")
Begin DoDot:1
+16 IF 'MEET
SET RESULT="NO"
QUIT
+17 SET RESULT="YES"
SET OTHER=$$FMTE^BQIUL1($PIECE(X,U,2))
SET VISIT="9000010:"_$PIECE(X,U,4)
End DoDot:1
+18 QUIT RESULT_U_OTHER_U_VISIT
+19 ;
ASFHX(BQDFN) ; EP - Family History of Asthma
+1 NEW APCHTFH,I,TLTIP
+2 IF $$VERSION^XPDUTL("BJPC")>1.0
DO FMH^APCHSAS1(BQDFN,.APCHTFH)
+3 IF '$DATA(APCHTFH)
QUIT ""
+4 SET TLTIP=""
SET I=0
FOR
SET I=$ORDER(APCHTFH(I))
IF I=""
QUIT
SET TLTIP=TLTIP_$CHAR(10)_APCHTFH(I)
+5 QUIT "YES"_U_U_TLTIP
+6 ;
LHOSV(BQDFN) ; EP - Last Hospital Visit
+1 ; TXNMY - List of taxonomies applicable to the visit
+2 NEW TEMP,TXNMY,IEN,VSDTM,VISIT
+3 SET TXNMY("BGP ASTHMA DXS")=""
+4 DO VISIT^BQIDCUTL(BQDFN,9000010.07,.TXNMY,"H","",1,.TEMP)
+5 SET VSDTM=$ORDER(TEMP(""),-1)
IF VSDTM=""
QUIT ""
+6 SET IEN=$ORDER(TEMP(VSDTM,""),-1)
IF IEN=""
QUIT ""
+7 SET VISIT=TEMP(VSDTM,IEN)
+8 QUIT $$FMTE^BQIUL1(VSDTM)_U_"9000010:"_VISIT
+9 ;
LERUC(BQDFN) ; EP - Last ER/UC Visit
+1 ; TXNMY - List of taxonomies applicable to the visit
+2 ; CLNY - List of locations applicable to the visit
+3 NEW TEMP,TXNMY,IEN,VSDTM,VISIT,CLNY
+4 SET TXNMY("BGP ASTHMA DXS")=""
+5 SET CLNY(30)=""
SET CLNY(80)=""
+6 DO VISIT^BQIDCUTL(BQDFN,9000010.07,.TXNMY,"",.CLNY,1,.TEMP)
+7 SET VSDTM=$ORDER(TEMP(""),-1)
IF VSDTM=""
QUIT ""
+8 SET IEN=$ORDER(TEMP(VSDTM,""),-1)
IF IEN=""
QUIT ""
+9 SET VISIT=TEMP(VSDTM,IEN)
+10 QUIT $$FMTE^BQIUL1(VSDTM)_U_"9000010:"_VISIT
+11 ;
ASTRIG(BQDFN) ; EP - Asthma Triggers
+1 NEW ASTRIG,APCHC,APCHF,ATRDT,HIEN,VISIT,VSDTM,HFNM,VALUE,HOVER,ADATA,RESULT
+2 KILL ASTRIG
+3 SET APCHC=$ORDER(^AUTTHF("B","ASTHMA TRIGGERS",0))
+4 SET APCHF=""
SET RESULT=""
+5 FOR
SET APCHF=$ORDER(^AUTTHF("AC",APCHC,APCHF))
IF APCHF=""
QUIT
Begin DoDot:1
+6 IF '$DATA(^AUPNVHF("AA",BQDFN,APCHF))
QUIT
+7 SET ATRDT=$ORDER(^AUPNVHF("AA",BQDFN,APCHF,""))
+8 SET HIEN=$ORDER(^AUPNVHF("AA",BQDFN,APCHF,ATRDT,""))
+9 SET VISIT=$PIECE(^AUPNVHF(HIEN,0),U,3)
IF VISIT=""
QUIT
+10 SET VSDTM=$PIECE(^AUPNVSIT(VISIT,0),U,1)\1
IF VSDTM=0
QUIT
+11 SET HFNM=$PIECE(^AUTTHF(APCHF,0),U,1)
+12 IF HFNM["-"
SET HFNM=$PIECE(HFNM,"-",2)
+13 SET ASTRIG(HFNM)=VSDTM_U_VISIT_U_HIEN
End DoDot:1
+14 ;
+15 SET HFNM=""
SET VALUE=""
SET HOVER=""
SET ADATA=""
+16 FOR
SET HFNM=$ORDER(ASTRIG(HFNM))
IF HFNM=""
QUIT
Begin DoDot:1
+17 SET VALUE=VALUE_HFNM_"; "
+18 SET HOVER=HOVER_HFNM_" ("_$$FMTE^BQIUL1($PIECE(ASTRIG(HFNM),U,1))_"); "
+19 ;S ADATA=ADATA_$P(ASTRIG(HFNM),U,1)_"|"_$P(ASTRIG(HFNM),U,2)_"; "
End DoDot:1
+20 SET VALUE=$$TKO^BQIUL1(VALUE,"; ")
+21 SET HOVER=$$TKO^BQIUL1(HOVER,"; ")
+22 SET ADATA=$$TKO^BQIUL1(ADATA,"; ")
+23 IF VALUE'=""
SET RESULT=VALUE_U_HOVER
+24 QUIT RESULT
+25 ;
TOB(BQDFN) ; EP - Last Tobacco Health Factors
+1 NEW ASTOB,APCHC,APCHF,ATRDT,HIEN,VISIT,VSDTM,VALUE,HOVER,HVISIT
+2 SET APCHC=$ORDER(^AUTTHF("B","TOBACCO",0))
+3 SET APCHF=""
+4 FOR
SET APCHF=$ORDER(^AUTTHF("AC",APCHC,APCHF))
IF APCHF=""
QUIT
Begin DoDot:1
+5 IF '$DATA(^AUPNVHF("AA",BQDFN,APCHF))
QUIT
+6 SET ATRDT=$ORDER(^AUPNVHF("AA",BQDFN,APCHF,""))
+7 SET HIEN=$ORDER(^AUPNVHF("AA",BQDFN,APCHF,ATRDT,""))
+8 SET VISIT=$PIECE(^AUPNVHF(HIEN,0),U,3)
IF VISIT=""
QUIT
+9 SET VSDTM=$PIECE(^AUPNVSIT(VISIT,0),U,1)\1
IF VSDTM=0
QUIT
+10 SET ASTOB(VSDTM,VISIT,HIEN)=$PIECE(^AUTTHF(APCHF,0),U,1)
End DoDot:1
+11 ;
+12 SET VSDTM=$ORDER(ASTOB(""),-1)
SET VALUE=""
SET HOVER=""
+13 IF VSDTM=""
QUIT VALUE
+14 ;
+15 SET VISIT=""
+16 FOR
SET VISIT=$ORDER(ASTOB(VSDTM,VISIT))
IF VISIT=""
QUIT
Begin DoDot:1
+17 SET HIEN=""
+18 FOR
SET HIEN=$ORDER(ASTOB(VSDTM,VISIT,HIEN))
IF HIEN=""
QUIT
Begin DoDot:2
+19 SET VALUE=VALUE_ASTOB(VSDTM,VISIT,HIEN)_"; "
+20 SET HOVER=$$FMTE^BQIUL1(VSDTM)
SET HVISIT="9000010:"_VISIT
End DoDot:2
End DoDot:1
+21 SET VALUE=$$TKO^BQIUL1(VALUE,"; ")
+22 QUIT VALUE_U_HOVER_U_HVISIT
+23 ;
ASVIS(BQDFN) ; EP - Last Asthma Visit
+1 NEW MEAS,VALUE,VTMP,AVALUE,IEN,QFL,VISIT,DTM,CLSN,TXIEN,DATM,BQI,FREF
+2 NEW GREF,ENDT,RESULT,TEMP,TIEN,TXNMY,TYP,VSDTM
+3 ; Check for measurements
+4 FOR MEAS="ADM","ASFD"
Begin DoDot:1
+5 SET VALUE=$$MEAS^BQIDCUTL(BQDFN,MEAS)
+6 IF VALUE
SET VTMP($PIECE(VALUE,U,6),$PIECE(VALUE,U,4),"V")=""
End DoDot:1
+7 ;
+8 ; Check for Asthma Triggers
+9 SET VALUE=$$ASTRIG(BQDFN)
+10 IF $PIECE(VALUE,U,3)'=""
Begin DoDot:1
+11 FOR BQI=1:1
SET AVALUE=$PIECE($PIECE(VALUE,U,3),"; ",BQI)
IF AVALUE=""
QUIT
Begin DoDot:2
+12 SET VTMP($PIECE(AVALUE,"|",1),$PIECE(AVALUE,"|",2),"V")=""
End DoDot:2
End DoDot:1
+13 ;
+14 ; Check for Asthma Patient Education
+15 SET VALUE=$$FED^BQITRUTL("",BQDFN,"ASM-")
+16 IF VALUE
SET VTMP($PIECE(VALUE,U,2),$PIECE(VALUE,U,4),"V")=""
+17 SET VALUE=$$FED^BQITRUTL("",BQDFN,"493")
+18 IF VALUE
SET VTMP($PIECE(VALUE,U,2),$PIECE(VALUE,U,4),"V")=""
+19 ;
+20 ; Check for Asthma Control
+21 SET IEN=""
+22 FOR
SET IEN=$ORDER(^AUPNVAST("AC",BQDFN,IEN))
IF IEN=""
QUIT
Begin DoDot:1
+23 IF $PIECE(^AUPNVAST(IEN,0),U,14)=""
QUIT
+24 SET VISIT=$PIECE(^AUPNVAST(IEN,0),U,3)
IF VISIT=""
QUIT
+25 SET DTM=$PIECE($GET(^AUPNVSIT(VISIT,0)),U,1)\1
IF DTM=0
QUIT
+26 SET VTMP(DTM,VISIT,"V")=""
End DoDot:1
+27 ;
+28 ; Check Problem List for addition/modification for Asthma Severity Classification
+29 SET CLSN=$ORDER(^APCDPLCL("B","ASTHMA SEVERITY",""))
IF CLSN'=""
Begin DoDot:1
+30 SET TXIEN=$PIECE(^APCDPLCL(CLSN,0),U,2)
SET TXNMY($PIECE(^ATXAX(TXIEN,0),U,1))=""
+31 DO PROB^BQIDCUTL(BQDFN,.TXNMY,.TEMP)
+32 SET DTM=""
SET QFL=0
+33 FOR
SET DTM=$ORDER(TEMP(DTM),-1)
IF DTM=""
QUIT
Begin DoDot:2
+34 SET IEN=""
+35 FOR
SET IEN=$ORDER(TEMP(DTM,IEN),-1)
IF IEN=""
QUIT
Begin DoDot:3
+36 IF $PIECE(^AUPNPROB(IEN,0),U,15)=""
QUIT
+37 SET QFL=1
SET VTMP(DTM,IEN,"P")=""
End DoDot:3
IF QFL
QUIT
End DoDot:2
IF QFL
QUIT
End DoDot:1
+38 ;
+39 SET DATM=$ORDER(VTMP(""),-1)
+40 IF DATM=""
QUIT ""
+41 SET IEN=$ORDER(VTMP(DATM,""),-1)
SET TYP=$ORDER(VTMP(DATM,IEN,""))
+42 SET TYP=$SELECT("P":9000011,1:9000010)
+43 QUIT DATM_U_TYP_":"_IEN
+44 ;
DSP(ASDFN,ASIEN) ; EP - Display Care Mgmt field
+1 NEW CODE,VALUE,RESULT,ASPIEN,CRIEN,CMSN,LINK
+2 SET CODE=$PIECE($GET(^BQI(90506.1,ASIEN,0)),U,1)
IF CODE=""
QUIT ""
+3 SET CMSN=$PIECE($GET(^BQI(90506.1,ASIEN,3)),U,1)
IF CMSN=""
QUIT ""
+4 SET CRIEN=$ORDER(^BQIPAT(ASDFN,60,"B",CMSN,""))
IF CRIEN=""
QUIT ""
+5 SET ASPIEN=""
SET VALUE=""
SET HOVER=""
SET LINK=""
SET RESULT=""
+6 FOR
SET ASPIEN=$ORDER(^BQIPAT(ASDFN,60,CRIEN,1,"B",CODE,ASPIEN))
IF ASPIEN=""
QUIT
Begin DoDot:1
+7 SET VALUE=$PIECE($GET(^BQIPAT(ASDFN,60,CRIEN,1,ASPIEN,0)),U,2)
+8 SET HOVER=$PIECE($GET(^BQIPAT(ASDFN,60,CRIEN,1,ASPIEN,0)),U,5)
+9 SET LINK=$PIECE($GET(^BQIPAT(ASDFN,60,CRIEN,1,ASPIEN,0)),U,4)
End DoDot:1
+10 ;I VALUE'="" S RESULT=VALUE_$C(26)_HOVER_$C(26)_LINK
+11 IF VALUE'=""
IF HOVER'=""
SET RESULT=VALUE_$CHAR(26)_HOVER_$CHAR(26)_LINK
+12 IF '$TEST
SET RESULT=VALUE
+13 QUIT RESULT
