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

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

initial load of FOIAVistA 6/30/08 version
File size: 2.4 KB
Line 
1DGPMBSR4 ;ALB/LM - STORE NEW TREATING SPECIALITY NODES; 16 JAN 91
2 ;;5.3;Registration;**85**;Aug 13, 1993
3 ;
4 ; Storing in the Medical Center Division File, Treating Specialty Census Data
5 Q:RD<TSRI ; Quit if report date is less than TSR Initialization date
6 ;
7 I TSRI>RD Q ; If TSR Initialization date is after report date quit
8A D Q
9 S DV=0 F I=0:0 S DV=$O(^DG(40.8,DV)) Q:'DV S T=0 F I1=0:0 S T=$O(^DG(40.8,DV,"TS",T)) Q:'T D TSET
10 ;
11Q K DV,I2,X Q
12 ;
13TSET F I2="DGTP","DGTI","DGTU","DGTA","DGTV","DGT6","DGTF","DGS","DGSN","DGS1","DGSN1","DGTOD","DGTAS" S X(I2)=$S($D(^UTILITY(I2,$J,DV,T)):^(T),1:0)
14 S:'X("DGS") $P(X("DGS"),U,1)=RD
15 F I2=5,6,8,12,13,14,15,16,17,18,19,20,21,22,23,24,26,27,28,29 S $P(X("DGS"),"^",I2)=$P(X("DGS"),"^",I2)+$P(X("DGSN"),"^",I2)
16 S $P(X("DGS"),"^",7)=$P(X("DGS"),"^",5)+$P(X("DGS"),"^",2) ; Patients Remaining [Cum] = Discharge-Total [Cum] + Patients Remaining
17 S X=$S(REM:+X("DGTI"),1:$P(X("DGS"),"^",2)+$P(X("DGSN"),"^",28)-$P(X("DGSN"),"^",24)) ; TS Inpatients OR Patients Remaining + Gains-Total [Cum] - Losses-Total [Cum]
18 S $P(X("DGS"),"^",2)=+X ; Patients Remaining
19 S $P(X("DGS"),"^",3)=$P(X("DGS"),"^",3)+X ; Patient Days of Care [Cum]
20 S $P(X("DGS"),"^",3)=$P(X("DGS"),"^",3)+X("DGTOD") ; Cum Patient Days of Care to include oneday admissions
21 S $P(X("DGS1"),"^",1)=+X("DGTF") ; Females Remaining
22 S $P(X("DGS1"),"^",3)=+X("DGT6") ; 65 and Over Remaining
23 S $P(X("DGS1"),"^",4)=+X("DGTV") ; Vietnam Era Remaining
24 S $P(X("DGS1"),"^",5)=+X("DGTP") ; Pass Patients Remaining
25 S $P(X("DGS1"),"^",6)=+X("DGTA") ; AA Remaining
26 S $P(X("DGS1"),"^",7)=+X("DGTU") ; UA Remaining
27 S $P(X("DGS1"),"^",8)=+X("DGTAS") ; ASIH Remaining
28 S $P(X("DGS1"),"^",11)=$P(X("DGS1"),"^",11)+X("DGTOD") ; One Day Discharges
29 S $P(X("DGS"),"^",9)=$P(X("DGS"),"^",9)+$P(X("DGS1"),"^",5) ; Pass Days [Cum] + AA<96
30 S $P(X("DGS"),"^",10)=$P(X("DGS"),"^",10)+$P(X("DGS1"),"^",6) ; AA Days [Cum] + AA
31 S $P(X("DGS"),"^",11)=$P(X("DGS"),"^",11)+$P(X("DGS1"),"^",7) ; UA Days [Cum] + UA
32 S:'$D(^DG(40.8,DV,"TS",0)) ^(0)="^40.806P^^"
33 S:'$D(^DG(40.8,DV,"TS",T,0)) X=^DG(40.8,DV,"TS",0),$P(X,"^",3)=T,$P(X,"^",4)=$P(X,"^",4)+1,^DG(40.8,DV,"TS",0)=X,^DG(40.8,DV,"TS","B",T,T)=""
34 S:'$D(^DG(40.8,DV,"TS",T,"C",0)) ^(0)="^40.807D^^"
35 S:'$D(^DG(40.8,DV,"TS",T,"C",RD,0)) X=^DG(40.8,DV,"TS",T,"C",0),$P(X,"^",3)=RD,$P(X,"^",4)=$P(X,"^",4)+1,^DG(40.8,DV,"TS",T,"C",0)=X
36 S ^DG(40.8,DV,"TS",T,"C",RD,0)=X("DGS")
37 S ^DG(40.8,DV,"TS",T,"C",RD,1)=X("DGS1")
38 Q
Note: See TracBrowser for help on using the repository browser.