DGPMBSP ;ALB/LM - BSR PRINT; 12 JUNE 90
;;5.3;Registration;**12,134**;Aug 13, 1993
;
A D TAB
D ^DGPMBSP1
; D ^DGPMBSP2 ; called in ^DGPMBSP1
D HEAD,HEAD2
D ^DGPMBSP3
D HEAD
D ^DGPMBSP4
D ^DGPMBSP5
D ^DGPMBSP6
;
W !,"TOTAL ELAPSED FISCAL DAYS: ",$J(FY("D"),3)
W !,"TOTAL ELAPSED MONTH DAYS : ",$J(FY("DIM"),3),!
S X=$S($D(IOSL):IOSL,1:60),X=$Y-X
F I=1:1:4 Q:I=2&(X<3) W !
W ?98 F I=1:1:33 W UL
W !?84,"Prepared by: ADMINISTRATIVE OFFICER OF THE DAY",!
;
K ADC,AT,C,CT,CUM,D,D1,I,I1,J,J1,K,L,X,X1,X2
Q Q
;
HEAD I $D(FF) W @IOF
S FF=2
W !?94,"Date/Time Printed: ",DGNOW
W !?RM-22\2,"BED STATUS REPORT"
S X=$$NAME^VASITE(RD)
I X']"" D
.S X="VA MEDICAL CENTER"
.S:$D(^DG(40.8,+$P(DGPM("GL"),"^",3),0)) X=X_", "_$P(^(0),"^")
W !?RM-$L(X)\2,X
S X=RD
D DW^%DTC
S X1=X,X="PERIOD ENDING MIDNIGHT "_X1_", "
S Y=RD X ^DD("DD") S X=X_Y
W !?RM-$L(X)\2,X,!
K X,X1,Y
Q
;
HEAD2 W !,?71,"Va-",?92,"Over",?116,"Cum",?127,"Cum"
W !?10,"Bed",?21,"Prev",?39,"Pt's",?71,"cant",?78,"Beds",?85,"Oper",?92,"Cap.",?100,"Auth",?108,"Cum",?116,"Occ.",?123,"Patient"
W !?2,"Ward",?10,"Section",?21,"Rem.",?27,"Gain",?33,"Loss",?39,"Rem.",?45,"Pass",?53,"AA",?59,"UA",?64,"ASIH",?71,"Beds",?79,"OOS",?85,"Beds",?92,"Beds",?100,"Beds",?108,"ADC",?116,"Rate",?126,"Days"
W:$Y<131 ?131,"" W $C(13) W:UL["-" ! F L=1:1:131 W UL
K L
Q
;
TAB S TAB="1^10^21^27^33^39^45^52^58^64^71^78^85^92^100^105^113^123"
S JUS="0^0^4^4^4^4^4^3^3^4^4^4^4^4^4^6^7^7"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPMBSP 1516 printed Sep 23, 2025@20:25:03 Page 2
DGPMBSP ;ALB/LM - BSR PRINT; 12 JUNE 90
+1 ;;5.3;Registration;**12,134**;Aug 13, 1993
+2 ;
A DO TAB
+1 DO ^DGPMBSP1
+2 ; D ^DGPMBSP2 ; called in ^DGPMBSP1
+3 DO HEAD
DO HEAD2
+4 DO ^DGPMBSP3
+5 DO HEAD
+6 DO ^DGPMBSP4
+7 DO ^DGPMBSP5
+8 DO ^DGPMBSP6
+9 ;
+10 WRITE !,"TOTAL ELAPSED FISCAL DAYS: ",$JUSTIFY(FY("D"),3)
+11 WRITE !,"TOTAL ELAPSED MONTH DAYS : ",$JUSTIFY(FY("DIM"),3),!
+12 SET X=$SELECT($DATA(IOSL):IOSL,1:60)
SET X=$Y-X
+13 FOR I=1:1:4
if I=2&(X<3)
QUIT
WRITE !
+14 WRITE ?98
FOR I=1:1:33
WRITE UL
+15 WRITE !?84,"Prepared by: ADMINISTRATIVE OFFICER OF THE DAY",!
+16 ;
+17 KILL ADC,AT,C,CT,CUM,D,D1,I,I1,J,J1,K,L,X,X1,X2
Q QUIT
+1 ;
HEAD IF $DATA(FF)
WRITE @IOF
+1 SET FF=2
+2 WRITE !?94,"Date/Time Printed: ",DGNOW
+3 WRITE !?RM-22\2,"BED STATUS REPORT"
+4 SET X=$$NAME^VASITE(RD)
+5 IF X']""
Begin DoDot:1
+6 SET X="VA MEDICAL CENTER"
+7 if $DATA(^DG(40.8,+$PIECE(DGPM("GL"),"^",3),0))
SET X=X_", "_$PIECE(^(0),"^")
End DoDot:1
+8 WRITE !?RM-$LENGTH(X)\2,X
+9 SET X=RD
+10 DO DW^%DTC
+11 SET X1=X
SET X="PERIOD ENDING MIDNIGHT "_X1_", "
+12 SET Y=RD
XECUTE ^DD("DD")
SET X=X_Y
+13 WRITE !?RM-$LENGTH(X)\2,X,!
+14 KILL X,X1,Y
+15 QUIT
+16 ;
HEAD2 WRITE !,?71,"Va-",?92,"Over",?116,"Cum",?127,"Cum"
+1 WRITE !?10,"Bed",?21,"Prev",?39,"Pt's",?71,"cant",?78,"Beds",?85,"Oper",?92,"Cap.",?100,"Auth",?108,"Cum",?116,"Occ.",?123,"Patient"
+2 WRITE !?2,"Ward",?10,"Section",?21,"Rem.",?27,"Gain",?33,"Loss",?39,"Rem.",?45,"Pass",?53,"AA",?59,"UA",?64,"ASIH",?71,"Beds",?79,"OOS",?85,"Beds",?92,"Beds",?100,"Beds",?108,"ADC",?116,"Rate",?126,"Days"
+3 if $Y<131
WRITE ?131,""
WRITE $CHAR(13)
if UL["-"
WRITE !
FOR L=1:1:131
WRITE UL
+4 KILL L
+5 QUIT
+6 ;
TAB SET TAB="1^10^21^27^33^39^45^52^58^64^71^78^85^92^100^105^113^123"
+1 SET JUS="0^0^4^4^4^4^4^3^3^4^4^4^4^4^4^6^7^7"
+2 QUIT
