- DGPMBSP4 ;ALB/LM - BSR PRINT, CONT.; 13 JUNE 90 ; 1/13/05 3:48pm
- ;;5.3;Registration;**592,641**;Aug 13, 1993
- ;
- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPMBSP4 1646 printed Mar 13, 2025@21:53:47 Page 2
- DGPMBSP4 ;ALB/LM - BSR PRINT, CONT.; 13 JUNE 90 ; 1/13/05 3:48pm
- +1 ;;5.3;Registration;**592,641**;Aug 13, 1993
- +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
