source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGPMDDCF.m@ 949

Last change on this file since 949 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.8 KB
Line 
1DGPMDDCF ;ALB/MIR - COMPUTED FIELDS IN FILES 42,405.4 ; 29 MAY 90 @1400
2 ;;5.3;Registration;;Aug 13, 1993
3 ;called from computed fields in ward location and room-bed files
4WIN ;is this ward location currently inactive? (1=inactive, 0=active)
5 ;input: D0 = IFN of WARD LOCATION file
6 ; DGPMOS = date for which you would like to know. leave
7 ; undefined if desired date is today.
8 ;output: X = 1 if inactive (out-of-service), 0 otherwise
9 ; (-1 if D0 not defined or date not valid)
10 ;
11 ; (called from record tracking package)
12 N DGX,DGY S X=-1 Q:'$D(D0) S DGY=$S($D(DGPMOS):DGPMOS,1:DT)
13 S DGY=$P(DGY,".") I DGY'?7N G WINQ
14 S DGX=+$O(^DIC(42,D0,"OOS","AINV",9999998.9-DGY)),DGX=$S($D(^DIC(42,D0,"OOS",+$O(^(+DGX,0)),0)):^(0),1:"")
15 I '$P(DGX,U,6) S X=0 G WINQ
16 I $P(DGX,U,6),'$P(DGX,U,4) S X=1 G WINQ
17 I $P(DGX,U,6),$P(DGX,U,4)<DGY S X=0 G WINQ
18 S X=1
19WINQ Q
20 ;
21 ;
22RIN ;inactive check for room-bed...same input/output as above except for room-bed file
23 ;
24 N DGX,DGY S X=-1 Q:'$D(D0) S DGY=$S($D(DGPMOS):DGPMOS,1:DT)
25 S DGY=$P(DGY,".") I DGY'?7N Q
26 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)
27 S X=$S(DGX=-1:0,'DGX:1,DGX<DGY:0,1:1)
28 Q
29BOS ;computed field in DIC(42...beds out of service
30 ;input: D0 = IFN of WARD LOCATION file
31 ; DGPMOS = date for which you want to compute number of beds
32 ; out-of-service. Leave undefined if desired date is
33 ; today.
34 ;output: X = number of beds out-of-service for given ward.
35 ;
36 N DGC,DGY S X=-1 Q:'$D(D0) S DGY=$S($D(DGPMOS):DGPMOS,1:DT)
37 S DGY=$P(DGY,".") I DGY'?7N G BOSQ
38 S DGX=+$O(^DIC(42,D0,"OOS","AINV",9999998.9-DGY)),DGX=$S($D(^DIC(42,D0,"OOS",+$O(^(+DGX,0)),0)):^(0),1:"")
39 I '$P(DGX,U,11) S X=0 G BOSQ
40 I $P(DGX,U,11),'$P(DGX,U,4) S X=$P(DGX,U,11) G BOSQ
41 I $P(DGX,U,11),$P(DGX,U,4)<DGY S X=0 G BOSQ
42 S X=$P(DGX,U,11)
43BOSQ Q
44 ;
45AUTH ;computed field in DIC(42...authorized beds
46 ;input: D0 = IFN of WARD LOCATION file
47 ; DGPMOS = date for which you want number of auth beds.
48 ; today is assumed when not defined.
49 ;output: X = number of authorized beds
50 N DGX S X=-1 Q:'$D(D0) S DGY=$S($D(DGPMOS):DGPMOS,1:DT)
51 S DGY=$P(DGY,".") I DGY'?7N G AUTHQ
52 S DGX=$O(^DIC(42,D0,"AUTH","AINV",9999998.8-DGY)),DGX=$S($D(^DIC(42,D0,"AUTH",+$O(^(+DGX,0)),0)):^(0),1:"")
53 S X=+$P(DGX,"^",2)
54AUTHQ Q
55 ;
56OPER ;computed field in DIC(42...operating beds (auth - o-o-s)
57 ;input: D0 = IFN of WARD LOCATION file
58 ; DGPMOS = date for which you want number of operating beds.
59 ; DT used if not defined.
60 N DGPMX,DGY S X=-1 Q:'$D(D0) S DGY=$S($D(DGPMOS):DGPMOS,1:DT)
61 S DGY=$P(DGY,".") I DGY'?7N G OPERQ
62 D AUTH S DGPMX=$S(X=-1:0,1:X) D BOS S X=DGPMX-$S(X=-1:0,1:X)
63OPERQ Q
Note: See TracBrowser for help on using the repository browser.