Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGPMDDCF

DGPMDDCF.m

Go to the documentation of this file.
  1. DGPMDDCF ;ALB/MIR - COMPUTED FIELDS IN FILES 42,405.4 ; 29 MAY 90 @1400
  1. ;;5.3;Registration;;Aug 13, 1993
  1. ;called from computed fields in ward location and room-bed files
  1. WIN ;is this ward location currently inactive? (1=inactive, 0=active)
  1. ;input: D0 = IFN of WARD LOCATION file
  1. ; DGPMOS = date for which you would like to know. leave
  1. ; undefined if desired date is today.
  1. ;output: X = 1 if inactive (out-of-service), 0 otherwise
  1. ; (-1 if D0 not defined or date not valid)
  1. ;
  1. ; (called from record tracking package)
  1. N DGX,DGY S X=-1 Q:'$D(D0) S DGY=$S($D(DGPMOS):DGPMOS,1:DT)
  1. S DGY=$P(DGY,".") I DGY'?7N G WINQ
  1. S DGX=+$O(^DIC(42,D0,"OOS","AINV",9999998.9-DGY)),DGX=$S($D(^DIC(42,D0,"OOS",+$O(^(+DGX,0)),0)):^(0),1:"")
  1. I '$P(DGX,U,6) S X=0 G WINQ
  1. I $P(DGX,U,6),'$P(DGX,U,4) S X=1 G WINQ
  1. I $P(DGX,U,6),$P(DGX,U,4)<DGY S X=0 G WINQ
  1. S X=1
  1. WINQ Q
  1. ;
  1. ;
  1. RIN ;inactive check for room-bed...same input/output as above except for room-bed file
  1. ;
  1. N DGX,DGY S X=-1 Q:'$D(D0) S DGY=$S($D(DGPMOS):DGPMOS,1:DT)
  1. S DGY=$P(DGY,".") I DGY'?7N Q
  1. 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)
  1. S X=$S(DGX=-1:0,'DGX:1,DGX<DGY:0,1:1)
  1. Q
  1. BOS ;computed field in DIC(42...beds out of service
  1. ;input: D0 = IFN of WARD LOCATION file
  1. ; DGPMOS = date for which you want to compute number of beds
  1. ; out-of-service. Leave undefined if desired date is
  1. ; today.
  1. ;output: X = number of beds out-of-service for given ward.
  1. ;
  1. N DGC,DGY S X=-1 Q:'$D(D0) S DGY=$S($D(DGPMOS):DGPMOS,1:DT)
  1. S DGY=$P(DGY,".") I DGY'?7N G BOSQ
  1. S DGX=+$O(^DIC(42,D0,"OOS","AINV",9999998.9-DGY)),DGX=$S($D(^DIC(42,D0,"OOS",+$O(^(+DGX,0)),0)):^(0),1:"")
  1. I '$P(DGX,U,11) S X=0 G BOSQ
  1. I $P(DGX,U,11),'$P(DGX,U,4) S X=$P(DGX,U,11) G BOSQ
  1. I $P(DGX,U,11),$P(DGX,U,4)<DGY S X=0 G BOSQ
  1. S X=$P(DGX,U,11)
  1. BOSQ Q
  1. ;
  1. AUTH ;computed field in DIC(42...authorized beds
  1. ;input: D0 = IFN of WARD LOCATION file
  1. ; DGPMOS = date for which you want number of auth beds.
  1. ; today is assumed when not defined.
  1. ;output: X = number of authorized beds
  1. N DGX S X=-1 Q:'$D(D0) S DGY=$S($D(DGPMOS):DGPMOS,1:DT)
  1. S DGY=$P(DGY,".") I DGY'?7N G AUTHQ
  1. S DGX=$O(^DIC(42,D0,"AUTH","AINV",9999998.8-DGY)),DGX=$S($D(^DIC(42,D0,"AUTH",+$O(^(+DGX,0)),0)):^(0),1:"")
  1. S X=+$P(DGX,"^",2)
  1. AUTHQ Q
  1. ;
  1. OPER ;computed field in DIC(42...operating beds (auth - o-o-s)
  1. ;input: D0 = IFN of WARD LOCATION file
  1. ; DGPMOS = date for which you want number of operating beds.
  1. ; DT used if not defined.
  1. N DGPMX,DGY S X=-1 Q:'$D(D0) S DGY=$S($D(DGPMOS):DGPMOS,1:DT)
  1. S DGY=$P(DGY,".") I DGY'?7N G OPERQ
  1. D AUTH S DGPMX=$S(X=-1:0,1:X) D BOS S X=DGPMX-$S(X=-1:0,1:X)
  1. OPERQ Q