source: FOIAVistA/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGPMBSR1.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: 3.6 KB
Line 
1DGPMBSR1 ;ALB/LM - BED STATUS REPORT RECALCULATION CONT.; 16 JAN 91
2 ;;5.3;Registration;**85**;Aug 13, 1993
3 ;
4A S DIE="^DG(43,",DA=1,DR="53///"_RD D ^DIE K DA,DIE,DR ; Date when recalc up to
5 S W=0 F I=0:0 S W=$O(^DIC(42,W)) Q:'W D SET
6 S D=0 F I=0:0 S D=$O(^DG(40.8,D)) Q:'D S ^UTILITY("DGD",$J,D)=$S($D(^DG(40.8,D,"CEN",PD,0)):$P(^(0),"^",12),1:0),^UTILITY("DGDN",$J,D)="" S T=0 F I1=0:0 S T=$O(^DG(40.8,D,"TS",T)) Q:'T D TSET
7 K I,I1,T,W,D
8 D ^DGPMGLG
9 Q
10 ;
11SET S X=$S($D(^DG(41.9,W,"C",PD,0)):^(0),1:""),X=RD_"^"_$P(X,"^",2,99)
12 S:$E(PD,4,7)="0930" X=$P(X,"^",1,2) ; New fiscal year
13 S ^UTILITY("DGC",$J,W)=X ; Census
14 S ^UTILITY("DGCN",$J,W)="" ; New census
15 S ^UTILITY("DGOD",$J,+W)=0 ; One Day Admissions
16 S X1=$S($D(^DG(41.9,W,"C",PD,1)):$P(^(1),"^",1,10),1:"")
17 S ^UTILITY("DGR",$J,W)=X1 ; Remaining
18 S ^UTILITY("DGRN",$J,W)="" ; New remaining (one node)
19 S ^UTILITY("DGFR",$J,+W)=0 ; Female Patients Remaining
20 S ^UTILITY("DG6",$J,+W)=0 ; Bed Occupants 65 & Over
21 S ^UTILITY("DGVN",$J,+W)=0 ; Bed Occupants VN
22 S ^UTILITY("DGPS",$J,+W)=$S('REM:+$P(X1,"^",5),1:0) ; Pass
23 S ^UTILITY("DGAA",$J,+W)=$S('REM:+$P(X1,"^",6),1:0) ; Auth absense
24 S ^UTILITY("DGUA",$J,+W)=$S('REM:+$P(X1,"^",7),1:0) ; Unauth absense
25 S:'REM ^UTILITY("DGAS",$J,+W)=+$P(X1,"^",8) ; ASIH
26 S:REM ^UTILITY("DGIP",$J,+W)=0 ; if count pt. remaining
27CEN S ^DG(41.9,W,"C",RD,0)=RD_"^"_$P(^UTILITY("DGC",$J,W),"^",2,99)
28 S:'$D(^DG(41.9,W,0))#2 ^(0)=W,^DG(41.9,"B",W,W)="",$P(^(0),"^",4)=$P(^DG(41.9,0),"^",4)+1,$P(^(0),"^",3)=RD
29 S:'$D(^DG(41.9,W,"C",0))#2 ^(0)="^41.91DA^^"
30 Q
31 ;
32TSET I TSRI>RD Q ; If TSR Initialization date is greater than report date quit
33 S X=$S($D(^DG(40.8,D,"TS",T,"C",PD,0)):^(0),1:""),X=RD_"^"_$P(X,"^",2,99)
34 I RD=TSRI,$P(X,U,2)']"" S X=RD_"^"_$P(^DG(40.8,D,"TS",T,0),"^",3)
35 S:$E(PD,4,7)="0930" X=$P(X,"^",1,2)
36 S ^UTILITY("DGS",$J,+D,+T)=X ; Treating Specialty census
37 S ^UTILITY("DGSN",$J,+D,+T)="" ; Treating Specialty new census
38 S ^UTILITY("DGTOD",$J,+D,+T)=0 ; One Day Admissions
39 S X1=$S($D(^DG(40.8,D,"TS",T,"C",PD,1)):$P(^(1),"^",1,10),1:"")
40 S ^UTILITY("DGS1",$J,+D,+T)=X1 ; Treating Specialty remaining
41 S ^UTILITY("DGSN1",$J,+D,+T)="" ; Treating Specialty new remaining (one node)
42 S ^UTILITY("DGTF",$J,+D,+T)=0 ; Female Patients Remaining
43 S ^UTILITY("DGT6",$J,+D,+T)=0 ; Bed Occupants 65 & Over
44 S ^UTILITY("DGTV",$J,+D,+T)=0 ; Bed Occupants VN
45 S ^UTILITY("DGTP",$J,+D,+T)=$S('REM:+$P(X1,"^",5),1:0) ; Treating Specialty Pass
46 S ^UTILITY("DGTA",$J,+D,+T)=$S('REM:+$P(X1,"^",6),1:0) ; Treating Specialty Auth absense
47 S ^UTILITY("DGTU",$J,+D,+T)=$S('REM:+$P(X1,"^",7),1:0) ; Treating Specialty Unauth absense
48 S:'REM ^UTILITY("DGTAS",$J,+D,+T)=+$P(X1,"^",8) ; Treating Specialty ASIH
49 S:REM ^UTILITY("DGTI",$J,+D,+T)=0 ; if count pt. remaining
50TCEN S ^DG(40.8,D,"TS",T,"C",RD,0)=RD_"^"_$P(^UTILITY("DGS",$J,D,T),"^",2,99),^DG(40.8,D,"TS",T,"C","B",RD,RD)=""
51 S:'$D(^DG(40.8,D,"TS",T,0))#2 ^(0)=T,^DG(40.8,D,"TS","B",T,T)=""
52 S:'$D(^DG(40.8,D,"TS",T,"C",0))#2 ^(0)="^40.807D^^",^DG(40.8,D,"TS",T,"C","B",T,T)=""
53 Q
54 ;
55UTIL ; Utility Nodes
56 ; DGD=Monthly Planned Dom. (yesterday) ;
57 ; DGDN=Monthly Planned Dom. (new) ;
58 ; DGC=Zero Node Census file (yesterday) ;
59 ; DGCN=Zero Node Census file (new) ;
60 ; DGR=One Node Census file (yesterday) ;
61 ; DGRN=One Node Census file (new) ;
62 ; DGS=Treating Specialty (yesterday) ;
63 ; DGSN=Treating Specialty (new) ;
64 ; DGS1=Treating Specialty One Node (yesterday) ;
65 ; DGSN1=Treating Specialty One Node (new) ;
66 ;
67VAR ; RC=ReCalc from date ; YD=YesterDay ; RD=Report Date ;
68 ; BS=Bed Status ; GL=G&L ; REM=Recalc patient days ;
69 ; PD=Previous Day ; W=Ward ; D=Division ; T=Treating Specialty
Note: See TracBrowser for help on using the repository browser.