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

BDMDB1T.m

Go to the documentation of this file. 
  1. BDMDB1T ; IHS/CMI/LAB - 2014 DIABETES AUDIT ;
  1.  ;;2.0;DIABETES MANAGEMENT SYSTEM;**7,8**;JUN 14, 2007;Build 53
  1.  ;
  1.  ;
  1. TOBACCO(P,BDATE,EDATE) ;EP
  1.  I '$G(P) Q ""
  1.  NEW BDMTOB,BDMSDX,BDMXPND,BDM1320,BDMSCPT,BDMALL,D,%,F,BDMTOBS,BDMTOBC,BDMSBD
  1.  S BDMSBD=BDATE
  1.  D TOBACCOS  ;get last hf in BDMTOBS, BDMTOBC
  1.  ;now get date of latest health factor and check for any of these next things after the HF
  1.  S BDMSBD=$P(BDMTOBS,U,3)
  1.  S BDMSDX=$$DX(P,$S(BDMSBD:BDMSBD,1:BDATE),EDATE)  ;get last dx in format code^date and compare to bdmdob
  1.  I BDMSDX]"",$P(BDMSDX,U,3)>BDMSBD S BDMTOBS=BDMSDX
  1.  S BDMSBD=$P(BDMTOBS,U,3)
  1.  S BDM1320=$$DENT(P,BDMSBD,EDATE)
  1.  I BDM1320]"",$P(BDM1320,U,3)>BDMSBD S BDMTOBS=BDM1320
  1.  S BDMSBD=$P(BDMTOBS,U,3)
  1.  S BDMSCPT=$$CPTSM(P,BDMSBD,EDATE)
  1.  I BDMSCPT]"",$P(BDMSCPT,U,3)>BDMSBD S BDMTOBS=BDMSCPT
  1.  Q BDMTOBS
  1.  ;
  1. DX(P,BDATE,EDATE) ;EP
  1.  NEW BDMG,T,X,G,Y,F,I,Z
  1.  S BDMG=$$LASTDXT^BDMAPIU(P,BDATE,EDATE,"BGP GPRA SMOKING DXS","E")
  1.  I BDMG]"" D  Q G
  1.  .S G=""
  1.  .S I=$P(BDMG,U,4)
  1.  .S F=$P(BDMG,U,5)
  1.  .S Z=$$VAL^XBDIQ1(F,I,.01)
  1.  .; check for non smoker dxs here as well
  1.  .I Z=305.13!(Z="V15.82") S G="2^2  Not a Current User "_$P(BDMG,U,2)_" "_$P(BDMG,U,3)_" "_$$FMTE^XLFDT($P(BDMG,U,1))_U_$P(BDMG,U,1) Q
  1.  .S G="1^1  Current User "_$P(BDMG,U,2)_" "_$P(BDMG,U,3)_" "_$$FMTE^XLFDT($P(BDMG,U,1))_U_$P(BDMG,U,1) Q
  1.  S T=$O(^ATXAX("B","BGP GPRA SMOKING DXS",0))
  1.  S X=0,G="" F  S X=$O(^AUPNPROB("AC",P,X)) Q:X'=+X!(G]"")  D
  1.  .Q:$P(^AUPNPROB(X,0),U,12)'="A"
  1.  .Q:$P(^AUPNPROB(X,0),U,3)>EDATE
  1.  .Q:$P(^AUPNPROB(X,0),U,3)<BDATE
  1.  .S Y=$P(^AUPNPROB(X,0),U)
  1.  .;Q:'$$ICD^ATXCHK(Y,T,9)
  1.  .Q:'$$ICD^BDMUTL(Y,$P(^ATXAX(T,0),U),9)  ;cmi/maw 05/15/2014 p8
  1.  .S Z=$P(^ICD9(Y,0),U,1)
  1.  .;see what the non smoker dxs are here in the BGP SMOKING DXS taxonomy and if many create a new taxonomy to point to
  1.  .I Z="305.13"!(Z="V15.82") S G="2^2  Not a Current User "_$P($$ICDDX^BDMUTL(Y),U,2)_" PROBLEM LIST "_" "_$$FMTE^XLFDT($P(^AUPNPROB(X,0),U,3))_U_$P(^AUPNPROB(X,0),U,3)
  1.  .S G="1^1  Current User "_$P($$ICDDX^BDMUTL(Y),U,2)_" PROBLEM LIST "_" "_$$FMTE^XLFDT($P(^AUPNPROB(X,0),U,3))_U_$P(^AUPNPROB(X,0),U,3)
  1.  .Q
  1.  Q G
  1. TOBACCOS ;EP
  1.  K BDM
  1.  S BDMTOBS="",BDMTOBC=""
  1.  S BDMTOBS=$$LASTHF(P,"TOBACCO (SMOKING)",BDATE,EDATE) K O,D,H
  1.  S BDMTOBC=$$LASTHF(P,"TOBACCO (SMOKELESS - CHEWING/DIP)",BDATE,EDATE) K O,D,H
  1.  I '$O(^AUTTHF("B","TOBACCO (SMOKING)",0)) S BDMTOBS=$$LASTHF(P,"TOBACCO",BDATE,EDATE) K O,D,H
  1.  ;if have both then take the one that indicates tobacco use
  1.  I $P(BDMTOBS,U)=1 Q
  1.  I $P(BDMTOBC,U)=1 S BDMTOBS=BDMTOBC Q
  1.  I BDMTOBS=2 Q
  1.  I BDMTOBC=2 S BDMTOBS=BDMTOBC Q
  1.  Q
  1.  ;
  1. LASTHF(P,C,BDATE,EDATE) ;EP - get last factor in category C for patient P
  1.  S C=$O(^AUTTHF("B",C,0)) ;ien of category passed
  1.  I '$G(C) Q ""
  1.  NEW H,D,O,F,Z
  1.  S (H,D)=0 K O
  1.  F  S H=$O(^AUTTHF("AC",C,H))  Q:'+H  D
  1.  .Q:'$D(^AUPNVHF("AA",P,H))
  1.  .S D="" F  S D=$O(^AUPNVHF("AA",P,H,D)) Q:D'=+D  D
  1.  ..Q:(9999999-D)>EDATE  ;after time frame
  1.  ..Q:(9999999-D)<BDATE  ;before time frame
  1.  ..S Z=$O(^AUPNVHF("AA",P,H,D,0))
  1.  ..S F=$$VAL^XBDIQ1(9000010.23,Z,.01)
  1.  ..I F="SMOKER IN HOME"!(F="SMOKE FREE HOME")!(F["CEREMONIAL")!(F["EXPOSURE TO") Q
  1.  ..S O(D)=$O(^AUPNVHF("AA",P,H,D,""))
  1.  .Q
  1.  S D=$O(O(0))
  1.  ;I D="" Q D
  1.  I D]"" D  Q Z
  1.  .S Z=$$TUHF($$VAL^XBDIQ1(9000010.23,O(D),.01))
  1.  .S Z=Z_U_$S(Z=1:"1  Current User ",1:"2  Not a Current User ")_$$VAL^XBDIQ1(9000010.23,O(D),.01)_"  "_$$FMTE^XLFDT(9999999-D)_"^"_(9999999-D)
  1.  S (H,D)=0 K O
  1.  F  S H=$O(^AUTTHF("AC",C,H))  Q:'+H  D
  1.  .Q:'$D(^AUPNVHF("AA",P,H))
  1.  .S D="" F  S D=$O(^AUPNVHF("AA",P,H,D)) Q:D'=+D  D
  1.  ..Q:(9999999-D)>EDATE  ;after time frame
  1.  ..Q:(9999999-D)<BDATE  ;before time frame
  1.  ..S Z=$O(^AUPNVHF("AA",P,H,D,0))
  1.  ..S F=$$VAL^XBDIQ1(9000010.23,Z,.01)
  1.  ..I F="SMOKER IN HOME"!(F="SMOKE FREE HOME")!(F["CEREMONIAL")!(F["EXPOSURE TO") S O(D)=$O(^AUPNVHF("AA",P,H,D,""))
  1.  .Q
  1.  S D=$O(O(0))
  1.  I D Q 2_"^2  Not a Current User "_$$VAL^XBDIQ1(9000010.23,O(D),.01)_"  "_$$FMTE^XLFDT(9999999-D)_"^"_(9999999-D)
  1.  Q "3^3  Not Documented"
  1.  ;
  1. TUHF(V) ;
  1.  I V="" Q 3
  1.  I V["CURRENT" Q 1
  1.  I V["CESSATION" Q 1
  1.  I V="SMOKELESS TOBACCO, STATUS UNKNOWN" Q 3
  1.  I V["STATUS UNKNOWN" Q 3
  1.  Q 2
  1. PED(P,BDATE,EDATE) ;EP
  1.  NEW BDMG,X,Y,T,D,%
  1.  S Y="BDMG("
  1.  S X=P_"^ALL EDUC;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,Y)
  1.  I '$D(BDMG) Q ""
  1.  S (X,D)=0,%="",T="" F  S X=$O(BDMG(X)) Q:X'=+X!(%]"")  D
  1.  .S T=$P(^AUPNVPED(+$P(BDMG(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 $P(T,"-")="TO" S %="1^1  Current User "_T_" "_$$FMTE^XLFDT($P(BDMG(X),U))_U_$P(BDMG(X),U) Q
  1.  .I $P(T,"-",2)="TO" S %="1^1  Current User "_T_" "_$$FMTE^XLFDT($P(BDMG(X),U))_U_$P(BDMG(X),U) Q
  1.  .I $P(T,"-",2)="SHS" S %="1^1  Current User "_T_" "_$$FMTE^XLFDT($P(BDMG(X),U))_U_$P(BDMG(X),U) Q
  1.  .I $P(T,"-")="305.1" S %="1^1  Current User "_T_" "_$$FMTE^XLFDT($P(BDMG(X),U))_U_$P(BDMG(X),U) Q
  1.  .I $P(T,"-")="305.10" S %="1^1  Current User "_T_" "_$$FMTE^XLFDT($P(BDMG(X),U))_U_$P(BDMG(X),U) Q
  1.  .I $P(T,"-")="305.11" S %="1^1  Current User "_T_" "_$$FMTE^XLFDT($P(BDMG(X),U))_U_$P(BDMG(X),U) Q
  1.  .I $P(T,"-")="305.12" S %="1^1  Current User "_T_" "_$$FMTE^XLFDT($P(BDMG(X),U))_U_$P(BDMG(X),U) Q
  1.  .I $P(T,"-")="305.13" S %="1^1  Current User "_T_" "_$$FMTE^XLFDT($P(BDMG(X),U))_U_$P(BDMG(X),U) Q
  1.  .I $P(T,"-")="649.00" S %="1^1  Current User "_T_" "_$$FMTE^XLFDT($P(BDMG(X),U))_U_$P(BDMG(X),U) Q
  1.  .I $P(T,"-")="649.01" S %="1^1  Current User "_T_" "_$$FMTE^XLFDT($P(BDMG(X),U))_U_$P(BDMG(X),U) Q
  1.  .I $P(T,"-")="649.02" S %="1^1  Current User "_T_" "_$$FMTE^XLFDT($P(BDMG(X),U))_U_$P(BDMG(X),U) Q
  1.  .I $P(T,"-")="649.03" S %="1^1  Current User "_T_" "_$$FMTE^XLFDT($P(BDMG(X),U))_U_$P(BDMG(X),U) Q
  1.  .I $P(T,"-")="649.04" S %="1^1  Current User "_T_" "_$$FMTE^XLFDT($P(BDMG(X),U))_U_$P(BDMG(X),U) Q
  1.  .I $P(T,"-")="V15.82" S %="1^1  Current User "_T_" "_$$FMTE^XLFDT($P(BDMG(X),U))_U_$P(BDMG(X),U) Q
  1.  Q %
  1.  ;
  1. DENT(P,BDATE,EDATE) ;EP
  1.  K ^TMP($J,"A")
  1.  NEW A,B,E,X,G,Z
  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.  .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=1_U_$P($P(^AUPNVSIT(V,0),U),".")
  1.  .Q
  1.  K ^TMP($J,"A")
  1.  I G=0 Q ""
  1.  Q "1^1  Current User ADA 1320"_U_$$FMTE^XLFDT($P(G,U,2))_U_$P(G,U,2)
  1.  ;
  1. CPTSM(P,BDATE,EDATE) ;EP - did pat have smoking cpt?
  1.  NEW X,G,Z
  1.  S G=""
  1.  S X=$$LASTCPTT^BDMAPIU(P,BDATE,EDATE,"DM AUDIT TOBACCO USE CPTS","E")
  1.  I X="" Q ""
  1.  S Z=$$VAL^XBDIQ1(9000010.18,$P(X,U,6),.01)
  1.  I Z="1036F" Q "2^2  Not a Current User "_$P(X,U,2)_" "_$$FMTE^XLFDT($P(X,U,1))_U_$P(X,U,1)
  1.  Q "1^1  Current User "_$P(X,U,2)_" "_$$FMTE^XLFDT($P(X,U,1))_U_$P(X,U,1)