DGPMV35.m

DGPMV35 ;ALB/MIR - CHECK-OUT LODGERS ; MAR 12 1990

 ;;5.3;Registration;**111**;Aug 13, 1993

 ;

 I '$P(DGPMA,"^",4) W !,"Incomplete Check-Out Movement" S DIK="^DGPM(",DA=DGPMDA D ^DIK W "   deleted" S DGPMA="" G Q

 ;D ADM^DGPMV33

Q Q

ONLY ;determine if this is the only CHECK-OUT movement type

 N C,I S C=0

 F I=0:0 S I=$O(^DG(405.1,"AT",5,I)) Q:'I  I $D(^DG(405.1,I,0)),$P(^(0),"^",4) S C=C+1,DGPMCO=I I C>1 K DGPMCO Q

 Q

REAS ;called from enter/edit reasons for lodging option

 S (DIC,DIE)="^DG(406.41,",DIC(0)="AELQMZ",DLAYGO=406.41 D ^DIC G REASQ:Y<0,REAS:'Y!$P(Y,"^",3)

 I '$P(Y,"^",3) S DR=.01,DA=+Y D ^DIE I '$D(Y) G REAS

REASQ K DA,DIC,DIE,DLAYGO,DR,X,Y Q

 Q

DICS S DGX=$P(DGPMAN,"^",4) I $S('$D(^DG(405.1,+DGX,0)):0,'$D(^DG(405.1,+Y,"F",+DGX)):1,1:0) S DGER=1 Q

 S DGER=0

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DGPMV35   801     printed  Apr 09, 2024@21:56:59                                                                                                                                                                                                      Page 2

DGPMV35   ;ALB/MIR - CHECK-OUT LODGERS ; MAR 12 1990

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

 +2       ;

 +3        IF '$PIECE(DGPMA,"^",4)

               WRITE !,"Incomplete Check-Out Movement"

               SET DIK="^DGPM("

               SET DA=DGPMDA

               DO ^DIK

               WRITE "   deleted"

               SET DGPMA=""

               GOTO Q

 +4       ;D ADM^DGPMV33

Q          QUIT 

ONLY      ;determine if this is the only CHECK-OUT movement type

 +1        NEW C,I

           SET C=0

 +2        FOR I=0:0

               SET I=$ORDER(^DG(405.1,"AT",5,I))

               if 'I

                   QUIT 

               IF $DATA(^DG(405.1,I,0))

                   IF $PIECE(^(0),"^",4)

                       SET C=C+1

                       SET DGPMCO=I

                       IF C>1

                           KILL DGPMCO

                           QUIT 

 +3        QUIT 

REAS      ;called from enter/edit reasons for lodging option

 +1        SET (DIC,DIE)="^DG(406.41,"

           SET DIC(0)="AELQMZ"

           SET DLAYGO=406.41

           DO ^DIC

           if Y<0

               GOTO REASQ

           if 'Y!$PIECE(Y,"^",3)

               GOTO REAS

 +2        IF '$PIECE(Y,"^",3)

               SET DR=.01

               SET DA=+Y

               DO ^DIE

               IF '$DATA(Y)

                   GOTO REAS

REASQ      KILL DA,DIC,DIE,DLAYGO,DR,X,Y

           QUIT 

 +1        QUIT 

DICS       SET DGX=$PIECE(DGPMAN,"^",4)

           IF $SELECT('$DATA(^DG(405.1,+DGX,0)):0,'$DATA(^DG(405.1,+Y,"F",+DGX)):1,1:0)

               SET DGER=1

               QUIT 

 +1        SET DGER=0

 +2        QUIT