DGPMBSP4.m

DGPMBSP4 ;ALB/LM - BSR PRINT, CONT.; 13 JUNE 90 ; 1/13/05 3:48pm

 ;;5.3;Registration;**592,641,1015**;Aug 13, 1993;Build 21

 ;

A Q:'PL

 ;

 S X="T O T A L S   B Y   P R I M A R Y   W A R D   L O C A T I O N"

 ;

 W ! W:$Y<131 ?131,"" W $C(13) W:UL["-" ! F L=1:1:131 W UL

 W !?0,"|",?(RM-$L(X)\2),X,?130,"|"

 W:$Y<131 ?131,"" W $C(13) W:UL["-" ! F L=1:1:131 W UL

 ;

HEAD2 W !?0,"|",?71,"Va-",?92,"Over",?116,"Cum",?127,"Cum|"

 W !?0,"|",?2,"Primary",?21,"Prev",?39,"Pt's",?71,"cant",?78,"Beds",?85,"Oper",?92,"Cap.",?100,"Auth",?108,"Cum",?116,"Occ.",?123,"Patient|"

 W !?0,"|",?2,"Location",?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

 ;

 S I=0 F I1=0:0 S I=$O(^UTILITY("DGWPL",$J,I)) Q:I=""  S X=^(I),X1=$S($D(^UTILITY("DGWPLT",$J,I)):^(I),1:0) D WR

 W:$Y<131 ?131,"" W $C(13) W:UL["-" ! F L=1:1:131 W UL

 K I,I1,X1,L

HEAD2Q Q

 ;

WR W !?0,"|",I

 S $P(X,"^",11)=$S(+$P(X,"^",13)>+$P(X,"^",6):($P(X,"^",13)-$P(X,"^",6)),1:0) ; Vacant Beds = Operating Beds - Patients Remaining

 S $P(X,"^",14)=$S(+$P(X,"^",6)>+$P(X,"^",13):($P(X,"^",6)-$P(X,"^",13)),1:0) ; Overcapacity = Patients Remaining - Operating Beds

 F N=3:1:15 W ?+$P(TAB,"^",N),$J($P(X,"^",N),+$P(JUS,"^",N))

 S X(16)=($P(X,"^",18)/FY("D"))

 S X2=$P(X1,"^",3)/FY("D")

 S X(17)=$S(X2'>0:0,1:((X(16)*100)/X2))

 S X(16)=$J(X(16),0,1)

 S X(17)=$J(X(17),0,1)_"%"

 S X(18)=+$P(X,"^",18)

 S X2=$P(X1,"^",2)/$P(X1,"^")

 F N=16:1:18 W ?+$P(TAB,"^",N),$J(X(N),$P(JUS,"^",N))

 W ?30,"|"

WRQ Q

DGPMBSP4  ;ALB/LM - BSR PRINT, CONT.; 13 JUNE 90 ; 1/13/05 3:48pm

 +1       ;;5.3;Registration;**592,641,1015**;Aug 13, 1993;Build 21

 +2       ;

A          IF 'PL

               QUIT 

 +1       ;

 +2        SET X="T O T A L S   B Y   P R I M A R Y   W A R D   L O C A T I O N"

 +3       ;

 +4        WRITE !

           IF $Y<131

               WRITE ?131,""

           WRITE $CHAR(13)

           IF UL["-"

               WRITE !

           FOR L=1:1:131

               WRITE UL

 +5        WRITE !?0,"|",?(RM-$LENGTH(X)\2),X,?130,"|"

 +6        IF $Y<131

               WRITE ?131,""

           WRITE $CHAR(13)

           IF UL["-"

               WRITE !

           FOR L=1:1:131

               WRITE UL

 +7       ;

HEAD2      WRITE !?0,"|",?71,"Va-",?92,"Over",?116,"Cum",?127,"Cum|"

 +1        WRITE !?0,"|",?2,"Primary",?21,"Prev",?39,"Pt's",?71,"cant",?78,"Beds",?85,"Oper",?92,"Cap.",?100,"Auth",?108,"Cum",?116,"Occ.",?123,"Patient|"

 +2        WRITE !?0,"|",?2,"Location",?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       ;

 +5        SET I=0

           FOR I1=0:0

               SET I=$ORDER(^UTILITY("DGWPL",$JOB,I))

               IF I=""

                   QUIT 

               SET X=^(I)

               SET X1=$SELECT($DATA(^UTILITY("DGWPLT",$JOB,I)):^(I),1:0)

               DO WR

 +6        IF $Y<131

               WRITE ?131,""

           WRITE $CHAR(13)

           IF UL["-"

               WRITE !

           FOR L=1:1:131

               WRITE UL

 +7        KILL I,I1,X1,L

HEAD2Q     QUIT 

 +1       ;

WR         WRITE !?0,"|",I

 +1       ; Vacant Beds = Operating Beds - Patients Remaining

           SET $PIECE(X,"^",11)=$SELECT(+$PIECE(X,"^",13)>+$PIECE(X,"^",6):($PIECE(X,"^",13)-$PIECE(X,"^",6)),1:0)

 +2       ; Overcapacity = Patients Remaining - Operating Beds

           SET $PIECE(X,"^",14)=$SELECT(+$PIECE(X,"^",6)>+$PIECE(X,"^",13):($PIECE(X,"^",6)-$PIECE(X,"^",13)),1:0)

 +3        FOR N=3:1:15

               WRITE ?+$PIECE(TAB,"^",N),$JUSTIFY($PIECE(X,"^",N),+$PIECE(JUS,"^",N))

 +4        SET X(16)=($PIECE(X,"^",18)/FY("D"))

 +5        SET X2=$PIECE(X1,"^",3)/FY("D")

 +6        SET X(17)=$SELECT(X2'>0:0,1:((X(16)*100)/X2))

 +7        SET X(16)=$JUSTIFY(X(16),0,1)

 +8        SET X(17)=$JUSTIFY(X(17),0,1)_"%"

 +9        SET X(18)=+$PIECE(X,"^",18)

 +10       SET X2=$PIECE(X1,"^",2)/$PIECE(X1,"^")

 +11       FOR N=16:1:18

               WRITE ?+$PIECE(TAB,"^",N),$JUSTIFY(X(N),$PIECE(JUS,"^",N))

 +12       WRITE ?30,"|"

WRQ        QUIT