DGPMBSP.m

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 ---DGPMBSP   1516     printed  Feb 19, 2025@00:15:12                                                                                                                                                                                                     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