DGPMBSP2.m

DGPMBSP2 ;ALB/LM - BSR PRINT, CONT.; 17 OCT 90 ; 1/13/05 3:48pm

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

 ;

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

DGPMBSP2  ;ALB/LM - BSR PRINT, CONT.; 17 OCT 90 ; 1/13/05 3:48pm

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

 +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