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

BDGM202B.m

Go to the documentation of this file. 
  1. BDGM202B ; IHS/ANMC/LJF - M202 PRINT ; [ 01/04/2005  5:03 PM ]
  1.  ;;5.3;PIMS;**1001,1006,1008,1013,1015,1019**;MAY 28, 2004;Build 3
  1.  ;IHS/ITSC/WAR 09/27/2004 PATCH 1001 Shift transfers Rt 1 position
  1.  ;IHS/ITSC/LJF 10/25/2004 PATCH 1001 remove blank lines to fit new info
  1.  ;IHS/OIT/LJF  08/24/2006 PATCH 1006 added lines for swing beds & observations
  1.  ;cmi/anch/maw 11/07/2007 PATCH 1008 set DGMIN and DGMAX = +$G, just in case they are not set when no data 
  1.  ;ihs/cmi/maw  04/18/2011 PATCH 1013 RQMT155 added day surgery
  1.  ;
  1.  NEW DGLINE
  1.  S DGLINE=$$REPEAT^XLFSTR("-",80)
  1.  U IO
  1.  D HD              ;print heading
  1.  D PART1           ;print Part I - Service and Census
  1.  D PART2           ;print Part II - Special Info
  1.  D ^BDGM202C       ;print Part III - Beds Available and Comments
  1.  Q                 ;returns to BDGM202A and EXIT subrtn
  1.  ;
  1. HD ; print heading
  1.  NEW X,Y
  1.  I BDGBM=BDGEM D
  1.  . S X="MONTHLY REPORT OF INPATIENT SERVICES IHS HOSPITALS"  ;m202
  1.  E  S X="RANGE OF MONTHS REPORT FOR INPATIENT SERVICES"      ;y202
  1.  ;
  1.  ;IHS/OIT/LJF 08/24/2006 PATCH 1006 remove form feed
  1.  ;W @IOF W ?80-$L(X)/2,X,!,DGLINE,!,"Name and Location of Hospital"
  1.  W ?80-$L(X)/2,X,!,DGLINE,!,"Name and Location of Hospital"
  1.  ;
  1.  ;W ?55,"Month and Year",!!,$$GET1^DIQ(4,+DUZ(2),.01)    ;facility
  1.  W ?55,"Month and Year",!,$$GET1^DIQ(4,+DUZ(2),.01)  ;facility; IHS/ITSC/LJF 10/25/2004 PATHC 1001
  1.  W "    ",$$GET1^DIQ(9999999.06,DUZ(2),.15)               ;city
  1.  W ", ",$$GET1^DIQ(9999999.06,DUZ(2),.16)                 ;state
  1.  W ?55,$$FMTE^XLFDT(BDGBM)
  1.  I BDGBM'=BDGEM W " to ",$$FMTE^XLFDT(BDGEM)
  1.  W !,DGLINE
  1.  Q
  1.  ;
  1. PART1 ; Print Part I
  1.  NEW X,S,I,J
  1.  S X="Part I - Service and Census" W !?80-$L(X)/2,X,!,DGLINE
  1.  ;
  1.  ;IHS/OIT/LJF 08/24/2006 PATCH 1006 shortened "Inpatient" 
  1.  W !?31,"Bom",?48,"Discharges",?64,"Eom",?70,"Inpatient"
  1.  W !?31,"Bom",?48,"Discharges",?64,"Eom",?70,"Inpt"
  1.  ;
  1.  W !?1,"Medical Services Provided",?30,"Census",?40,"Adm"
  1.  W ?48,"Death",?55,"Other",?63,"Census",?72,"Days",!,DGLINE,!
  1.  ;
  1.  ; for each service category, print columns of data
  1.  F S=1,2,3,5,6,7 D COL
  1.  ;
  1.  ; now print column totals
  1.  D TOT Q
  1.  ;                            
  1. COL ; -- columns
  1.  ; start with transfers between service categories
  1.  ;IHS/ITSC/WAR 9/27/04 PATCH #1001 Shift Rt 1 position
  1.  ;W:DGA(S,7) ?40,DGA(S,7)_"t" W:DGA(S,8) ?54,DGA(S,8)_"t"
  1.  W:DGA(S,7) ?40,DGA(S,7)_"t" W:DGA(S,8) ?55,DGA(S,8)_"t"
  1.  ;
  1.  ; then name of service category
  1.  W !,$P($T(SRV+S),";;",2)
  1.  ;   and then the columns
  1.  W ?32,$J(DGA(S,1),3),?40,$J(DGA(S,2),3),?48,$J(DGA(S,3),3)
  1.  W ?55,$J(DGA(S,4),3),?64,$J(DGA(S,5),3),?72,$J(DGA(S,6),4),!
  1.  Q
  1.  ;
  1. TOT ; -- totals
  1.  W ?30,"-----",?38,"-----",?46,"-----",?53,"-----",?62,"-----"
  1.  W ?70,"------" F I=1:1:6 S DGX(I)=0
  1.  F I=1,2,3,5,6,7 F J=1:1:6 S DGX(J)=DGX(J)+DGA(I,J)  ;totals
  1.  W !?10,"TOTAL",?32,$J(DGX(1),3),?40,$J(DGX(2),3),?48,$J(DGX(3),3)
  1.  W ?55,$J(DGX(4),3),?64,$J(DGX(5),3),?72,$J(DGX(6),4),!,DGLINE
  1.  ; -- newborn
  1.  ;IHS/ITSC/WAR 9/27/04 PATCH #1001 Shift Rt 1 position
  1.  ;W ! W:DGA(4,7) ?40,DGA(4,7)_"t" W:DGA(4,8) ?54,DGA(4,8)_"t"
  1.  W ! W:DGA(4,7) ?40,DGA(4,7)_"t" W:DGA(4,8) ?55,DGA(4,8)_"t"
  1.  ;
  1.  ;IHS/OIT/LJF 08/24/2006 PATCH 1006 add swing bed & observations
  1.  ;F S=4,8,9 D
  1.  F S=4,8,9,10 D  ;ihs/cmi/maw 04/18/2011 added day surgery
  1.  . W $P($T(SRV+S),";;",2)
  1.  . W ?32,$J(DGA(S,1),3),?40,$J(DGA(S,2),3) W:DGA(S,7) " ("_DGA(S,7)_"t)"
  1.  . W ?48,$J(DGA(S,3),3),?55,$J(DGA(S,4),3) W:DGA(S,8) " ("_DGA(S,8)_"t)"
  1.  . W ?64,$J($S(DGA(S,5)<0:0,1:DGA(S,5)),3),?72,$J(DGA(S,6),4),!
  1.  W DGLINE
  1.  Q
  1.  ;
  1.  W !,"NEWBORN"
  1.  W ?32,$J(DGA(4,1),3),?40,$J(DGA(4,2),3),?48,$J(DGA(4,3),3)
  1.  W ?55,$J(DGA(4,4),3),?64,$J(DGA(4,5),3),?72,$J(DGA(4,6),4),!,DGLINE
  1.  Q
  1.  ;
  1.  ;IHS/OIT/LJF 08/24/2006 PATCH 1006 removed extra dotted line
  1. PART2 ;W !?26,"Part II - Special Information",!,DGLINE
  1.  W !?26,"Part II - Special Information"
  1.  ;W !!,"Peak Census, Excluding Newborn................................."
  1.  W !,"Peak Census, Excluding Newborn................................."  ;IHS/ITSC/LJF 10/25/2004 PATCH 1001
  1.  ;W ?64,DGMAX  ;cmi/maw 11/7/2007 orig line  
  1.  W ?64,+$G(DGMAX)  ;cmi/maw 11/7/2007 mod because PEAK^BDGM202A sometimes does not get set
  1.  ;W !!,"Minimum Census, Excluding Newborn..............................."
  1.  W !,"Minimum Census, Excluding Newborn..............................."  ;IHS/ITSC/LJF 10/25/2004 PATCH 1001
  1.  ;W ?64,DGMIN  ;cmi/maw 11/7/2007 orig line
  1.  W ?64,$S(+$G(DGMIN)<0:0,1:$G(DGMIN))  ;cmi/maw 11/7/2007 mod because PEAK^BDGM202A sometimes does not get set
  1.  Q
  1.  ;
  1.  ;IHS/OIT/LJF 08/24/2006 patch 1006 added Swing Beds & Observations to list below
  1. SRV ;;
  1.  ;;MEDICAL & SURGICAL (Adult)
  1.  ;;MEDICAL & SURGICAL (Ped.)
  1.  ;;OBSTETRIC
  1.  ;;NEWBORN
  1.  ;;TUBERCULOSIS
  1.  ;;ALCOHOLISM/SUBSTANCE ABUSE
  1.  ;;MENTAL HEALTH
  1.  ;;SWING BEDS
  1.  ;;OBSERVATIONS
  1.  ;;DAY SURGERY