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

BDMD81G.m

Go to the documentation of this file. 
  1. BDMD81G ; IHS/CMI/LAB - calc indicators 16 Jan 2007 8:13 PM ;
  1.  ;;2.0;DIABETES MANAGEMENT SYSTEM;**2**;JUN 14, 2007
  1.  ;
  1. ACTDMPT(DFN,BDMBDAT,BDMEDAT,BDMCOMT,BDMBEN,BDM3YE) ;EP
  1.  K BDM365,BDMACUP,BDMACCL,BDMAGEB,BDMAGEE,BDMSEX,BDMDM1,BDMDM2,BDMFDMD,BDM2V,BDM2DMV,BDM1DMV,BDMDMD1,BDMDMD2,BDMDMD3,BDMDMD5
  1.  S BDM365=BDMBDAT,BDMDMD2=0
  1.  S BDMACUP=$$ACTUP(DFN,BDM3YE,BDMEDAT,BDMCOMT,BDMBEN) ;user pop
  1.  I 'BDMACUP Q 0
  1.  S BDMACCL=$$ACTCL(DFN,BDM3YE,BDMEDAT) ;active clinical
  1.  I 'BDMACCL Q 0 ;not active clinical
  1.  S BDMAGEB=$$AGE^AUPNPAT(DFN,BDMBDAT)
  1.  S BDMAGEE=$$AGE^AUPNPAT(DFN,BDMEDAT)
  1.  S BDMSEX=$P(^DPT(DFN,0),U,2)
  1.  S BDMDM1=$$DM(DFN,,BDMEDAT) ;dm diagnosis ever?
  1.  S BDMDM2=$$DM(DFN,BDM365,BDMEDAT) ;dm diagnosis in past year
  1.  I BDMDM1 D  ;set up 4 dm demoninators
  1.  .S BDMFDMD=$$FIRSTDM(DFN,BDMEDAT) ;1 OR 0 FIRST DX BEFORE BEG
  1.  .S BDM2V=$$V2(DFN,BDM365,BDMEDAT)
  1.  .S BDM2DMV=$$V2DM(DFN,$$DOB^AUPNPAT(DFN),BDMEDAT)
  1.  .S BDM1DMV=$$V1DM(DFN,BDM365,BDMEDAT)
  1.  .S BDMDMD2=0 I BDMFDMD,BDM2V,BDM2DMV,BDMACCL S BDMDMD2=1
  1.  K ^TMP($J,"A")
  1.  K BDM365,BDMACUP,BDMACCL,BDMAGEB,BDMAGEE,BDMSEX,BDMDM1,BDMDM2,BDMFDMD,BDM2V,BDM2DMV,BDM1DMV,BDMDMD1
  1.  Q BDMDMD2
  1. V1DM(P,D,EDATE) ;
  1.  I '$G(P) Q ""
  1.  I '$D(^AUPNVSIT("AC",P)) Q ""
  1.  S PC=$O(^ATXAX("B","BDM PRIMARY CARE CLINICS",0))
  1.  I 'PC Q ""
  1.  ;I 'PP Q ""
  1.  K ^TMP($J,"A")
  1.  S A="^TMP($J,""A"",",B=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(D)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(B,A)
  1.  I '$D(^TMP($J,"A",1)) Q ""
  1.  S T=$O(^ATXAX("B","SURVEILLANCE DIABETES",0))
  1.  I 'T Q ""
  1.  S (X,G)=0 F  S X=$O(^TMP($J,"A",X)) Q:X'=+X!(G>2)  S V=$P(^TMP($J,"A",X),U,5) D
  1.  .Q:'$D(^AUPNVSIT(V,0))
  1.  .Q:'$P(^AUPNVSIT(V,0),U,9)
  1.  .Q:$P(^AUPNVSIT(V,0),U,11)
  1.  .Q:"SAHO"'[$P(^AUPNVSIT(V,0),U,7)
  1.  .Q:'$D(^AUPNVPRV("AD",V))
  1.  .;Q:$P(^AUPNVSIT(V,0),U,6)'=DUZ(2) ;PER TERRY
  1.  .Q:'$D(^AUPNVPOV("AD",V))
  1.  .S (D,Y)=0 F  S Y=$O(^AUPNVPOV("AD",V,Y)) Q:Y'=+Y!(D)  I $D(^AUPNVPOV(Y,0)) S %=$P(^AUPNVPOV(Y,0),U) I $$ICD^ATXCHK(%,T,9) S D=1
  1.  .Q:'D
  1.  .Q:"V"[$P(^AUPNVSIT(V,0),U,3)
  1.  .S Y=$$PRIMPROV^APCLV(V,"F")
  1.  .Q:'Y
  1.  .;Q:'$D(^ATXAX(PP,21,"B",Y))
  1.  .Q:$P($G(^DIC(7,Y,9999999)),U,3)'="Y"
  1.  .S Y=$$CLINIC^APCLV(V,"I")
  1.  .Q:'Y
  1.  .Q:'$D(^ATXAX(PC,21,"B",Y))
  1.  .S G=G+1
  1.  .Q
  1.  Q $S(G<1:"",1:1)
  1.  ;
  1. V2(P,BDATE,EDATE) ;
  1.  I '$D(^AUPNVSIT("AC",P)) Q ""
  1.  K ^TMP($J,"A")
  1.  S A="^TMP($J,""A"",",B=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(B,A)
  1.  I '$D(^TMP($J,"A",1)) Q ""
  1.  S (X,G)=0 F  S X=$O(^TMP($J,"A",X)) Q:X'=+X!(G>2)  S V=$P(^TMP($J,"A",X),U,5) D
  1.  .Q:'$D(^AUPNVSIT(V,0))
  1.  .Q:'$P(^AUPNVSIT(V,0),U,9)
  1.  .Q:$P(^AUPNVSIT(V,0),U,11)
  1.  .Q:"SAHO"'[$P(^AUPNVSIT(V,0),U,7)
  1.  .Q:"V"[$P(^AUPNVSIT(V,0),U,3)
  1.  .S G=G+1
  1.  .Q
  1.  Q $S(G<2:"",1:1)
  1.  ;
  1. V2DM(P,BDATE,EDATE) ;
  1.  I '$G(P) Q ""
  1.  I '$D(^AUPNVSIT("AC",P)) Q ""
  1.  K ^TMP($J,"A")
  1.  S A="^TMP($J,""A"",",B=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(B,A)
  1.  I '$D(^TMP($J,"A",1)) Q ""
  1.  S T=$O(^ATXAX("B","SURVEILLANCE DIABETES",0))
  1.  I 'T Q ""
  1.  S (X,G)=0 F  S X=$O(^TMP($J,"A",X)) Q:X'=+X!(G>2)  S V=$P(^TMP($J,"A",X),U,5) D
  1.  .Q:'$D(^AUPNVSIT(V,0))
  1.  .Q:'$P(^AUPNVSIT(V,0),U,9)
  1.  .Q:$P(^AUPNVSIT(V,0),U,11)
  1.  .Q:"SAHO"'[$P(^AUPNVSIT(V,0),U,7)
  1.  .Q:"V"[$P(^AUPNVSIT(V,0),U,3)
  1.  .S (D,Y)=0 F  S Y=$O(^AUPNVPOV("AD",V,Y)) Q:Y'=+Y!(D)  I $D(^AUPNVPOV(Y,0)) S %=$P(^AUPNVPOV(Y,0),U) I $$ICD^ATXCHK(%,T,9) S D=1
  1.  .Q:'D
  1.  .S G=G+1
  1.  .Q
  1.  Q $S(G<2:"",1:1)
  1.  ;
  1. DM(P,BDATE,EDATE) ;EP is patient diabetic 1 or 0
  1.  I $G(BDATE)="" S BDATE=$$DOB^AUPNPAT(P)
  1.  K BDMG
  1.  S Y="BDMG("
  1.  S X=P_"^LAST DX [SURVEILLANCE DIABETES;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,Y)
  1.  I $D(BDMG(1)) Q 1  ;has a dx
  1.  Q 0
  1.  ;
  1. ACTUP(P,BDATE,EDATE,T,B) ;EP - is this patient in user pop?
  1.  I B=1,$$BEN^AUPNPAT(P,"C")'="01" Q 0  ;must be Indian/Alaskan Native
  1.  I B=2,$$BEN^AUPNPAT(P,"C")="01" Q 0  ;must not be I/A
  1.  S DOD=$$DOD^AUPNPAT(P) I DOD]"",DOD<EDATE Q 0
  1.  S X=$P($G(^AUPNPAT(P,11)),U,18) I X="" Q 0
  1.  I '$D(^ATXAX(T,21,"B",($P(^AUPNPAT(P,11),U,18)))),'$D(^ATXAX(T,21,"AA",$P(^AUPNPAT(P,11),U,18),$P(^AUPNPAT(P,11),U,18))) Q 0
  1.  S X=$$LASTVD(P,BDATE,EDATE)
  1.  Q $S(X:1,1:0)
  1.  ;
  1. ACTCL(P,BDATE,EDATE) ;EP - clinical user
  1.  NEW CL S CL=$O(^BDMCNTL("B","DM AUDIT 2005 CLINIC LIST 1",0))
  1.  NEW CL2 S CL2=$O(^BDMCNTL("B","DM AUDIT 2005 CLINIC LIST 2",0))
  1.  S (X,G,F,S)=0 F  S X=$O(^TMP($J,"A",X)) Q:X'=+X!(F)  S V=$P(^TMP($J,"A",X),U,5) D
  1.  .Q:'$D(^AUPNVSIT(V,0))
  1.  .Q:'$P(^AUPNVSIT(V,0),U,9)
  1.  .Q:$P(^AUPNVSIT(V,0),U,11)
  1.  .Q:'$D(^AUPNVPRV("AD",V))
  1.  .Q:"SAHO"'[$P(^AUPNVSIT(V,0),U,7)
  1.  .Q:"V"[$P(^AUPNVSIT(V,0),U,3)
  1.  .S B=$$CLINIC^APCLV(V,"C")
  1.  .Q:B=""
  1.  .I 'G,$D(^BDMCNTL(CL,11,"B",B)) S G=V  ;must be a primary clinic S G=V
  1.  .I V'=G,$D(^BDMCNTL(CL2,11,"B",B)) S S=1
  1.  .I G,S S F=1
  1.  .Q
  1.  Q $S(F:1,1:0)
  1.  ;
  1. FIRSTDM(P,EDATE) ;
  1.  I $G(P)="" Q ""
  1.  K BDMG
  1.  S Y="BDMG("
  1.  S X=P_"^FIRST DX [SURVEILLANCE DIABETES" S E=$$START1^APCLDF(X,Y)
  1.  I '$D(BDMG(1)) Q ""
  1.  S X=$$FMDIFF^XLFDT(EDATE,$P(BDMG(1),U))
  1.  Q $S(X>365:1,1:"")
  1.  ;
  1. LASTVD(P,BDATE,EDATE) ;
  1.  I '$D(^AUPNVSIT("AC",P)) Q ""
  1.  K ^TMP($J,"A")
  1.  S A="^TMP($J,""A"",",B=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(B,A)
  1.  I '$D(^TMP($J,"A",1)) Q ""
  1.  S (X,G)=0 F  S X=$O(^TMP($J,"A",X)) Q:X'=+X!(G)  S V=$P(^TMP($J,"A",X),U,5) D
  1.  .Q:'$D(^AUPNVSIT(V,0))
  1.  .Q:'$P(^AUPNVSIT(V,0),U,9)
  1.  .Q:$P(^AUPNVSIT(V,0),U,11)
  1.  .Q:'$D(^AUPNVPRV("AD",V))
  1.  .Q:"SAHO"'[$P(^AUPNVSIT(V,0),U,7)
  1.  .Q:"V"[$P(^AUPNVSIT(V,0),U,3)
  1.  .S G=1
  1.  .Q
  1.  Q G
  1.  ;
  1. LOINC(A,B) ;
  1.  NEW %
  1.  S %=$P($G(^LAB(95.3,A,9999999)),U,2)
  1.  I %]"",$D(^ATXAX(B,21,"B",%)) Q 1
  1.  S %=$P($G(^LAB(95.3,A,0)),U)_"-"_$P($G(^LAB(95.3,A,0)),U,15)
  1.  I $D(^ATXAX(B,21,"B",%)) Q 1
  1.  Q ""