DGPMDDRB.m

DGPMDDRB ;ALB/RMO - ROOM-BED FILE 405.4 DD CALLS; 7 JAN 90

 ;;5.3;Registration;;Aug 13, 1993

CK ;Check that no other Room-bed with this name is associated with

 ;this Ward. If one is found to exist do not allow this Ward to be added.

 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

 K DGI,DGX Q

 ;

ID ;Write first five Wards Associated with Room-bed

 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

 W:'DGCNT ?23,"NONE ASSIGNED"

 K DGCNT,DGI Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DGPMDDRB   745     printed  Apr 09, 2024@21:52:35                                                                                                                                                                                                     Page 2

DGPMDDRB  ;ALB/RMO - ROOM-BED FILE 405.4 DD CALLS; 7 JAN 90

 +1       ;;5.3;Registration;;Aug 13, 1993

CK        ;Check that no other Room-bed with this name is associated with

 +1       ;this Ward. If one is found to exist do not allow this Ward to be added.

 +2        SET DGX=$SELECT($DATA(^DG(405.4,DA(1),0)):$PIECE(^(0),"^"),1:"")

           IF DGX]""

               FOR DGI=0:0

                   SET DGI=$ORDER(^DG(405.4,"B",DGX,DGI))

                   if 'DGI

                       QUIT 

                   IF $DATA(^DG(405.4,DGI,"W","B",X,X))

                       WRITE !,"Ward is already associated with a Room-bed with this name!"

                       KILL X

                       QUIT 

 +3        KILL DGI,DGX

           QUIT 

 +4       ;

ID        ;Write first five Wards Associated with Room-bed

 +1        WRITE !?10,"WARD(S): "

           SET DGCNT=0

           FOR DGI=0:0

               SET DGI=$ORDER(^DG(405.4,+Y,"W",DGI))

               if 'DGI!(DGCNT=5)

                   QUIT 

               IF $DATA(^(DGI,0))

                   IF $DATA(^DIC(42,+^(0),0))

                       if DGCNT

                           WRITE !

                       WRITE ?23,$PIECE(^(0),"^")

                       SET DGCNT=DGCNT+1

 +2        if 'DGCNT

               WRITE ?23,"NONE ASSIGNED"

 +3        KILL DGCNT,DGI

           QUIT