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

BDMD811.m

Go to the documentation of this file. 
  1. BDMD811 ; IHS/CMI/LAB -IHS -CUMULATIVE REPORT ;
  1.  ;;2.0;DIABETES MANAGEMENT SYSTEM;**2**;JUN 14, 2007
  1.  ;
  1.  ;
  1. IMM ;
  1.  S:'$D(BDMCUML(140)) BDMCUML(140)="IMMUNIZATIONS"
  1.  S $P(BDMCUML(140),U,2)=$P(BDMCUML(140),U,2)+1
  1.  S V=$G(^XTMP("BDMDM81",BDMJOB,BDMBTH,"AUDIT",BDMPD,64))
  1.  I $E(V)="Y" S $P(BDMCUML(140),U,3)=$P(BDMCUML(140),U,3)+1
  1.  I $E(V)="R" S $P(BDMCUML(140),U,6)=$P(BDMCUML(140),U,6)+1
  1.  S V=$G(^XTMP("BDMDM81",BDMJOB,BDMBTH,"AUDIT",BDMPD,66))
  1.  I $E(V)="Y" S $P(BDMCUML(140),U,4)=$P(BDMCUML(140),U,4)+1
  1.  I $E(V)="R" S $P(BDMCUML(140),U,7)=$P(BDMCUML(140),U,7)+1
  1.  S V=$G(^XTMP("BDMDM81",BDMJOB,BDMBTH,"AUDIT",BDMPD,68))
  1.  I $E(V)="Y" S $P(BDMCUML(140),U,5)=$P(BDMCUML(140),U,5)+1
  1.  I $E(V)="R" S $P(BDMCUML(140),U,8)=$P(BDMCUML(140),U,8)+1
  1.  ;
  1. QUAN ;
  1.  ;145
  1.  ;title^total^uacr^upcr^other quant^albumin normal^micro present^overt present
  1.  K BDMOFLG
  1.  S BDMOFLG=0
  1.  ;I '$D(^MAW($J,"UACR")) S ^MAW($J,"UACR")=0
  1.  ;I '$D(^MAW($J,"UPCR")) S ^MAW($J,"UPCR")=0
  1.  ;I '$D(^MAW($J,"OTH")) S ^MAW($J,"OTH")=0
  1.  S:'$D(BDMCUML(145)) BDMCUML(145)="URINALYSIS"
  1.  ;S:'$D(BDMCUML(146)) BDMCUML(146)="Total Urine Prot Not Known"
  1.  S V=$G(^XTMP("BDMDM81",BDMJOB,BDMBTH,"AUDIT",BDMPD,91))
  1.  ;S V=$$UACR^BDMD81C(BDMPD,BDMBDAT,BDMADAT) ;cmi/maw 12/17/2007 DM2008
  1.  ;S A=$$UPCR^BDMD81C(BDMPD,BDMBDAT,BDMADAT) ;cmi/maw 12/17/2007 DM2008
  1.  ;S O=$$QUAN^BDMD81C(BDMPD,BDMBDAT,BDMADAT) ;cmi/maw 12/17/2007 DM2008
  1.  S A=$G(^XTMP("BDMDM81",BDMJOB,BDMBTH,"AUDIT",BDMPD,93))
  1.  S O=$G(^XTMP("BDMDM81",BDMJOB,BDMBTH,"AUDIT",BDMPD,95))
  1.  I $E(V)="X" D
  1.  .;S $P(BDMCUML(146),U,2)=$P(BDMCUML(146),U,2)+1  ;1/9/08
  1.  .S $P(BDMCUML(145),U,2)=$P(BDMCUML(145),U,2)+1  ;added for total 1/9/08
  1.  .S $P(BDMCUML(145),U,3)=$P(BDMCUML(145),U,3)+1
  1.  .;S ^MAW($J,"UACR")=^MAW($J,"UACR")+1
  1.  .I $P(V,U,2)]"",$P(V,U,2)["<" S $P(BDMCUML(145),U,6)=$P(BDMCUML(145),U,6)+1 Q  ;albumin normal
  1.  .I $P(V,U,2)]"",$P(V,U,2)["-" S $P(BDMCUML(145),U,7)=$P(BDMCUML(145),U,7)+1 Q  ;micro
  1.  .I $P(V,U,2)]"",$P(V,U,2)[">" S $P(BDMCUML(145),U,8)=$P(BDMCUML(145),U,8)+1 Q  ;overt
  1.  .I $P(V,U,2)]"" S $P(V,U,2)=$$STV^BDMD818($P(V,U,2),9) ;if stripping chars evals to null quit
  1.  .Q:$P(V,U,2)=""  ;don't count if all chars were alpha
  1.  .I $P(V,U,2)]"",$P(V,U,2)<30 S $P(BDMCUML(145),U,6)=$P(BDMCUML(145),U,6)+1  ;albumin normal
  1.  .I $P(V,U,2)]"",$P(V,U,2)>30,$P(V,U,2)<299.9 S $P(BDMCUML(145),U,7)=$P(BDMCUML(145),U,7)+1  ;micro present
  1.  .I $P(V,U,2)]"",$P(V,U,2)>299.9 S $P(BDMCUML(145),U,8)=$P(BDMCUML(145),U,8)+1  ;overt
  1.  I $E(A)="X" D
  1.  . ;S BDMOFLG=1,$P(BDMCUML(146),U,2)=$P(BDMCUML(146),U,2)+1  ;1/9/08
  1.  . S $P(BDMCUML(145),U,2)=$P(BDMCUML(145),U,2)+1  ;added for total 1/9/08
  1.  . Q:$E(V)="X"
  1.  . ;S ^MAW($J,"UPCR")=^MAW($J,"UPCR")+1
  1.  . S $P(BDMCUML(145),U,4)=$P(BDMCUML(145),U,4)+1
  1.  I $E(O)="X" D
  1.  . ;S BDMOFLG=1,$P(BDMCUML(146),U,2)=$P(BDMCUML(146),U,2)+1  ;1/9/08
  1.  . S $P(BDMCUML(145),U,2)=$P(BDMCUML(145),U,2)+1  ;added for total 1/9/08
  1.  . Q:$E(V)="X"
  1.  . Q:$E(A)="X"
  1.  . ;S ^MAW($J,"OTH")=^MAW($J,"OTH")+1
  1.  . S $P(BDMCUML(145),U,5)=$P(BDMCUML(145),U,5)+1
  1.  ;S OV=$G(^XTMP("BDMDM81",BDMJOB,BDMBTH,"AUDIT",BDMPD,94))
  1.  ;I $E(OV)="Y" S $P(BDMCUML(145),U,8)=$P(BDMCUML(145),U,8)+1
  1.  ;S Q=$G(^XTMP("BDMDM81",BDMJOB,BDMBTH,"AUDIT",BDMPD,96))
  1.  ;I $E(Q,1,3)="Pos" S $P(BDMCUML(145),U,7)=$P(BDMCUML(145),U,7)+1
  1.  K BDMOFLG  ;1/9/08
  1. URIN ;cmi/maw 12/26/2007 no longer needed DM2008
  1.  ;title^total^total with urinalysis^protein present^protein absent^protein not done^micro present^micro absent^micro not done
  1.  ;145
  1.  ;'$D(BDMCUML(146)) BDMCUML(146)="URINALYSIS"
  1.  ;S $P(BDMCUML(146),U,2)=$P(BDMCUML(146),U,2)+1
  1.  ;S V=$G(^XTMP("BDMDM81",BDMJOB,BDMBTH,"AUDIT",BDMPD,92))
  1.  ;S A=$G(^XTMP("BDMDM81",BDMJOB,BDMBTH,"AUDIT",BDMPD,94))
  1.  ;I $E(V)="Y" S $P(BDMCUML(145),U,3)=$P(BDMCUML(145),U,3)+1
  1.  ;I $E(A)="Y" S $P(BDMCUML(145),U,4)=$P(BDMCUML(145),U,4)+1
  1.  ;I A["No result" S $P(BDMCUML(145),U,6)=$P(BDMCUML(145),U,6)+1 G EKG
  1.  ;I $E(A)="N" S $P(BDMCUML(145),U,5)=$P(BDMCUML(145),U,5)+1 D
  1.  ;.S V=$G(^XTMP("BDMDM81",BDMJOB,BDMBTH,"AUDIT",BDMPD,96))
  1.  ;.I $E(V,1,3)="Pos" S $P(BDMCUML(145),U,7)=$P(BDMCUML(145),U,7)+1 Q
  1.  ;.I $E(V,1,3)="Neg" S $P(BDMCUML(145),U,8)=$P(BDMCUML(145),U,8)+1 Q
  1.  ;.S $P(BDMCUML(145),U,9)=$P(BDMCUML(145),U,9)+1
  1.  ;.Q
  1. EKG ;need date of last ekg
  1.  S:'$D(BDMCUML(150)) BDMCUML(150)="EKG"
  1.  G:$$AGE^AUPNPAT(BDMPD,BDMADAT)<30 CREAT
  1.  S $P(BDMCUML(150),U,2)=$P(BDMCUML(150),U,2)+1
  1.  S V=$$EKG^BDMD812(BDMPD,BDMRED,"I")
  1.  I V]"" D
  1.  .S E=$$FMDIFF^XLFDT(BDMADAT,V)
  1.  .I E<(365.25*3) S $P(BDMCUML(150),U,3)=$P(BDMCUML(150),U,3)+1
  1.  .I E<(365.25*5) S $P(BDMCUML(150),U,4)=$P(BDMCUML(150),U,4)+1
  1.  .S $P(BDMCUML(150),U,5)=$P(BDMCUML(150),U,5)+1
  1. CREAT ;
  1.  S:'$D(BDMCUML(170)) BDMCUML(170)="Creatinine obtained in the past 12 months"
  1.  S $P(BDMCUML(170),U,2)=$P(BDMCUML(170),U,2)+1
  1.  S V=$$CREAT^BDMD818(BDMPD,BDMBDAT,BDMADAT,"I")
  1.  I V="" S $P(BDMCUML(170),U,5)=$P(BDMCUML(170),U,5)+1 G TCHOL
  1.  S V=$P(V,U)
  1.  I $E(V)'=+$E(V),$E(V)'="." S $P(BDMCUML(170),U,6)=$P(BDMCUML(170),U,6)+1 G TCHOL ;unable to determine result, not a number
  1.  I V>1.9 S $P(BDMCUML(170),U,3)=$P(BDMCUML(170),U,3)+1
  1.  I V<2.0 S $P(BDMCUML(170),U,4)=$P(BDMCUML(170),U,4)+1
  1.  ;
  1. GFR ;
  1.  S:'$D(BDMCUML(175)) BDMCUML(175)="Estimated GFR documented in the past 12 months"
  1.  S $P(BDMCUML(175),U,2)=$P(BDMCUML(175),U,2)+1
  1.  ;S V=$$GFR^BDMD81C(BDMPD,BDMBDAT,BDMADAT)
  1.  S V=$G(^XTMP("BDMDM81",BDMJOB,BDMBTH,"AUDIT",BDMPD,79))  ;maw 1/18/08
  1.  I V="Yes" S $P(BDMCUML(175),U,5)=$P(BDMCUML(175),U,5)+1
  1.  ;
  1. TCHOL ;
  1.  S:'$D(BDMCUML(180)) BDMCUML(180)="Total Cholesterol obtained in past 12 months"
  1.  S $P(BDMCUML(180),U,2)=$P(BDMCUML(180),U,2)+1
  1.  S V=$$CHOL^BDMD818(BDMPD,BDMBDAT,BDMADAT,"I")
  1.  I V="" S $P(BDMCUML(180),U,6)=$P(BDMCUML(180),U,6)+1 G LDL
  1.  S V=$P(V,U)
  1.  I $E(V)'=+$E(V) S $P(BDMCUML(180),U,7)=$P(BDMCUML(180),U,7)+1 G LDL ;unable to determine result, not a number or is blank
  1.  I V<200 S $P(BDMCUML(180),U,3)=$P(BDMCUML(180),U,3)+1 G LDL
  1.  I V<240 S $P(BDMCUML(180),U,4)=$P(BDMCUML(180),U,4)+1 G LDL
  1.  S $P(BDMCUML(180),U,5)=$P(BDMCUML(180),U,5)+1
  1. LDL ;
  1.  S:'$D(BDMCUML(190)) BDMCUML(190)="LDL Cholesterol obtained in the past 12 months"
  1.  S $P(BDMCUML(190),U,2)=$P(BDMCUML(190),U,2)+1
  1.  S V=$$LDL^BDMD818(BDMPD,BDMBDAT,BDMADAT,"I")
  1.  I V="" S $P(BDMCUML(190),U,7)=$P(BDMCUML(190),U,7)+1 G HDL
  1.  S V=$P(V,U)
  1.  I $E(V)'=+$E(V) S $P(BDMCUML(190),U,8)=$P(BDMCUML(190),U,8)+1 G HDL ;unable to determine result, not a number or blank
  1.  I V<100 S $P(BDMCUML(190),U,3)=$P(BDMCUML(190),U,3)+1 G HDL
  1.  I V<130 S $P(BDMCUML(190),U,4)=$P(BDMCUML(190),U,4)+1 G HDL
  1.  I V<160.1 S $P(BDMCUML(190),U,5)=$P(BDMCUML(190),U,5)+1 G HDL
  1.  S $P(BDMCUML(190),U,6)=$P(BDMCUML(190),U,6)+1
  1. HDL ;
  1.  S:'$D(BDMCUML(195)) BDMCUML(195)="HDL Cholesterol obtained in the past 12 months"
  1.  S $P(BDMCUML(195),U,2)=$P(BDMCUML(195),U,2)+1
  1.  S V=$$HDL^BDMD818(BDMPD,BDMBDAT,BDMADAT,"I")
  1.  I V="" S $P(BDMCUML(195),U,7)=$P(BDMCUML(195),U,7)+1 G TRIG
  1.  S V=$P(V,U)
  1.  I $E(V)'=+$E(V) S $P(BDMCUML(195),U,8)=$P(BDMCUML(195),U,8)+1 G TRIG ;unable to determine result, not a number
  1.  S V=$P(V,".")
  1.  I V<35 S $P(BDMCUML(195),U,3)=$P(BDMCUML(195),U,3)+1 G TRIG
  1.  I V<46 S $P(BDMCUML(195),U,4)=$P(BDMCUML(195),U,4)+1 G TRIG
  1.  I V<55.1 S $P(BDMCUML(195),U,5)=$P(BDMCUML(195),U,5)+1 G TRIG
  1.  S $P(BDMCUML(195),U,6)=$P(BDMCUML(195),U,6)+1
  1. TRIG ;
  1.  S:'$D(BDMCUML(200)) BDMCUML(200)="Triglycerides obtained in past 12 months"
  1.  S $P(BDMCUML(200),U,2)=$P(BDMCUML(200),U,2)+1
  1.  S V=$$TRIG^BDMD818(BDMPD,BDMBDAT,BDMADAT,"I")
  1.  I V="" S $P(BDMCUML(200),U,7)=$P(BDMCUML(200),U,7)+1 G SELF
  1.  S V=$P(V,U)
  1.  I $E(V)'=+$E(V) S $P(BDMCUML(200),U,8)=$P(BDMCUML(200),U,8)+1 G SELF ;unable to determine result, not a number
  1.  I V<150 S $P(BDMCUML(200),U,3)=$P(BDMCUML(200),U,3)+1 G SELF
  1.  I V<200 S $P(BDMCUML(200),U,4)=$P(BDMCUML(200),U,4)+1 G SELF
  1.  I V<401 S $P(BDMCUML(200),U,5)=$P(BDMCUML(200),U,5)+1 G SELF
  1.  S $P(BDMCUML(200),U,6)=$P(BDMCUML(200),U,6)+1
  1. SELF ;
  1.  ;S:'$D(BDMCUML(210)) BDMCUML(210)="Self monitoring of blood glucose documented"
  1.  ;S $P(BDMCUML(210),U,2)=$P(BDMCUML(210),U,2)+1
  1.  ;S V=$G(^XTMP("BDMDM81",BDMJOB,BDMBTH,"AUDIT",BDMPD,98))
  1.  ;S P=$S($E(V)="Y":3,$E(V)="N":4,$E(V)="R":5,1:6)
  1.  ;S $P(BDMCUML(210),U,P)=$P(BDMCUML(210),U,P)+1
  1. SDM  ;
  1.  ;Q  ;NOT IN 2008
  1.  ;S:'$D(BDMCUML(220)) BDMCUML(220)="Participating in SDM"
  1.  ;S $P(BDMCUML(220),U,2)=$P(BDMCUML(220),U,2)+1
  1.  ;S V=$G(^XTMP("BDMDM81",BDMJOB,BDMBTH,"AUDIT",BDMPD,100))
  1.  ;S P=$S($E(V)="Y":3,1:4)
  1.  ;S $P(BDMCUML(220),U,P)=$P(BDMCUML(220),U,P)+1
  1.  Q
  1. PED(P,BDATE,EDATE) ;EP
  1.  K BDMALED
  1.  NEW Y,B,D,T,A,G,Z,V,X
  1.  S Y="BDMALED("
  1.  S X=P_"^ALL EDUC;DURING "_BDATE_"-"_EDATE S E=$$START1^APCLDF(X,Y)
  1.  I $D(BDMALED(1)) S %="" D  I %]"" Q %
  1.  .S (X,D)=0,%="",T="" F  S X=$O(BDMALED(X)) Q:X'=+X!(%]"")  D
  1.  ..S T=$P(^AUPNVPED(+$P(BDMALED(X),U,4),0),U)
  1.  ..Q:'T
  1.  ..Q:'$D(^AUTTEDT(T,0))
  1.  ..S T=$P(^AUTTEDT(T,0),U,2)
  1.  ..I $E(T,1,4)="TO-Q" S %="Yes-"_T_" "_$$FMTE^XLFDT($P(BDMALED(X),U),5) Q
  1.  ..I T="TO-LA" S %="Yes-"_T_" "_$$FMTE^XLFDT($P(BDMALED(X),U),5) 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=0,G="" 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.  .S B=$$CLINIC^APCLV(V,"C")
  1.  .I B=94 S G="Yes-"_$$FMTE^XLFDT($P($P(^AUPNVSIT(V,0),U),"."),5)_" CL 94" Q
  1.  .S Z=0 F  S Z=$O(^AUPNVDEN("AD",V,Z)) Q:Z'=+Z!(G)  S B=$P($G(^AUPNVDEN(Z,0)),U) I B S B=$P($G(^AUTTADA(B,0)),U) I B=1320 S G="Yes-"_$$FMTE^XLFDT($P($P(^AUPNVSIT(V,0),U),"."),5)_" ADA 1320" Q
  1.  .Q
  1.  Q G
  1. CESS(P,B,D) ;EP - find any cessation hf in 12 months before E
  1.  I '$G(P) Q ""
  1.  I $E($$TOBACCO^BDMD816(P,D))'=1 Q ""
  1.  NEW BDM,E,X,G,T
  1.  K BDM
  1.  S X=P_"^LAST HEALTH [DM AUDIT CESSATION HLTH FACTOR;DURING "_B_"-"_D S E=$$START1^APCLDF(X,"BDM(")
  1.  I $D(BDM(1)) Q "Yes-"_$$FMTE^XLFDT($P(BDM(1),U),5)
  1.  S X=P_"^EDUC [DM AUDIT SMOKING CESS EDUC;DURING "_B_"-"_D S E=$$START1^APCLDF(X,"BDM(")
  1.  I $D(BDM(1)) Q "Yes-"_$$FMTE^XLFDT($P(BDM(1),U),5)
  1.  S BDM=$$PED(P,B,D)
  1.  I BDM]"" Q BDM
  1.  NEW T S T=$O(^ATXAX("B","DM AUDIT SMOKING CESS EDUC",0))
  1.  ;I 'T Q "No"
  1.  S (X,G)=0
  1.  I T F  S X=$O(^ATXAX(T,21,X)) Q:X'=+X!(G)  I $$REFUSAL^BDMD817(P,9999999.09,$P(^ATXAX(T,21,X,0),U),B,D) S G=1
  1.  I G Q "Refused"
  1.  S X=$O(^AUTTEDT("C","TO-Q",0))
  1.  I X,$$REFUSAL^BDMD817(P,9999999.09,X,B,D) Q "Refused"
  1.  S X=$O(^AUTTEDT("C","TO-LA",0))
  1.  I X,$$REFUSAL^BDMD817(P,9999999.09,X,B,D) Q "Refused"
  1.  S X=$O(^AUTTEDT("C","TO-QT",0))
  1.  I X,$$REFUSAL^BDMD817(P,9999999.09,X,B,D) Q "Refused"
  1.  S X=$O(^AUTTEDT("C","TO-QU",0))
  1.  I X,$$REFUSAL^BDMD817(P,9999999.09,X,B,D) Q "Refused"
  1.  Q "No"
  1.  ;