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

BGP3D28.m

Go to the documentation of this file. 
  1. BGP3D28 ; IHS/CMI/LAB - measure I2 ;
  1.  ;;13.0;IHS CLINICAL REPORTING;;NOV 20, 2012;Build 81
  1.  ;
  1. IAA ;EP  - ASTHMA ASSESSMENTS
  1.  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
  1.  I BGPAGEB<5 S BGPSTOP=1 Q
  1.  I $$EMP^BGP3D22(DFN,$$DOB^AUPNPAT(DFN),BGPEDATE) S BGPSTOP=1 Q  ;has dx of emphysema
  1.  I $$COPD^BGP3D22(DFN,$$DOB^AUPNPAT(DFN),BGPEDATE) S BGPSTOP=1 Q  ;has copd
  1.  S (BGPASTH1,BGPASTH2)=$$ASSEV^BGP3D22(DFN,BGPEDATE)
  1.  I BGPASTH1="" S BGPASTH1=$$PERASTH^BGP3D22(DFN,$$FMADD^XLFDT(BGPBDATE,-365),BGPBDATE)
  1.  I BGPASTH2="" S BGPASTH2=$$PERASTH^BGP3D22(DFN,BGPBDATE,BGPEDATE)
  1.  I 'BGPASTH1!('BGPASTH2) K ^TMP($J,"A") S BGPSTOP=1 Q  ;not asthma in both time periods
  1.  K ^TMP($J,"A")
  1.  I BGPACTCL S BGPD1=1
  1.  I BGPACTCL,BGPAGEB>4,BGPAGEB<15 S BGPD2=1
  1.  I BGPACTCL,BGPAGEB>14,BGPAGEB<35 S BGPD3=1
  1.  I BGPACTCL,BGPAGEB>34,BGPAGEB<65 S BGPD4=1
  1.  I BGPACTUP,BGPAGEB>64 S BGPD5=1
  1.  S BGPAMP=$$ASMP(DFN,BGPBDATE,BGPEDATE)  ;RETURN Mgmt Plan: date
  1.  I BGPAMP]"" S BGPN1=1
  1.  S BGPASD=$$SEV^BGP3D31(DFN,$$DOB^AUPNPAT(DFN),BGPEDATE)
  1.  I BGPASD]"" S BGPN2=1
  1.  S BGPACON=$$ACON(DFN,BGPBDATE,BGPEDATE,1)
  1.  I BGPACON]"" S BGPN3=1
  1.  S BGPSFD=$$SFD(DFN,BGPBDATE,BGPEDATE)
  1.  I BGPSFD]"" S BGPN4=1 S Y=$P(BGPSFD,U,2) D
  1.  .I Y<6 S BGPN5=1 Q
  1.  .I Y>5,Y<13 S BGPN6=1 Q
  1.  .I Y>12 S BGPN7=1 Q
  1.  S BGPSWD=$$ADM(DFN,BGPBDATE,BGPEDATE)
  1.  I BGPSWD]"" S BGPN8=1 S Y=$P(BGPSWD,U,2) D
  1.  .I Y<3 S BGPN9=1 Q
  1.  .I Y>2,Y<8 S BGPN10=1 Q
  1.  .I Y>7 S BGPN11=1 Q
  1.  S BGPVALUE=$S(BGPRTYPE=3:"",BGPD2:"UP;",1:"")_$S(BGPD1:"AC",1:"")_" "_$P(BGPASTH1,U,2)_" "_$S(BGPASTH1'=BGPASTH2:$P(BGPASTH2,U,2),1:"")_"|||"
  1.  S N=""
  1.  I BGPAMP]"" D
  1.  .S N=$S(N]"":N_"; ",1:"")_BGPAMP
  1.  I BGPASD]"" D
  1.  .S N=$S(N]"":N_"; ",1:"")_"Severity: "_BGPASD
  1.  I BGPACON]"" D
  1.  .S N=$S(N]"":N_"; ",1:"")_BGPACON
  1.  I BGPSFD]"" D
  1.  .S N=$S(N]"":N_"; ",1:"")_$P(BGPSFD,U,1)
  1.  I BGPSWD]"" D
  1.  .S N=$S(N]"":N_"; ",1:"")_$P(BGPSWD,U,1)
  1.  S BGPVALUE=BGPVALUE_N
  1.  K ^TMP($J,"A")
  1.  Q
  1. ASMP(P,BD,ED) ;
  1.  NEW Y,BGPX,BGPM
  1.  S BGPX=0,Y="" F  S BGPX=$O(^AUTTEDT("C","ASM-SMP",BGPX)) Q:BGPX'=+BGPX  D
  1.  .S Y=$$LASTITEM^APCLAPIU(P,"`"_BGPX,"EDUCATION",BD,ED,"D")
  1.  .Q:Y=""
  1.  .S BGPM(Y)=""
  1.  S Y=$O(BGPM(0))
  1.  I Y="" Q ""
  1.  Q "Mgmt Plan: "_$$DATE^BGP3UTL(Y)
  1.  ;
  1. SFD(P,BD,ED) ;
  1.  NEW Y,B,E,Z,G,H,B,E,X
  1.  S B=9999999-BD
  1.  S E=9999999-ED,E=E-1
  1.  S Z=$O(^AUTTMSR("B","ASFD",0))
  1.  S G="",H=""
  1.  F  S E=$O(^AUPNVMSR("AA",P,Z,E)) Q:E'=+E!(E>B)  D
  1.  .S X=0 F  S X=$O(^AUPNVMSR("AA",P,Z,E,X)) Q:X'=+X  D
  1.  ..S G=(9999999-E),H=$P(^AUPNVMSR(X,0),U,4)
  1.  I G="" Q ""
  1.  Q "Symptom Free Days: "_$$DATE^BGP3UTL(G)_" ["_H_"]"_U_H
  1.  ;
  1.  ;
  1.  ;
  1. ADM(P,BD,ED) ;
  1.  NEW Y,B,E,Z,G,H,B,E,X
  1.  S B=9999999-BD
  1.  S E=9999999-ED,E=E-1
  1.  S Z=$O(^AUTTMSR("B","ADM",0))
  1.  S G="",H=""
  1.  F  S E=$O(^AUPNVMSR("AA",P,Z,E)) Q:E'=+E!(E>B)  D
  1.  .S X=0 F  S X=$O(^AUPNVMSR("AA",P,Z,E,X)) Q:X'=+X  D
  1.  ..S G=(9999999-E),H=$P(^AUPNVMSR(X,0),U,4)
  1.  I G="" Q ""
  1.  Q "Days Missed: "_$$DATE^BGP3UTL(G)_" ["_H_"]"_U_H
  1.  ;
  1.  ;
  1. ACON(P,BD,ED,F) ;EP - return last ASTHMA CONTROL recorded
  1.  NEW D,LAST,E,S,G
  1.  I '$G(P) Q ""
  1.  I '$G(F) S F=1
  1.  S G="",E=0 F  S E=$O(^AUPNVAST("AC",P,E)) Q:E'=+E!(G)  D
  1.  .S D=$$VD^APCLV($P(^AUPNVAST(E,0),U,3))
  1.  .Q:D<BD
  1.  .Q:D>ED
  1.  .Q:$P(^AUPNVAST(E,0),U,14)=""
  1.  .S G=D
  1.  I G="" Q ""
  1.  I F=1 Q "Control: "_$$DATE^BGP3UTL(G)
  1.  ;
  1.  Q ""
  1.  ;