BDGSTAT2 ; IHS/ANMC/LJF - INPT STATS BY WARD ;
;;5.3;PIMS;**1009,1013,1018**;MAY 28, 2004;Build 27
;
;
;cmi/anch/maw 04/08/2007 PATCH 1009 requirement 24 added code to count swing beds
;ihs/cmi/maw 04/15/2011 PATCH 1013 RQMT155 add day surgery
;IHS/OIT/CLS 03/31/2015 PATCH 1018 changed '=' to '[' DAY SURGERY to allow for subspecialties
;
NEW BDGBD,BDGED,BDGIA,BDGTYP
;
S BDGBD=$$READ^BDGF("DO^::EX","Select Beginning Date") Q:BDGBD<1
S BDGED=$$READ^BDGF("DO^::EX","Select Ending Date") Q:BDGED<1
;
S BDGIA=$$READ^BDGF("Y","Include INACTIVE Wards","NO")
;
;S BDGTYP=$$READ^BDGF("S^1:Inpatients Only;2:Observation Patients Only;3:Both","Select Patient Type","BOTH") Q:BDGTYP=U
S BDGTYP=$$READ^BDGF("S^1:Inpatients Only;2:Observation Patients Only;3:Day Surgery Patients Only;4:All","Select Patient Type","ALL") Q:BDGTYP=U ;ihs/cmi/maw 04/15/2011 PATCH 1013 RQMT155
;
D ZIS^BDGF("PQ","EN^BDGSTAT2","STATS BY WARD","BDGBD;BDGED;BDGIA;BDGTYP")
Q
;
EN ; -- main entry point for BDG STAT BY WARD
I $E(IOST,1,2)="P-" D INIT,PRINT Q ;if printing to paper
NEW VALMCNT D TERM^VALM0,CLEAR^VALM1
D EN^VALM("BDG STAT BY WARD")
D CLEAR^VALM1
Q
;
HDR ; -- header code
NEW X
S X="For "_$$FMTE^XLFDT(BDGBD)_" through "_$$FMTE^XLFDT(BDGED)
S VALMHDR(1)=$$SP(75-$L(X)\2)_X
;I BDGTYP=3 S X="Includes Inpatients AND Observations"
I BDGTYP=4 S X="Includes Inpatients, Observations AND Day Surgery"
E S X=$S(BDGTYP=1:"Inpatients Only",BDGTYP=2:"Observations Only",1:"Day Surgery Only")
S VALMHDR(2)=$$SP(75-$L(X)\2)_X
Q
;
INIT ; -- init variables and list array
NEW BDGDAYS,WARD,WRDNM,DATE,X,BDGA,Y,LINE,I,BDGNB,TOTAL
K ^TMP("BDGSTAT2",$J)
S VALMCNT=0,TOTAL=0
S BDGDAYS=$$FMDIFF^XLFDT(BDGED,BDGBD)+1 ;# of days for division
;
S WARD=0 F S WARD=$O(^BDGCWD(WARD)) Q:'WARD D
. ;
. ; quit if inactive and not including inactives
. Q:'$D(^BDGWD(WARD))
. I BDGIA=0,$$GET1^DIQ(9009016.5,WARD,.03)="INACTIVE" Q
. S WRDNM=$$GET1^DIQ(9009016.5,WARD,.02) ;ward abbrev
. ;
. S DATE=BDGBD-.001
. F S DATE=$O(^BDGCWD(WARD,1,DATE)) Q:DATE>BDGED Q:'DATE D
.. ;
.. ; if inpatient only or observation only
.. I BDGTYP'=4 D ONLY(WARD,WRDNM,DATE) Q
.. ;
.. ; else grab all
.. S X=$G(^BDGCWD(WARD,1,DATE,0)) ;grab data node
.. D NEWBORN(WARD,DATE,.X) ;subtract out newborn numbers
.. ;cmi/maw 4/8/2007 PATCH 1009 requirement 24
.. D SWING(WARD,DATE,.X) ;subtract out swing bed numbers
.. ;
.. ; put data in column order (adm, txi, txo, dsc, dth)
.. S Y=$P(X,U,3)_U_$P(X,U,5)_U_$P(X,U,6)_U_$P(X,U,4)_U_$P(X,U,7)
.. ; then add 1day pts, pat days (remaining + 1day pts)
.. S Y=Y_U_$P(X,U,8)_U_($P(X,U,2)+$P(X,U,8))
.. ; then los (includes observation - converted from hours)
.. S Y=Y_U_($P(X,U,9)+($P(X,U,11)\24))
.. ;
.. ; increment array for totals
.. F I=1:1:8 S $P(BDGA(WRDNM),U,I)=$P($G(BDGA(WRDNM)),U,I)+$P(Y,U,I)
.. F I=1:1:8 S $P(TOTAL,U,I)=$P($G(TOTAL),U,I)+$P(Y,U,I)
;
;
S WARD=0 F S WARD=$O(BDGA(WARD)) Q:WARD="" D
. S LINE=$$PAD(WARD,10)
. F I=1:1:7 S LINE=LINE_$J($P(BDGA(WARD),U,I),4)_" "
. S LINE=LINE_$J($P(BDGA(WARD),U,7)/BDGDAYS,6,2) ;adpl
. S LINE=LINE_$J($P(BDGA(WARD),U,8),6)_" /" ;losdsch
. S X=$P(BDGA(WARD),3)+$P(BDGA(WARD),U,4)+$P(BDGA(WARD),U,5)
. S LINE=LINE_$J($P(BDGA(WARD),U,8)\$S(X=0:1,1:X),3) ;alos
. S X=$P(BDGA(WARD),U)+$P(BDGA(WARD),U,2) S:X=0 X=1 ;#admit+txi
. S LINE=LINE_$J($P(BDGA(WARD),U,7)\X,8) ;losadmit
. D SET(LINE,.VALMCNT)
;
; add totals to display array
S LINE=$$PAD("TOTAL:",10)
F I=1:1:7 S LINE=LINE_$J($P(TOTAL,U,I),4)_" "
S LINE=LINE_$J($P(TOTAL,U,7)/BDGDAYS,6,2) ;adpl
S LINE=LINE_$J($P(TOTAL,U,8),7)_" /" ;los
S X=$P(TOTAL,U,3)+$P(TOTAL,U,4)+$P(TOTAL,U,5) ;#txo+dsc+deaths
S LINE=LINE_$J($P(TOTAL,U,8)\$S(X=0:1,1:X),3) ;alos
S X=$P(TOTAL,U)+$P(TOTAL,U,2) S:X=0 X=1 ;#admits+txi
S LINE=LINE_$J($P(TOTAL,U,7)\X,8) ;losadmit
D SET($$REPEAT^XLFSTR("=",80),.VALMCNT),SET(LINE,.VALMCNT)
;
; add newborn stats to display array
I $D(BDGNB) D
. S LINE=$$PAD("NEWBORN:",10)
. F I=1:1:7 S LINE=LINE_$J($P(BDGNB,U,I),4)_" "
. S LINE=LINE_$J($P(BDGNB,U,7)/BDGDAYS,6,2) ;adpl
. S LINE=LINE_$J($P(BDGNB,U,8),7)_" /" ;losdsch
. S X=$P(BDGNB,U,3)+$P(BDGNB,U,4)+$P(BDGNB,U,5) ;#txo+dsc+deaths
. S LINE=LINE_$J($P(BDGNB,U,8)\$S(X=0:1,1:X),3) ;alos by discharge
. S X=$P(BDGNB,U)+$P(BDGNB,U,2) S:X=0 X=1 ;#admits+txi
. S LINE=LINE_$J($P(BDGNB,U,7)\X,8) ;losadmit
. D SET($$REPEAT^XLFSTR("-",80),.VALMCNT),SET(LINE,.VALMCNT)
;
; cmi/maw 04/08/2008 requirement 24 added for swing bed counts
; add swing bed stats to display array
I $D(BDGSWING) D
. S LINE=$$PAD("SWING BED:",10)
. F I=1:1:7 S LINE=LINE_$J($P(BDGSWING,U,I),4)_" "
. S LINE=LINE_$J($P(BDGSWING,U,7)/BDGDAYS,6,2) ;adpl
. S LINE=LINE_$J($P(BDGSWING,U,8),7)_" /" ;losdsch
. S X=$P(BDGSWING,U,3)+$P(BDGSWING,U,4)+$P(BDGSWING,U,5) ;#txo+dsc+deaths
. S LINE=LINE_$J($P(BDGSWING,U,8)\$S(X=0:1,1:X),3) ;alos by discharge
. S X=$P(BDGSWING,U)+$P(BDGSWING,U,2) S:X=0 X=1 ;#admits+txi
. S LINE=LINE_$J($P(BDGSWING,U,7)\X,8) ;losadmit
. D SET($$REPEAT^XLFSTR("-",80),.VALMCNT),SET(LINE,.VALMCNT)
;
I '$D(^TMP("BDGSTAT2",$J)) D SET("No data found",.VALMCNT)
;
D LEGEND
;
Q
;
ONLY(WARD,NAME,DATE) ; find data by inpt service
NEW SRV,X,Y,I
S SRV=0 F S SRV=$O(^BDGCWD(WARD,1,DATE,1,SRV)) Q:'SRV D
. S SRVNM=$$GET1^DIQ(45.7,SRV,.01)
. I BDGTYP=1 Q:SRVNM["OBSERVATION"
. ;I BDGTYP=1 Q:SRVNM="DAY SURGERY" ;ihs/cmi/maw 02/26/2014 for claremore to test
. I BDGTYP=1 Q:SRVNM["DAY SURGERY" ;ihs/cmi/maw 02/26/2014 for claremore to test; IHS/OIT/CLS 03/31/2015 patch 1018
. I BDGTYP=2 Q:SRVNM'["OBSERVATION"
. ;I BDGTYP=3 Q:SRVNM'="DAY SURGERY" ;ihs/cmi/maw 04/15/2011 PATCH 1013 RQMT155
. I BDGTYP=3 Q:SRVNM'["DAY SURGERY" ;ihs/cmi/maw 04/15/2011 PATCH 1013 RQMT155; IHS/OIT/CLS 03/31/2015 patch 1018
. ;
. S X=$G(^BDGCWD(WARD,1,DATE,1,SRV,0)) ;grab data node
. ;
. ; put data in column order (adm, txi)
. S Y=($P(X,U,3)+$P(X,U,13))_U_($P(X,U,5)+$P(X,U,15))
. ; then add txo and dsch
. S Y=Y_U_($P(X,U,6)+$P(X,U,16))_U_($P(X,U,4)+$P(X,U,14))
. ; and death
. S Y=Y_U_($P(X,U,7)+$P(X,U,17))
. ; then add 1day pts
. S Y=Y_U_($P(X,U,8)+$P(X,U,18))
. ; and pat days (remaining + 1day pts)
. S Y=Y_U_($P(X,U,2)+$P(X,U,12)+$P(X,U,8)+$P(X,U,18))
. ; then los (includes observation - converted from hours)
. S Y=Y_U_($P(X,U,9)+$P(X,U,19)+($P(X,U,11)\24)+($P(X,U,21)\24))
. ;
. ; increment array for totals
. I SRVNM="NEWBORN" D Q
.. F I=1:1:8 S $P(BDGNB,U,I)=$P($G(BDGNB),U,I)+$P(Y,U,I)
. I SRVNM="SWING BED" D Q ;cmi/maw 4/8/2008 PATCH 1009 requirement 24
.. F I=1:1:8 S $P(BDGSWING,U,I)=$P($G(BDGSWING),U,I)+$P(Y,U,I)
. ;
. F I=1:1:8 S $P(BDGA(NAME),U,I)=$P($G(BDGA(NAME)),U,I)+$P(Y,U,I)
. F I=1:1:8 S $P(TOTAL,U,I)=$P($G(TOTAL),U,I)+$P(Y,U,I)
Q
;
NEWBORN(WARD,DATE,DATA) ; subtract out newborn numbers of ward and date
NEW NEWB,X,I
S NEWB=$O(^DIC(45.7,"B","NEWBORN",0)) Q:'NEWB
S X=$G(^BDGCWD(WARD,1,DATE,1,NEWB,0)) Q:X="" ;no data
F I=1:1:11 S $P(DATA,U,I)=$P(DATA,U,I)-$P(X,U,I)
Q
;
SWING(WARD,DATE,DATA) ; subtract out swing bed numbers of ward and date
NEW SWING,X,I
S SWING=$O(^DIC(45.7,"B","SWING BED",0)) Q:'SWING
S X=$G(^BDGCWD(WARD,1,DATE,1,SWING,0)) Q:X="" ;no data
F I=1:1:11 S $P(DATA,U,I)=$P(DATA,U,I)-$P(X,U,I)
Q
;
SET(DATA,NUM) ; put data into display array
S NUM=NUM+1
S ^TMP("BDGSTAT2",$J,NUM,0)=DATA
Q
;
LEGEND ; add legend explaining column headings
D SET("",.VALMCNT)
D SET("ADM = admissions, TXI = ward transfers in",.VALMCNT)
D SET("TXO = ward transfer out, DSC = discharges",.VALMCNT)
D SET("DTH = deaths, 1DAY = admitted & discharged same day",.VALMCNT)
D SET("DAYS = total patient days, ADPL = ave daily patient load",.VALMCNT)
D SET("LOSD = length of stay for patients discharged: total / average",.VALMCNT)
D SET(" (discharged = TXO + DSC + DTH)",.VALMCNT)
D SET("LOSA = length of stay by admissions (inpt days/#ADM+TXI)",.VALMCNT)
Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
K ^TMP("BDGSTAT2",$J)
Q
;
PRINT ; print to paper
NEW BDGLN,BDGPG
U IO D INIT^BDGF,HDG
S BDGLN=0 F S BDGLN=$O(^TMP("BDGSTAT2",$J,BDGLN)) Q:'BDGLN D
. I $Y>(IOSL-4) D HDG
. W !,^TMP("BDGSTAT2",$J,BDGLN,0)
D ^%ZISC,PRTKL^BDGF,EXIT
Q
;
HDG ; heading if printing to paper
S BDGPG=$G(BDGPG)+1 I BDGPG>1 W @IOF
W !,BDGUSR,?31,"Statistics by Ward"
NEW X S X="For "_$$FMTE^XLFDT(BDGBD)_" through "_$$FMTE^XLFDT(BDGED)
W !,BDGTIME,?(80-$L(X)\2),X,?71,"Page: ",BDGPG
I BDGTYP=3 S X="Includes Inpatients AND Observations"
E S X=$S(BDGTYP=1:"Inpatients Only",1:"Observations Only")
W !,BDGDATE,?(80-$L(X)\2),X
W !,"Ward",?11,"ADM",?17,"TXI",?23,"TXO",?29,"DSC",?35,"DTH",?40,"1DAY"
W ?47,"DAYS",?55,"ADPL",?64,"LOSD",?74,"LOSA"
W !,$$REPEAT^XLFSTR("=",80)
Q
;
EXPND ; -- expand code
Q
;
PAD(D,L) ;EP -- SUBRTN to pad length of data
; -- D=data L=length
Q $E(D_$$REPEAT^XLFSTR(" ",L),1,L)
;
SP(N) ; -- SUBRTN to pad N number of spaces
Q $$PAD(" ",N)
BDGSTAT2 ; IHS/ANMC/LJF - INPT STATS BY WARD ;
+1 ;;5.3;PIMS;**1009,1013,1018**;MAY 28, 2004;Build 27
+2 ;
+3 ;
+4 ;cmi/anch/maw 04/08/2007 PATCH 1009 requirement 24 added code to count swing beds
+5 ;ihs/cmi/maw 04/15/2011 PATCH 1013 RQMT155 add day surgery
+6 ;IHS/OIT/CLS 03/31/2015 PATCH 1018 changed '=' to '[' DAY SURGERY to allow for subspecialties
+7 ;
+8 NEW BDGBD,BDGED,BDGIA,BDGTYP
+9 ;
+10 SET BDGBD=$$READ^BDGF("DO^::EX","Select Beginning Date")
IF BDGBD<1
QUIT
+11 SET BDGED=$$READ^BDGF("DO^::EX","Select Ending Date")
IF BDGED<1
QUIT
+12 ;
+13 SET BDGIA=$$READ^BDGF("Y","Include INACTIVE Wards","NO")
+14 ;
+15 ;S BDGTYP=$$READ^BDGF("S^1:Inpatients Only;2:Observation Patients Only;3:Both","Select Patient Type","BOTH") Q:BDGTYP=U
+16 ;ihs/cmi/maw 04/15/2011 PATCH 1013 RQMT155
SET BDGTYP=$$READ^BDGF("S^1:Inpatients Only;2:Observation Patients Only;3:Day Surgery Patients Only;4:All","Select Patient Type","ALL")
IF BDGTYP=U
QUIT
+17 ;
+18 DO ZIS^BDGF("PQ","EN^BDGSTAT2","STATS BY WARD","BDGBD;BDGED;BDGIA;BDGTYP")
+19 QUIT
+20 ;
EN ; -- main entry point for BDG STAT BY WARD
+1 ;if printing to paper
IF $EXTRACT(IOST,1,2)="P-"
DO INIT
DO PRINT
QUIT
+2 NEW VALMCNT
DO TERM^VALM0
DO CLEAR^VALM1
+3 DO EN^VALM("BDG STAT BY WARD")
+4 DO CLEAR^VALM1
+5 QUIT
+6 ;
HDR ; -- header code
+1 NEW X
+2 SET X="For "_$$FMTE^XLFDT(BDGBD)_" through "_$$FMTE^XLFDT(BDGED)
+3 SET VALMHDR(1)=$$SP(75-$LENGTH(X)\2)_X
+4 ;I BDGTYP=3 S X="Includes Inpatients AND Observations"
+5 IF BDGTYP=4
SET X="Includes Inpatients, Observations AND Day Surgery"
+6 IF '$TEST
SET X=$SELECT(BDGTYP=1:"Inpatients Only",BDGTYP=2:"Observations Only",1:"Day Surgery Only")
+7 SET VALMHDR(2)=$$SP(75-$LENGTH(X)\2)_X
+8 QUIT
+9 ;
INIT ; -- init variables and list array
+1 NEW BDGDAYS,WARD,WRDNM,DATE,X,BDGA,Y,LINE,I,BDGNB,TOTAL
+2 KILL ^TMP("BDGSTAT2",$JOB)
+3 SET VALMCNT=0
SET TOTAL=0
+4 ;# of days for division
SET BDGDAYS=$$FMDIFF^XLFDT(BDGED,BDGBD)+1
+5 ;
+6 SET WARD=0
FOR
SET WARD=$ORDER(^BDGCWD(WARD))
IF 'WARD
QUIT
Begin DoDot:1
+7 ;
+8 ; quit if inactive and not including inactives
+9 IF '$DATA(^BDGWD(WARD))
QUIT
+10 IF BDGIA=0
IF $$GET1^DIQ(9009016.5,WARD,.03)="INACTIVE"
QUIT
+11 ;ward abbrev
SET WRDNM=$$GET1^DIQ(9009016.5,WARD,.02)
+12 ;
+13 SET DATE=BDGBD-.001
+14 FOR
SET DATE=$ORDER(^BDGCWD(WARD,1,DATE))
IF DATE>BDGED
QUIT
IF 'DATE
QUIT
Begin DoDot:2
+15 ;
+16 ; if inpatient only or observation only
+17 IF BDGTYP'=4
DO ONLY(WARD,WRDNM,DATE)
QUIT
+18 ;
+19 ; else grab all
+20 ;grab data node
SET X=$GET(^BDGCWD(WARD,1,DATE,0))
+21 ;subtract out newborn numbers
DO NEWBORN(WARD,DATE,.X)
+22 ;cmi/maw 4/8/2007 PATCH 1009 requirement 24
+23 ;subtract out swing bed numbers
DO SWING(WARD,DATE,.X)
+24 ;
+25 ; put data in column order (adm, txi, txo, dsc, dth)
+26 SET Y=$PIECE(X,U,3)_U_$PIECE(X,U,5)_U_$PIECE(X,U,6)_U_$PIECE(X,U,4)_U_$PIECE(X,U,7)
+27 ; then add 1day pts, pat days (remaining + 1day pts)
+28 SET Y=Y_U_$PIECE(X,U,8)_U_($PIECE(X,U,2)+$PIECE(X,U,8))
+29 ; then los (includes observation - converted from hours)
+30 SET Y=Y_U_($PIECE(X,U,9)+($PIECE(X,U,11)\24))
+31 ;
+32 ; increment array for totals
+33 FOR I=1:1:8
SET $PIECE(BDGA(WRDNM),U,I)=$PIECE($GET(BDGA(WRDNM)),U,I)+$PIECE(Y,U,I)
+34 FOR I=1:1:8
SET $PIECE(TOTAL,U,I)=$PIECE($GET(TOTAL),U,I)+$PIECE(Y,U,I)
End DoDot:2
End DoDot:1
+35 ;
+36 ;
+37 SET WARD=0
FOR
SET WARD=$ORDER(BDGA(WARD))
IF WARD=""
QUIT
Begin DoDot:1
+38 SET LINE=$$PAD(WARD,10)
+39 FOR I=1:1:7
SET LINE=LINE_$JUSTIFY($PIECE(BDGA(WARD),U,I),4)_" "
+40 ;adpl
SET LINE=LINE_$JUSTIFY($PIECE(BDGA(WARD),U,7)/BDGDAYS,6,2)
+41 ;losdsch
SET LINE=LINE_$JUSTIFY($PIECE(BDGA(WARD),U,8),6)_" /"
+42 SET X=$PIECE(BDGA(WARD),3)+$PIECE(BDGA(WARD),U,4)+$PIECE(BDGA(WARD),U,5)
+43 ;alos
SET LINE=LINE_$JUSTIFY($PIECE(BDGA(WARD),U,8)\$SELECT(X=0:1,1:X),3)
+44 ;#admit+txi
SET X=$PIECE(BDGA(WARD),U)+$PIECE(BDGA(WARD),U,2)
IF X=0
SET X=1
+45 ;losadmit
SET LINE=LINE_$JUSTIFY($PIECE(BDGA(WARD),U,7)\X,8)
+46 DO SET(LINE,.VALMCNT)
End DoDot:1
+47 ;
+48 ; add totals to display array
+49 SET LINE=$$PAD("TOTAL:",10)
+50 FOR I=1:1:7
SET LINE=LINE_$JUSTIFY($PIECE(TOTAL,U,I),4)_" "
+51 ;adpl
SET LINE=LINE_$JUSTIFY($PIECE(TOTAL,U,7)/BDGDAYS,6,2)
+52 ;los
SET LINE=LINE_$JUSTIFY($PIECE(TOTAL,U,8),7)_" /"
+53 ;#txo+dsc+deaths
SET X=$PIECE(TOTAL,U,3)+$PIECE(TOTAL,U,4)+$PIECE(TOTAL,U,5)
+54 ;alos
SET LINE=LINE_$JUSTIFY($PIECE(TOTAL,U,8)\$SELECT(X=0:1,1:X),3)
+55 ;#admits+txi
SET X=$PIECE(TOTAL,U)+$PIECE(TOTAL,U,2)
IF X=0
SET X=1
+56 ;losadmit
SET LINE=LINE_$JUSTIFY($PIECE(TOTAL,U,7)\X,8)
+57 DO SET($$REPEAT^XLFSTR("=",80),.VALMCNT)
DO SET(LINE,.VALMCNT)
+58 ;
+59 ; add newborn stats to display array
+60 IF $DATA(BDGNB)
Begin DoDot:1
+61 SET LINE=$$PAD("NEWBORN:",10)
+62 FOR I=1:1:7
SET LINE=LINE_$JUSTIFY($PIECE(BDGNB,U,I),4)_" "
+63 ;adpl
SET LINE=LINE_$JUSTIFY($PIECE(BDGNB,U,7)/BDGDAYS,6,2)
+64 ;losdsch
SET LINE=LINE_$JUSTIFY($PIECE(BDGNB,U,8),7)_" /"
+65 ;#txo+dsc+deaths
SET X=$PIECE(BDGNB,U,3)+$PIECE(BDGNB,U,4)+$PIECE(BDGNB,U,5)
+66 ;alos by discharge
SET LINE=LINE_$JUSTIFY($PIECE(BDGNB,U,8)\$SELECT(X=0:1,1:X),3)
+67 ;#admits+txi
SET X=$PIECE(BDGNB,U)+$PIECE(BDGNB,U,2)
IF X=0
SET X=1
+68 ;losadmit
SET LINE=LINE_$JUSTIFY($PIECE(BDGNB,U,7)\X,8)
+69 DO SET($$REPEAT^XLFSTR("-",80),.VALMCNT)
DO SET(LINE,.VALMCNT)
End DoDot:1
+70 ;
+71 ; cmi/maw 04/08/2008 requirement 24 added for swing bed counts
+72 ; add swing bed stats to display array
+73 IF $DATA(BDGSWING)
Begin DoDot:1
+74 SET LINE=$$PAD("SWING BED:",10)
+75 FOR I=1:1:7
SET LINE=LINE_$JUSTIFY($PIECE(BDGSWING,U,I),4)_" "
+76 ;adpl
SET LINE=LINE_$JUSTIFY($PIECE(BDGSWING,U,7)/BDGDAYS,6,2)
+77 ;losdsch
SET LINE=LINE_$JUSTIFY($PIECE(BDGSWING,U,8),7)_" /"
+78 ;#txo+dsc+deaths
SET X=$PIECE(BDGSWING,U,3)+$PIECE(BDGSWING,U,4)+$PIECE(BDGSWING,U,5)
+79 ;alos by discharge
SET LINE=LINE_$JUSTIFY($PIECE(BDGSWING,U,8)\$SELECT(X=0:1,1:X),3)
+80 ;#admits+txi
SET X=$PIECE(BDGSWING,U)+$PIECE(BDGSWING,U,2)
IF X=0
SET X=1
+81 ;losadmit
SET LINE=LINE_$JUSTIFY($PIECE(BDGSWING,U,7)\X,8)
+82 DO SET($$REPEAT^XLFSTR("-",80),.VALMCNT)
DO SET(LINE,.VALMCNT)
End DoDot:1
+83 ;
+84 IF '$DATA(^TMP("BDGSTAT2",$JOB))
DO SET("No data found",.VALMCNT)
+85 ;
+86 DO LEGEND
+87 ;
+88 QUIT
+89 ;
ONLY(WARD,NAME,DATE) ; find data by inpt service
+1 NEW SRV,X,Y,I
+2 SET SRV=0
FOR
SET SRV=$ORDER(^BDGCWD(WARD,1,DATE,1,SRV))
IF 'SRV
QUIT
Begin DoDot:1
+3 SET SRVNM=$$GET1^DIQ(45.7,SRV,.01)
+4 IF BDGTYP=1
IF SRVNM["OBSERVATION"
QUIT
+5 ;I BDGTYP=1 Q:SRVNM="DAY SURGERY" ;ihs/cmi/maw 02/26/2014 for claremore to test
+6 ;ihs/cmi/maw 02/26/2014 for claremore to test; IHS/OIT/CLS 03/31/2015 patch 1018
IF BDGTYP=1
IF SRVNM["DAY SURGERY"
QUIT
+7 IF BDGTYP=2
IF SRVNM'["OBSERVATION"
QUIT
+8 ;I BDGTYP=3 Q:SRVNM'="DAY SURGERY" ;ihs/cmi/maw 04/15/2011 PATCH 1013 RQMT155
+9 ;ihs/cmi/maw 04/15/2011 PATCH 1013 RQMT155; IHS/OIT/CLS 03/31/2015 patch 1018
IF BDGTYP=3
IF SRVNM'["DAY SURGERY"
QUIT
+10 ;
+11 ;grab data node
SET X=$GET(^BDGCWD(WARD,1,DATE,1,SRV,0))
+12 ;
+13 ; put data in column order (adm, txi)
+14 SET Y=($PIECE(X,U,3)+$PIECE(X,U,13))_U_($PIECE(X,U,5)+$PIECE(X,U,15))
+15 ; then add txo and dsch
+16 SET Y=Y_U_($PIECE(X,U,6)+$PIECE(X,U,16))_U_($PIECE(X,U,4)+$PIECE(X,U,14))
+17 ; and death
+18 SET Y=Y_U_($PIECE(X,U,7)+$PIECE(X,U,17))
+19 ; then add 1day pts
+20 SET Y=Y_U_($PIECE(X,U,8)+$PIECE(X,U,18))
+21 ; and pat days (remaining + 1day pts)
+22 SET Y=Y_U_($PIECE(X,U,2)+$PIECE(X,U,12)+$PIECE(X,U,8)+$PIECE(X,U,18))
+23 ; then los (includes observation - converted from hours)
+24 SET Y=Y_U_($PIECE(X,U,9)+$PIECE(X,U,19)+($PIECE(X,U,11)\24)+($PIECE(X,U,21)\24))
+25 ;
+26 ; increment array for totals
+27 IF SRVNM="NEWBORN"
Begin DoDot:2
+28 FOR I=1:1:8
SET $PIECE(BDGNB,U,I)=$PIECE($GET(BDGNB),U,I)+$PIECE(Y,U,I)
End DoDot:2
QUIT
+29 ;cmi/maw 4/8/2008 PATCH 1009 requirement 24
IF SRVNM="SWING BED"
Begin DoDot:2
+30 FOR I=1:1:8
SET $PIECE(BDGSWING,U,I)=$PIECE($GET(BDGSWING),U,I)+$PIECE(Y,U,I)
End DoDot:2
QUIT
+31 ;
+32 FOR I=1:1:8
SET $PIECE(BDGA(NAME),U,I)=$PIECE($GET(BDGA(NAME)),U,I)+$PIECE(Y,U,I)
+33 FOR I=1:1:8
SET $PIECE(TOTAL,U,I)=$PIECE($GET(TOTAL),U,I)+$PIECE(Y,U,I)
End DoDot:1
+34 QUIT
+35 ;
NEWBORN(WARD,DATE,DATA) ; subtract out newborn numbers of ward and date
+1 NEW NEWB,X,I
+2 SET NEWB=$ORDER(^DIC(45.7,"B","NEWBORN",0))
IF 'NEWB
QUIT
+3 ;no data
SET X=$GET(^BDGCWD(WARD,1,DATE,1,NEWB,0))
IF X=""
QUIT
+4 FOR I=1:1:11
SET $PIECE(DATA,U,I)=$PIECE(DATA,U,I)-$PIECE(X,U,I)
+5 QUIT
+6 ;
SWING(WARD,DATE,DATA) ; subtract out swing bed numbers of ward and date
+1 NEW SWING,X,I
+2 SET SWING=$ORDER(^DIC(45.7,"B","SWING BED",0))
IF 'SWING
QUIT
+3 ;no data
SET X=$GET(^BDGCWD(WARD,1,DATE,1,SWING,0))
IF X=""
QUIT
+4 FOR I=1:1:11
SET $PIECE(DATA,U,I)=$PIECE(DATA,U,I)-$PIECE(X,U,I)
+5 QUIT
+6 ;
SET(DATA,NUM) ; put data into display array
+1 SET NUM=NUM+1
+2 SET ^TMP("BDGSTAT2",$JOB,NUM,0)=DATA
+3 QUIT
+4 ;
LEGEND ; add legend explaining column headings
+1 DO SET("",.VALMCNT)
+2 DO SET("ADM = admissions, TXI = ward transfers in",.VALMCNT)
+3 DO SET("TXO = ward transfer out, DSC = discharges",.VALMCNT)
+4 DO SET("DTH = deaths, 1DAY = admitted & discharged same day",.VALMCNT)
+5 DO SET("DAYS = total patient days, ADPL = ave daily patient load",.VALMCNT)
+6 DO SET("LOSD = length of stay for patients discharged: total / average",.VALMCNT)
+7 DO SET(" (discharged = TXO + DSC + DTH)",.VALMCNT)
+8 DO SET("LOSA = length of stay by admissions (inpt days/#ADM+TXI)",.VALMCNT)
+9 QUIT
+10 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 KILL ^TMP("BDGSTAT2",$JOB)
+2 QUIT
+3 ;
PRINT ; print to paper
+1 NEW BDGLN,BDGPG
+2 USE IO
DO INIT^BDGF
DO HDG
+3 SET BDGLN=0
FOR
SET BDGLN=$ORDER(^TMP("BDGSTAT2",$JOB,BDGLN))
IF 'BDGLN
QUIT
Begin DoDot:1
+4 IF $Y>(IOSL-4)
DO HDG
+5 WRITE !,^TMP("BDGSTAT2",$JOB,BDGLN,0)
End DoDot:1
+6 DO ^%ZISC
DO PRTKL^BDGF
DO EXIT
+7 QUIT
+8 ;
HDG ; heading if printing to paper
+1 SET BDGPG=$GET(BDGPG)+1
IF BDGPG>1
WRITE @IOF
+2 WRITE !,BDGUSR,?31,"Statistics by Ward"
+3 NEW X
SET X="For "_$$FMTE^XLFDT(BDGBD)_" through "_$$FMTE^XLFDT(BDGED)
+4 WRITE !,BDGTIME,?(80-$LENGTH(X)\2),X,?71,"Page: ",BDGPG
+5 IF BDGTYP=3
SET X="Includes Inpatients AND Observations"
+6 IF '$TEST
SET X=$SELECT(BDGTYP=1:"Inpatients Only",1:"Observations Only")
+7 WRITE !,BDGDATE,?(80-$LENGTH(X)\2),X
+8 WRITE !,"Ward",?11,"ADM",?17,"TXI",?23,"TXO",?29,"DSC",?35,"DTH",?40,"1DAY"
+9 WRITE ?47,"DAYS",?55,"ADPL",?64,"LOSD",?74,"LOSA"
+10 WRITE !,$$REPEAT^XLFSTR("=",80)
+11 QUIT
+12 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
PAD(D,L) ;EP -- SUBRTN to pad length of data
+1 ; -- D=data L=length
+2 QUIT $EXTRACT(D_$$REPEAT^XLFSTR(" ",L),1,L)
+3 ;
SP(N) ; -- SUBRTN to pad N number of spaces
+1 QUIT $$PAD(" ",N)
