BDGSTAT3 ; IHS/ANMC/LJF - INPT STATS BY SERV ; [ 06/16/2003 2:47 PM ]
;;5.3;PIMS;**1013**;APR 26, 2002
;
;ihs/cmi/maw 04/15/2011 PATCH 1013 RQMT155
;
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 Services","NO")
;
;S BDGTYP=$$READ^BDGF("S^1:Inpatient Services Only;2:Observation Services 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^BDGSTAT3","STATS BY SERV","BDGBD;BDGED;BDGIA;BDGTYP")
Q
;
EN ; -- main entry point for BDG STAT BY SERV
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 SERVICE")
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=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,SERV,SVABV,DATE,X,BDGA,Y,Y1,LINE,I,TOTAL,AGE
K ^TMP("BDGSTAT3",$J)
S (VALMCNT,TOTAL,TOTAL("A"),TOTAL("P"))=0
S BDGDAYS=$$FMDIFF^XLFDT(BDGED,BDGBD)+1 ;# of days for division
;
S SERV=0 F S SERV=$O(^BDGCTX(SERV)) Q:'SERV D
. ;
. ; quit if inactive and not including inactives
. I BDGIA=0,$$ACTSRV^BDGPAR(SERV,BDGBD)=0 Q
. ;
. S SVABV=$$GET1^DIQ(45.7,SERV,99) ;serv abbrev
. I SVABV="" S SVABV=SERV_"??"
. I BDGTYP=1 Q:$$GET1^DIQ(45.7,SERV,.01)["OBSERVATION" ;inpt only
. I BDGTYP=2 Q:$$GET1^DIQ(45.7,SERV,.01)'["OBSERVATION" ;obser only
. I BDGTYP=3 Q:$$GET1^DIQ(45.7,SERV,.01)'="DAY SURGERY" ;day surgery only ihs/cmi/maw PATCH 1013
. ;
. S DATE=BDGBD-.001
. F S DATE=$O(^BDGCTX(SERV,1,DATE)) Q:DATE>BDGED Q:'DATE D
.. ;
.. S X=$G(^BDGCTX(SERV,1,DATE,0)) ;grab data node
.. ;
.. ; put adult 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))
.. ;
.. ; put peds data in column order (adm, txi, txo, dsc, dth)
.. S Y1=$P(X,U,13)_U_$P(X,U,15)_U_$P(X,U,16)_U_$P(X,U,14)_U_$P(X,U,17)
.. ; then add 1day pts, pat days (remaining + 1day pts)
.. S Y1=Y1_U_$P(X,U,18)_U_($P(X,U,12)+$P(X,U,18))
.. ; then los (includes observation - converted from hours)
.. S Y1=Y1_U_($P(X,U,19)+($P(X,U,21)\24))
.. ;
.. ; increment array for totals
.. F I=1:1:8 S $P(BDGA("A",SVABV),U,I)=$P($G(BDGA("A",SVABV)),U,I)+$P(Y,U,I)
.. F I=1:1:8 S $P(BDGA("P",SVABV),U,I)=$P($G(BDGA("P",SVABV)),U,I)+$P(Y1,U,I)
.. F I=1:1:8 S $P(TOTAL,U,I)=$P($G(TOTAL),U,I)+$P(Y,U,I)+$P(Y1,U,I)
.. F I=1:1:8 S $P(TOTAL("A"),U,I)=$P($G(TOTAL("A")),U,I)+$P(Y,U,I)
.. F I=1:1:8 S $P(TOTAL("P"),U,I)=$P($G(TOTAL("P")),U,I)+$P(Y1,U,I)
;
;
F AGE="A","P" D
. S X=$S(AGE="A":"Adult",1:"Pediatric")_" Patients"
. D SET(X,.VALMCNT)
. S SERV=0 F S SERV=$O(BDGA(AGE,SERV)) Q:SERV="" D
.. Q:SERV="NEWBORN" ;list newborn data at end
.. S LINE=$$PAD(SERV,10)
.. F I=1:1:7 S LINE=LINE_$J($P(BDGA(AGE,SERV),U,I),4)_" "
.. S LINE=LINE_$J($P(BDGA(AGE,SERV),U,7)/BDGDAYS,6,2) ;adpl
.. S LINE=LINE_$J($P(BDGA(AGE,SERV),U,8),7)_" /" ;los
.. S X=$P(BDGA(AGE,SERV),U,3)+$P(BDGA(AGE,SERV),U,4)+$P(BDGA(AGE,SERV),U,5)
.. S LINE=LINE_$J($P(BDGA(AGE,SERV),U,8)\$S(X=0:1,1:X),3) ;alos
.. ; los based on admissions (inpt days/# admissions)
.. S X=$P(BDGA(AGE,SERV),U)+$P(BDGA(AGE,SERV),U,2) S:X=0 X=1
.. S LINE=LINE_$J($P(BDGA(AGE,SERV),U,7)\X,8)
.. D SET(LINE,.VALMCNT)
. ;
. ; add totals to display array
. S LINE=$$PAD("SUBTOTAL:",10)
. F I=1:1:7 S LINE=LINE_$J($P(TOTAL(AGE),U,I),4)_" "
. S LINE=LINE_$J($P(TOTAL(AGE),U,7)/BDGDAYS,6,2) ;adpl
. S LINE=LINE_$J($P(TOTAL(AGE),U,8),7)_" /" ;los
. S X=$P(TOTAL(AGE),U,3)+$P(TOTAL(AGE),U,4)+$P(TOTAL(AGE),U,5)
. S LINE=LINE_$J($P(TOTAL(AGE),U,8)\$S(X=0:1,1:X),3) ;alos
. S X=$P(TOTAL(AGE),U)+$P(TOTAL(AGE),U,2) S:X=0 X=1
. S LINE=LINE_$J($P(TOTAL(AGE),U,7)\X,8)
. D SET($$REPEAT^XLFSTR("=",80),.VALMCNT),SET(LINE,.VALMCNT)
. D SET("",.VALMCNT)
;
; add grand 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) S:X=0 X=1
S LINE=LINE_$J($P(TOTAL,U,8)\X,3) ;alos
S X=$P(TOTAL,U)+$P(TOTAL,U,2) S:X=0 X=1
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(BDGA("P","NEWBORN")) D
. NEW LINE,NEW
. S LINE=$$PAD("NEWBORN",10),NEW=BDGA("P","NEWBORN")
. F I=1:1:7 S LINE=LINE_$J($P(NEW,U,I),4)_" "
. S LINE=LINE_$J($P(NEW,U,7)/BDGDAYS,6,2) ;adpl
. S LINE=LINE_$J($P(NEW,U,8),7)_" /" ;los
. S X=$P(NEW,U,3)+$P(NEW,U,4)+$P(NEW,U,5) S:X=0 X=1
. S LINE=LINE_$J($P(NEW,U,8)\X,3) ;alos
. S X=$P(NEW,U)+$P(NEW,U,2) S:X=0 X=1
. S LINE=LINE_$J($P(NEW,U,7)\X,8) ;losadmit
. D SET($$REPEAT^XLFSTR("-",80),.VALMCNT),SET(LINE,.VALMCNT)
;
I '$D(^TMP("BDGSTAT3",$J)) D SET("No data found",.VALMCNT)
;
D LEGEND
;
Q
;
NEWBORN(SERV,DATE,DATA) ; subtract out newborn numbers of ward and date
NEW NEWB
S NEWB=$O(^DIC(45.7,"B","NEWBORN",0)) Q:'NEWB
S X=$G(^BDGCTX(SERV,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
;
SET(DATA,NUM) ; put data into display array
S NUM=NUM+1
S ^TMP("BDGSTAT3",$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("TPD = 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("BDGSTAT3",$J)
Q
;
EXPND ; -- expand code
Q
;
PRINT ; print to paper
NEW BDGLN,BDGPG
U IO D INIT^BDGF,HDG
S BDGLN=0 F S BDGLN=$O(^TMP("BDGSTAT3",$J,BDGLN)) Q:'BDGLN D
. I $Y>(IOSL-4) D HDG
. W !,^TMP("BDGSTAT3",$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,?30,"Statistics by Service"
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:"Inpatient Services",1:"Observation Services")_" Only"
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")
W !,BDGDATE,?(80-$L(X)\2),X
W !,"Service",?11,"ADM",?17,"TXI",?23,"TXO",?29,"DSC",?35,"DTH"
W ?40,"1DAY",?47,"DAYS",?55,"ADPL",?64,"LOSD",?74,"LOSA"
W !,$$REPEAT^XLFSTR("=",80),!
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)
;
BDGSTAT3 ; IHS/ANMC/LJF - INPT STATS BY SERV ; [ 06/16/2003 2:47 PM ]
+1 ;;5.3;PIMS;**1013**;APR 26, 2002
+2 ;
+3 ;ihs/cmi/maw 04/15/2011 PATCH 1013 RQMT155
+4 ;
+5 NEW BDGBD,BDGED,BDGIA,BDGTYP
+6 ;
+7 SET BDGBD=$$READ^BDGF("DO^::EX","Select Beginning Date")
IF BDGBD<1
QUIT
+8 SET BDGED=$$READ^BDGF("DO^::EX","Select Ending Date")
IF BDGED<1
QUIT
+9 ;
+10 SET BDGIA=$$READ^BDGF("Y","Include INACTIVE Services","NO")
+11 ;
+12 ;S BDGTYP=$$READ^BDGF("S^1:Inpatient Services Only;2:Observation Services Only;3:Both","Select Patient Type","BOTH") Q:BDGTYP=U
+13 ;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
+14 ;
+15 DO ZIS^BDGF("PQ","EN^BDGSTAT3","STATS BY SERV","BDGBD;BDGED;BDGIA;BDGTYP")
+16 QUIT
+17 ;
EN ; -- main entry point for BDG STAT BY SERV
+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 SERVICE")
+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 IF BDGTYP=4
SET X="Includes Inpatients, Observations AND Day Surgery"
+5 IF '$TEST
SET X=$SELECT(BDGTYP=1:"Inpatients Only",BDGTYP=2:"Observations Only",1:"Day Surgery Only")
+6 SET VALMHDR(2)=$$SP(75-$LENGTH(X)\2)_X
+7 QUIT
+8 ;
INIT ; -- init variables and list array
+1 NEW BDGDAYS,SERV,SVABV,DATE,X,BDGA,Y,Y1,LINE,I,TOTAL,AGE
+2 KILL ^TMP("BDGSTAT3",$JOB)
+3 SET (VALMCNT,TOTAL,TOTAL("A"),TOTAL("P"))=0
+4 ;# of days for division
SET BDGDAYS=$$FMDIFF^XLFDT(BDGED,BDGBD)+1
+5 ;
+6 SET SERV=0
FOR
SET SERV=$ORDER(^BDGCTX(SERV))
IF 'SERV
QUIT
Begin DoDot:1
+7 ;
+8 ; quit if inactive and not including inactives
+9 IF BDGIA=0
IF $$ACTSRV^BDGPAR(SERV,BDGBD)=0
QUIT
+10 ;
+11 ;serv abbrev
SET SVABV=$$GET1^DIQ(45.7,SERV,99)
+12 IF SVABV=""
SET SVABV=SERV_"??"
+13 ;inpt only
IF BDGTYP=1
IF $$GET1^DIQ(45.7,SERV,.01)["OBSERVATION"
QUIT
+14 ;obser only
IF BDGTYP=2
IF $$GET1^DIQ(45.7,SERV,.01)'["OBSERVATION"
QUIT
+15 ;day surgery only ihs/cmi/maw PATCH 1013
IF BDGTYP=3
IF $$GET1^DIQ(45.7,SERV,.01)'="DAY SURGERY"
QUIT
+16 ;
+17 SET DATE=BDGBD-.001
+18 FOR
SET DATE=$ORDER(^BDGCTX(SERV,1,DATE))
IF DATE>BDGED
QUIT
IF 'DATE
QUIT
Begin DoDot:2
+19 ;
+20 ;grab data node
SET X=$GET(^BDGCTX(SERV,1,DATE,0))
+21 ;
+22 ; put adult data in column order (adm, txi, txo, dsc, dth)
+23 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)
+24 ; then add 1day pts, pat days (remaining + 1day pts)
+25 SET Y=Y_U_$PIECE(X,U,8)_U_($PIECE(X,U,2)+$PIECE(X,U,8))
+26 ; then los (includes observation - converted from hours)
+27 SET Y=Y_U_($PIECE(X,U,9)+($PIECE(X,U,11)\24))
+28 ;
+29 ; put peds data in column order (adm, txi, txo, dsc, dth)
+30 SET Y1=$PIECE(X,U,13)_U_$PIECE(X,U,15)_U_$PIECE(X,U,16)_U_$PIECE(X,U,14)_U_$PIECE(X,U,17)
+31 ; then add 1day pts, pat days (remaining + 1day pts)
+32 SET Y1=Y1_U_$PIECE(X,U,18)_U_($PIECE(X,U,12)+$PIECE(X,U,18))
+33 ; then los (includes observation - converted from hours)
+34 SET Y1=Y1_U_($PIECE(X,U,19)+($PIECE(X,U,21)\24))
+35 ;
+36 ; increment array for totals
+37 FOR I=1:1:8
SET $PIECE(BDGA("A",SVABV),U,I)=$PIECE($GET(BDGA("A",SVABV)),U,I)+$PIECE(Y,U,I)
+38 FOR I=1:1:8
SET $PIECE(BDGA("P",SVABV),U,I)=$PIECE($GET(BDGA("P",SVABV)),U,I)+$PIECE(Y1,U,I)
+39 FOR I=1:1:8
SET $PIECE(TOTAL,U,I)=$PIECE($GET(TOTAL),U,I)+$PIECE(Y,U,I)+$PIECE(Y1,U,I)
+40 FOR I=1:1:8
SET $PIECE(TOTAL("A"),U,I)=$PIECE($GET(TOTAL("A")),U,I)+$PIECE(Y,U,I)
+41 FOR I=1:1:8
SET $PIECE(TOTAL("P"),U,I)=$PIECE($GET(TOTAL("P")),U,I)+$PIECE(Y1,U,I)
End DoDot:2
End DoDot:1
+42 ;
+43 ;
+44 FOR AGE="A","P"
Begin DoDot:1
+45 SET X=$SELECT(AGE="A":"Adult",1:"Pediatric")_" Patients"
+46 DO SET(X,.VALMCNT)
+47 SET SERV=0
FOR
SET SERV=$ORDER(BDGA(AGE,SERV))
IF SERV=""
QUIT
Begin DoDot:2
+48 ;list newborn data at end
IF SERV="NEWBORN"
QUIT
+49 SET LINE=$$PAD(SERV,10)
+50 FOR I=1:1:7
SET LINE=LINE_$JUSTIFY($PIECE(BDGA(AGE,SERV),U,I),4)_" "
+51 ;adpl
SET LINE=LINE_$JUSTIFY($PIECE(BDGA(AGE,SERV),U,7)/BDGDAYS,6,2)
+52 ;los
SET LINE=LINE_$JUSTIFY($PIECE(BDGA(AGE,SERV),U,8),7)_" /"
+53 SET X=$PIECE(BDGA(AGE,SERV),U,3)+$PIECE(BDGA(AGE,SERV),U,4)+$PIECE(BDGA(AGE,SERV),U,5)
+54 ;alos
SET LINE=LINE_$JUSTIFY($PIECE(BDGA(AGE,SERV),U,8)\$SELECT(X=0:1,1:X),3)
+55 ; los based on admissions (inpt days/# admissions)
+56 SET X=$PIECE(BDGA(AGE,SERV),U)+$PIECE(BDGA(AGE,SERV),U,2)
IF X=0
SET X=1
+57 SET LINE=LINE_$JUSTIFY($PIECE(BDGA(AGE,SERV),U,7)\X,8)
+58 DO SET(LINE,.VALMCNT)
End DoDot:2
+59 ;
+60 ; add totals to display array
+61 SET LINE=$$PAD("SUBTOTAL:",10)
+62 FOR I=1:1:7
SET LINE=LINE_$JUSTIFY($PIECE(TOTAL(AGE),U,I),4)_" "
+63 ;adpl
SET LINE=LINE_$JUSTIFY($PIECE(TOTAL(AGE),U,7)/BDGDAYS,6,2)
+64 ;los
SET LINE=LINE_$JUSTIFY($PIECE(TOTAL(AGE),U,8),7)_" /"
+65 SET X=$PIECE(TOTAL(AGE),U,3)+$PIECE(TOTAL(AGE),U,4)+$PIECE(TOTAL(AGE),U,5)
+66 ;alos
SET LINE=LINE_$JUSTIFY($PIECE(TOTAL(AGE),U,8)\$SELECT(X=0:1,1:X),3)
+67 SET X=$PIECE(TOTAL(AGE),U)+$PIECE(TOTAL(AGE),U,2)
IF X=0
SET X=1
+68 SET LINE=LINE_$JUSTIFY($PIECE(TOTAL(AGE),U,7)\X,8)
+69 DO SET($$REPEAT^XLFSTR("=",80),.VALMCNT)
DO SET(LINE,.VALMCNT)
+70 DO SET("",.VALMCNT)
End DoDot:1
+71 ;
+72 ; add grand totals to display array
+73 SET LINE=$$PAD("TOTAL:",10)
+74 FOR I=1:1:7
SET LINE=LINE_$JUSTIFY($PIECE(TOTAL,U,I),4)_" "
+75 ;adpl
SET LINE=LINE_$JUSTIFY($PIECE(TOTAL,U,7)/BDGDAYS,6,2)
+76 ;los
SET LINE=LINE_$JUSTIFY($PIECE(TOTAL,U,8),7)_" /"
+77 SET X=$PIECE(TOTAL,U,3)+$PIECE(TOTAL,U,4)+$PIECE(TOTAL,U,5)
IF X=0
SET X=1
+78 ;alos
SET LINE=LINE_$JUSTIFY($PIECE(TOTAL,U,8)\X,3)
+79 SET X=$PIECE(TOTAL,U)+$PIECE(TOTAL,U,2)
IF X=0
SET X=1
+80 ;losadmit
SET LINE=LINE_$JUSTIFY($PIECE(TOTAL,U,7)\X,8)
+81 DO SET($$REPEAT^XLFSTR("=",80),.VALMCNT)
DO SET(LINE,.VALMCNT)
+82 ;
+83 ; add newborn stats to display array
+84 IF $DATA(BDGA("P","NEWBORN"))
Begin DoDot:1
+85 NEW LINE,NEW
+86 SET LINE=$$PAD("NEWBORN",10)
SET NEW=BDGA("P","NEWBORN")
+87 FOR I=1:1:7
SET LINE=LINE_$JUSTIFY($PIECE(NEW,U,I),4)_" "
+88 ;adpl
SET LINE=LINE_$JUSTIFY($PIECE(NEW,U,7)/BDGDAYS,6,2)
+89 ;los
SET LINE=LINE_$JUSTIFY($PIECE(NEW,U,8),7)_" /"
+90 SET X=$PIECE(NEW,U,3)+$PIECE(NEW,U,4)+$PIECE(NEW,U,5)
IF X=0
SET X=1
+91 ;alos
SET LINE=LINE_$JUSTIFY($PIECE(NEW,U,8)\X,3)
+92 SET X=$PIECE(NEW,U)+$PIECE(NEW,U,2)
IF X=0
SET X=1
+93 ;losadmit
SET LINE=LINE_$JUSTIFY($PIECE(NEW,U,7)\X,8)
+94 DO SET($$REPEAT^XLFSTR("-",80),.VALMCNT)
DO SET(LINE,.VALMCNT)
End DoDot:1
+95 ;
+96 IF '$DATA(^TMP("BDGSTAT3",$JOB))
DO SET("No data found",.VALMCNT)
+97 ;
+98 DO LEGEND
+99 ;
+100 QUIT
+101 ;
NEWBORN(SERV,DATE,DATA) ; subtract out newborn numbers of ward and date
+1 NEW NEWB
+2 SET NEWB=$ORDER(^DIC(45.7,"B","NEWBORN",0))
IF 'NEWB
QUIT
+3 ;no data
SET X=$GET(^BDGCTX(SERV,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 ;
SET(DATA,NUM) ; put data into display array
+1 SET NUM=NUM+1
+2 SET ^TMP("BDGSTAT3",$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("TPD = 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("BDGSTAT3",$JOB)
+2 QUIT
+3 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
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("BDGSTAT3",$JOB,BDGLN))
IF 'BDGLN
QUIT
Begin DoDot:1
+4 IF $Y>(IOSL-4)
DO HDG
+5 WRITE !,^TMP("BDGSTAT3",$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,?30,"Statistics by Service"
+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 ;I BDGTYP=3 S X="Includes Inpatients AND Observations"
+6 ;E S X=$S(BDGTYP=1:"Inpatient Services",1:"Observation Services")_" Only"
+7 IF BDGTYP=4
SET X="Includes Inpatients, Observations AND Day Surgery"
+8 IF '$TEST
SET X=$SELECT(BDGTYP=1:"Inpatients Only",BDGTYP=2:"Observations Only",1:"Day Surgery Only")
+9 WRITE !,BDGDATE,?(80-$LENGTH(X)\2),X
+10 WRITE !,"Service",?11,"ADM",?17,"TXI",?23,"TXO",?29,"DSC",?35,"DTH"
+11 WRITE ?40,"1DAY",?47,"DAYS",?55,"ADPL",?64,"LOSD",?74,"LOSA"
+12 WRITE !,$$REPEAT^XLFSTR("=",80),!
+13 QUIT
+14 ;
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)
+2 ;
