BGP3D28 ; IHS/CMI/LAB - measure I2 ;
;;13.0;IHS CLINICAL REPORTING;;NOV 20, 2012;Build 81
;
IAA ;EP - ASTHMA ASSESSMENTS
S (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7,BGPN8,BGPN9,BGPN10,BGPN11,BGPN12,BGPN13,BGPD1,BGPD2,BGPD3,BGPD4,BGPD5,BGPD6,BGPD7,BGPD8,BGPAMP,BGPASD,BGPACON,BGPSFD,BGPSWD)=0
I BGPAGEB<5 S BGPSTOP=1 Q
I $$EMP^BGP3D22(DFN,$$DOB^AUPNPAT(DFN),BGPEDATE) S BGPSTOP=1 Q ;has dx of emphysema
I $$COPD^BGP3D22(DFN,$$DOB^AUPNPAT(DFN),BGPEDATE) S BGPSTOP=1 Q ;has copd
S (BGPASTH1,BGPASTH2)=$$ASSEV^BGP3D22(DFN,BGPEDATE)
I BGPASTH1="" S BGPASTH1=$$PERASTH^BGP3D22(DFN,$$FMADD^XLFDT(BGPBDATE,-365),BGPBDATE)
I BGPASTH2="" S BGPASTH2=$$PERASTH^BGP3D22(DFN,BGPBDATE,BGPEDATE)
I 'BGPASTH1!('BGPASTH2) K ^TMP($J,"A") S BGPSTOP=1 Q ;not asthma in both time periods
K ^TMP($J,"A")
I BGPACTCL S BGPD1=1
I BGPACTCL,BGPAGEB>4,BGPAGEB<15 S BGPD2=1
I BGPACTCL,BGPAGEB>14,BGPAGEB<35 S BGPD3=1
I BGPACTCL,BGPAGEB>34,BGPAGEB<65 S BGPD4=1
I BGPACTUP,BGPAGEB>64 S BGPD5=1
S BGPAMP=$$ASMP(DFN,BGPBDATE,BGPEDATE) ;RETURN Mgmt Plan: date
I BGPAMP]"" S BGPN1=1
S BGPASD=$$SEV^BGP3D31(DFN,$$DOB^AUPNPAT(DFN),BGPEDATE)
I BGPASD]"" S BGPN2=1
S BGPACON=$$ACON(DFN,BGPBDATE,BGPEDATE,1)
I BGPACON]"" S BGPN3=1
S BGPSFD=$$SFD(DFN,BGPBDATE,BGPEDATE)
I BGPSFD]"" S BGPN4=1 S Y=$P(BGPSFD,U,2) D
.I Y<6 S BGPN5=1 Q
.I Y>5,Y<13 S BGPN6=1 Q
.I Y>12 S BGPN7=1 Q
S BGPSWD=$$ADM(DFN,BGPBDATE,BGPEDATE)
I BGPSWD]"" S BGPN8=1 S Y=$P(BGPSWD,U,2) D
.I Y<3 S BGPN9=1 Q
.I Y>2,Y<8 S BGPN10=1 Q
.I Y>7 S BGPN11=1 Q
S BGPVALUE=$S(BGPRTYPE=3:"",BGPD2:"UP;",1:"")_$S(BGPD1:"AC",1:"")_" "_$P(BGPASTH1,U,2)_" "_$S(BGPASTH1'=BGPASTH2:$P(BGPASTH2,U,2),1:"")_"|||"
S N=""
I BGPAMP]"" D
.S N=$S(N]"":N_"; ",1:"")_BGPAMP
I BGPASD]"" D
.S N=$S(N]"":N_"; ",1:"")_"Severity: "_BGPASD
I BGPACON]"" D
.S N=$S(N]"":N_"; ",1:"")_BGPACON
I BGPSFD]"" D
.S N=$S(N]"":N_"; ",1:"")_$P(BGPSFD,U,1)
I BGPSWD]"" D
.S N=$S(N]"":N_"; ",1:"")_$P(BGPSWD,U,1)
S BGPVALUE=BGPVALUE_N
K ^TMP($J,"A")
Q
ASMP(P,BD,ED) ;
NEW Y,BGPX,BGPM
S BGPX=0,Y="" F S BGPX=$O(^AUTTEDT("C","ASM-SMP",BGPX)) Q:BGPX'=+BGPX D
.S Y=$$LASTITEM^APCLAPIU(P,"`"_BGPX,"EDUCATION",BD,ED,"D")
.Q:Y=""
.S BGPM(Y)=""
S Y=$O(BGPM(0))
I Y="" Q ""
Q "Mgmt Plan: "_$$DATE^BGP3UTL(Y)
;
SFD(P,BD,ED) ;
NEW Y,B,E,Z,G,H,B,E,X
S B=9999999-BD
S E=9999999-ED,E=E-1
S Z=$O(^AUTTMSR("B","ASFD",0))
S G="",H=""
F S E=$O(^AUPNVMSR("AA",P,Z,E)) Q:E'=+E!(E>B) D
.S X=0 F S X=$O(^AUPNVMSR("AA",P,Z,E,X)) Q:X'=+X D
..S G=(9999999-E),H=$P(^AUPNVMSR(X,0),U,4)
I G="" Q ""
Q "Symptom Free Days: "_$$DATE^BGP3UTL(G)_" ["_H_"]"_U_H
;
;
;
ADM(P,BD,ED) ;
NEW Y,B,E,Z,G,H,B,E,X
S B=9999999-BD
S E=9999999-ED,E=E-1
S Z=$O(^AUTTMSR("B","ADM",0))
S G="",H=""
F S E=$O(^AUPNVMSR("AA",P,Z,E)) Q:E'=+E!(E>B) D
.S X=0 F S X=$O(^AUPNVMSR("AA",P,Z,E,X)) Q:X'=+X D
..S G=(9999999-E),H=$P(^AUPNVMSR(X,0),U,4)
I G="" Q ""
Q "Days Missed: "_$$DATE^BGP3UTL(G)_" ["_H_"]"_U_H
;
;
ACON(P,BD,ED,F) ;EP - return last ASTHMA CONTROL recorded
NEW D,LAST,E,S,G
I '$G(P) Q ""
I '$G(F) S F=1
S G="",E=0 F S E=$O(^AUPNVAST("AC",P,E)) Q:E'=+E!(G) D
.S D=$$VD^APCLV($P(^AUPNVAST(E,0),U,3))
.Q:D<BD
.Q:D>ED
.Q:$P(^AUPNVAST(E,0),U,14)=""
.S G=D
I G="" Q ""
I F=1 Q "Control: "_$$DATE^BGP3UTL(G)
;
Q ""
;
BGP3D28 ; IHS/CMI/LAB - measure I2 ;
+1 ;;13.0;IHS CLINICAL REPORTING;;NOV 20, 2012;Build 81
+2 ;
IAA ;EP - ASTHMA ASSESSMENTS
+1 SET (BGPN1,BGPN2,BGPN3,BGPN4,BGPN5,BGPN6,BGPN7,BGPN8,BGPN9,BGPN10,BGPN11,BGPN12,BGPN13,BGPD1,BGPD2,BGPD3,BGPD4,BGPD5,BGPD6,BGPD7,BGPD8,BGPAMP,BGPASD,BGPACON,BGPSFD,BGPSWD)=0
+2 IF BGPAGEB<5
SET BGPSTOP=1
QUIT
+3 ;has dx of emphysema
IF $$EMP^BGP3D22(DFN,$$DOB^AUPNPAT(DFN),BGPEDATE)
SET BGPSTOP=1
QUIT
+4 ;has copd
IF $$COPD^BGP3D22(DFN,$$DOB^AUPNPAT(DFN),BGPEDATE)
SET BGPSTOP=1
QUIT
+5 SET (BGPASTH1,BGPASTH2)=$$ASSEV^BGP3D22(DFN,BGPEDATE)
+6 IF BGPASTH1=""
SET BGPASTH1=$$PERASTH^BGP3D22(DFN,$$FMADD^XLFDT(BGPBDATE,-365),BGPBDATE)
+7 IF BGPASTH2=""
SET BGPASTH2=$$PERASTH^BGP3D22(DFN,BGPBDATE,BGPEDATE)
+8 ;not asthma in both time periods
IF 'BGPASTH1!('BGPASTH2)
KILL ^TMP($JOB,"A")
SET BGPSTOP=1
QUIT
+9 KILL ^TMP($JOB,"A")
+10 IF BGPACTCL
SET BGPD1=1
+11 IF BGPACTCL
IF BGPAGEB>4
IF BGPAGEB<15
SET BGPD2=1
+12 IF BGPACTCL
IF BGPAGEB>14
IF BGPAGEB<35
SET BGPD3=1
+13 IF BGPACTCL
IF BGPAGEB>34
IF BGPAGEB<65
SET BGPD4=1
+14 IF BGPACTUP
IF BGPAGEB>64
SET BGPD5=1
+15 ;RETURN Mgmt Plan: date
SET BGPAMP=$$ASMP(DFN,BGPBDATE,BGPEDATE)
+16 IF BGPAMP]""
SET BGPN1=1
+17 SET BGPASD=$$SEV^BGP3D31(DFN,$$DOB^AUPNPAT(DFN),BGPEDATE)
+18 IF BGPASD]""
SET BGPN2=1
+19 SET BGPACON=$$ACON(DFN,BGPBDATE,BGPEDATE,1)
+20 IF BGPACON]""
SET BGPN3=1
+21 SET BGPSFD=$$SFD(DFN,BGPBDATE,BGPEDATE)
+22 IF BGPSFD]""
SET BGPN4=1
SET Y=$PIECE(BGPSFD,U,2)
Begin DoDot:1
+23 IF Y<6
SET BGPN5=1
QUIT
+24 IF Y>5
IF Y<13
SET BGPN6=1
QUIT
+25 IF Y>12
SET BGPN7=1
QUIT
End DoDot:1
+26 SET BGPSWD=$$ADM(DFN,BGPBDATE,BGPEDATE)
+27 IF BGPSWD]""
SET BGPN8=1
SET Y=$PIECE(BGPSWD,U,2)
Begin DoDot:1
+28 IF Y<3
SET BGPN9=1
QUIT
+29 IF Y>2
IF Y<8
SET BGPN10=1
QUIT
+30 IF Y>7
SET BGPN11=1
QUIT
End DoDot:1
+31 SET BGPVALUE=$SELECT(BGPRTYPE=3:"",BGPD2:"UP;",1:"")_$SELECT(BGPD1:"AC",1:"")_" "_$PIECE(BGPASTH1,U,2)_" "_$SELECT(BGPASTH1'=BGPASTH2:$PIECE(BGPASTH2,U,2),1:"")_"|||"
+32 SET N=""
+33 IF BGPAMP]""
Begin DoDot:1
+34 SET N=$SELECT(N]"":N_"; ",1:"")_BGPAMP
End DoDot:1
+35 IF BGPASD]""
Begin DoDot:1
+36 SET N=$SELECT(N]"":N_"; ",1:"")_"Severity: "_BGPASD
End DoDot:1
+37 IF BGPACON]""
Begin DoDot:1
+38 SET N=$SELECT(N]"":N_"; ",1:"")_BGPACON
End DoDot:1
+39 IF BGPSFD]""
Begin DoDot:1
+40 SET N=$SELECT(N]"":N_"; ",1:"")_$PIECE(BGPSFD,U,1)
End DoDot:1
+41 IF BGPSWD]""
Begin DoDot:1
+42 SET N=$SELECT(N]"":N_"; ",1:"")_$PIECE(BGPSWD,U,1)
End DoDot:1
+43 SET BGPVALUE=BGPVALUE_N
+44 KILL ^TMP($JOB,"A")
+45 QUIT
ASMP(P,BD,ED) ;
+1 NEW Y,BGPX,BGPM
+2 SET BGPX=0
SET Y=""
FOR
SET BGPX=$ORDER(^AUTTEDT("C","ASM-SMP",BGPX))
IF BGPX'=+BGPX
QUIT
Begin DoDot:1
+3 SET Y=$$LASTITEM^APCLAPIU(P,"`"_BGPX,"EDUCATION",BD,ED,"D")
+4 IF Y=""
QUIT
+5 SET BGPM(Y)=""
End DoDot:1
+6 SET Y=$ORDER(BGPM(0))
+7 IF Y=""
QUIT ""
+8 QUIT "Mgmt Plan: "_$$DATE^BGP3UTL(Y)
+9 ;
SFD(P,BD,ED) ;
+1 NEW Y,B,E,Z,G,H,B,E,X
+2 SET B=9999999-BD
+3 SET E=9999999-ED
SET E=E-1
+4 SET Z=$ORDER(^AUTTMSR("B","ASFD",0))
+5 SET G=""
SET H=""
+6 FOR
SET E=$ORDER(^AUPNVMSR("AA",P,Z,E))
IF E'=+E!(E>B)
QUIT
Begin DoDot:1
+7 SET X=0
FOR
SET X=$ORDER(^AUPNVMSR("AA",P,Z,E,X))
IF X'=+X
QUIT
Begin DoDot:2
+8 SET G=(9999999-E)
SET H=$PIECE(^AUPNVMSR(X,0),U,4)
End DoDot:2
End DoDot:1
+9 IF G=""
QUIT ""
+10 QUIT "Symptom Free Days: "_$$DATE^BGP3UTL(G)_" ["_H_"]"_U_H
+11 ;
+12 ;
+13 ;
ADM(P,BD,ED) ;
+1 NEW Y,B,E,Z,G,H,B,E,X
+2 SET B=9999999-BD
+3 SET E=9999999-ED
SET E=E-1
+4 SET Z=$ORDER(^AUTTMSR("B","ADM",0))
+5 SET G=""
SET H=""
+6 FOR
SET E=$ORDER(^AUPNVMSR("AA",P,Z,E))
IF E'=+E!(E>B)
QUIT
Begin DoDot:1
+7 SET X=0
FOR
SET X=$ORDER(^AUPNVMSR("AA",P,Z,E,X))
IF X'=+X
QUIT
Begin DoDot:2
+8 SET G=(9999999-E)
SET H=$PIECE(^AUPNVMSR(X,0),U,4)
End DoDot:2
End DoDot:1
+9 IF G=""
QUIT ""
+10 QUIT "Days Missed: "_$$DATE^BGP3UTL(G)_" ["_H_"]"_U_H
+11 ;
+12 ;
ACON(P,BD,ED,F) ;EP - return last ASTHMA CONTROL recorded
+1 NEW D,LAST,E,S,G
+2 IF '$GET(P)
QUIT ""
+3 IF '$GET(F)
SET F=1
+4 SET G=""
SET E=0
FOR
SET E=$ORDER(^AUPNVAST("AC",P,E))
IF E'=+E!(G)
QUIT
Begin DoDot:1
+5 SET D=$$VD^APCLV($PIECE(^AUPNVAST(E,0),U,3))
+6 IF D<BD
QUIT
+7 IF D>ED
QUIT
+8 IF $PIECE(^AUPNVAST(E,0),U,14)=""
QUIT
+9 SET G=D
End DoDot:1
+10 IF G=""
QUIT ""
+11 IF F=1
QUIT "Control: "_$$DATE^BGP3UTL(G)
+12 ;
+13 QUIT ""
+14 ;
