- BDMDE1T ; IHS/CMI/LAB - 2017 DIABETES AUDIT ;
- ;;2.0;DIABETES MANAGEMENT SYSTEM;**10**;JUN 14, 2007;Build 12
- ;
- ;
- TOBACCO(P,BDATE,EDATE) ;EP
- I '$G(P) Q ""
- NEW BDMTOB,BDMSDX,BDMXPND,BDM1320,BDMSCPT,BDMALL,D,%,F,BDMTOBS,BDMSBD,BDMTOBC,G
- S BDMSBD=BDATE
- D TOBACCOS ;get last hf in BDMTOBS, BDMTOBC
- ;now get date of latest health factor and check for any of these next things after the HF
- S BDMSBD=$P(BDMTOBS,U,3)
- S BDMSDX=$$DX(P,$S(BDMSBD:BDMSBD,1:BDATE),EDATE) ;get last dx in format code^date and compare to bdmdob
- I BDMSDX]"",$P(BDMSDX,U,3)>BDMSBD S BDMTOBS=BDMSDX
- S BDMSBD=$P(BDMTOBS,U,3)
- S BDM1320=$$DENT(P,$S(BDMSBD:BDMSBD,1:BDATE),EDATE)
- I BDM1320]"",$P(BDM1320,U,3)>BDMSBD S BDMTOBS=BDM1320
- S BDMSBD=$P(BDMTOBS,U,3)
- S BDMSCPT=$$CPTSM(P,$S(BDMSBD:BDMSBD,1:BDATE),EDATE)
- I BDMSCPT]"",$P(BDMSCPT,U,3)>BDMSBD S BDMTOBS=BDMSCPT
- Q BDMTOBS
- ;
- DX(P,BDATE,EDATE) ;EP
- NEW BDMG,T,X,G,Y,F,I,Z
- S BDMG=$$LASTDXT^BDMAPIU(P,BDATE,EDATE,"BGP TOBACCO DXS","E")
- I BDMG]"" D Q G
- .S G=""
- .S I=$P(BDMG,U,6)
- .S F=$P(BDMG,U,5)
- .S Z=$$VALI^XBDIQ1(F,I,.01)
- .; check for non smoker dxs here as well
- .I '$$ICD^BDMUTL(Z,"BGP TOBACCO USER DXS",9) S G="2^2 Not a Current User "_$P(BDMG,U,2)_" "_$P(BDMG,U,3)_" "_$$DATE^BDMS9B1($P(BDMG,U,1))_U_$P(BDMG,U,1) Q
- .S G="1^1 Current User "_$P(BDMG,U,2)_" "_$P(BDMG,U,3)_" "_$$DATE^BDMS9B1($P(BDMG,U,1))_U_$P(BDMG,U,1) Q
- S T=$O(^ATXAX("B","BGP TOBACCO DXS",0))
- S X=0,G="" F S X=$O(^AUPNPROB("AC",P,X)) Q:X'=+X!(G]"") D
- .Q:$P(^AUPNPROB(X,0),U,12)'="A"
- .Q:$P(^AUPNPROB(X,0),U,3)>EDATE
- .Q:$P(^AUPNPROB(X,0),U,3)<BDATE
- .S Y=$P(^AUPNPROB(X,0),U)
- .Q:'$$ICD^BDMUTL(Y,$P(^ATXAX(T,0),U),9) ;cmi/maw 05/15/2014 p8
- .S Z=$P(^ICD9(Y,0),U,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
- .I '$$ICD^BDMUTL(Z,"BGP TOBACCO USER DXS",9) S G="2^2 Not a Current User "_$P($$ICDDX^BDMUTL(Y),U,2)_" PROBLEM LIST "_" "_$$DATE^BDMS9B1($P(^AUPNPROB(X,0),U,3))_U_$P(^AUPNPROB(X,0),U,3)
- .S G="1^1 Current User "_$P($$ICDDX^BDMUTL(Y),U,2)_" PROBLEM LIST "_" "_$$DATE^BDMS9B1($P(^AUPNPROB(X,0),U,3))_U_$P(^AUPNPROB(X,0),U,3)
- .Q
- Q G
- TOBACCOS ;EP
- K BDM
- S BDMTOBS="",BDMTOBC=""
- S BDMTOBS=$$LASTHF(P,"TOBACCO (SMOKING)",BDATE,EDATE) K O,D,H
- S BDMTOBC=$$LASTHF(P,"TOBACCO (SMOKELESS - CHEWING/DIP)",BDATE,EDATE) K O,D,H
- I '$O(^AUTTHF("B","TOBACCO (SMOKING)",0)) S BDMTOBS=$$LASTHF(P,"TOBACCO",BDATE,EDATE) K O,D,H
- ;if have both then take the one that indicates tobacco use
- I $P(BDMTOBS,U)=1 Q
- I $P(BDMTOBC,U)=1 S BDMTOBS=BDMTOBC Q
- I BDMTOBS=2 Q
- I BDMTOBC=2 S BDMTOBS=BDMTOBC Q
- Q
- ;
- LASTHF(P,C,BDATE,EDATE) ;EP - get last factor in category C for patient P
- S C=$O(^AUTTHF("B",C,0)) ;ien of category passed
- I '$G(C) Q ""
- NEW H,D,O,F,Z
- S (H,D)=0 K O
- F S H=$O(^AUTTHF("AC",C,H)) Q:'+H D
- .Q:'$D(^AUPNVHF("AA",P,H))
- .S D="" F S D=$O(^AUPNVHF("AA",P,H,D)) Q:D'=+D D
- ..Q:(9999999-D)>EDATE ;after time frame
- ..Q:(9999999-D)<BDATE ;before time frame
- ..S Z=$O(^AUPNVHF("AA",P,H,D,0))
- ..S F=$$VAL^XBDIQ1(9000010.23,Z,.01)
- ..I F="SMOKER IN HOME"!(F="SMOKE FREE HOME")!(F["CEREMONIAL")!(F["EXPOSURE TO") Q
- ..S O(D)=$O(^AUPNVHF("AA",P,H,D,""))
- .Q
- S D=$O(O(0))
- I D]"" D Q Z
- .S Z=$$TUHF($$VAL^XBDIQ1(9000010.23,O(D),.01))
- .S Z=Z_U_$S(Z=1:"1 Current User ",1:"2 Not a Current User ")_$$VAL^XBDIQ1(9000010.23,O(D),.01)_" "_$$DATE^BDMS9B1(9999999-D)_"^"_(9999999-D)
- S (H,D)=0 K O
- F S H=$O(^AUTTHF("AC",C,H)) Q:'+H D
- .Q:'$D(^AUPNVHF("AA",P,H))
- .S D="" F S D=$O(^AUPNVHF("AA",P,H,D)) Q:D'=+D D
- ..Q:(9999999-D)>EDATE ;after time frame
- ..Q:(9999999-D)<BDATE ;before time frame
- ..S Z=$O(^AUPNVHF("AA",P,H,D,0))
- ..S F=$$VAL^XBDIQ1(9000010.23,Z,.01)
- ..I F="SMOKER IN HOME"!(F="SMOKE FREE HOME")!(F["CEREMONIAL")!(F["EXPOSURE TO") S O(D)=$O(^AUPNVHF("AA",P,H,D,""))
- .Q
- S D=$O(O(0))
- I D Q 2_"^2 Not a Current User "_$$VAL^XBDIQ1(9000010.23,O(D),.01)_" "_$$DATE^BDMS9B1(9999999-D)_"^"_(9999999-D)
- Q "3^3 Not Documented"
- ;
- TUHF(V) ;
- I V="" Q 3
- I V["CURRENT" Q 1
- I V["CESSATION" Q 1
- I V["HEAVY TOBACCO" Q 1
- I V["LIGHT TOBACCO" Q 1
- I V="SMOKELESS TOBACCO, STATUS UNKNOWN" Q 3
- I V["STATUS UNKNOWN" Q 3
- Q 2
- ;
- DENT(P,BDATE,EDATE) ;EP
- K ^TMP($J,"A")
- NEW A,B,E,X,G,Z
- S A="^TMP($J,""A"",",B=P_"^ALL VISITS;DURING "_$$DATE^BDMS9B1(BDATE)_"-"_$$DATE^BDMS9B1(EDATE),E=$$START1^APCLDF(B,A)
- I '$D(^TMP($J,"A",1)) Q ""
- 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
- .Q:'$D(^AUPNVSIT(V,0))
- .Q:'$P(^AUPNVSIT(V,0),U,9)
- .Q:$P(^AUPNVSIT(V,0),U,11)
- .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),".")
- .Q
- K ^TMP($J,"A")
- I G=0 Q ""
- Q "1^1 Current User ADA 1320 "_$$DATE^BDMS9B1($P(G,U,2))_U_$P(G,U,2)
- ;
- CPTSM(P,BDATE,EDATE) ;EP - did pat have smoking cpt?
- NEW X,G,Z
- S G=""
- S X=$$LASTCPTT^BDMAPIU(P,BDATE,EDATE,"BGP TOBACCO SCREEN CPTS","E")
- I X="" Q ""
- S Z=$$VALI^XBDIQ1(9000010.18,$P(X,U,6),.01)
- I '$$ICD^BDMUTL(Z,"BGP TOBACCO USER CPTS",1) Q "2^2 Not a Current User "_$P(X,U,2)_" "_$$DATE^BDMS9B1($P(X,U,1))_U_$P(X,U,1)
- Q "1^1 Current User "_$P(X,U,2)_" "_$$DATE^BDMS9B1($P(X,U,1))_U_$P(X,U,1)
- ENDS(P,BD,ED) ;EP
- I $G(P)="" Q ""
- NEW X
- S X=$$LASTHF^BDMSMU(P,"ELECTRONIC NICOTINE DELIV SYSTEM (ENDS)","B",BD,ED)
- I X="" Q "2^3"
- I $P(X,U,1)["CURRENT"!($P(X,U,1)["CESSATION") Q "1^1^"_X
- I $P(X,U,1)["PREVIOUS"!($P(X,U,1)["NEVER") Q "1^2^"_X
- Q ""
- BDMDE1T ; IHS/CMI/LAB - 2017 DIABETES AUDIT ;
- +1 ;;2.0;DIABETES MANAGEMENT SYSTEM;**10**;JUN 14, 2007;Build 12
- +2 ;
- +3 ;
- TOBACCO(P,BDATE,EDATE) ;EP
- +1 IF '$GET(P)
- QUIT ""
- +2 NEW BDMTOB,BDMSDX,BDMXPND,BDM1320,BDMSCPT,BDMALL,D,%,F,BDMTOBS,BDMSBD,BDMTOBC,G
- +3 SET BDMSBD=BDATE
- +4 ;get last hf in BDMTOBS, BDMTOBC
- DO TOBACCOS
- +5 ;now get date of latest health factor and check for any of these next things after the HF
- +6 SET BDMSBD=$PIECE(BDMTOBS,U,3)
- +7 ;get last dx in format code^date and compare to bdmdob
- SET BDMSDX=$$DX(P,$SELECT(BDMSBD:BDMSBD,1:BDATE),EDATE)
- +8 IF BDMSDX]""
- IF $PIECE(BDMSDX,U,3)>BDMSBD
- SET BDMTOBS=BDMSDX
- +9 SET BDMSBD=$PIECE(BDMTOBS,U,3)
- +10 SET BDM1320=$$DENT(P,$SELECT(BDMSBD:BDMSBD,1:BDATE),EDATE)
- +11 IF BDM1320]""
- IF $PIECE(BDM1320,U,3)>BDMSBD
- SET BDMTOBS=BDM1320
- +12 SET BDMSBD=$PIECE(BDMTOBS,U,3)
- +13 SET BDMSCPT=$$CPTSM(P,$SELECT(BDMSBD:BDMSBD,1:BDATE),EDATE)
- +14 IF BDMSCPT]""
- IF $PIECE(BDMSCPT,U,3)>BDMSBD
- SET BDMTOBS=BDMSCPT
- +15 QUIT BDMTOBS
- +16 ;
- DX(P,BDATE,EDATE) ;EP
- +1 NEW BDMG,T,X,G,Y,F,I,Z
- +2 SET BDMG=$$LASTDXT^BDMAPIU(P,BDATE,EDATE,"BGP TOBACCO DXS","E")
- +3 IF BDMG]""
- Begin DoDot:1
- +4 SET G=""
- +5 SET I=$PIECE(BDMG,U,6)
- +6 SET F=$PIECE(BDMG,U,5)
- +7 SET Z=$$VALI^XBDIQ1(F,I,.01)
- +8 ; check for non smoker dxs here as well
- +9 IF '$$ICD^BDMUTL(Z,"BGP TOBACCO USER DXS",9)
- SET G="2^2 Not a Current User "_$PIECE(BDMG,U,2)_" "_$PIECE(BDMG,U,3)_" "_$$DATE^BDMS9B1($PIECE(BDMG,U,1))_U_$PIECE(BDMG,U,1)
- QUIT
- +10 SET G="1^1 Current User "_$PIECE(BDMG,U,2)_" "_$PIECE(BDMG,U,3)_" "_$$DATE^BDMS9B1($PIECE(BDMG,U,1))_U_$PIECE(BDMG,U,1)
- QUIT
- End DoDot:1
- QUIT G
- +11 SET T=$ORDER(^ATXAX("B","BGP TOBACCO DXS",0))
- +12 SET X=0
- SET G=""
- FOR
- SET X=$ORDER(^AUPNPROB("AC",P,X))
- IF X'=+X!(G]"")
- QUIT
- Begin DoDot:1
- +13 IF $PIECE(^AUPNPROB(X,0),U,12)'="A"
- QUIT
- +14 IF $PIECE(^AUPNPROB(X,0),U,3)>EDATE
- QUIT
- +15 IF $PIECE(^AUPNPROB(X,0),U,3)<BDATE
- QUIT
- +16 SET Y=$PIECE(^AUPNPROB(X,0),U)
- +17 ;cmi/maw 05/15/2014 p8
- IF '$$ICD^BDMUTL(Y,$PIECE(^ATXAX(T,0),U),9)
- QUIT
- +18 SET Z=$PIECE(^ICD9(Y,0),U,1)
- +19 ;see what the non smoker dxs are here in the BGP SMOKING DXS taxonomy and if many create a new taxonomy to point to
- +20 IF '$$ICD^BDMUTL(Z,"BGP TOBACCO USER DXS",9)
- SET G="2^2 Not a Current User "_$PIECE($$ICDDX^BDMUTL(Y),U,2)_" PROBLEM LIST "_" "_$$DATE^BDMS9B1($PIECE(^AUPNPROB(X,0),U,3))_U_$PIECE(^AUPNPROB(X,0),U,3)
- +21 SET G="1^1 Current User "_$PIECE($$ICDDX^BDMUTL(Y),U,2)_" PROBLEM LIST "_" "_$$DATE^BDMS9B1($PIECE(^AUPNPROB(X,0),U,3))_U_$PIECE(^AUPNPROB(X,0),U,3)
- +22 QUIT
- End DoDot:1
- +23 QUIT G
- TOBACCOS ;EP
- +1 KILL BDM
- +2 SET BDMTOBS=""
- SET BDMTOBC=""
- +3 SET BDMTOBS=$$LASTHF(P,"TOBACCO (SMOKING)",BDATE,EDATE)
- KILL O,D,H
- +4 SET BDMTOBC=$$LASTHF(P,"TOBACCO (SMOKELESS - CHEWING/DIP)",BDATE,EDATE)
- KILL O,D,H
- +5 IF '$ORDER(^AUTTHF("B","TOBACCO (SMOKING)",0))
- SET BDMTOBS=$$LASTHF(P,"TOBACCO",BDATE,EDATE)
- KILL O,D,H
- +6 ;if have both then take the one that indicates tobacco use
- +7 IF $PIECE(BDMTOBS,U)=1
- QUIT
- +8 IF $PIECE(BDMTOBC,U)=1
- SET BDMTOBS=BDMTOBC
- QUIT
- +9 IF BDMTOBS=2
- QUIT
- +10 IF BDMTOBC=2
- SET BDMTOBS=BDMTOBC
- QUIT
- +11 QUIT
- +12 ;
- LASTHF(P,C,BDATE,EDATE) ;EP - get last factor in category C for patient P
- +1 ;ien of category passed
- SET C=$ORDER(^AUTTHF("B",C,0))
- +2 IF '$GET(C)
- QUIT ""
- +3 NEW H,D,O,F,Z
- +4 SET (H,D)=0
- KILL O
- +5 FOR
- SET H=$ORDER(^AUTTHF("AC",C,H))
- IF '+H
- QUIT
- Begin DoDot:1
- +6 IF '$DATA(^AUPNVHF("AA",P,H))
- QUIT
- +7 SET D=""
- FOR
- SET D=$ORDER(^AUPNVHF("AA",P,H,D))
- IF D'=+D
- QUIT
- Begin DoDot:2
- +8 ;after time frame
- IF (9999999-D)>EDATE
- QUIT
- +9 ;before time frame
- IF (9999999-D)<BDATE
- QUIT
- +10 SET Z=$ORDER(^AUPNVHF("AA",P,H,D,0))
- +11 SET F=$$VAL^XBDIQ1(9000010.23,Z,.01)
- +12 IF F="SMOKER IN HOME"!(F="SMOKE FREE HOME")!(F["CEREMONIAL")!(F["EXPOSURE TO")
- QUIT
- +13 SET O(D)=$ORDER(^AUPNVHF("AA",P,H,D,""))
- End DoDot:2
- +14 QUIT
- End DoDot:1
- +15 SET D=$ORDER(O(0))
- +16 IF D]""
- Begin DoDot:1
- +17 SET Z=$$TUHF($$VAL^XBDIQ1(9000010.23,O(D),.01))
- +18 SET Z=Z_U_$SELECT(Z=1:"1 Current User ",1:"2 Not a Current User ")_$$VAL^XBDIQ1(9000010.23,O(D),.01)_" "_$$DATE^BDMS9B1(9999999-D)_"^"_(9999999-D)
- End DoDot:1
- QUIT Z
- +19 SET (H,D)=0
- KILL O
- +20 FOR
- SET H=$ORDER(^AUTTHF("AC",C,H))
- IF '+H
- QUIT
- Begin DoDot:1
- +21 IF '$DATA(^AUPNVHF("AA",P,H))
- QUIT
- +22 SET D=""
- FOR
- SET D=$ORDER(^AUPNVHF("AA",P,H,D))
- IF D'=+D
- QUIT
- Begin DoDot:2
- +23 ;after time frame
- IF (9999999-D)>EDATE
- QUIT
- +24 ;before time frame
- IF (9999999-D)<BDATE
- QUIT
- +25 SET Z=$ORDER(^AUPNVHF("AA",P,H,D,0))
- +26 SET F=$$VAL^XBDIQ1(9000010.23,Z,.01)
- +27 IF F="SMOKER IN HOME"!(F="SMOKE FREE HOME")!(F["CEREMONIAL")!(F["EXPOSURE TO")
- SET O(D)=$ORDER(^AUPNVHF("AA",P,H,D,""))
- End DoDot:2
- +28 QUIT
- End DoDot:1
- +29 SET D=$ORDER(O(0))
- +30 IF D
- QUIT 2_"^2 Not a Current User "_$$VAL^XBDIQ1(9000010.23,O(D),.01)_" "_$$DATE^BDMS9B1(9999999-D)_"^"_(9999999-D)
- +31 QUIT "3^3 Not Documented"
- +32 ;
- TUHF(V) ;
- +1 IF V=""
- QUIT 3
- +2 IF V["CURRENT"
- QUIT 1
- +3 IF V["CESSATION"
- QUIT 1
- +4 IF V["HEAVY TOBACCO"
- QUIT 1
- +5 IF V["LIGHT TOBACCO"
- QUIT 1
- +6 IF V="SMOKELESS TOBACCO, STATUS UNKNOWN"
- QUIT 3
- +7 IF V["STATUS UNKNOWN"
- QUIT 3
- +8 QUIT 2
- +9 ;
- DENT(P,BDATE,EDATE) ;EP
- +1 KILL ^TMP($JOB,"A")
- +2 NEW A,B,E,X,G,Z
- +3 SET A="^TMP($J,""A"","
- SET B=P_"^ALL VISITS;DURING "_$$DATE^BDMS9B1(BDATE)_"-"_$$DATE^BDMS9B1(EDATE)
- SET E=$$START1^APCLDF(B,A)
- +4 IF '$DATA(^TMP($JOB,"A",1))
- QUIT ""
- +5 SET (X,G)=0
- FOR
- SET X=$ORDER(^TMP($JOB,"A",X))
- IF X'=+X!(G)
- QUIT
- SET V=$PIECE(^TMP($JOB,"A",X),U,5)
- Begin DoDot:1
- +6 IF '$DATA(^AUPNVSIT(V,0))
- QUIT
- +7 IF '$PIECE(^AUPNVSIT(V,0),U,9)
- QUIT
- +8 IF $PIECE(^AUPNVSIT(V,0),U,11)
- QUIT
- +9 SET Z=0
- FOR
- SET Z=$ORDER(^AUPNVDEN("AD",V,Z))
- IF Z'=+Z!(G)
- QUIT
- SET B=$PIECE($GET(^AUPNVDEN(Z,0)),U)
- IF B
- SET B=$PIECE($GET(^AUTTADA(B,0)),U)
- IF B=1320
- SET G=1_U_$PIECE($PIECE(^AUPNVSIT(V,0),U),".")
- +10 QUIT
- End DoDot:1
- +11 KILL ^TMP($JOB,"A")
- +12 IF G=0
- QUIT ""
- +13 QUIT "1^1 Current User ADA 1320 "_$$DATE^BDMS9B1($PIECE(G,U,2))_U_$PIECE(G,U,2)
- +14 ;
- CPTSM(P,BDATE,EDATE) ;EP - did pat have smoking cpt?
- +1 NEW X,G,Z
- +2 SET G=""
- +3 SET X=$$LASTCPTT^BDMAPIU(P,BDATE,EDATE,"BGP TOBACCO SCREEN CPTS","E")
- +4 IF X=""
- QUIT ""
- +5 SET Z=$$VALI^XBDIQ1(9000010.18,$PIECE(X,U,6),.01)
- +6 IF '$$ICD^BDMUTL(Z,"BGP TOBACCO USER CPTS",1)
- QUIT "2^2 Not a Current User "_$PIECE(X,U,2)_" "_$$DATE^BDMS9B1($PIECE(X,U,1))_U_$PIECE(X,U,1)
- +7 QUIT "1^1 Current User "_$PIECE(X,U,2)_" "_$$DATE^BDMS9B1($PIECE(X,U,1))_U_$PIECE(X,U,1)
- ENDS(P,BD,ED) ;EP
- +1 IF $GET(P)=""
- QUIT ""
- +2 NEW X
- +3 SET X=$$LASTHF^BDMSMU(P,"ELECTRONIC NICOTINE DELIV SYSTEM (ENDS)","B",BD,ED)
- +4 IF X=""
- QUIT "2^3"
- +5 IF $PIECE(X,U,1)["CURRENT"!($PIECE(X,U,1)["CESSATION")
- QUIT "1^1^"_X
- +6 IF $PIECE(X,U,1)["PREVIOUS"!($PIECE(X,U,1)["NEVER")
- QUIT "1^2^"_X
- +7 QUIT ""
