ADGSTAW1 ; IHS/ADC/PDW/ENM - INPATIENT STATS BY WARD (cont.) ; [ 03/25/1999 11:48 AM ]
;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999
;
A ; -- main
D H,W,T,N,K,PRTOPT^ADGVAR,Q Q
;
W ; -- loop ward counts for a period
S (T,W)=0 F S W=$O(DGWD(W)) Q:'W D
. Q:'$$AW D 1,L
Q
;
1 ; -- total ward counts (newborn 12-19; below + 10)
; (2 rem, 3 adm, 4 dis, 5 txi, 6 txo, 7 dth, 8 1day, 9 los)
F P=2:1:9,12:1:19 S $P(T,U,P)=$P(T,U,P)+$P(DGWD(W),U,P)
Q
;
L ; -- line
D:$Y>(IOSL-6) P(1)
W !!,$E($P(^DIC(42,W,0),U),1,10)
W ?16,$J($P(DGWD(W),U,3),3),?22,$J($P(DGWD(W),U,5),3)
W ?28,$J($P(DGWD(W),U,6),3),?34,$J($P(DGWD(W),U,4),3)
W ?40,$J($P(DGWD(W),U,7),3),?46,$J($P(DGWD(W),U,8),3)
W ?52,$J($$TISD(DGWD(W)),4),?60,$J($$ADIC(DGWD(W)),5,2)
W ?69,$J($P(DGWD(W),U,9),3),?74,$J($$ALOS(DGWD(W)),5,2) Q
;
T ; -- totals
D:$Y>(IOSL-6) P(1)
W !,$$LN("-"),!!,"TOTAL:",?16,$J($P(T,U,3),3)
W ?22,$J($P(T,U,5),3),?28,$J($P(T,U,6),3),?34,$J($P(T,U,4),3)
W ?40,$J($P(T,U,7),3),?46,$J($P(T,U,8),3),?52,$J($$TISD(T),4)
W ?59,$J($$ADIC(T),5,2),?68,$J($P(T,U,9),3)
W ?74,$J($$ALOS(T),5,2) Q
;
N ; -- newborn
D:$Y>(IOSL-6) P(1)
W !,$$LN("-"),!!,"NEWBORN",?16,$J($P(T,U,13),3)
W ?22,$J($P(T,U,15),3),?28,$J($P(T,U,16),3),?34,$J($P(T,U,14),3)
W ?40,$J($P(T,U,17),3),?46,$J($P(T,U,18),3)
W ?52,$J($$TISD($P(T,U,11,19)),4),?60,$J($$ADIC($P(T,U,11,19)),5,2)
W ?69,$J($P(T,U,19),3),?74,$J($$ALOS($P(T,U,11,19)),5,2) Q
;
Q ; -- cleanup
K DGWD,T,DGBD,DGED W @IOF D ^%ZISC Q
;
H ; -- heading
U IO W:IOST["C-" @IOF W $$UI,?80-$L($$FAC)\2,$$FAC,! D ^%T
W ?24,"INPATIENT STATISTICS BY WARD",!,$$DT(DT),?25,"from "
W $$DT(DGBD)," to ",$$DT(DGED),!!,"WARD",?16,"ADM",?22,"TXI"
W ?28,"TXO",?34,"DIS",?40,"DTH",?46,"1DAY",?52,"TISD",?61,"ADIC"
W ?68,"TLOS",?75,"ALOS",!,$$LN("=") Q
;
P(Z) ; -- page
Q:IOST'["C-" W ! N X,Y K DIR S DIR(0)="E" D ^DIR W @IOF D H:Z Q
;
K ; -- key
W !!,"TXI = transfers in, TXO = transfers out"
W !,"TISD = total inpatient service days"
W !,"ADIC = average daily inpatient census (adpl)"
W !,"TLOS = total length of stay (discharge days)"
W !,"ALOS = average length of stay (average stay)" Q
;
FAC() ; -- facility name
Q $P(^DIC(4,DUZ(2),0),U)
;
UI() ; -- user's initials
Q $P(^VA(200,DUZ,0),U,2)
;
LS(X) ; -- losses (dis+txo+dth)
Q $P(X,U,4)+$P(X,U,6)+$P(X,U,7)
;
AW() ; -- admitting ward
Q $S($D(^DIC(42,"AGL",1,+W)):1,1:0)
;
DT(X) ; -- date format
Q $E(X,4,5)_"/"_$E(X,6,7)_"/"_($E(X,1,3)+1700)
;
TISD(X) ; -- total inpatient service days
Q $P(X,U,2)+$P(X,U,8)
;
ADIC(X) ; -- average daily inpatient census (tisd / total # of days)
Q $$TISD(X)/$$ND(DGED,DGBD)
;
ALOS(X) ; -- average length of stay (los / losses)
Q $P(X,U,9)/$S($$LS(X):$$LS(X),1:1)
;
LN(X,Y) ; -- line
S Y="",$P(Y,X,IOM)="" Q Y
;
ND(X1,X2,X) ; -- number of days
D ^%DTC Q X+1
;
ADGSTAW1 ; IHS/ADC/PDW/ENM - INPATIENT STATS BY WARD (cont.) ; [ 03/25/1999 11:48 AM ]
+1 ;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999
+2 ;
A ; -- main
+1 DO H
DO W
DO T
DO N
DO K
DO PRTOPT^ADGVAR
DO Q
QUIT
+2 ;
W ; -- loop ward counts for a period
+1 SET (T,W)=0
FOR
SET W=$ORDER(DGWD(W))
IF 'W
QUIT
Begin DoDot:1
+2 IF '$$AW
QUIT
DO 1
DO L
End DoDot:1
+3 QUIT
+4 ;
1 ; -- total ward counts (newborn 12-19; below + 10)
+1 ; (2 rem, 3 adm, 4 dis, 5 txi, 6 txo, 7 dth, 8 1day, 9 los)
+2 FOR P=2:1:9,12:1:19
SET $PIECE(T,U,P)=$PIECE(T,U,P)+$PIECE(DGWD(W),U,P)
+3 QUIT
+4 ;
L ; -- line
+1 IF $Y>(IOSL-6)
DO P(1)
+2 WRITE !!,$EXTRACT($PIECE(^DIC(42,W,0),U),1,10)
+3 WRITE ?16,$JUSTIFY($PIECE(DGWD(W),U,3),3),?22,$JUSTIFY($PIECE(DGWD(W),U,5),3)
+4 WRITE ?28,$JUSTIFY($PIECE(DGWD(W),U,6),3),?34,$JUSTIFY($PIECE(DGWD(W),U,4),3)
+5 WRITE ?40,$JUSTIFY($PIECE(DGWD(W),U,7),3),?46,$JUSTIFY($PIECE(DGWD(W),U,8),3)
+6 WRITE ?52,$JUSTIFY($$TISD(DGWD(W)),4),?60,$JUSTIFY($$ADIC(DGWD(W)),5,2)
+7 WRITE ?69,$JUSTIFY($PIECE(DGWD(W),U,9),3),?74,$JUSTIFY($$ALOS(DGWD(W)),5,2)
QUIT
+8 ;
T ; -- totals
+1 IF $Y>(IOSL-6)
DO P(1)
+2 WRITE !,$$LN("-"),!!,"TOTAL:",?16,$JUSTIFY($PIECE(T,U,3),3)
+3 WRITE ?22,$JUSTIFY($PIECE(T,U,5),3),?28,$JUSTIFY($PIECE(T,U,6),3),?34,$JUSTIFY($PIECE(T,U,4),3)
+4 WRITE ?40,$JUSTIFY($PIECE(T,U,7),3),?46,$JUSTIFY($PIECE(T,U,8),3),?52,$JUSTIFY($$TISD(T),4)
+5 WRITE ?59,$JUSTIFY($$ADIC(T),5,2),?68,$JUSTIFY($PIECE(T,U,9),3)
+6 WRITE ?74,$JUSTIFY($$ALOS(T),5,2)
QUIT
+7 ;
N ; -- newborn
+1 IF $Y>(IOSL-6)
DO P(1)
+2 WRITE !,$$LN("-"),!!,"NEWBORN",?16,$JUSTIFY($PIECE(T,U,13),3)
+3 WRITE ?22,$JUSTIFY($PIECE(T,U,15),3),?28,$JUSTIFY($PIECE(T,U,16),3),?34,$JUSTIFY($PIECE(T,U,14),3)
+4 WRITE ?40,$JUSTIFY($PIECE(T,U,17),3),?46,$JUSTIFY($PIECE(T,U,18),3)
+5 WRITE ?52,$JUSTIFY($$TISD($PIECE(T,U,11,19)),4),?60,$JUSTIFY($$ADIC($PIECE(T,U,11,19)),5,2)
+6 WRITE ?69,$JUSTIFY($PIECE(T,U,19),3),?74,$JUSTIFY($$ALOS($PIECE(T,U,11,19)),5,2)
QUIT
+7 ;
Q ; -- cleanup
+1 KILL DGWD,T,DGBD,DGED
WRITE @IOF
DO ^%ZISC
QUIT
+2 ;
H ; -- heading
+1 USE IO
IF IOST["C-"
WRITE @IOF
WRITE $$UI,?80-$LENGTH($$FAC)\2,$$FAC,!
DO ^%T
+2 WRITE ?24,"INPATIENT STATISTICS BY WARD",!,$$DT(DT),?25,"from "
+3 WRITE $$DT(DGBD)," to ",$$DT(DGED),!!,"WARD",?16,"ADM",?22,"TXI"
+4 WRITE ?28,"TXO",?34,"DIS",?40,"DTH",?46,"1DAY",?52,"TISD",?61,"ADIC"
+5 WRITE ?68,"TLOS",?75,"ALOS",!,$$LN("=")
QUIT
+6 ;
P(Z) ; -- page
+1 IF IOST'["C-"
QUIT
WRITE !
NEW X,Y
KILL DIR
SET DIR(0)="E"
DO ^DIR
WRITE @IOF
IF Z
DO H
QUIT
+2 ;
K ; -- key
+1 WRITE !!,"TXI = transfers in, TXO = transfers out"
+2 WRITE !,"TISD = total inpatient service days"
+3 WRITE !,"ADIC = average daily inpatient census (adpl)"
+4 WRITE !,"TLOS = total length of stay (discharge days)"
+5 WRITE !,"ALOS = average length of stay (average stay)"
QUIT
+6 ;
FAC() ; -- facility name
+1 QUIT $PIECE(^DIC(4,DUZ(2),0),U)
+2 ;
UI() ; -- user's initials
+1 QUIT $PIECE(^VA(200,DUZ,0),U,2)
+2 ;
LS(X) ; -- losses (dis+txo+dth)
+1 QUIT $PIECE(X,U,4)+$PIECE(X,U,6)+$PIECE(X,U,7)
+2 ;
AW() ; -- admitting ward
+1 QUIT $SELECT($DATA(^DIC(42,"AGL",1,+W)):1,1:0)
+2 ;
DT(X) ; -- date format
+1 QUIT $EXTRACT(X,4,5)_"/"_$EXTRACT(X,6,7)_"/"_($EXTRACT(X,1,3)+1700)
+2 ;
TISD(X) ; -- total inpatient service days
+1 QUIT $PIECE(X,U,2)+$PIECE(X,U,8)
+2 ;
ADIC(X) ; -- average daily inpatient census (tisd / total # of days)
+1 QUIT $$TISD(X)/$$ND(DGED,DGBD)
+2 ;
ALOS(X) ; -- average length of stay (los / losses)
+1 QUIT $PIECE(X,U,9)/$SELECT($$LS(X):$$LS(X),1:1)
+2 ;
LN(X,Y) ; -- line
+1 SET Y=""
SET $PIECE(Y,X,IOM)=""
QUIT Y
+2 ;
ND(X1,X2,X) ; -- number of days
+1 DO ^%DTC
QUIT X+1
+2 ;
