- DGPMBSR ;ALB/LM - BED STATUS REPORT RECALCULATION; 16 JAN 91
- ;;5.3;Registration;;Aug 13, 1993
- ;
- A I $S('$D(RC):1,'RC:1,1:0) Q ; RC=ReCalc from Date
- D CLEAN^DGPMGLG
- ;D UP43 ; Update file 43
- S DGP("RD")=RD,DGP("PD")=PD,DGP("GL")=GL,DGP("BS")=BS,DGP("TSR")=TSR,DGP("REM")=REM
- S X1=DT,X2=-1 D C^%DTC S YD=X ; YD=YesterDay
- S X1=PD,X2=-1 D C^%DTC S TSRIPD=X ; TSR initialization previous date
- S (BS,GL,TSR)=0,DAYC=-1
- ; Steps thru days to do Recalc
- 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
- ; Deletes ReCalc started and ReCalc up to from file 43
- S DIE="^DG(43,",DA=1,DR="52///@;53///@" D ^DIE K DA,DIE,DR
- S RD=DGP("RD"),PD=DGP("PD"),GL=DGP("GL"),BS=DGP("BS"),TSR=DGP("TSR"),REM=DGP("REM"),RC=0
- ;
- Q K PP,BD,C,D,DAYC,DGP,I,I1,T,W,X,X1,X2,DGI,DR,DA,DIE Q
- ;
- UP43 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
- 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
- Q
- ;
- DELETE ; Nulls earliest date to correct in the G&L Corrections file once that date has been recalculated and set recalculation date
- 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
- Q
- ;
- VAR ; RC=ReCalc from date ; YD=YesterDay ; RD=Report Date ;
- ; BS=Bed Status ; GL=G&L ; REM=Recalc patient days ;
- ; PD=Previous Day ; W=Ward ; D=Division ; T=Treating Speciality
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPMBSR 1841 printed Apr 23, 2025@19:03:19 Page 2
- DGPMBSR ;ALB/LM - BED STATUS REPORT RECALCULATION; 16 JAN 91
- +1 ;;5.3;Registration;;Aug 13, 1993
- +2 ;
- A ; RC=ReCalc from Date
- IF $SELECT('$DATA(RC):1,'RC:1,1:0)
- QUIT
- +1 DO CLEAN^DGPMGLG
- +2 ;D UP43 ; Update file 43
- +3 SET DGP("RD")=RD
- SET DGP("PD")=PD
- SET DGP("GL")=GL
- SET DGP("BS")=BS
- SET DGP("TSR")=TSR
- SET DGP("REM")=REM
- +4 ; YD=YesterDay
- SET X1=DT
- SET X2=-1
- DO C^%DTC
- SET YD=X
- +5 ; TSR initialization previous date
- SET X1=PD
- SET X2=-1
- DO C^%DTC
- SET TSRIPD=X
- +6 SET (BS,GL,TSR)=0
- SET DAYC=-1
- +7 ; Steps thru days to do Recalc
- +8 FOR PP=1:1
- SET X1=RC
- SET DAYC=DAYC+1
- SET X2=DAYC
- DO C^%DTC
- SET (RD,X1)=X
- SET X2=-1
- DO C^%DTC
- SET PD=X
- if RD>YD!('PD)
- QUIT
- DO ^DGPMBSR1
- DO ^DGPMBSR2
- DO ^DGPMBSR3
- DO ^DGPMBSR4
- IF $DATA(^DGS(43.5,"AGL"))
- DO DELETE
- +9 ; Deletes ReCalc started and ReCalc up to from file 43
- +10 SET DIE="^DG(43,"
- SET DA=1
- SET DR="52///@;53///@"
- DO ^DIE
- KILL DA,DIE,DR
- +11 SET RD=DGP("RD")
- SET PD=DGP("PD")
- SET GL=DGP("GL")
- SET BS=DGP("BS")
- SET TSR=DGP("TSR")
- SET REM=DGP("REM")
- SET RC=0
- +12 ;
- Q KILL PP,BD,C,D,DAYC,DGP,I,I1,T,W,X,X1,X2,DGI,DR,DA,DIE
- QUIT
- +1 ;
- UP43 ; Find time queued
- IF $DATA(ZTSK)
- IF ZTSK]""
- IF $DATA(^%ZTSK(ZTSK))
- SET DGX=$PIECE(^%ZTSK(ZTSK,0),"^",6)
- SET %H=$PIECE(DGX,",")
- DO YMD^%DTC
- SET DGX=$PIECE(DGX,",",2)
- SET Z=X_((DGX#3600\60)/100+(DGX\3600)/100)
- KILL DGX
- +1 ; Update file 43
- SET Y=""
- if $DATA(^%ZOSF("VOL"))
- SET Y=^("VOL")
- if '$DATA(ZTSK)
- SET ZTSK=""
- if '$DATA(Z)
- SET Z="N"
- SET DIE="^DG(43,"
- SET DA=1
- SET DR="52///N;54///"_ZTSK_";55///"_$SELECT(Z'="N":"/",1:"")_Z_";56///"_Y
- DO ^DIE
- KILL ZTSK,IO("Q"),DA,DIE,DR
- +2 QUIT
- +3 ;
- DELETE ; Nulls earliest date to correct in the G&L Corrections file once that date has been recalculated and set recalculation date
- +1 ; S $P(^DGS(43.5,DA,10),"^")=DT
- FOR I=0:0
- SET I=$ORDER(^DGS(43.5,"AGL",I))
- if 'I
- QUIT
- FOR DGI=0:0
- SET DGI=$ORDER(^DGS(43.5,"AGL",I,DGI))
- if 'DGI
- QUIT
- SET DR=".08///@;10////"_DT
- SET DA=DGI
- SET DIE="^DGS(43.5,"
- DO ^DIE
- +2 QUIT
- +3 ;
- VAR ; RC=ReCalc from date ; YD=YesterDay ; RD=Report Date ;
- +1 ; BS=Bed Status ; GL=G&L ; REM=Recalc patient days ;
- +2 ; PD=Previous Day ; W=Ward ; D=Division ; T=Treating Speciality