- 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 Feb 19, 2025@00:15:26 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