Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BDGSTAT2

BDGSTAT2.m

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