DGPMBSP2 ;ALB/LM - BSR PRINT, CONT.; 17 OCT 90 ; 1/13/05 3:48pm
;;5.3;Registration;**59,592,641**;Aug 13, 1993
;
A S BD=1 S BD("DY")=BD("OSD") ;(BD*BD("M")) ; Total Elapsed Fiscal Days * Bed Days Multipler
S ^UTILITY("DGWBD",$J,+ORDER)=BD("DY")_"^"_BD("S")_"^"_BD("D")_"^"_BD("CB") ; Total Elapsed Fiscal Days * Bed Days Multipler_^_Include Stat's_^_Display on BSR_^_Cum Beds
Q:'BD("S") ; Include Stat's
;
CENSUS S X=$S($D(^DG(41.9,W,"C",RD,0)):^(0),1:"") ; Census File 0 Node (Report Date) NEW NODE
S ^UTILITY("DGWNN",$J,ORDER)=X ; Census File 0 Node (Report Date) NEW NODE
S ^UTILITY("DGWON",$J,ORDER)=$S($D(^DG(41.9,W,"C",FY("L"),0)):^(0),1:"") ; Census File 0 Node (last fiscal year) OLD NODE
S X(1)=$S($D(^DG(41.9,W,"C",RD,1)):^(1),1:"") ; Census File 1 Node (Report Date)
S X1=$S($D(^DG(41.9,W,"C",PD,0)):^(0),1:"") ; Census File 0 Node (Previous Date)
S:$E(PD,4,7)="0930" X1="^"_$P(X1,"^",2) ; Pats Remaining
;
PM S BD("PM")=$S($D(^DG(41.9,W,"C",FY("EOM"),0)):+$P(^(0),"^",3),1:0) ; Cum Pat Days of Care
S:$E(FY("EOM"),4,7)="0930" BD("PM")=0
;
N ; BD("N") = BSR Display Stat's Node ; $P(1,2)=Name of Ward^Bed Section
S $P(BD("N"),"^",3)=+$P(X1,"^",2) ; Pats Remaining (Previous Date)
S $P(BD("N"),"^",4)=$P(X,"^",28)-$P(X1,"^",28) ; Gains Total Cum (new) - Gains Total Cum (previous)
S $P(BD("N"),"^",5)=$P(X,"^",24)-$P(X1,"^",24) ; losses (new) - losses (previous)
S $P(BD("N"),"^",6)=+$P(X,"^",2) ; Pats Remaining
S $P(BD("N"),"^",7)=+$P(X(1),"^",5) ; AA<96
S $P(BD("N"),"^",8)=+$P(X(1),"^",6) ; AA
S $P(BD("N"),"^",9)=+$P(X(1),"^",7) ; UA
S $P(BD("N"),"^",10)=+$P(X(1),"^",8) ; ASIH
;
BEDS S BD("DOS")=+$P(X(1),"^",9) ; Beds OOS
S BD("AB")=+$P(X(1),"^",10) ; Auth Beds
S X(2)=(BD("AB")-BD("DOS")) ; Auth Beds - Bed OOS
S $P(BD("N"),"^",11)=$S(BD("AB")&($P(X,"^",2)'>X(2)):(BD("AB")-($P(X,"^",2)+BD("DOS"))),1:0) ; AB=Auth Bed - Pat Remaining + Beds OOS = Vacant Beds
S $P(BD("N"),"^",12)=+BD("DOS") ; Beds OOS
S $P(BD("N"),"^",13)=$P(X(1),"^",2) ; Operation Beds
S $P(BD("N"),"^",14)=$S($P(X,"^",2)'>X(2):0,1:$P(X,"^",2)-X(2)) ; Pats Remaining greater than Auth Bed - Bed OOS = Over Cap Beds
S $P(BD("N"),"^",15)=BD("AB") ; AB=Auth Bed
;
ADC S BD("P")=+$P(X,"^",3) ; Cum Pat Days of Care (new)
;S X(2)=(BD("P")/FY("D")) ; Cum Pat Days of Care/Days into Fiscal Year (Cum Ave Daily Census)
S X(2)=$S(FY("D")-BD("OSD"):BD("P")/(FY("D")-BD("OSD")),1:0) ; Pat Days/Total Elapsed Fiscal Days - days OOS (Cum ADC*)
S X(3)=(BD("P")*100) ; Cum Pat Days of Care * 100
;
S BD("OR")=$S(BD("CB")>0:(X(3)/BD("CB")),1:0) ; Cum Beds >0 then Pat Days of Care * 100 divided by Cum Beds (Cum Occ. Rate)
S $P(BD("N"),"^",16)=$J(X(2),0,1) ; Cum ADC
S $P(BD("N"),"^",17)=$J(BD("OR"),0,1)_"%" ; Cum Occ. Rate
S $P(BD("N"),"^",18)=BD("P") ; Cum Pat Days of Care (new) ADC
;
OOS ; OOS stats
S X(2)=$S(FY("D")-BD("OSD"):BD("P")/(FY("D")-BD("OSD")),1:0) ; Pat Days/Total Elapsed Fiscal Days - days OOS (Cum ADC*)
S X(3)=(BD("P")*100) ; Pat Days * 100
; *Occ Rate is *ADC multiplied by 100 divided by FYTD-OOS days
S BD("OOR")=$S(BD("CB")>0:(X(3)/BD("CB")),1:0) ; Cum Beds >0 then Pat Days of Care * 100 divided by Cum Beds (Cum Occ. Rate*)
;
NODE S ^UTILITY("DGWOR",$J,ORDER)=BD("N") ; BSR Display Stat's Node
S ADC=+BD("P")_"^"_(+BD("P")-(BD("PM"))) ; Cum Pat Days of Care new ADC _^_ Cum Pat Days of Care new ADC _^_ Cum Pt Day of Care FY
F X=1:1:2 S $P(ADC(BD("DV"),BD("ADC")),"^",X)=$P(ADC(BD("DV"),BD("ADC")),"^",X)+$P(ADC,"^",X) ; BD("DV") = Division BD("ADC") = Service Type
S X=^UTILITY("DGWPL",$J,BD("PL")) ; BD("PL") = Primary Location
F I=3:1:15,18 S $P(X,"^",I)=$P(X,"^",I)+$P(BD("N"),"^",I)
;
SET S ^UTILITY("DGWPL",$J,BD("PL"))=X ; Ward totals
S X=^UTILITY("DGWPLT",$J,BD("PL"))
S $P(X,"^")=$P(X,"^")+1
S $P(X,"^",2)=$P(X,"^",2)+BD("DY") ; Total elasped fiscal days * bed day multipler
S $P(X,"^",3)=$P(X,"^",3)+BD("CB") ; Cum beds
S ^UTILITY("DGWPLT",$J,BD("PL"))=X ; Total of wards _^_ Total elapsed fiscal days * bed days multipler _^_ Cum bed
Q Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPMBSP2 4109 printed Sep 23, 2025@20:25:04 Page 2
DGPMBSP2 ;ALB/LM - BSR PRINT, CONT.; 17 OCT 90 ; 1/13/05 3:48pm
+1 ;;5.3;Registration;**59,592,641**;Aug 13, 1993
+2 ;
A ;(BD*BD("M")) ; Total Elapsed Fiscal Days * Bed Days Multipler
SET BD=1
SET BD("DY")=BD("OSD")
+1 ; Total Elapsed Fiscal Days * Bed Days Multipler_^_Include Stat's_^_Display on BSR_^_Cum Beds
SET ^UTILITY("DGWBD",$JOB,+ORDER)=BD("DY")_"^"_BD("S")_"^"_BD("D")_"^"_BD("CB")
+2 ; Include Stat's
if 'BD("S")
QUIT
+3 ;
CENSUS ; Census File 0 Node (Report Date) NEW NODE
SET X=$SELECT($DATA(^DG(41.9,W,"C",RD,0)):^(0),1:"")
+1 ; Census File 0 Node (Report Date) NEW NODE
SET ^UTILITY("DGWNN",$JOB,ORDER)=X
+2 ; Census File 0 Node (last fiscal year) OLD NODE
SET ^UTILITY("DGWON",$JOB,ORDER)=$SELECT($DATA(^DG(41.9,W,"C",FY("L"),0)):^(0),1:"")
+3 ; Census File 1 Node (Report Date)
SET X(1)=$SELECT($DATA(^DG(41.9,W,"C",RD,1)):^(1),1:"")
+4 ; Census File 0 Node (Previous Date)
SET X1=$SELECT($DATA(^DG(41.9,W,"C",PD,0)):^(0),1:"")
+5 ; Pats Remaining
if $EXTRACT(PD,4,7)="0930"
SET X1="^"_$PIECE(X1,"^",2)
+6 ;
PM ; Cum Pat Days of Care
SET BD("PM")=$SELECT($DATA(^DG(41.9,W,"C",FY("EOM"),0)):+$PIECE(^(0),"^",3),1:0)
+1 if $EXTRACT(FY("EOM"),4,7)="0930"
SET BD("PM")=0
+2 ;
N ; BD("N") = BSR Display Stat's Node ; $P(1,2)=Name of Ward^Bed Section
+1 ; Pats Remaining (Previous Date)
SET $PIECE(BD("N"),"^",3)=+$PIECE(X1,"^",2)
+2 ; Gains Total Cum (new) - Gains Total Cum (previous)
SET $PIECE(BD("N"),"^",4)=$PIECE(X,"^",28)-$PIECE(X1,"^",28)
+3 ; losses (new) - losses (previous)
SET $PIECE(BD("N"),"^",5)=$PIECE(X,"^",24)-$PIECE(X1,"^",24)
+4 ; Pats Remaining
SET $PIECE(BD("N"),"^",6)=+$PIECE(X,"^",2)
+5 ; AA<96
SET $PIECE(BD("N"),"^",7)=+$PIECE(X(1),"^",5)
+6 ; AA
SET $PIECE(BD("N"),"^",8)=+$PIECE(X(1),"^",6)
+7 ; UA
SET $PIECE(BD("N"),"^",9)=+$PIECE(X(1),"^",7)
+8 ; ASIH
SET $PIECE(BD("N"),"^",10)=+$PIECE(X(1),"^",8)
+9 ;
BEDS ; Beds OOS
SET BD("DOS")=+$PIECE(X(1),"^",9)
+1 ; Auth Beds
SET BD("AB")=+$PIECE(X(1),"^",10)
+2 ; Auth Beds - Bed OOS
SET X(2)=(BD("AB")-BD("DOS"))
+3 ; AB=Auth Bed - Pat Remaining + Beds OOS = Vacant Beds
SET $PIECE(BD("N"),"^",11)=$SELECT(BD("AB")&($PIECE(X,"^",2)'>X(2)):(BD("AB")-($PIECE(X,"^",2)+BD("DOS"))),1:0)
+4 ; Beds OOS
SET $PIECE(BD("N"),"^",12)=+BD("DOS")
+5 ; Operation Beds
SET $PIECE(BD("N"),"^",13)=$PIECE(X(1),"^",2)
+6 ; Pats Remaining greater than Auth Bed - Bed OOS = Over Cap Beds
SET $PIECE(BD("N"),"^",14)=$SELECT($PIECE(X,"^",2)'>X(2):0,1:$PIECE(X,"^",2)-X(2))
+7 ; AB=Auth Bed
SET $PIECE(BD("N"),"^",15)=BD("AB")
+8 ;
ADC ; Cum Pat Days of Care (new)
SET BD("P")=+$PIECE(X,"^",3)
+1 ;S X(2)=(BD("P")/FY("D")) ; Cum Pat Days of Care/Days into Fiscal Year (Cum Ave Daily Census)
+2 ; Pat Days/Total Elapsed Fiscal Days - days OOS (Cum ADC*)
SET X(2)=$SELECT(FY("D")-BD("OSD"):BD("P")/(FY("D")-BD("OSD")),1:0)
+3 ; Cum Pat Days of Care * 100
SET X(3)=(BD("P")*100)
+4 ;
+5 ; Cum Beds >0 then Pat Days of Care * 100 divided by Cum Beds (Cum Occ. Rate)
SET BD("OR")=$SELECT(BD("CB")>0:(X(3)/BD("CB")),1:0)
+6 ; Cum ADC
SET $PIECE(BD("N"),"^",16)=$JUSTIFY(X(2),0,1)
+7 ; Cum Occ. Rate
SET $PIECE(BD("N"),"^",17)=$JUSTIFY(BD("OR"),0,1)_"%"
+8 ; Cum Pat Days of Care (new) ADC
SET $PIECE(BD("N"),"^",18)=BD("P")
+9 ;
OOS ; OOS stats
+1 ; Pat Days/Total Elapsed Fiscal Days - days OOS (Cum ADC*)
SET X(2)=$SELECT(FY("D")-BD("OSD"):BD("P")/(FY("D")-BD("OSD")),1:0)
+2 ; Pat Days * 100
SET X(3)=(BD("P")*100)
+3 ; *Occ Rate is *ADC multiplied by 100 divided by FYTD-OOS days
+4 ; Cum Beds >0 then Pat Days of Care * 100 divided by Cum Beds (Cum Occ. Rate*)
SET BD("OOR")=$SELECT(BD("CB")>0:(X(3)/BD("CB")),1:0)
+5 ;
NODE ; BSR Display Stat's Node
SET ^UTILITY("DGWOR",$JOB,ORDER)=BD("N")
+1 ; Cum Pat Days of Care new ADC _^_ Cum Pat Days of Care new ADC _^_ Cum Pt Day of Care FY
SET ADC=+BD("P")_"^"_(+BD("P")-(BD("PM")))
+2 ; BD("DV") = Division BD("ADC") = Service Type
FOR X=1:1:2
SET $PIECE(ADC(BD("DV"),BD("ADC")),"^",X)=$PIECE(ADC(BD("DV"),BD("ADC")),"^",X)+$PIECE(ADC,"^",X)
+3 ; BD("PL") = Primary Location
SET X=^UTILITY("DGWPL",$JOB,BD("PL"))
+4 FOR I=3:1:15,18
SET $PIECE(X,"^",I)=$PIECE(X,"^",I)+$PIECE(BD("N"),"^",I)
+5 ;
SET ; Ward totals
SET ^UTILITY("DGWPL",$JOB,BD("PL"))=X
+1 SET X=^UTILITY("DGWPLT",$JOB,BD("PL"))
+2 SET $PIECE(X,"^")=$PIECE(X,"^")+1
+3 ; Total elasped fiscal days * bed day multipler
SET $PIECE(X,"^",2)=$PIECE(X,"^",2)+BD("DY")
+4 ; Cum beds
SET $PIECE(X,"^",3)=$PIECE(X,"^",3)+BD("CB")
+5 ; Total of wards _^_ Total elapsed fiscal days * bed days multipler _^_ Cum bed
SET ^UTILITY("DGWPLT",$JOB,BD("PL"))=X
Q QUIT
