47 lines
3.0 KiB
Mathematica
47 lines
3.0 KiB
Mathematica
DGPMBSG2 ;ALB/LM - BED STATUS ABSENCE REMAINING; 6 JUNE 90
|
|
;;5.3;Registration;**34**;Aug 13, 1993
|
|
;
|
|
A Q:$S('$D(REM):1,REM:1,1:0) ; +/- from previous day
|
|
Q:$S('$D(M):1,'M:1,1:0) ; Movement type unknown
|
|
D PASS,ASIH,AA,UA
|
|
Q
|
|
;
|
|
PASS ; 1=AA<96; 23=From AA<96
|
|
I NLS=1 S ^(+MV("LWD"))=$S($D(^UTILITY("DGPS",$J,+MV("LWD"))):^(+MV("LWD")),1:0)-1,^(+MV("PTS"))=$S($D(^UTILITY("DGTP",$J,+PTSDV,+MV("PTS"))):^(+MV("PTS")),1:0)-1 G PASSQ
|
|
Q:"^1^23^"'[("^"_+M_"^")
|
|
S ^(+MV("LWD"))=$S($D(^UTILITY("DGPS",$J,+MV("LWD"))):^(+MV("LWD")),1:0)+$S(+M=1:1,1:-1)
|
|
S ^(+MV("PTS"))=$S($D(^UTILITY("DGTP",$J,+PTSDV,+MV("PTS"))):^(+MV("PTS")),1:0)+$S(+M=1:1,1:-1)
|
|
PASSQ S X3=5 ; Piece position on the 1 Node in the Census File
|
|
Q
|
|
;
|
|
ASIH ; Patients on ASIH as of midnight of census date
|
|
; 13=To ASIH (VAH); 14=From ASIH (VAH); 40=To ASIH; 41=From ASIH; 42=While ASIH; 43=To ASIH (OTHER FACILITY); 44=Resume ASIH in parent facility 45=Change ASIH location (other fac); 46=Continue ASIH (Other Fac); 47=Discharge From NHCU
|
|
I "^13^42^43^47^"[("^"_+M_"^") G 40
|
|
I M'=14 Q
|
|
S ^(+MV("PTS"))=$G(^UTILITY("DGTAS",$J,+PTSDV,+MV("PTS")))-1 ; decrease TSR ASIH to reflect return
|
|
S ^(+MV("PWD"))=$G(^UTILITY("DGAS",$J,+MV("PWD")))-1 ; decrease BSR ASIH column to reflect return
|
|
G ASIHQ
|
|
40 ; Entry place if irregular discharge (M=17) and previous movement TO ASIH (40)
|
|
S ^(+MV("LWD"))=$S($D(^UTILITY("DGAS",$J,+MV("LWD"))):^(+MV("LWD")),1:0)+$S(+M=13:1,+M=43:1,+M=14:0,+M=42:-1,+M=47:-1,1:0)
|
|
S ^(+MV("PTS"))=$S($D(^UTILITY("DGTAS",$J,+PTSDV,+MV("PTS"))):^(+MV("PTS")),1:0)+$S(+M=13:1,+M=43:1,+M=14:0,+M=42:-1,+M=47:-1,1:0)
|
|
ASIHQ S X3=8 ; Piece position on the 1 Node in the Census File
|
|
Q
|
|
;
|
|
AA ; 1=AA<96; 2=AA; 24=From AA; 25=From AA to UA; 26=From UA to AA
|
|
I NLS=2!(NLS=26) S ^(+MV("LWD"))=$S($D(^UTILITY("DGAA",$J,+MV("LWD"))):^(+MV("LWD")),1:0)-1,^(+MV("PTS"))=$S($D(^UTILITY("DGTA",$J,+PTSDV,+MV("PTS"))):^(+MV("PTS")),1:0)-1 G AAQ
|
|
Q:"^2^24^25^26^"'[("^"_+M_"^")
|
|
226 ; Entry place if irregular discharge (M=17) and previous movement (2) AA, (26) FROM UA TO AA
|
|
S ^(+MV("LWD"))=$S($D(^UTILITY("DGAA",$J,+MV("LWD"))):^(+MV("LWD")),1:0)+$S(+M=2:1,+M=26:1,+$P(MDP,"^",18)=1:0,NLS=2:0,MP=2:0,MP=26:0,1:-1)
|
|
S ^(+MV("PTS"))=$S($D(^UTILITY("DGTA",$J,+PTSDV,+MV("PTS"))):^(+MV("PTS")),1:0)+$S(+M=2:1,+M=26:1,+$P(MDP,"^",18)=1:0,NLS=2:0,MP=2:0,MP=26:0,1:-1)
|
|
AAQ S X3=6 ; Piece position on the 1 Node in the Census File
|
|
Q
|
|
;
|
|
UA ; 3=UA; 22=From UA; 25=From AA to UA; 26=From UA to AA
|
|
I NLS=3!(NLS=25) S ^(+MV("LWD"))=$S($D(^UTILITY("DGUA",$J,+MV("LWD"))):^(+MV("LWD")),1:0)-1,^(+MV("PTS"))=$S($D(^UTILITY("DGTU",$J,+PTSDV,+MV("PTS"))):^(+MV("PTS")),1:0)-1 G UAQ
|
|
Q:"^3^22^25^26^"'[("^"_+M_"^")
|
|
325 ; Entry place if irregular discharge (M=17) and previous movement (3) UA, (25) FROM AA TO UA
|
|
S ^(+MV("LWD"))=$S($D(^UTILITY("DGUA",$J,+MV("LWD"))):^(+MV("LWD")),1:0)+$S(+M=3:1,+M=25:1,NLS=3:0,MP=3:0,MP=25:0,1:-1)
|
|
S ^(+MV("PTS"))=$S($D(^UTILITY("DGTU",$J,+PTSDV,+MV("PTS"))):^(+MV("PTS")),1:0)+$S(+M=3:1,+M=25:1,NLS=3:0,MP=3:0,MP=25:0,1:-1)
|
|
UAQ S X3=7 ; Piece position on the 1 Node in the Census File
|
|
Q
|