DGRUGC1.m

DGRUGC1 ;ALB/MLI - CREATE A PAI CONTINUED ; 26 JULY 88

 ;;5.3;Registration;**89,1015**;Aug 13, 1993;Build 21

SELECT S (J,DGCT,DGFL,DGFT)=0 F I=1:1:DGNO F J=0:0 S J=$O(^UTILITY($J,"DTS",I,J)) Q:J'>0  S K=$O(^UTILITY($J,"DTS",I,J,0)) W !,?5,I,")",?12 S DGCT=DGCT+1,Y=K D DT^DIQ W:$P(^(K),U,3)="*" " -- ADMISSION DATE" D:'(DGCT#5) PRT5 G:DGFL!$D(DGD) QUIT

 S DGFT=1

PRT5 W !!,"CHOOSE 1-",DGCT,!,"'^' TO EXIT" W:DGCT<DGNO !,"RETURN FOR MORE CHOICES" R ": ",X:DTIME S:X="^"!'$T DGFL=1 Q:DGFL!(X=""&'DGFT)  G:+X'=X!(X<1)!(X>DGCT) PRT5 S J=$O(^UTILITY($J,"DTS",X,0)),K=$O(^UTILITY($J,"DTS",X,J,0)),DGD=K,DGI=^(K)

QUIT Q

ASD I '$D(DGD) S DGD=$G(X)

 S DFN=+^DG(45.9,DA,0) I $D(^DG(45.9,"AD",DFN,X))&($P(^DG(45.9,DA,0),U,2)'=X) K X W !,"There is already a PAF entry for that date."

 I $D(X),$D(DGSEMI) S DGAD=$E(X,4,7) I $S(DGAD<301:1,DGAD>1130:1,DGAD>500&(DGAD<901):1,1:0) W !,*7,"Assessment date must be within a month of the semi-annual census date" K X

 I $D(X),X<$P(DGD,".",1) K X W !!,"The assessment date must not be before the date of admission/transfer in."

 S DGCNV=$S($D(^DG(43,1,"RUG")):+$P(^("RUG"),"^",2),1:0) I 'DGCNV!'$D(X) K DGAD,DGCNV Q

 S DGAD=$P(^DG(45.9,DA,0),"^",2) I DGAD,(DGAD<DGCNV),(X'<DGCNV) K X W !!,"Assessment date can not be changed to after the RUG17 conversion date.  Must remain before " S Y=DGCNV X ^DD("DD") W Y

 I $D(X),(DGAD'<DGCNV),(X<DGCNV) K X W !!,"Assessment date can not be changed to prior to conversion.  Date must be on or after " S Y=DGCNV X ^DD("DD") W Y

 K DGAD,DGCNV Q

HM S DGMINIM=$S($L(X)<3:X,$L(X)=3:$E(X,2,3),1:$E(X,3,4)) I DGMINIM>59 W !,*7,"Can not have more than 59 minutes of therapy" K X

 K DGMINIM Q

DGRUGC1   ;ALB/MLI - CREATE A PAI CONTINUED ; 26 JULY 88

 +1       ;;5.3;Registration;**89,1015**;Aug 13, 1993;Build 21

SELECT     SET (J,DGCT,DGFL,DGFT)=0

           FOR I=1:1:DGNO

               FOR J=0:0

                   SET J=$ORDER(^UTILITY($JOB,"DTS",I,J))

                   IF J'>0

                       QUIT 

                   SET K=$ORDER(^UTILITY($JOB,"DTS",I,J,0))

                   WRITE !,?5,I,")",?12

                   SET DGCT=DGCT+1

                   SET Y=K

                   DO DT^DIQ

                   IF $PIECE(^(K),U,3)="*"

                       WRITE " -- ADMISSION DATE"

                   IF '(DGCT#5)

                       DO PRT5

                   IF DGFL!$DATA(DGD)

                       GOTO QUIT

 +1        SET DGFT=1

PRT5       WRITE !!,"CHOOSE 1-",DGCT,!,"'^' TO EXIT"

           IF DGCT<DGNO

               WRITE !,"RETURN FOR MORE CHOICES"

           READ ": ",X:DTIME

           IF X="^"!'$TEST

               SET DGFL=1

           IF DGFL!(X=""&'DGFT)

               QUIT 

           IF +X'=X!(X<1)!(X>DGCT)

               GOTO PRT5

           SET J=$ORDER(^UTILITY($JOB,"DTS",X,0))

           SET K=$ORDER(^UTILITY($JOB,"DTS",X,J,0))

           SET DGD=K

           SET DGI=^(K)

QUIT       QUIT 

ASD        IF '$DATA(DGD)

               SET DGD=$GET(X)

 +1        SET DFN=+^DG(45.9,DA,0)

           IF $DATA(^DG(45.9,"AD",DFN,X))&($PIECE(^DG(45.9,DA,0),U,2)'=X)

               KILL X

               WRITE !,"There is already a PAF entry for that date."

 +2        IF $DATA(X)

               IF $DATA(DGSEMI)

                   SET DGAD=$EXTRACT(X,4,7)

                   IF $SELECT(DGAD<301:1,DGAD>1130:1,DGAD>500&(DGAD<901):1,1:0)

                       WRITE !,*7,"Assessment date must be within a month of the semi-annual census date"

                       KILL X

 +3        IF $DATA(X)

               IF X<$PIECE(DGD,".",1)

                   KILL X

                   WRITE !!,"The assessment date must not be before the date of admission/transfer in."

 +4        SET DGCNV=$SELECT($DATA(^DG(43,1,"RUG")):+$PIECE(^("RUG"),"^",2),1:0)

           IF 'DGCNV!'$DATA(X)

               KILL DGAD,DGCNV

               QUIT 

 +5        SET DGAD=$PIECE(^DG(45.9,DA,0),"^",2)

           IF DGAD

               IF (DGAD<DGCNV)

                   IF (X'<DGCNV)

                       KILL X

                       WRITE !!,"Assessment date can not be changed to after the RUG17 conversion date.  Must remain before "

                       SET Y=DGCNV

                       XECUTE ^DD("DD")

                       WRITE Y

 +6        IF $DATA(X)

               IF (DGAD'<DGCNV)

                   IF (X<DGCNV)

                       KILL X

                       WRITE !!,"Assessment date can not be changed to prior to conversion.  Date must be on or after "

                       SET Y=DGCNV

                       XECUTE ^DD("DD")

                       WRITE Y

 +7        KILL DGAD,DGCNV

           QUIT 

HM         SET DGMINIM=$SELECT($LENGTH(X)<3:X,$LENGTH(X)=3:$EXTRACT(X,2,3),1:$EXTRACT(X,3,4))

           IF DGMINIM>59

               WRITE !,*7,"Can not have more than 59 minutes of therapy"

               KILL X

 +1        KILL DGMINIM

           QUIT