source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGPMBSR.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: 1.8 KB
RevLine 
[613]1DGPMBSR ;ALB/LM - BED STATUS REPORT RECALCULATION; 16 JAN 91
2 ;;5.3;Registration;;Aug 13, 1993
3 ;
4A I $S('$D(RC):1,'RC:1,1:0) Q ; RC=ReCalc from Date
5 D CLEAN^DGPMGLG
6 ;D UP43 ; Update file 43
7 S DGP("RD")=RD,DGP("PD")=PD,DGP("GL")=GL,DGP("BS")=BS,DGP("TSR")=TSR,DGP("REM")=REM
8 S X1=DT,X2=-1 D C^%DTC S YD=X ; YD=YesterDay
9 S X1=PD,X2=-1 D C^%DTC S TSRIPD=X ; TSR initialization previous date
10 S (BS,GL,TSR)=0,DAYC=-1
11 ; Steps thru days to do Recalc
12 F PP=1:1 S X1=RC,DAYC=DAYC+1,X2=DAYC D C^%DTC S (RD,X1)=X,X2=-1 D C^%DTC S PD=X Q:RD>YD!('PD) D ^DGPMBSR1,^DGPMBSR2,^DGPMBSR3,^DGPMBSR4 I $D(^DGS(43.5,"AGL")) D DELETE
13 ; Deletes ReCalc started and ReCalc up to from file 43
14 S DIE="^DG(43,",DA=1,DR="52///@;53///@" D ^DIE K DA,DIE,DR
15 S RD=DGP("RD"),PD=DGP("PD"),GL=DGP("GL"),BS=DGP("BS"),TSR=DGP("TSR"),REM=DGP("REM"),RC=0
16 ;
17Q K PP,BD,C,D,DAYC,DGP,I,I1,T,W,X,X1,X2,DGI,DR,DA,DIE Q
18 ;
19UP43 I $D(ZTSK),ZTSK]"",$D(^%ZTSK(ZTSK)) S DGX=$P(^%ZTSK(ZTSK,0),"^",6),%H=$P(DGX,",") D YMD^%DTC S DGX=$P(DGX,",",2),Z=X_((DGX#3600\60)/100+(DGX\3600)/100) K DGX ; Find time queued
20 S Y="" S:$D(^%ZOSF("VOL")) Y=^("VOL") S:'$D(ZTSK) ZTSK="" S:'$D(Z) Z="N" S DIE="^DG(43,",DA=1,DR="52///N;54///"_ZTSK_";55///"_$S(Z'="N":"/",1:"")_Z_";56///"_Y D ^DIE K ZTSK,IO("Q"),DA,DIE,DR ; Update file 43
21 Q
22 ;
23DELETE ; Nulls earliest date to correct in the G&L Corrections file once that date has been recalculated and set recalculation date
24 F I=0:0 S I=$O(^DGS(43.5,"AGL",I)) Q:'I F DGI=0:0 S DGI=$O(^DGS(43.5,"AGL",I,DGI)) Q:'DGI S DR=".08///@;10////"_DT,DA=DGI,DIE="^DGS(43.5," D ^DIE ; S $P(^DGS(43.5,DA,10),"^")=DT
25 Q
26 ;
27VAR ; RC=ReCalc from date ; YD=YesterDay ; RD=Report Date ;
28 ; BS=Bed Status ; GL=G&L ; REM=Recalc patient days ;
29 ; PD=Previous Day ; W=Ward ; D=Division ; T=Treating Speciality
Note: See TracBrowser for help on using the repository browser.