- BGP0CU5 ; IHS/CMI/LAB - calc CMS measures 26 Sep 2004 11:28 AM 04 May 2009 2:38 PM ;
- ;;10.0;IHS CLINICAL REPORTING;;JUN 18, 2010
- ;
- SCIP(P,BDATE,EDATE,BGPY) ;EP - major surgical procedure during hospital stay?
- NEW X,BD,ED,C,T,Y
- S T=$O(^ATXAX("B","BGP CMS MAJOR SURGERY PROCS",0))
- S C=0
- S BD=9999999-BDATE,ED=9999999-EDATE-1
- F S ED=$O(^AUPNVPRC("AA",P,ED)) Q:ED'=+ED!(ED>BD) D
- .S X=0 F S X=$O(^AUPNVPRC("AA",P,ED,X)) Q:X'=+X D
- ..S Y=$P($G(^AUPNVPRC(X,0)),U)
- ..Q:$P(^AUPNVPRC(X,0),U,7)'="Y" ;not principle procedure
- ..Q:'Y
- ..Q:'$$ICD^ATXCHK(Y,T,0)
- ..S C=C+1,BGPY(C)=$$VAL^XBDIQ1(9000010.08,X,.01)_" "_$$VAL^XBDIQ1(9000010.08,X,.04)
- ..Q
- .Q
- Q
- ;
- SCIP1(P,BDATE,EDATE,BGPY) ;EP - major surgical procedure during hospital stay?
- NEW X,BD,ED,C,T,Y,G
- S T=$O(^ATXAX("B","BGP CMS MAJOR SURGERY PROCS",0))
- S C=0
- S BD=9999999-BDATE,ED=9999999-EDATE-1
- F S ED=$O(^AUPNVPRC("AA",P,ED)) Q:ED'=+ED!(ED>BD) D
- .S X=0 F S X=$O(^AUPNVPRC("AA",P,ED,X)) Q:X'=+X D
- ..S Y=$P($G(^AUPNVPRC(X,0)),U)
- ..Q:$P(^AUPNVPRC(X,0),U,7)'="Y" ;not principle procedure
- ..Q:'Y
- ..Q:'$$ICD^ATXCHK(Y,T,0)
- ..D Q:'G
- ...S G=""
- ...I $$ICD^ATXCHK(Y,$O(^ATXAX("B","BGP CMS CABG PROCEDURES",0)),0) S G=1_U_"CABG"
- ...I $$ICD^ATXCHK(Y,$O(^ATXAX("B","BGP CMS OTHER CARDIAC PROCS",0)),0) S G=1_U_"Other Cardiac"
- ...I $$ICD^ATXCHK(Y,$O(^ATXAX("B","BGP CMS HIP ARTHROPLASTY PROCS",0)),0) S G=1_U_"Hip Arthroplasty"
- ...I $$ICD^ATXCHK(Y,$O(^ATXAX("B","BGP CMS KNEE ARTHROPLASTY PROC",0)),0) S G=1_U_"Knee Arthroplasty"
- ...I $$ICD^ATXCHK(Y,$O(^ATXAX("B","BGP CMS COLON SURGERY PROCS",0)),0) S G=1_U_"Colon Surgery"
- ...I $$ICD^ATXCHK(Y,$O(^ATXAX("B","BGP CMS ABD HYSTERECTOMY PROCS",0)),0) S G=1_U_"Hysterectomy"
- ...I $$ICD^ATXCHK(Y,$O(^ATXAX("B","BGP CMS VAG HYSTERECTOMY PROCS",0)),0) S G=1_U_"Hysterectomy"
- ...I $$ICD^ATXCHK(Y,$O(^ATXAX("B","BGP CMS VASCULAR SURGERY PROCS",0)),0) S G=1_U_"Vascular Surgery"
- ..S C=C+1,BGPY(C)=$P(G,U,2)_" "_$$VAL^XBDIQ1(9000010.08,X,.01)_" "_$$VAL^XBDIQ1(9000010.08,X,.04)_U_Y_U_$S($P(^AUPNVPRC(X,0),U,6)]"":$P(^AUPNVPRC(X,0),U,6),1:9999999-ED)_U_$$VAL^XBDIQ1(9000010.08,X,.08)
- ..Q
- .Q
- Q
- ADMPRIM(H,T) ;EP
- S T=$O(^ATXAX("B",T,0))
- I 'T Q ""
- NEW I
- S I=$P($G(^AUPNVINP(H,0)),U,12)
- I $$ICD^ATXCHK(I,T,9) Q 1_U_"Admitting DX, preoperative infectious disease: "_$$VAL^XBDIQ1(9000010.02,H,.12)
- S I=$$PRIMPOV^APCLV($P(^AUPNVINP(H,0),U,3),"I")
- I $$ICD^ATXCHK(I,T,9) Q 1_U_"Primary POV, preoperative infectious disease: "_$$PRIMPOV^APCLV($P(^AUPNVINP(H,0),U,3),"C")_" - "_$$PRIMPOV^APCLV($P(^AUPNVINP(H,0),U,3),"N")
- Q ""
- ;
- POSTINF(P,PD,PP) ;EP
- NEW DAYS
- S DAYS=$S($P(PP,U,1)["CABG":3,$P(PP,U,1)["Other Cardiac":3,1:2)
- S X=$$LASTDX^BGP0UTL1(P,"BGP CMS POST-OPERATIVE INF DXS",PD,$$FMADD^XLFDT(PD,DAYS))
- I X Q $P(X,U,2)_" "_$$VAL^XBDIQ1(9000010.07,$P(X,U,5),.04)_" "_$$DATE^BGP0UTL($P(X,U,3))
- Q ""
- BGP0CU5 ; IHS/CMI/LAB - calc CMS measures 26 Sep 2004 11:28 AM 04 May 2009 2:38 PM ;
- +1 ;;10.0;IHS CLINICAL REPORTING;;JUN 18, 2010
- +2 ;
- SCIP(P,BDATE,EDATE,BGPY) ;EP - major surgical procedure during hospital stay?
- +1 NEW X,BD,ED,C,T,Y
- +2 SET T=$ORDER(^ATXAX("B","BGP CMS MAJOR SURGERY PROCS",0))
- +3 SET C=0
- +4 SET BD=9999999-BDATE
- SET ED=9999999-EDATE-1
- +5 FOR
- SET ED=$ORDER(^AUPNVPRC("AA",P,ED))
- IF ED'=+ED!(ED>BD)
- QUIT
- Begin DoDot:1
- +6 SET X=0
- FOR
- SET X=$ORDER(^AUPNVPRC("AA",P,ED,X))
- IF X'=+X
- QUIT
- Begin DoDot:2
- +7 SET Y=$PIECE($GET(^AUPNVPRC(X,0)),U)
- +8 ;not principle procedure
- IF $PIECE(^AUPNVPRC(X,0),U,7)'="Y"
- QUIT
- +9 IF 'Y
- QUIT
- +10 IF '$$ICD^ATXCHK(Y,T,0)
- QUIT
- +11 SET C=C+1
- SET BGPY(C)=$$VAL^XBDIQ1(9000010.08,X,.01)_" "_$$VAL^XBDIQ1(9000010.08,X,.04)
- +12 QUIT
- End DoDot:2
- +13 QUIT
- End DoDot:1
- +14 QUIT
- +15 ;
- SCIP1(P,BDATE,EDATE,BGPY) ;EP - major surgical procedure during hospital stay?
- +1 NEW X,BD,ED,C,T,Y,G
- +2 SET T=$ORDER(^ATXAX("B","BGP CMS MAJOR SURGERY PROCS",0))
- +3 SET C=0
- +4 SET BD=9999999-BDATE
- SET ED=9999999-EDATE-1
- +5 FOR
- SET ED=$ORDER(^AUPNVPRC("AA",P,ED))
- IF ED'=+ED!(ED>BD)
- QUIT
- Begin DoDot:1
- +6 SET X=0
- FOR
- SET X=$ORDER(^AUPNVPRC("AA",P,ED,X))
- IF X'=+X
- QUIT
- Begin DoDot:2
- +7 SET Y=$PIECE($GET(^AUPNVPRC(X,0)),U)
- +8 ;not principle procedure
- IF $PIECE(^AUPNVPRC(X,0),U,7)'="Y"
- QUIT
- +9 IF 'Y
- QUIT
- +10 IF '$$ICD^ATXCHK(Y,T,0)
- QUIT
- +11 Begin DoDot:3
- +12 SET G=""
- +13 IF $$ICD^ATXCHK(Y,$ORDER(^ATXAX("B","BGP CMS CABG PROCEDURES",0)),0)
- SET G=1_U_"CABG"
- +14 IF $$ICD^ATXCHK(Y,$ORDER(^ATXAX("B","BGP CMS OTHER CARDIAC PROCS",0)),0)
- SET G=1_U_"Other Cardiac"
- +15 IF $$ICD^ATXCHK(Y,$ORDER(^ATXAX("B","BGP CMS HIP ARTHROPLASTY PROCS",0)),0)
- SET G=1_U_"Hip Arthroplasty"
- +16 IF $$ICD^ATXCHK(Y,$ORDER(^ATXAX("B","BGP CMS KNEE ARTHROPLASTY PROC",0)),0)
- SET G=1_U_"Knee Arthroplasty"
- +17 IF $$ICD^ATXCHK(Y,$ORDER(^ATXAX("B","BGP CMS COLON SURGERY PROCS",0)),0)
- SET G=1_U_"Colon Surgery"
- +18 IF $$ICD^ATXCHK(Y,$ORDER(^ATXAX("B","BGP CMS ABD HYSTERECTOMY PROCS",0)),0)
- SET G=1_U_"Hysterectomy"
- +19 IF $$ICD^ATXCHK(Y,$ORDER(^ATXAX("B","BGP CMS VAG HYSTERECTOMY PROCS",0)),0)
- SET G=1_U_"Hysterectomy"
- +20 IF $$ICD^ATXCHK(Y,$ORDER(^ATXAX("B","BGP CMS VASCULAR SURGERY PROCS",0)),0)
- SET G=1_U_"Vascular Surgery"
- End DoDot:3
- IF 'G
- QUIT
- +21 SET C=C+1
- SET BGPY(C)=$PIECE(G,U,2)_" "_$$VAL^XBDIQ1(9000010.08,X,.01)_" "_$$VAL^XBDIQ1(9000010.08,X,.04)_U_Y_U_$SELECT($PIECE(^AUPNVPRC(X,0),U,6)]"":$PIECE(^AUPNVPRC(X,0),U,6),1:9999999-ED)_U_$$VAL^XBDIQ1(9000010.08,X,.08)
- +22 QUIT
- End DoDot:2
- +23 QUIT
- End DoDot:1
- +24 QUIT
- ADMPRIM(H,T) ;EP
- +1 SET T=$ORDER(^ATXAX("B",T,0))
- +2 IF 'T
- QUIT ""
- +3 NEW I
- +4 SET I=$PIECE($GET(^AUPNVINP(H,0)),U,12)
- +5 IF $$ICD^ATXCHK(I,T,9)
- QUIT 1_U_"Admitting DX, preoperative infectious disease: "_$$VAL^XBDIQ1(9000010.02,H,.12)
- +6 SET I=$$PRIMPOV^APCLV($PIECE(^AUPNVINP(H,0),U,3),"I")
- +7 IF $$ICD^ATXCHK(I,T,9)
- QUIT 1_U_"Primary POV, preoperative infectious disease: "_$$PRIMPOV^APCLV($PIECE(^AUPNVINP(H,0),U,3),"C")_" - "_$$PRIMPOV^APCLV($PIECE(^AUPNVINP(H,0),U,3),"N")
- +8 QUIT ""
- +9 ;
- POSTINF(P,PD,PP) ;EP
- +1 NEW DAYS
- +2 SET DAYS=$SELECT($PIECE(PP,U,1)["CABG":3,$PIECE(PP,U,1)["Other Cardiac":3,1:2)
- +3 SET X=$$LASTDX^BGP0UTL1(P,"BGP CMS POST-OPERATIVE INF DXS",PD,$$FMADD^XLFDT(PD,DAYS))
- +4 IF X
- QUIT $PIECE(X,U,2)_" "_$$VAL^XBDIQ1(9000010.07,$PIECE(X,U,5),.04)_" "_$$DATE^BGP0UTL($PIECE(X,U,3))
- +5 QUIT ""
