BDMD41T ; IHS/CMI/LAB - 2012 DIABETES AUDIT ;
;;2.0;DIABETES MANAGEMENT SYSTEM;**5**;JUN 14, 2007
;
;
TOBACCO(P,BDATE,EDATE) ;EP
I '$G(P) Q ""
NEW BDMTOB,BDMSDX,BDMXPND,BDM1320,BDMSCPT,BDMALL,D,%,F,BDMTOBS,BDMTOBC,BDMSBD
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 BDMXPND=$$PED(P,BDMSBD,EDATE)
;I BDMXPND]"",$P(BDMXPND,U,3)>BDMSBD S BDMTOBS=BDMXPND
;S BDMSBD=$P(BDMTOBS,U,3)
S BDM1320=$$DENT(P,BDMSBD,EDATE)
I BDM1320]"",$P(BDM1320,U,3)>BDMSBD S BDMTOBS=BDM1320
S BDMSBD=$P(BDMTOBS,U,3)
S BDMSCPT=$$CPTSM(P,BDMSBD,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 GPRA SMOKING DXS","E")
I BDMG]"" D Q G
.S G=""
.S I=$P(BDMG,U,4)
.S F=$P(BDMG,U,5)
.S Z=$$VAL^XBDIQ1(F,I,.01)
.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
.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
S T=$O(^ATXAX("B","BGP GPRA SMOKING 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^ATXCHK(Y,T,9)
.S Z=$P(^ICD9(Y,0),U,1)
.I Z="305.13"!(Z="V15.82") S G="2^2 Not a Current User "_$P($$ICDDX^ICDCODE(Y),U,2)_" PROBLEM LIST "_" "_$$FMTE^XLFDT($P(^AUPNPROB(X,0),U,3))_U_$P(^AUPNPROB(X,0),U,3)
.S G="1^1 Current User "_$P($$ICDDX^ICDCODE(Y),U,2)_" PROBLEM LIST "_" "_$$FMTE^XLFDT($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="" Q D
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)_" "_$$FMTE^XLFDT(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)_" "_$$FMTE^XLFDT(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="SMOKELESS TOBACCO, STATUS UNKNOWN" Q 3
I V["STATUS UNKNOWN" Q 3
Q 2
PED(P,BDATE,EDATE) ;EP
NEW BDMG,X,Y,T,D,%
S Y="BDMG("
S X=P_"^ALL EDUC;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,Y)
I '$D(BDMG) Q ""
S (X,D)=0,%="",T="" F S X=$O(BDMG(X)) Q:X'=+X!(%]"") D
.S T=$P(^AUPNVPED(+$P(BDMG(X),U,4),0),U)
.Q:'T
.Q:'$D(^AUTTEDT(T,0))
.S T=$P(^AUTTEDT(T,0),U,2)
.I $P(T,"-")="TO" S %="1^1 Current User "_T_" "_$$FMTE^XLFDT($P(BDMG(X),U))_U_$P(BDMG(X),U) Q
.I $P(T,"-",2)="TO" S %="1^1 Current User "_T_" "_$$FMTE^XLFDT($P(BDMG(X),U))_U_$P(BDMG(X),U) Q
.I $P(T,"-",2)="SHS" S %="1^1 Current User "_T_" "_$$FMTE^XLFDT($P(BDMG(X),U))_U_$P(BDMG(X),U) Q
.I $P(T,"-")="305.1" S %="1^1 Current User "_T_" "_$$FMTE^XLFDT($P(BDMG(X),U))_U_$P(BDMG(X),U) Q
.I $P(T,"-")="305.10" S %="1^1 Current User "_T_" "_$$FMTE^XLFDT($P(BDMG(X),U))_U_$P(BDMG(X),U) Q
.I $P(T,"-")="305.11" S %="1^1 Current User "_T_" "_$$FMTE^XLFDT($P(BDMG(X),U))_U_$P(BDMG(X),U) Q
.I $P(T,"-")="305.12" S %="1^1 Current User "_T_" "_$$FMTE^XLFDT($P(BDMG(X),U))_U_$P(BDMG(X),U) Q
.I $P(T,"-")="305.13" S %="1^1 Current User "_T_" "_$$FMTE^XLFDT($P(BDMG(X),U))_U_$P(BDMG(X),U) Q
.I $P(T,"-")="649.00" S %="1^1 Current User "_T_" "_$$FMTE^XLFDT($P(BDMG(X),U))_U_$P(BDMG(X),U) Q
.I $P(T,"-")="649.01" S %="1^1 Current User "_T_" "_$$FMTE^XLFDT($P(BDMG(X),U))_U_$P(BDMG(X),U) Q
.I $P(T,"-")="649.02" S %="1^1 Current User "_T_" "_$$FMTE^XLFDT($P(BDMG(X),U))_U_$P(BDMG(X),U) Q
.I $P(T,"-")="649.03" S %="1^1 Current User "_T_" "_$$FMTE^XLFDT($P(BDMG(X),U))_U_$P(BDMG(X),U) Q
.I $P(T,"-")="649.04" S %="1^1 Current User "_T_" "_$$FMTE^XLFDT($P(BDMG(X),U))_U_$P(BDMG(X),U) Q
.I $P(T,"-")="V15.82" S %="1^1 Current User "_T_" "_$$FMTE^XLFDT($P(BDMG(X),U))_U_$P(BDMG(X),U) Q
Q %
;
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 "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(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"_U_$$FMTE^XLFDT($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,"DM AUDIT TOBACCO USE CPTS","E")
I X="" Q ""
S Z=$$VAL^XBDIQ1(9000010.18,$P(X,U,6),.01)
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)
Q "1^1 Current User "_$P(X,U,2)_" "_$$FMTE^XLFDT($P(X,U,1))_U_$P(X,U,1)
BDMD41T ; IHS/CMI/LAB - 2012 DIABETES AUDIT ;
+1 ;;2.0;DIABETES MANAGEMENT SYSTEM;**5**;JUN 14, 2007
+2 ;
+3 ;
TOBACCO(P,BDATE,EDATE) ;EP
+1 IF '$GET(P)
QUIT ""
+2 NEW BDMTOB,BDMSDX,BDMXPND,BDM1320,BDMSCPT,BDMALL,D,%,F,BDMTOBS,BDMTOBC,BDMSBD
+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 ;S BDMXPND=$$PED(P,BDMSBD,EDATE)
+11 ;I BDMXPND]"",$P(BDMXPND,U,3)>BDMSBD S BDMTOBS=BDMXPND
+12 ;S BDMSBD=$P(BDMTOBS,U,3)
+13 SET BDM1320=$$DENT(P,BDMSBD,EDATE)
+14 IF BDM1320]""
IF $PIECE(BDM1320,U,3)>BDMSBD
SET BDMTOBS=BDM1320
+15 SET BDMSBD=$PIECE(BDMTOBS,U,3)
+16 SET BDMSCPT=$$CPTSM(P,BDMSBD,EDATE)
+17 IF BDMSCPT]""
IF $PIECE(BDMSCPT,U,3)>BDMSBD
SET BDMTOBS=BDMSCPT
+18 QUIT BDMTOBS
+19 ;
DX(P,BDATE,EDATE) ;EP
+1 NEW BDMG,T,X,G,Y,F,I,Z
+2 SET BDMG=$$LASTDXT^BDMAPIU(P,BDATE,EDATE,"BGP GPRA SMOKING DXS","E")
+3 IF BDMG]""
Begin DoDot:1
+4 SET G=""
+5 SET I=$PIECE(BDMG,U,4)
+6 SET F=$PIECE(BDMG,U,5)
+7 SET Z=$$VAL^XBDIQ1(F,I,.01)
+8 IF Z=305.13!(Z="V15.82")
SET G="2^2 Not a Current User "_$PIECE(BDMG,U,2)_" "_$PIECE(BDMG,U,3)_" "_$$FMTE^XLFDT($PIECE(BDMG,U,1))_U_$PIECE(BDMG,U,1)
QUIT
+9 SET G="1^1 Current User "_$PIECE(BDMG,U,2)_" "_$PIECE(BDMG,U,3)_" "_$$FMTE^XLFDT($PIECE(BDMG,U,1))_U_$PIECE(BDMG,U,1)
QUIT
End DoDot:1
QUIT G
+10 SET T=$ORDER(^ATXAX("B","BGP GPRA SMOKING DXS",0))
+11 SET X=0
SET G=""
FOR
SET X=$ORDER(^AUPNPROB("AC",P,X))
IF X'=+X!(G]"")
QUIT
Begin DoDot:1
+12 IF $PIECE(^AUPNPROB(X,0),U,12)'="A"
QUIT
+13 IF $PIECE(^AUPNPROB(X,0),U,3)>EDATE
QUIT
+14 IF $PIECE(^AUPNPROB(X,0),U,3)<BDATE
QUIT
+15 SET Y=$PIECE(^AUPNPROB(X,0),U)
+16 IF '$$ICD^ATXCHK(Y,T,9)
QUIT
+17 SET Z=$PIECE(^ICD9(Y,0),U,1)
+18 IF Z="305.13"!(Z="V15.82")
SET G="2^2 Not a Current User "_$PIECE($$ICDDX^ICDCODE(Y),U,2)_" PROBLEM LIST "_" "_$$FMTE^XLFDT($PIECE(^AUPNPROB(X,0),U,3))_U_$PIECE(^AUPNPROB(X,0),U,3)
+19 SET G="1^1 Current User "_$PIECE($$ICDDX^ICDCODE(Y),U,2)_" PROBLEM LIST "_" "_$$FMTE^XLFDT($PIECE(^AUPNPROB(X,0),U,3))_U_$PIECE(^AUPNPROB(X,0),U,3)
+20 QUIT
End DoDot:1
+21 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 ;I D="" Q D
+17 IF D]""
Begin DoDot:1
+18 SET Z=$$TUHF($$VAL^XBDIQ1(9000010.23,O(D),.01))
+19 SET Z=Z_U_$SELECT(Z=1:"1 Current User ",1:"2 Not a Current User ")_$$VAL^XBDIQ1(9000010.23,O(D),.01)_" "_$$FMTE^XLFDT(9999999-D)_"^"_(9999999-D)
End DoDot:1
QUIT Z
+20 SET (H,D)=0
KILL O
+21 FOR
SET H=$ORDER(^AUTTHF("AC",C,H))
IF '+H
QUIT
Begin DoDot:1
+22 IF '$DATA(^AUPNVHF("AA",P,H))
QUIT
+23 SET D=""
FOR
SET D=$ORDER(^AUPNVHF("AA",P,H,D))
IF D'=+D
QUIT
Begin DoDot:2
+24 ;after time frame
IF (9999999-D)>EDATE
QUIT
+25 ;before time frame
IF (9999999-D)<BDATE
QUIT
+26 SET Z=$ORDER(^AUPNVHF("AA",P,H,D,0))
+27 SET F=$$VAL^XBDIQ1(9000010.23,Z,.01)
+28 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
+29 QUIT
End DoDot:1
+30 SET D=$ORDER(O(0))
+31 IF D
QUIT 2_"^2 Not a Current User "_$$VAL^XBDIQ1(9000010.23,O(D),.01)_" "_$$FMTE^XLFDT(9999999-D)_"^"_(9999999-D)
+32 QUIT "3^3 Not Documented"
+33 ;
TUHF(V) ;
+1 IF V=""
QUIT 3
+2 IF V["CURRENT"
QUIT 1
+3 IF V["CESSATION"
QUIT 1
+4 IF V="SMOKELESS TOBACCO, STATUS UNKNOWN"
QUIT 3
+5 IF V["STATUS UNKNOWN"
QUIT 3
+6 QUIT 2
PED(P,BDATE,EDATE) ;EP
+1 NEW BDMG,X,Y,T,D,%
+2 SET Y="BDMG("
+3 SET X=P_"^ALL EDUC;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(X,Y)
+4 IF '$DATA(BDMG)
QUIT ""
+5 SET (X,D)=0
SET %=""
SET T=""
FOR
SET X=$ORDER(BDMG(X))
IF X'=+X!(%]"")
QUIT
Begin DoDot:1
+6 SET T=$PIECE(^AUPNVPED(+$PIECE(BDMG(X),U,4),0),U)
+7 IF 'T
QUIT
+8 IF '$DATA(^AUTTEDT(T,0))
QUIT
+9 SET T=$PIECE(^AUTTEDT(T,0),U,2)
+10 IF $PIECE(T,"-")="TO"
SET %="1^1 Current User "_T_" "_$$FMTE^XLFDT($PIECE(BDMG(X),U))_U_$PIECE(BDMG(X),U)
QUIT
+11 IF $PIECE(T,"-",2)="TO"
SET %="1^1 Current User "_T_" "_$$FMTE^XLFDT($PIECE(BDMG(X),U))_U_$PIECE(BDMG(X),U)
QUIT
+12 IF $PIECE(T,"-",2)="SHS"
SET %="1^1 Current User "_T_" "_$$FMTE^XLFDT($PIECE(BDMG(X),U))_U_$PIECE(BDMG(X),U)
QUIT
+13 IF $PIECE(T,"-")="305.1"
SET %="1^1 Current User "_T_" "_$$FMTE^XLFDT($PIECE(BDMG(X),U))_U_$PIECE(BDMG(X),U)
QUIT
+14 IF $PIECE(T,"-")="305.10"
SET %="1^1 Current User "_T_" "_$$FMTE^XLFDT($PIECE(BDMG(X),U))_U_$PIECE(BDMG(X),U)
QUIT
+15 IF $PIECE(T,"-")="305.11"
SET %="1^1 Current User "_T_" "_$$FMTE^XLFDT($PIECE(BDMG(X),U))_U_$PIECE(BDMG(X),U)
QUIT
+16 IF $PIECE(T,"-")="305.12"
SET %="1^1 Current User "_T_" "_$$FMTE^XLFDT($PIECE(BDMG(X),U))_U_$PIECE(BDMG(X),U)
QUIT
+17 IF $PIECE(T,"-")="305.13"
SET %="1^1 Current User "_T_" "_$$FMTE^XLFDT($PIECE(BDMG(X),U))_U_$PIECE(BDMG(X),U)
QUIT
+18 IF $PIECE(T,"-")="649.00"
SET %="1^1 Current User "_T_" "_$$FMTE^XLFDT($PIECE(BDMG(X),U))_U_$PIECE(BDMG(X),U)
QUIT
+19 IF $PIECE(T,"-")="649.01"
SET %="1^1 Current User "_T_" "_$$FMTE^XLFDT($PIECE(BDMG(X),U))_U_$PIECE(BDMG(X),U)
QUIT
+20 IF $PIECE(T,"-")="649.02"
SET %="1^1 Current User "_T_" "_$$FMTE^XLFDT($PIECE(BDMG(X),U))_U_$PIECE(BDMG(X),U)
QUIT
+21 IF $PIECE(T,"-")="649.03"
SET %="1^1 Current User "_T_" "_$$FMTE^XLFDT($PIECE(BDMG(X),U))_U_$PIECE(BDMG(X),U)
QUIT
+22 IF $PIECE(T,"-")="649.04"
SET %="1^1 Current User "_T_" "_$$FMTE^XLFDT($PIECE(BDMG(X),U))_U_$PIECE(BDMG(X),U)
QUIT
+23 IF $PIECE(T,"-")="V15.82"
SET %="1^1 Current User "_T_" "_$$FMTE^XLFDT($PIECE(BDMG(X),U))_U_$PIECE(BDMG(X),U)
QUIT
End DoDot:1
+24 QUIT %
+25 ;
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 "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(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"_U_$$FMTE^XLFDT($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,"DM AUDIT TOBACCO USE CPTS","E")
+4 IF X=""
QUIT ""
+5 SET Z=$$VAL^XBDIQ1(9000010.18,$PIECE(X,U,6),.01)
+6 IF Z="1036F"
QUIT "2^2 Not a Current User "_$PIECE(X,U,2)_" "_$$FMTE^XLFDT($PIECE(X,U,1))_U_$PIECE(X,U,1)
+7 QUIT "1^1 Current User "_$PIECE(X,U,2)_" "_$$FMTE^XLFDT($PIECE(X,U,1))_U_$PIECE(X,U,1)
