APCM24EM ;IHS/CMI/LAB - IHS MU AVG CENSUS;
;;1.0;IHS MU PERFORMANCE REPORTS;**5,6**;MAR 26, 2012;Build 65
;
;
AVC(APCMBD,APCMED,F) ;EP - GET # H VISITS IN PREVIOUS CALENDAR YEAR AND DIVIDE BY 365
NEW BD,ED,X,Y,T,D
S X=$E(APCMBD,1,3)-1
S BD=X_"0101"
S ED=X_"1231"
S Y=1700+X
S D=$S($$LEAP^%DTC(Y):366,1:365)
S SD=$$FMADD^XLFDT(BD,-1)_".9999"
S T=0
F S SD=$O(^AUPNVSIT("B",SD)) Q:SD'=+SD!($P(SD,".")>ED) D
.S X=0 F S X=$O(^AUPNVSIT("B",SD,X)) Q:X'=+X D
..Q:'$D(^AUPNVSIT(X,0))
..Q:$P(^AUPNVSIT(X,0),U,7)'="H"
..Q:$P(^AUPNVSIT(X,0),U,6)'=F
..Q:$P(^AUPNVSIT(X,0),U,11) ;deleted
..S T=T+1
Q T/D
AVCADT(APCMBD,APCMED) ; -- have user select report by ward or by service
NEW APCMFRM,APCMIA
S APCMFRM=1
S APCMIA=1
;
;
INIT ; -- init variables and list array
NEW APCMDAYS,APCMADC
K APCMADC
S APCMDAYS=$$FMDIFF^XLFDT(APCMED,APCMBD)+1 ;# of days in date range
;
D 1 ;gather ward or service stats for date range
;
I '$D(APCMADC) Q 0
;
Q APCMADC
;
1 ; step thru ADT Census-Ward file for date range
NEW WARD,WRDNM,DATE,APCMA,X,LINE,TOTAL
S WARD=0
F S WARD=$O(^BDGCWD(WARD)) Q:'WARD D
. I APCMIA=0,'$D(^BDGWD(WARD)) Q ;old ward, no longer used
. I APCMIA=0,$$GET1^DIQ(9009016.5,WARD,.03)="INACTIVE" Q
. S WRDNM=$$GET1^DIQ(42,WARD,.01) ;ward name
. ;
. S DATE=APCMBD-.001
. F S DATE=$O(^BDGCWD(WARD,1,DATE)) Q:DATE>APCMED Q:'DATE D
.. ; count patients remaining and one day patients
.. S X=$P($G(^BDGCWD(WARD,1,DATE,0)),U,2)+$P($G(^(0)),U,8)
.. ; increment array for total inpatient days
.. S APCMA(WRDNM)=$G(APCMA(WRDNM))+X
;
; put sorted data into display array
S WARD=0 F S WARD=$O(APCMA(WARD)) Q:WARD="" D
. ; increment totals
. S TOTAL=$G(TOTAL)+APCMA(WARD)
;
; put totals line into display array
I $G(TOTAL) D
. S APCMADC=TOTAL/APCMDAYS
Q
APCM24EM ;IHS/CMI/LAB - IHS MU AVG CENSUS;
+1 ;;1.0;IHS MU PERFORMANCE REPORTS;**5,6**;MAR 26, 2012;Build 65
+2 ;
+3 ;
AVC(APCMBD,APCMED,F) ;EP - GET # H VISITS IN PREVIOUS CALENDAR YEAR AND DIVIDE BY 365
+1 NEW BD,ED,X,Y,T,D
+2 SET X=$EXTRACT(APCMBD,1,3)-1
+3 SET BD=X_"0101"
+4 SET ED=X_"1231"
+5 SET Y=1700+X
+6 SET D=$SELECT($$LEAP^%DTC(Y):366,1:365)
+7 SET SD=$$FMADD^XLFDT(BD,-1)_".9999"
+8 SET T=0
+9 FOR
SET SD=$ORDER(^AUPNVSIT("B",SD))
IF SD'=+SD!($PIECE(SD,".")>ED)
QUIT
Begin DoDot:1
+10 SET X=0
FOR
SET X=$ORDER(^AUPNVSIT("B",SD,X))
IF X'=+X
QUIT
Begin DoDot:2
+11 IF '$DATA(^AUPNVSIT(X,0))
QUIT
+12 IF $PIECE(^AUPNVSIT(X,0),U,7)'="H"
QUIT
+13 IF $PIECE(^AUPNVSIT(X,0),U,6)'=F
QUIT
+14 ;deleted
IF $PIECE(^AUPNVSIT(X,0),U,11)
QUIT
+15 SET T=T+1
End DoDot:2
End DoDot:1
+16 QUIT T/D
AVCADT(APCMBD,APCMED) ; -- have user select report by ward or by service
+1 NEW APCMFRM,APCMIA
+2 SET APCMFRM=1
+3 SET APCMIA=1
+4 ;
+5 ;
INIT ; -- init variables and list array
+1 NEW APCMDAYS,APCMADC
+2 KILL APCMADC
+3 ;# of days in date range
SET APCMDAYS=$$FMDIFF^XLFDT(APCMED,APCMBD)+1
+4 ;
+5 ;gather ward or service stats for date range
DO 1
+6 ;
+7 IF '$DATA(APCMADC)
QUIT 0
+8 ;
+9 QUIT APCMADC
+10 ;
1 ; step thru ADT Census-Ward file for date range
+1 NEW WARD,WRDNM,DATE,APCMA,X,LINE,TOTAL
+2 SET WARD=0
+3 FOR
SET WARD=$ORDER(^BDGCWD(WARD))
IF 'WARD
QUIT
Begin DoDot:1
+4 ;old ward, no longer used
IF APCMIA=0
IF '$DATA(^BDGWD(WARD))
QUIT
+5 IF APCMIA=0
IF $$GET1^DIQ(9009016.5,WARD,.03)="INACTIVE"
QUIT
+6 ;ward name
SET WRDNM=$$GET1^DIQ(42,WARD,.01)
+7 ;
+8 SET DATE=APCMBD-.001
+9 FOR
SET DATE=$ORDER(^BDGCWD(WARD,1,DATE))
IF DATE>APCMED
QUIT
IF 'DATE
QUIT
Begin DoDot:2
+10 ; count patients remaining and one day patients
+11 SET X=$PIECE($GET(^BDGCWD(WARD,1,DATE,0)),U,2)+$PIECE($GET(^(0)),U,8)
+12 ; increment array for total inpatient days
+13 SET APCMA(WRDNM)=$GET(APCMA(WRDNM))+X
End DoDot:2
End DoDot:1
+14 ;
+15 ; put sorted data into display array
+16 SET WARD=0
FOR
SET WARD=$ORDER(APCMA(WARD))
IF WARD=""
QUIT
Begin DoDot:1
+17 ; increment totals
+18 SET TOTAL=$GET(TOTAL)+APCMA(WARD)
End DoDot:1
+19 ;
+20 ; put totals line into display array
+21 IF $GET(TOTAL)
Begin DoDot:1
+22 SET APCMADC=TOTAL/APCMDAYS
End DoDot:1
+23 QUIT
