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

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

initial load of WorldVistAEHR

File size: 734 bytes
RevLine 
[613]1DGPMDDRB ;ALB/RMO - ROOM-BED FILE 405.4 DD CALLS; 7 JAN 90
2 ;;5.3;Registration;;Aug 13, 1993
3CK ;Check that no other Room-bed with this name is associated with
4 ;this Ward. If one is found to exist do not allow this Ward to be added.
5 S DGX=$S($D(^DG(405.4,DA(1),0)):$P(^(0),"^"),1:"") I DGX]"" F DGI=0:0 S DGI=$O(^DG(405.4,"B",DGX,DGI)) Q:'DGI I $D(^DG(405.4,DGI,"W","B",X,X)) W !,"Ward is already associated with a Room-bed with this name!" K X Q
6 K DGI,DGX Q
7 ;
8ID ;Write first five Wards Associated with Room-bed
9 W !?10,"WARD(S): " S DGCNT=0 F DGI=0:0 S DGI=$O(^DG(405.4,+Y,"W",DGI)) Q:'DGI!(DGCNT=5) I $D(^(DGI,0)),$D(^DIC(42,+^(0),0)) W:DGCNT ! W ?23,$P(^(0),"^") S DGCNT=DGCNT+1
10 W:'DGCNT ?23,"NONE ASSIGNED"
11 K DGCNT,DGI Q
Note: See TracBrowser for help on using the repository browser.