source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGPMBSP2.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.9 KB
RevLine 
[613]1DGPMBSP2 ;ALB/LM - BSR PRINT, CONT.; 17 OCT 90 ; 1/13/05 3:48pm
2 ;;5.3;Registration;**59,592,641**;Aug 13, 1993
3 ;
4A S BD=1 S BD("DY")=BD("OSD") ;(BD*BD("M")) ; Total Elapsed Fiscal Days * Bed Days Multipler
5 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
6 Q:'BD("S") ; Include Stat's
7 ;
8CENSUS S X=$S($D(^DG(41.9,W,"C",RD,0)):^(0),1:"") ; Census File 0 Node (Report Date) NEW NODE
9 S ^UTILITY("DGWNN",$J,ORDER)=X ; Census File 0 Node (Report Date) NEW NODE
10 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
11 S X(1)=$S($D(^DG(41.9,W,"C",RD,1)):^(1),1:"") ; Census File 1 Node (Report Date)
12 S X1=$S($D(^DG(41.9,W,"C",PD,0)):^(0),1:"") ; Census File 0 Node (Previous Date)
13 S:$E(PD,4,7)="0930" X1="^"_$P(X1,"^",2) ; Pats Remaining
14 ;
15PM S BD("PM")=$S($D(^DG(41.9,W,"C",FY("EOM"),0)):+$P(^(0),"^",3),1:0) ; Cum Pat Days of Care
16 S:$E(FY("EOM"),4,7)="0930" BD("PM")=0
17 ;
18N ; BD("N") = BSR Display Stat's Node ; $P(1,2)=Name of Ward^Bed Section
19 S $P(BD("N"),"^",3)=+$P(X1,"^",2) ; Pats Remaining (Previous Date)
20 S $P(BD("N"),"^",4)=$P(X,"^",28)-$P(X1,"^",28) ; Gains Total Cum (new) - Gains Total Cum (previous)
21 S $P(BD("N"),"^",5)=$P(X,"^",24)-$P(X1,"^",24) ; losses (new) - losses (previous)
22 S $P(BD("N"),"^",6)=+$P(X,"^",2) ; Pats Remaining
23 S $P(BD("N"),"^",7)=+$P(X(1),"^",5) ; AA<96
24 S $P(BD("N"),"^",8)=+$P(X(1),"^",6) ; AA
25 S $P(BD("N"),"^",9)=+$P(X(1),"^",7) ; UA
26 S $P(BD("N"),"^",10)=+$P(X(1),"^",8) ; ASIH
27 ;
28BEDS S BD("DOS")=+$P(X(1),"^",9) ; Beds OOS
29 S BD("AB")=+$P(X(1),"^",10) ; Auth Beds
30 S X(2)=(BD("AB")-BD("DOS")) ; Auth Beds - Bed OOS
31 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
32 S $P(BD("N"),"^",12)=+BD("DOS") ; Beds OOS
33 S $P(BD("N"),"^",13)=$P(X(1),"^",2) ; Operation Beds
34 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
35 S $P(BD("N"),"^",15)=BD("AB") ; AB=Auth Bed
36 ;
37ADC S BD("P")=+$P(X,"^",3) ; Cum Pat Days of Care (new)
38 ;S X(2)=(BD("P")/FY("D")) ; Cum Pat Days of Care/Days into Fiscal Year (Cum Ave Daily Census)
39 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*)
40 S X(3)=(BD("P")*100) ; Cum Pat Days of Care * 100
41 ;
42 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)
43 S $P(BD("N"),"^",16)=$J(X(2),0,1) ; Cum ADC
44 S $P(BD("N"),"^",17)=$J(BD("OR"),0,1)_"%" ; Cum Occ. Rate
45 S $P(BD("N"),"^",18)=BD("P") ; Cum Pat Days of Care (new) ADC
46 ;
47OOS ; OOS stats
48 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*)
49 S X(3)=(BD("P")*100) ; Pat Days * 100
50 ; *Occ Rate is *ADC multiplied by 100 divided by FYTD-OOS days
51 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*)
52 ;
53NODE S ^UTILITY("DGWOR",$J,ORDER)=BD("N") ; BSR Display Stat's Node
54 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
55 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
56 S X=^UTILITY("DGWPL",$J,BD("PL")) ; BD("PL") = Primary Location
57 F I=3:1:15,18 S $P(X,"^",I)=$P(X,"^",I)+$P(BD("N"),"^",I)
58 ;
59SET S ^UTILITY("DGWPL",$J,BD("PL"))=X ; Ward totals
60 S X=^UTILITY("DGWPLT",$J,BD("PL"))
61 S $P(X,"^")=$P(X,"^")+1
62 S $P(X,"^",2)=$P(X,"^",2)+BD("DY") ; Total elasped fiscal days * bed day multipler
63 S $P(X,"^",3)=$P(X,"^",3)+BD("CB") ; Cum beds
64 S ^UTILITY("DGWPLT",$J,BD("PL"))=X ; Total of wards _^_ Total elapsed fiscal days * bed days multipler _^_ Cum bed
65Q Q
Note: See TracBrowser for help on using the repository browser.