APCM25EM.m

APCM25EM ;IHS/CMI/LAB - IHS MU AVG CENSUS;

 ;;1.0;MU PERFORMANCE REPORTS;**7**;MAR 26, 2012;Build 15

 ;

 ;

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

APCM25EM  ;IHS/CMI/LAB - IHS MU AVG CENSUS;

 +1       ;;1.0;MU PERFORMANCE REPORTS;**7**;MAR 26, 2012;Build 15

 +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