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

BDGSTAT3.m

Go to the documentation of this file. 
  1. BDGSTAT3 ; IHS/ANMC/LJF - INPT STATS BY SERV ;  [ 06/16/2003  2:47 PM ]
  1.  ;;5.3;PIMS;**1013**;APR 26, 2002
  1.  ;
  1.  ;ihs/cmi/maw 04/15/2011 PATCH 1013 RQMT155
  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 Services","NO")
  1.  ;
  1.  ;S BDGTYP=$$READ^BDGF("S^1:Inpatient Services Only;2:Observation Services 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^BDGSTAT3","STATS BY SERV","BDGBD;BDGED;BDGIA;BDGTYP")
  1.  Q
  1.  ;
  1. EN ; -- main entry point for BDG STAT BY SERV
  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 SERVICE")
  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=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,SERV,SVABV,DATE,X,BDGA,Y,Y1,LINE,I,TOTAL,AGE
  1.  K ^TMP("BDGSTAT3",$J)
  1.  S (VALMCNT,TOTAL,TOTAL("A"),TOTAL("P"))=0
  1.  S BDGDAYS=$$FMDIFF^XLFDT(BDGED,BDGBD)+1   ;# of days for division
  1.  ;
  1.  S SERV=0 F  S SERV=$O(^BDGCTX(SERV)) Q:'SERV  D
  1.  . ;
  1.  . ; quit if inactive and not including inactives
  1.  . I BDGIA=0,$$ACTSRV^BDGPAR(SERV,BDGBD)=0 Q
  1.  . ;
  1.  . S SVABV=$$GET1^DIQ(45.7,SERV,99)        ;serv abbrev
  1.  . I SVABV="" S SVABV=SERV_"??"
  1.  . I BDGTYP=1 Q:$$GET1^DIQ(45.7,SERV,.01)["OBSERVATION"   ;inpt only
  1.  . I BDGTYP=2 Q:$$GET1^DIQ(45.7,SERV,.01)'["OBSERVATION"  ;obser only
  1.  . I BDGTYP=3 Q:$$GET1^DIQ(45.7,SERV,.01)'="DAY SURGERY"  ;day surgery only ihs/cmi/maw PATCH 1013
  1.  . ;
  1.  . S DATE=BDGBD-.001
  1.  . F  S DATE=$O(^BDGCTX(SERV,1,DATE)) Q:DATE>BDGED  Q:'DATE  D
  1.  .. ;
  1.  .. S X=$G(^BDGCTX(SERV,1,DATE,0))     ;grab data node
  1.  .. ;
  1.  .. ; put adult 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.  .. ; put peds data in column order (adm, txi, txo, dsc, dth)
  1.  .. 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)
  1.  .. ;  then add 1day pts, pat days (remaining + 1day pts)
  1.  .. S Y1=Y1_U_$P(X,U,18)_U_($P(X,U,12)+$P(X,U,18))
  1.  .. ;  then los (includes observation - converted from hours)
  1.  .. S Y1=Y1_U_($P(X,U,19)+($P(X,U,21)\24))
  1.  .. ;
  1.  .. ; increment array for totals
  1.  .. F I=1:1:8 S $P(BDGA("A",SVABV),U,I)=$P($G(BDGA("A",SVABV)),U,I)+$P(Y,U,I)
  1.  .. F I=1:1:8 S $P(BDGA("P",SVABV),U,I)=$P($G(BDGA("P",SVABV)),U,I)+$P(Y1,U,I)
  1.  .. F I=1:1:8 S $P(TOTAL,U,I)=$P($G(TOTAL),U,I)+$P(Y,U,I)+$P(Y1,U,I)
  1.  .. F I=1:1:8 S $P(TOTAL("A"),U,I)=$P($G(TOTAL("A")),U,I)+$P(Y,U,I)
  1.  .. F I=1:1:8 S $P(TOTAL("P"),U,I)=$P($G(TOTAL("P")),U,I)+$P(Y1,U,I)
  1.  ;
  1.  ;
  1.  F AGE="A","P" D
  1.  . S X=$S(AGE="A":"Adult",1:"Pediatric")_" Patients"
  1.  . D SET(X,.VALMCNT)
  1.  . S SERV=0 F  S SERV=$O(BDGA(AGE,SERV)) Q:SERV=""  D
  1.  .. Q:SERV="NEWBORN"    ;list newborn data at end
  1.  .. S LINE=$$PAD(SERV,10)
  1.  .. F I=1:1:7 S LINE=LINE_$J($P(BDGA(AGE,SERV),U,I),4)_"  "
  1.  .. S LINE=LINE_$J($P(BDGA(AGE,SERV),U,7)/BDGDAYS,6,2)  ;adpl
  1.  .. S LINE=LINE_$J($P(BDGA(AGE,SERV),U,8),7)_" /"   ;los
  1.  .. S X=$P(BDGA(AGE,SERV),U,3)+$P(BDGA(AGE,SERV),U,4)+$P(BDGA(AGE,SERV),U,5)
  1.  .. S LINE=LINE_$J($P(BDGA(AGE,SERV),U,8)\$S(X=0:1,1:X),3)    ;alos
  1.  .. ; los based on admissions (inpt days/# admissions)
  1.  .. S X=$P(BDGA(AGE,SERV),U)+$P(BDGA(AGE,SERV),U,2) S:X=0 X=1
  1.  .. S LINE=LINE_$J($P(BDGA(AGE,SERV),U,7)\X,8)
  1.  .. D SET(LINE,.VALMCNT)
  1.  . ;
  1.  . ; add totals to display array
  1.  . S LINE=$$PAD("SUBTOTAL:",10)
  1.  . F I=1:1:7 S LINE=LINE_$J($P(TOTAL(AGE),U,I),4)_"  "
  1.  . S LINE=LINE_$J($P(TOTAL(AGE),U,7)/BDGDAYS,6,2)  ;adpl
  1.  . S LINE=LINE_$J($P(TOTAL(AGE),U,8),7)_" /"   ;los
  1.  . S X=$P(TOTAL(AGE),U,3)+$P(TOTAL(AGE),U,4)+$P(TOTAL(AGE),U,5)
  1.  . S LINE=LINE_$J($P(TOTAL(AGE),U,8)\$S(X=0:1,1:X),3)    ;alos
  1.  . S X=$P(TOTAL(AGE),U)+$P(TOTAL(AGE),U,2) S:X=0 X=1
  1.  . S LINE=LINE_$J($P(TOTAL(AGE),U,7)\X,8)
  1.  . D SET($$REPEAT^XLFSTR("=",80),.VALMCNT),SET(LINE,.VALMCNT)
  1.  . D SET("",.VALMCNT)
  1.  ;
  1.  ; add grand 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) S:X=0 X=1
  1.  S LINE=LINE_$J($P(TOTAL,U,8)\X,3)    ;alos
  1.  S X=$P(TOTAL,U)+$P(TOTAL,U,2) S:X=0 X=1
  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(BDGA("P","NEWBORN")) D
  1.  . NEW LINE,NEW
  1.  . S LINE=$$PAD("NEWBORN",10),NEW=BDGA("P","NEWBORN")
  1.  . F I=1:1:7 S LINE=LINE_$J($P(NEW,U,I),4)_"  "
  1.  . S LINE=LINE_$J($P(NEW,U,7)/BDGDAYS,6,2)  ;adpl
  1.  . S LINE=LINE_$J($P(NEW,U,8),7)_" /"   ;los
  1.  . S X=$P(NEW,U,3)+$P(NEW,U,4)+$P(NEW,U,5) S:X=0 X=1
  1.  . S LINE=LINE_$J($P(NEW,U,8)\X,3)    ;alos
  1.  . S X=$P(NEW,U)+$P(NEW,U,2) S:X=0 X=1
  1.  . S LINE=LINE_$J($P(NEW,U,7)\X,8)   ;losadmit
  1.  . D SET($$REPEAT^XLFSTR("-",80),.VALMCNT),SET(LINE,.VALMCNT)
  1.  ;
  1.  I '$D(^TMP("BDGSTAT3",$J)) D SET("No data found",.VALMCNT)
  1.  ;
  1.  D LEGEND
  1.  ;
  1.  Q
  1.  ;
  1. NEWBORN(SERV,DATE,DATA) ; subtract out newborn numbers of ward and date
  1.  NEW NEWB
  1.  S NEWB=$O(^DIC(45.7,"B","NEWBORN",0)) Q:'NEWB
  1.  S X=$G(^BDGCTX(SERV,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. SET(DATA,NUM) ; put data into display array
  1.  S NUM=NUM+1
  1.  S ^TMP("BDGSTAT3",$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("TPD = 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("BDGSTAT3",$J)
  1.  Q
  1.  ;
  1. EXPND ; -- expand code
  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("BDGSTAT3",$J,BDGLN)) Q:'BDGLN  D
  1.  . I $Y>(IOSL-4) D HDG
  1.  . W !,^TMP("BDGSTAT3",$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,?30,"Statistics by Service"
  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:"Inpatient Services",1:"Observation Services")_" Only"
  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.  W !,BDGDATE,?(80-$L(X)\2),X
  1.  W !,"Service",?11,"ADM",?17,"TXI",?23,"TXO",?29,"DSC",?35,"DTH"
  1.  W ?40,"1DAY",?47,"DAYS",?55,"ADPL",?64,"LOSD",?74,"LOSA"
  1.  W !,$$REPEAT^XLFSTR("=",80),!
  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)
  1.  ;