- APCHS9B7 ; IHS/CMI/LAB - DIABETIC CARE SUMMARY SUPPLEMENT 06 Jan 2005 5:09 PM ;
- ;;2.0;IHS PCC SUITE;;MAY 14, 2009
- ;
- ;
- EKG(P) ;EP
- NEW APCHY,%,LEKG S LEKG="",%=P_"^LAST DIAGNOSTIC ECG SUMMARY",E=$$START1^APCLDF(%,"APCHY(")
- I $D(APCHY) S LEKG=$P(APCHY(1),U)_U_$$VAL^XBDIQ1(9000010.21,+$P(APCHY(1),U,4),.04)
- K APCHY S %=P_"^LAST PROCEDURE 89.51",E=$$START1^APCLDF(%,"APCHY(")
- I $D(APCHY(1)) D
- .Q:LEKG>$P(APCHY(1),U)
- .S LEKG=$P(APCHY(1),U)
- K APCHY S %=P_"^LAST PROCEDURE 89.52",E=$$START1^APCLDF(%,"APCHY(")
- I $D(APCHY(1)) D
- .Q:LEKG>$P(APCHY(1),U)
- .S LEKG=$P(APCHY(1),U)
- K APCHY S %=P_"^LAST PROCEDURE 89.53",E=$$START1^APCLDF(%,"APCHY(")
- I $D(APCHY(1)) D
- .Q:LEKG>$P(APCHY(1),U)
- .S LEKG=$P(APCHY(1),U)
- ;check CPT
- S T=$O(^ATXAX("B","DM AUDIT EKG CPTS",0))
- K APCHY I T S APCHY(1)=$$CPT(P,,,T,3) D
- .I APCHY(1)="" K APCHY Q
- .Q:LEKG>$P(APCHY(1),U)
- .S LEKG=$P(APCHY(1),U)
- K APCHY I T S APCHY(1)=$$RAD(P,,,T,3) D
- .I APCHY(1)="" K APCHY Q
- .Q:LEKG>$P(APCHY(1),U)
- .S LEKG=$P(APCHY(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 ""
- APCHS9B7 ; IHS/CMI/LAB - DIABETIC CARE SUMMARY SUPPLEMENT 06 Jan 2005 5:09 PM ;
- +1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
- +2 ;
- +3 ;
- EKG(P) ;EP
- +1 NEW APCHY,%,LEKG
- SET LEKG=""
- SET %=P_"^LAST DIAGNOSTIC ECG SUMMARY"
- SET E=$$START1^APCLDF(%,"APCHY(")
- +2 IF $DATA(APCHY)
- SET LEKG=$PIECE(APCHY(1),U)_U_$$VAL^XBDIQ1(9000010.21,+$PIECE(APCHY(1),U,4),.04)
- +3 KILL APCHY
- SET %=P_"^LAST PROCEDURE 89.51"
- SET E=$$START1^APCLDF(%,"APCHY(")
- +4 IF $DATA(APCHY(1))
- Begin DoDot:1
- +5 IF LEKG>$PIECE(APCHY(1),U)
- QUIT
- +6 SET LEKG=$PIECE(APCHY(1),U)
- End DoDot:1
- +7 KILL APCHY
- SET %=P_"^LAST PROCEDURE 89.52"
- SET E=$$START1^APCLDF(%,"APCHY(")
- +8 IF $DATA(APCHY(1))
- Begin DoDot:1
- +9 IF LEKG>$PIECE(APCHY(1),U)
- QUIT
- +10 SET LEKG=$PIECE(APCHY(1),U)
- End DoDot:1
- +11 KILL APCHY
- SET %=P_"^LAST PROCEDURE 89.53"
- SET E=$$START1^APCLDF(%,"APCHY(")
- +12 IF $DATA(APCHY(1))
- Begin DoDot:1
- +13 IF LEKG>$PIECE(APCHY(1),U)
- QUIT
- +14 SET LEKG=$PIECE(APCHY(1),U)
- End DoDot:1
- +15 ;check CPT
- +16 SET T=$ORDER(^ATXAX("B","DM AUDIT EKG CPTS",0))
- +17 KILL APCHY
- IF T
- SET APCHY(1)=$$CPT(P,,,T,3)
- Begin DoDot:1
- +18 IF APCHY(1)=""
- KILL APCHY
- QUIT
- +19 IF LEKG>$PIECE(APCHY(1),U)
- QUIT
- +20 SET LEKG=$PIECE(APCHY(1),U)
- End DoDot:1
- +21 KILL APCHY
- IF T
- SET APCHY(1)=$$RAD(P,,,T,3)
- Begin DoDot:1
- +22 IF APCHY(1)=""
- KILL APCHY
- QUIT
- +23 IF LEKG>$PIECE(APCHY(1),U)
- QUIT
- +24 SET LEKG=$PIECE(APCHY(1),U)
- End DoDot:1
- +25 ;
- +26 ;
- +27 QUIT $$FMTE^XLFDT(LEKG)_U_$PIECE(LEKG,U,2)
- +28 ;
- 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 ""