| 1 | DGPMRB ;ALB/MRL,MIR - ROOM-BED DETERMINATION (SINGLE WARD); 9 JAN 89
|
|---|
| 2 | ;;5.3;Registration;**54**;Aug 13, 1993
|
|---|
| 3 | N I,I1,J,L,M,W,Y
|
|---|
| 4 | D Q S DGHOW=$S(('$D(X)#2):1,X["??":0,1:1),DGPMDD=$S('$D(DGSWITCH):+^DGPM(DA,0),1:DT),W=+$P(^DGPM(DA,0),"^",6),(DGL,DGA,DGFL)=0 G Q:'$D(^DIC(42,+W,0))
|
|---|
| 5 | W !!,"CHOOSE FROM",!
|
|---|
| 6 | F I=0:0 S I=$O(^DG(405.4,"W",W,I)) Q:I'>0!(DGFL) I $D(^DG(405.4,+I,0)) S J=^(0),J=$P($P(J,"^",1,3)_"^^^","^",1,3),DGR=$P(J,"^",1) D ACT I 'DGU D DIS
|
|---|
| 7 | I DGA W !!,"Select from the above listing the bed you wish to assign this patient." I DGHOW W !,"Enter two question marks for a more detailed list of available beds." G Q
|
|---|
| 8 | I 'DGA W !!,"There are no available beds on this ward."
|
|---|
| 9 | F I=0:0 S I=$O(^DGS(41.1,"ARSV",W,I)) Q:'I I $D(^DGS(41.1,I,0)) S J=^(0) I '$P(J,"^",13),($P(J,"^",2)'<DT),'$P(J,"^",17) W !,"Scheduled Admission for " W:$D(^DPT(+J,0)) $P(^(0),"^",1)," -- ",$P(^(0),"^",9) S Y=$P(J,"^",2) I J W " on " D DT^DIQ
|
|---|
| 10 | I '$D(^UTILITY("DGPMLD",$J)) G Q
|
|---|
| 11 | W !,"There are beds on this ward which are assigned to ""lodger"" patients. In order",!,"to use these beds you will need to either ""check-out"" the lodger occupying",!,"the bed or move him to another available bed."
|
|---|
| 12 | W ! S DGL=1,DGR=0 F I1=0:0 S DGR=$O(^UTILITY("DGPMLD",$J,DGR)) Q:DGR="" S J=^(DGR) D LOD
|
|---|
| 13 | G Q
|
|---|
| 14 | ;
|
|---|
| 15 | ACT S DGU=1,Y=I D OCC I 'DGPMOC S DGU=0
|
|---|
| 16 | S M=$O(^DGPM("ARM",I,0)) I M,^(M) D LDGER Q
|
|---|
| 17 | I DGU Q
|
|---|
| 18 | S DGU=0,X=$O(^DG(405.4,I,"I","AINV",9999999-DGPMDD)),X=$O(^(+X,0)) I $D(^DG(405.4,I,"I",+X,0)) S DGPMDD("D")=^(0) D AVAIL
|
|---|
| 19 | I DGU Q
|
|---|
| 20 | S DGA=DGA+1 Q
|
|---|
| 21 | ;
|
|---|
| 22 | AVAIL I +DGPMDD("D")'>DGPMDD,$S('$P(DGPMDD("D"),"^",4):1,$P(DGPMDD("D"),"^",4)>DGPMDD:1,1:0) S DGU=1
|
|---|
| 23 | Q
|
|---|
| 24 | ;
|
|---|
| 25 | DIS W:DGA=1 !?3 I DGHOW S $P(J,"^",1)=$E($P(J,"^",1)_" ",1,18) W:$X+$L($P(J,"^",1))>79 !?3 W $P(J,"^",1) Q
|
|---|
| 26 | LOD W !?3,DGR,", (",$S($D(^DG(405.6,+$P(J,"^",2),0)):$P(^(0),"^",1),1:"NO DESCRIPTION"),")" W:$D(^DIC(45.7,+$P(J,"^",3),0)) ",",$P(^(0),"^",1) W "."
|
|---|
| 27 | I DGL W !?3,"[Occupied by lodger patient '",$P(J,"^",4),"' SSN: ",$S($P(J,"^",5)]"":$P(J,"^",5),1:"UNKNOWN"),"]"
|
|---|
| 28 | I '(DGA#15) D READ
|
|---|
| 29 | Q
|
|---|
| 30 | LDGER ;create UTILITY for lodgers
|
|---|
| 31 | ;J=ROOM-BED NAME^DESCRIPTION^T.S
|
|---|
| 32 | N DFN
|
|---|
| 33 | Q:'$D(^DGPM(+M,0)) S DFN=+$P(^(0),"^",3)
|
|---|
| 34 | S ^UTILITY("DGPMLD",$J,DGR)=J
|
|---|
| 35 | I $D(^DPT(DFN,0)) S ^UTILITY("DGPMLD",$J,DGR)=^UTILITY("DGPMLD",$J,DGR)_"^"_$P(^DPT(DFN,0),"^",1)
|
|---|
| 36 | D PID^VADPT6 S ^(DGR)=^UTILITY("DGPMLD",$J,DGR)_"^"_VA("PID")
|
|---|
| 37 | Q
|
|---|
| 38 | Q K DGA,DGFL,DGHOW,DGL,DGPMDD,DGR,DGU,VA
|
|---|
| 39 | Q1 K ^UTILITY("DGPMLD",$J) Q
|
|---|
| 40 | DD ;
|
|---|
| 41 | S DGX=X,DGPMOS=+^DGPM(DA,0),D0=+X D RIN^DGPMDDCF K DGPMOS
|
|---|
| 42 | I X W "...INACTIVE" K X,DGX Q
|
|---|
| 43 | S X=DGX K DGX
|
|---|
| 44 | Q
|
|---|
| 45 | READ ;prompt to continue
|
|---|
| 46 | W !,"Enter RETURN to continue or '^' to exit: " R DGPMX:DTIME S:'$T!(DGPMX["^") DGFL=1
|
|---|
| 47 | I DGPMX["?" W !!?5,"Enter either RETURN or '^'",! G READ
|
|---|
| 48 | K DGPMX Q
|
|---|
| 49 | ;
|
|---|
| 50 | ;
|
|---|
| 51 | OCC ;is bed occupied
|
|---|
| 52 | ;
|
|---|
| 53 | ; INPUT: DA...ifn of DGPM entry
|
|---|
| 54 | ;OUTPUT: DGPMOC...1 if occupied, 0 if not
|
|---|
| 55 | ;
|
|---|
| 56 | N DFN S DGPMOC=0
|
|---|
| 57 | S DFN=$P(^DGPM(DA,0),"^",3) I 'DFN G OCCQ
|
|---|
| 58 | S DGPMX=$O(^DGPM("ARM",+Y,0)) I '$D(^DGPM(+DGPMX,0)) G OCCQ
|
|---|
| 59 | S DGPMX=^(0) I DFN=$P(DGPMX,"^",3),($D(^DG(405.4,+Y,"W","B",+$P(^DGPM(DA,0),"^",6)))) S DGPMOC=0 G OCCQ
|
|---|
| 60 | S DGPMOC=1
|
|---|
| 61 | OCCQ K DGPMX Q
|
|---|
