| 1 | DGPMBSR3 ;ALB/LM - STORE NEW CENSUS NODES; 16 JAN 91
|
|---|
| 2 | ;;5.3;Registration;**34**;Aug 13, 1993
|
|---|
| 3 | ;
|
|---|
| 4 | ; Storing in the Census File and accumulating data in ^Utility
|
|---|
| 5 | A D Q
|
|---|
| 6 | S FY("B")=$S(+$E(RD,4,5)<10:+$E(RD,1,3)-1,1:$E(RD,1,3)_"0930") ; Place holder for FY
|
|---|
| 7 | S W=0 F I=0:0 S W=$O(^DIC(42,W)) Q:'W D WSET,CMPD,AUTH,OOS,DGR
|
|---|
| 8 | ;
|
|---|
| 9 | Q K I,I1,W,X,X1,X2,Z,Z1,Z2,Z3,%,RB,OSI Q
|
|---|
| 10 | ;
|
|---|
| 11 | WSET F I1="DGAA","DGUA","DGPS","DGIP","DGVN","DGFR","DG6","DGC","DGCN","DGR","DGRN","DGOD","DGAS" S X(I1)=$S($D(^UTILITY(I1,$J,W)):^(W),1:0)
|
|---|
| 12 | F I1=5,6,8,12,13,14,15,16,17,18,19,20,21,22,23,24,26,27,28,29 S $P(X("DGC"),"^",I1)=$P(X("DGC"),"^",I1)+$P(X("DGCN"),"^",I1)
|
|---|
| 13 | S $P(X("DGC"),"^",7)=$P(X("DGC"),"^",5)+$P(X("DGC"),"^",2) ; Cum Rem = Cum Disch + Patients Remaining
|
|---|
| 14 | S X=$S(REM:X("DGIP"),1:$P(X("DGC"),"^",2)+$P(X("DGCN"),"^",28)-$P(X("DGCN"),"^",24)) ; Inpatient (BO) OR Patients Remaining + Gains-Total [Cum] - Cum Losses
|
|---|
| 15 | S $P(X("DGC"),"^",2)=+X ; Patients Remaining
|
|---|
| 16 | S $P(X("DGC"),"^",3)=X+$P(X("DGC"),"^",3)+X("DGOD") ; Cum Patient Days of Care = previous cum pat days of care + patients remaining + oneday admissions
|
|---|
| 17 | Q
|
|---|
| 18 | ;
|
|---|
| 19 | CMPD ; $P(X("DGC"),"^",25) = Cum Monthly Pat Days (0;25) in file #41.9)
|
|---|
| 20 | I +$E(X("DGC"),6,7)=1 S $P(X("DGC"),"^",25)=0 ; initializes monthly pt days of care
|
|---|
| 21 | ; on first of month.
|
|---|
| 22 | S $P(X("DGC"),"^",25)=$P(X("DGC"),"^",25)+$P(X("DGC"),"^",2)+X("DGOD") ; monthly days of care cum.
|
|---|
| 23 | Q
|
|---|
| 24 | ;
|
|---|
| 25 | AUTH ; -- how many auth beds
|
|---|
| 26 | S D0=+W,DGPMOS=RD D AUTH^DGPMDDCF S X("AB")=$S(X=-1:0,1:X)
|
|---|
| 27 | K D0,DGPMOS Q
|
|---|
| 28 | ;
|
|---|
| 29 | OOS ; -- Is Ward OOS for Date?
|
|---|
| 30 | S D0=+W,DGPMOS=RD D WIN^DGPMDDCF I X=1 S X("OS")=X("AB") G OOSQ
|
|---|
| 31 | D BOS^DGPMDDCF S X("OS")=$S(X=-1:0,1:X)
|
|---|
| 32 | OOSQ K D0,DGPMOS Q
|
|---|
| 33 | ;
|
|---|
| 34 | DGR S $P(X("DGR"),"^",1)=+X("DGFR") ; Female Patients Remaining
|
|---|
| 35 | S X("OB")=X("AB")-X("OS") ; Operating Beds
|
|---|
| 36 | S $P(X("DGR"),"^",2)=+X("OB") ; Operating Beds
|
|---|
| 37 | S $P(X("DGR"),"^",3)=+X("DG6") ; Bed Occ. 65 and Over
|
|---|
| 38 | S $P(X("DGR"),"^",4)=+X("DGVN") ; Bed Occ. Vietnam Era
|
|---|
| 39 | S $P(X("DGR"),"^",5)=+X("DGPS") ; AA<96
|
|---|
| 40 | S $P(X("DGR"),"^",6)=+X("DGAA") ; AA
|
|---|
| 41 | S $P(X("DGR"),"^",7)=+X("DGUA") ; UA
|
|---|
| 42 | S $P(X("DGR"),"^",8)=+X("DGAS") ; ASIH
|
|---|
| 43 | S $P(X("DGR"),"^",9)=+X("OS") ; Beds Out Of Service
|
|---|
| 44 | S $P(X("DGR"),"^",10)=+X("AB") ; Authorized Beds
|
|---|
| 45 | S $P(X("DGR"),"^",11)=+X("DGOD") ; Oneday admission/discharge
|
|---|
| 46 | DGC S $P(X("DGC"),"^",4)=$P(X("DGC"),"^",4)+X("OB") ; Cum Bed + Oper Beds
|
|---|
| 47 | S $P(X("DGC"),"^",9)=$P(X("DGC"),"^",9)+$P(X("DGR"),"^",5) ; Cum Pass Days + AA<96
|
|---|
| 48 | S $P(X("DGC"),"^",10)=$P(X("DGC"),"^",10)+$P(X("DGR"),"^",6) ; Cum ABO Days + AA
|
|---|
| 49 | S $P(X("DGC"),"^",11)=$P(X("DGC"),"^",11)+$P(X("DGR"),"^",7) ; Cum UA Days + UA
|
|---|
| 50 | ;
|
|---|
| 51 | CENSUS S:'$D(^DG(41.9,+W,0)) X=^DG(41.9,0),$P(X,"^",3)=+W,$P(X,"^",4)=$P(X,"^",4)+1,^DG(41.9,0)=X,^DG(41.9,"B",+W,+W)=""
|
|---|
| 52 | S:'$D(^DG(41.9,+W,"C",0)) ^(0)="^41.91DA^^"
|
|---|
| 53 | S:'$D(^DG(41.9,+W,"C",RD,0)) X=^DG(41.9,+W,"C",0),$P(X,"^",3)=RD,$P(X,"^",4)=$P(X,"^",4)+1,^DG(41.9,+W,"C",0)=X
|
|---|
| 54 | S ^DG(41.9,+W,"C",RD,0)=X("DGC"),^UTILITY("DGC",$J,+W)=X("DGC")
|
|---|
| 55 | S ^DG(41.9,+W,"C",RD,1)=X("DGR"),^UTILITY("DGR",$J,+W)=X("DGR")
|
|---|
| 56 | Q
|
|---|
