DGPMDDCF ;ALB/MIR - COMPUTED FIELDS IN FILES 42,405.4 ; 29 MAY 90 @1400
;;5.3;Registration;;Aug 13, 1993
;called from computed fields in ward location and room-bed files
WIN ;is this ward location currently inactive? (1=inactive, 0=active)
;input: D0 = IFN of WARD LOCATION file
; DGPMOS = date for which you would like to know. leave
; undefined if desired date is today.
;output: X = 1 if inactive (out-of-service), 0 otherwise
; (-1 if D0 not defined or date not valid)
;
; (called from record tracking package)
N DGX,DGY S X=-1 Q:'$D(D0) S DGY=$S($D(DGPMOS):DGPMOS,1:DT)
S DGY=$P(DGY,".") I DGY'?7N G WINQ
S DGX=+$O(^DIC(42,D0,"OOS","AINV",9999998.9-DGY)),DGX=$S($D(^DIC(42,D0,"OOS",+$O(^(+DGX,0)),0)):^(0),1:"")
I '$P(DGX,U,6) S X=0 G WINQ
I $P(DGX,U,6),'$P(DGX,U,4) S X=1 G WINQ
I $P(DGX,U,6),$P(DGX,U,4)<DGY S X=0 G WINQ
S X=1
WINQ Q
;
;
RIN ;inactive check for room-bed...same input/output as above except for room-bed file
;
N DGX,DGY S X=-1 Q:'$D(D0) S DGY=$S($D(DGPMOS):DGPMOS,1:DT)
S DGY=$P(DGY,".") I DGY'?7N Q
S DGX=9999998.9-DGY,DGX=$O(^DG(405.4,D0,"I","AINV",+DGX)),DGX=$O(^(+DGX,0)) S DGX=$S($D(^DG(405.4,D0,"I",+DGX,0)):$P(^(0),"^",4),1:-1)
S X=$S(DGX=-1:0,'DGX:1,DGX<DGY:0,1:1)
Q
BOS ;computed field in DIC(42...beds out of service
;input: D0 = IFN of WARD LOCATION file
; DGPMOS = date for which you want to compute number of beds
; out-of-service. Leave undefined if desired date is
; today.
;output: X = number of beds out-of-service for given ward.
;
N DGC,DGY S X=-1 Q:'$D(D0) S DGY=$S($D(DGPMOS):DGPMOS,1:DT)
S DGY=$P(DGY,".") I DGY'?7N G BOSQ
S DGX=+$O(^DIC(42,D0,"OOS","AINV",9999998.9-DGY)),DGX=$S($D(^DIC(42,D0,"OOS",+$O(^(+DGX,0)),0)):^(0),1:"")
I '$P(DGX,U,11) S X=0 G BOSQ
I $P(DGX,U,11),'$P(DGX,U,4) S X=$P(DGX,U,11) G BOSQ
I $P(DGX,U,11),$P(DGX,U,4)<DGY S X=0 G BOSQ
S X=$P(DGX,U,11)
BOSQ Q
;
AUTH ;computed field in DIC(42...authorized beds
;input: D0 = IFN of WARD LOCATION file
; DGPMOS = date for which you want number of auth beds.
; today is assumed when not defined.
;output: X = number of authorized beds
N DGX S X=-1 Q:'$D(D0) S DGY=$S($D(DGPMOS):DGPMOS,1:DT)
S DGY=$P(DGY,".") I DGY'?7N G AUTHQ
S DGX=$O(^DIC(42,D0,"AUTH","AINV",9999998.8-DGY)),DGX=$S($D(^DIC(42,D0,"AUTH",+$O(^(+DGX,0)),0)):^(0),1:"")
S X=+$P(DGX,"^",2)
AUTHQ Q
;
OPER ;computed field in DIC(42...operating beds (auth - o-o-s)
;input: D0 = IFN of WARD LOCATION file
; DGPMOS = date for which you want number of operating beds.
; DT used if not defined.
N DGPMX,DGY S X=-1 Q:'$D(D0) S DGY=$S($D(DGPMOS):DGPMOS,1:DT)
S DGY=$P(DGY,".") I DGY'?7N G OPERQ
D AUTH S DGPMX=$S(X=-1:0,1:X) D BOS S X=DGPMX-$S(X=-1:0,1:X)
OPERQ Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPMDDCF 2903 printed Dec 13, 2024@02:49:24 Page 2
DGPMDDCF ;ALB/MIR - COMPUTED FIELDS IN FILES 42,405.4 ; 29 MAY 90 @1400
+1 ;;5.3;Registration;;Aug 13, 1993
+2 ;called from computed fields in ward location and room-bed files
WIN ;is this ward location currently inactive? (1=inactive, 0=active)
+1 ;input: D0 = IFN of WARD LOCATION file
+2 ; DGPMOS = date for which you would like to know. leave
+3 ; undefined if desired date is today.
+4 ;output: X = 1 if inactive (out-of-service), 0 otherwise
+5 ; (-1 if D0 not defined or date not valid)
+6 ;
+7 ; (called from record tracking package)
+8 NEW DGX,DGY
SET X=-1
if '$DATA(D0)
QUIT
SET DGY=$SELECT($DATA(DGPMOS):DGPMOS,1:DT)
+9 SET DGY=$PIECE(DGY,".")
IF DGY'?7N
GOTO WINQ
+10 SET DGX=+$ORDER(^DIC(42,D0,"OOS","AINV",9999998.9-DGY))
SET DGX=$SELECT($DATA(^DIC(42,D0,"OOS",+$ORDER(^(+DGX,0)),0)):^(0),1:"")
+11 IF '$PIECE(DGX,U,6)
SET X=0
GOTO WINQ
+12 IF $PIECE(DGX,U,6)
IF '$PIECE(DGX,U,4)
SET X=1
GOTO WINQ
+13 IF $PIECE(DGX,U,6)
IF $PIECE(DGX,U,4)<DGY
SET X=0
GOTO WINQ
+14 SET X=1
WINQ QUIT
+1 ;
+2 ;
RIN ;inactive check for room-bed...same input/output as above except for room-bed file
+1 ;
+2 NEW DGX,DGY
SET X=-1
if '$DATA(D0)
QUIT
SET DGY=$SELECT($DATA(DGPMOS):DGPMOS,1:DT)
+3 SET DGY=$PIECE(DGY,".")
IF DGY'?7N
QUIT
+4 SET DGX=9999998.9-DGY
SET DGX=$ORDER(^DG(405.4,D0,"I","AINV",+DGX))
SET DGX=$ORDER(^(+DGX,0))
SET DGX=$SELECT($DATA(^DG(405.4,D0,"I",+DGX,0)):$PIECE(^(0),"^",4),1:-1)
+5 SET X=$SELECT(DGX=-1:0,'DGX:1,DGX<DGY:0,1:1)
+6 QUIT
BOS ;computed field in DIC(42...beds out of service
+1 ;input: D0 = IFN of WARD LOCATION file
+2 ; DGPMOS = date for which you want to compute number of beds
+3 ; out-of-service. Leave undefined if desired date is
+4 ; today.
+5 ;output: X = number of beds out-of-service for given ward.
+6 ;
+7 NEW DGC,DGY
SET X=-1
if '$DATA(D0)
QUIT
SET DGY=$SELECT($DATA(DGPMOS):DGPMOS,1:DT)
+8 SET DGY=$PIECE(DGY,".")
IF DGY'?7N
GOTO BOSQ
+9 SET DGX=+$ORDER(^DIC(42,D0,"OOS","AINV",9999998.9-DGY))
SET DGX=$SELECT($DATA(^DIC(42,D0,"OOS",+$ORDER(^(+DGX,0)),0)):^(0),1:"")
+10 IF '$PIECE(DGX,U,11)
SET X=0
GOTO BOSQ
+11 IF $PIECE(DGX,U,11)
IF '$PIECE(DGX,U,4)
SET X=$PIECE(DGX,U,11)
GOTO BOSQ
+12 IF $PIECE(DGX,U,11)
IF $PIECE(DGX,U,4)<DGY
SET X=0
GOTO BOSQ
+13 SET X=$PIECE(DGX,U,11)
BOSQ QUIT
+1 ;
AUTH ;computed field in DIC(42...authorized beds
+1 ;input: D0 = IFN of WARD LOCATION file
+2 ; DGPMOS = date for which you want number of auth beds.
+3 ; today is assumed when not defined.
+4 ;output: X = number of authorized beds
+5 NEW DGX
SET X=-1
if '$DATA(D0)
QUIT
SET DGY=$SELECT($DATA(DGPMOS):DGPMOS,1:DT)
+6 SET DGY=$PIECE(DGY,".")
IF DGY'?7N
GOTO AUTHQ
+7 SET DGX=$ORDER(^DIC(42,D0,"AUTH","AINV",9999998.8-DGY))
SET DGX=$SELECT($DATA(^DIC(42,D0,"AUTH",+$ORDER(^(+DGX,0)),0)):^(0),1:"")
+8 SET X=+$PIECE(DGX,"^",2)
AUTHQ QUIT
+1 ;
OPER ;computed field in DIC(42...operating beds (auth - o-o-s)
+1 ;input: D0 = IFN of WARD LOCATION file
+2 ; DGPMOS = date for which you want number of operating beds.
+3 ; DT used if not defined.
+4 NEW DGPMX,DGY
SET X=-1
if '$DATA(D0)
QUIT
SET DGY=$SELECT($DATA(DGPMOS):DGPMOS,1:DT)
+5 SET DGY=$PIECE(DGY,".")
IF DGY'?7N
GOTO OPERQ
+6 DO AUTH
SET DGPMX=$SELECT(X=-1:0,1:X)
DO BOS
SET X=DGPMX-$SELECT(X=-1:0,1:X)
OPERQ QUIT
