BDMS9B7 ; IHS/CMI/LAB - DIABETIC CARE SUMMARY SUPPLEMENT 06 Jan 2005 5:09 PM ;
;;2.0;DIABETES MANAGEMENT SYSTEM;**3**;JUN 14, 2007
;
;
EKG(P) ;EP
NEW BDMY,%,LEKG S LEKG="",%=P_"^LAST DIAGNOSTIC ECG SUMMARY",E=$$START1^APCLDF(%,"BDMY(")
I $D(BDMY) S LEKG=$P(BDMY(1),U)_U_$$VAL^XBDIQ1(9000010.21,+$P(BDMY(1),U,4),.04)
K BDMY S %=P_"^LAST PROCEDURE 89.50",E=$$START1^APCLDF(%,"BDMY(")
I $D(BDMY(1)) D
.Q:LEKG>$P(BDMY(1),U)
.S LEKG=$P(BDMY(1),U)
K BDMY S %=P_"^LAST PROCEDURE 89.51",E=$$START1^APCLDF(%,"BDMY(")
I $D(BDMY(1)) D
.Q:LEKG>$P(BDMY(1),U)
.S LEKG=$P(BDMY(1),U)
K BDMY S %=P_"^LAST PROCEDURE 89.52",E=$$START1^APCLDF(%,"BDMY(")
I $D(BDMY(1)) D
.Q:LEKG>$P(BDMY(1),U)
.S LEKG=$P(BDMY(1),U)
K BDMY S %=P_"^LAST PROCEDURE 89.53",E=$$START1^APCLDF(%,"BDMY(")
I $D(BDMY(1)) D
.Q:LEKG>$P(BDMY(1),U)
.S LEKG=$P(BDMY(1),U)
K BDMY S %=P_"^LAST DX 794.31",E=$$START1^APCLDF(%,"BDMY(")
I $D(BDMY(1)) D
.Q:LEKG>$P(BDMY(1),U)
.S LEKG=$P(BDMY(1),U)
;check CPT
S T=$O(^ATXAX("B","DM AUDIT EKG CPTS",0))
K BDMY I T S BDMY(1)=$$CPT(P,,,T,3) D
.I BDMY(1)="" K BDMY Q
.Q:LEKG>$P(BDMY(1),U)
.S LEKG=$P(BDMY(1),U)
K BDMY I T S BDMY(1)=$$RAD(P,,,T,3) D
.I BDMY(1)="" K BDMY Q
.Q:LEKG>$P(BDMY(1),U)
.S LEKG=$P(BDMY(1),U)
;
;
Q $$FMTE^XLFDT(LEKG)_U_$P(LEKG,U,2)
;
CPT(P,BDATE,EDATE,T,F) ;
I '$G(P) Q ""
I '$G(T) Q ""
I '$G(F) S F=1
I $G(EDATE)="" S EDATE=DT
I $G(BDATE)="" S BDATE=$P(^DPT(P,0),U,3)
;go through visits in a date range for this patient, check cpts
NEW D,BD,ED,X,Y,D,G,V
S ED=9999999-EDATE,BD=9999999-BDATE,G=0
F S ED=$O(^AUPNVSIT("AA",P,ED)) Q:ED=""!($P(ED,".")>BD)!(G) D
.S V=0 F S V=$O(^AUPNVSIT("AA",P,ED,V)) Q:V'=+V!(G) D
..Q:'$D(^AUPNVSIT(V,0))
..Q:'$D(^AUPNVCPT("AD",V))
..S X=0 F S X=$O(^AUPNVCPT("AD",V,X)) Q:X'=+X!(G) D
...I $$ICD^ATXCHK($P(^AUPNVCPT(X,0),U),T,1) S G=X
...Q
..Q
.Q
I 'G Q ""
I F=1 Q $S(G:1,1:"")
I F=2 Q G
I F=3 S V=$P(^AUPNVCPT(G,0),U,3) I V Q $P($P($G(^AUPNVSIT(V,0)),U),".")
I F=4 S V=$P(^AUPNVCPT(G,0),U,3) I V Q $$FMTE^XLFDT($P($P($G(^AUPNVSIT(V,0)),U),"."))
Q ""
RAD(P,BDATE,EDATE,T,F) ;return if a v rad entry in date range
I '$G(P) Q ""
I '$G(T) Q ""
I '$G(F) S F=1
I $G(EDATE)="" S EDATE=DT
I $G(BDATE)="" S BDATE=$P(^DPT(P,0),U,3)
;go through visits in a date range for this patient, check cpts
NEW D,BD,ED,X,Y,D,G,V
S ED=9999999-EDATE,BD=9999999-BDATE,G=0
F S ED=$O(^AUPNVSIT("AA",P,ED)) Q:ED=""!($P(ED,".")>BD)!(G) D
.S V=0 F S V=$O(^AUPNVSIT("AA",P,ED,V)) Q:V'=+V!(G) D
..Q:'$D(^AUPNVSIT(V,0))
..Q:'$D(^AUPNVRAD("AD",V))
..S X=0 F S X=$O(^AUPNVRAD("AD",V,X)) Q:X'=+X!(G) D
...Q:'$D(^AUPNVRAD(X,0))
...S Y=$P(^AUPNVRAD(X,0),U) Q:'Y Q:'$D(^RAMIS(71,Y,0))
...S Y=$P($G(^RAMIS(71,Y,0)),U,9) Q:'Y
...Q:'$$ICD^ATXCHK(Y,T,1)
...S G=X
...Q
..Q
.Q
I 'G Q ""
I F=1 Q $S(G:1,1:"")
I F=2 Q G
I F=3 S V=$P(^AUPNVRAD(G,0),U,3) I V Q $P($P($G(^AUPNVSIT(V,0)),U),".")
I F=4 S V=$P(^AUPNVRAD(G,0),U,3) I V Q $$FMTE^XLFDT($P($P($G(^AUPNVSIT(V,0)),U),"."))
Q ""
BDMS9B7 ; IHS/CMI/LAB - DIABETIC CARE SUMMARY SUPPLEMENT 06 Jan 2005 5:09 PM ;
+1 ;;2.0;DIABETES MANAGEMENT SYSTEM;**3**;JUN 14, 2007
+2 ;
+3 ;
EKG(P) ;EP
+1 NEW BDMY,%,LEKG
SET LEKG=""
SET %=P_"^LAST DIAGNOSTIC ECG SUMMARY"
SET E=$$START1^APCLDF(%,"BDMY(")
+2 IF $DATA(BDMY)
SET LEKG=$PIECE(BDMY(1),U)_U_$$VAL^XBDIQ1(9000010.21,+$PIECE(BDMY(1),U,4),.04)
+3 KILL BDMY
SET %=P_"^LAST PROCEDURE 89.50"
SET E=$$START1^APCLDF(%,"BDMY(")
+4 IF $DATA(BDMY(1))
Begin DoDot:1
+5 IF LEKG>$PIECE(BDMY(1),U)
QUIT
+6 SET LEKG=$PIECE(BDMY(1),U)
End DoDot:1
+7 KILL BDMY
SET %=P_"^LAST PROCEDURE 89.51"
SET E=$$START1^APCLDF(%,"BDMY(")
+8 IF $DATA(BDMY(1))
Begin DoDot:1
+9 IF LEKG>$PIECE(BDMY(1),U)
QUIT
+10 SET LEKG=$PIECE(BDMY(1),U)
End DoDot:1
+11 KILL BDMY
SET %=P_"^LAST PROCEDURE 89.52"
SET E=$$START1^APCLDF(%,"BDMY(")
+12 IF $DATA(BDMY(1))
Begin DoDot:1
+13 IF LEKG>$PIECE(BDMY(1),U)
QUIT
+14 SET LEKG=$PIECE(BDMY(1),U)
End DoDot:1
+15 KILL BDMY
SET %=P_"^LAST PROCEDURE 89.53"
SET E=$$START1^APCLDF(%,"BDMY(")
+16 IF $DATA(BDMY(1))
Begin DoDot:1
+17 IF LEKG>$PIECE(BDMY(1),U)
QUIT
+18 SET LEKG=$PIECE(BDMY(1),U)
End DoDot:1
+19 KILL BDMY
SET %=P_"^LAST DX 794.31"
SET E=$$START1^APCLDF(%,"BDMY(")
+20 IF $DATA(BDMY(1))
Begin DoDot:1
+21 IF LEKG>$PIECE(BDMY(1),U)
QUIT
+22 SET LEKG=$PIECE(BDMY(1),U)
End DoDot:1
+23 ;check CPT
+24 SET T=$ORDER(^ATXAX("B","DM AUDIT EKG CPTS",0))
+25 KILL BDMY
IF T
SET BDMY(1)=$$CPT(P,,,T,3)
Begin DoDot:1
+26 IF BDMY(1)=""
KILL BDMY
QUIT
+27 IF LEKG>$PIECE(BDMY(1),U)
QUIT
+28 SET LEKG=$PIECE(BDMY(1),U)
End DoDot:1
+29 KILL BDMY
IF T
SET BDMY(1)=$$RAD(P,,,T,3)
Begin DoDot:1
+30 IF BDMY(1)=""
KILL BDMY
QUIT
+31 IF LEKG>$PIECE(BDMY(1),U)
QUIT
+32 SET LEKG=$PIECE(BDMY(1),U)
End DoDot:1
+33 ;
+34 ;
+35 QUIT $$FMTE^XLFDT(LEKG)_U_$PIECE(LEKG,U,2)
+36 ;
CPT(P,BDATE,EDATE,T,F) ;
+1 IF '$GET(P)
QUIT ""
+2 IF '$GET(T)
QUIT ""
+3 IF '$GET(F)
SET F=1
+4 IF $GET(EDATE)=""
SET EDATE=DT
+5 IF $GET(BDATE)=""
SET BDATE=$PIECE(^DPT(P,0),U,3)
+6 ;go through visits in a date range for this patient, check cpts
+7 NEW D,BD,ED,X,Y,D,G,V
+8 SET ED=9999999-EDATE
SET BD=9999999-BDATE
SET G=0
+9 FOR
SET ED=$ORDER(^AUPNVSIT("AA",P,ED))
IF ED=""!($PIECE(ED,".")>BD)!(G)
QUIT
Begin DoDot:1
+10 SET V=0
FOR
SET V=$ORDER(^AUPNVSIT("AA",P,ED,V))
IF V'=+V!(G)
QUIT
Begin DoDot:2
+11 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+12 IF '$DATA(^AUPNVCPT("AD",V))
QUIT
+13 SET X=0
FOR
SET X=$ORDER(^AUPNVCPT("AD",V,X))
IF X'=+X!(G)
QUIT
Begin DoDot:3
+14 IF $$ICD^ATXCHK($PIECE(^AUPNVCPT(X,0),U),T,1)
SET G=X
+15 QUIT
End DoDot:3
+16 QUIT
End DoDot:2
+17 QUIT
End DoDot:1
+18 IF 'G
QUIT ""
+19 IF F=1
QUIT $SELECT(G:1,1:"")
+20 IF F=2
QUIT G
+21 IF F=3
SET V=$PIECE(^AUPNVCPT(G,0),U,3)
IF V
QUIT $PIECE($PIECE($GET(^AUPNVSIT(V,0)),U),".")
+22 IF F=4
SET V=$PIECE(^AUPNVCPT(G,0),U,3)
IF V
QUIT $$FMTE^XLFDT($PIECE($PIECE($GET(^AUPNVSIT(V,0)),U),"."))
+23 QUIT ""
RAD(P,BDATE,EDATE,T,F) ;return if a v rad entry in date range
+1 IF '$GET(P)
QUIT ""
+2 IF '$GET(T)
QUIT ""
+3 IF '$GET(F)
SET F=1
+4 IF $GET(EDATE)=""
SET EDATE=DT
+5 IF $GET(BDATE)=""
SET BDATE=$PIECE(^DPT(P,0),U,3)
+6 ;go through visits in a date range for this patient, check cpts
+7 NEW D,BD,ED,X,Y,D,G,V
+8 SET ED=9999999-EDATE
SET BD=9999999-BDATE
SET G=0
+9 FOR
SET ED=$ORDER(^AUPNVSIT("AA",P,ED))
IF ED=""!($PIECE(ED,".")>BD)!(G)
QUIT
Begin DoDot:1
+10 SET V=0
FOR
SET V=$ORDER(^AUPNVSIT("AA",P,ED,V))
IF V'=+V!(G)
QUIT
Begin DoDot:2
+11 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+12 IF '$DATA(^AUPNVRAD("AD",V))
QUIT
+13 SET X=0
FOR
SET X=$ORDER(^AUPNVRAD("AD",V,X))
IF X'=+X!(G)
QUIT
Begin DoDot:3
+14 IF '$DATA(^AUPNVRAD(X,0))
QUIT
+15 SET Y=$PIECE(^AUPNVRAD(X,0),U)
IF 'Y
QUIT
IF '$DATA(^RAMIS(71,Y,0))
QUIT
+16 SET Y=$PIECE($GET(^RAMIS(71,Y,0)),U,9)
IF 'Y
QUIT
+17 IF '$$ICD^ATXCHK(Y,T,1)
QUIT
+18 SET G=X
+19 QUIT
End DoDot:3
+20 QUIT
End DoDot:2
+21 QUIT
End DoDot:1
+22 IF 'G
QUIT ""
+23 IF F=1
QUIT $SELECT(G:1,1:"")
+24 IF F=2
QUIT G
+25 IF F=3
SET V=$PIECE(^AUPNVRAD(G,0),U,3)
IF V
QUIT $PIECE($PIECE($GET(^AUPNVSIT(V,0)),U),".")
+26 IF F=4
SET V=$PIECE(^AUPNVRAD(G,0),U,3)
IF V
QUIT $$FMTE^XLFDT($PIECE($PIECE($GET(^AUPNVSIT(V,0)),U),"."))
+27 QUIT ""
