- DGRUG1 ;ALB/MLI - RUG-II GROUPER ; 23 NOV 88@1600
- ;;5.3;Registration;;Aug 13, 1993
- CVD I $P(DGINFO,U,58)=2 S DGRUG=17,G=2 G PRT
- REHAB S (DGD,DGHM)=0 F E=48:2:56 I $P(DGINFO,U,E)=3 S T=$P(DGINFO,U,E+15-(E-48/2)),DGHM=DGHM+$S(T<100:T,T<1000:$E(T,1,1)*60+$E(T,2,3),1:$E(T,1,2)*60+$E(T,3,4)),DGD=DGD+$P(DGINFO,U,E+1) I DGD>4,(DGHM>149) G GROUPR
- SPECIAL I DGSUM>4&($P(DGINFO,U,23)=4) G GROUPS
- I DGSUM>4 F E=11,14,15,24,32,33 I $S(E'=14&($P(DGINFO,U,E)=2):1,E=14&($P(DGINFO,U,14)=2)&($P(DGINFO,U,21)'=7):1,1:0) G GROUPS
- CLINIC I DGSUM<5&($P(DGINFO,U,23)=4) G GROUPC
- I DGSUM<5 F E=11,14,15,24,32,33 I $S(E'=14&($P(DGINFO,U,E)=2):1,E=14&($P(DGINFO,U,14)=2)&($P(DGINFO,U,21)'=7):1,1:0) G GROUPC
- F E=12,16,17,18,19,20,25,26,27,28,34,35 I $P(DGINFO,U,E)=2 G GROUPC
- BEHAVE I $P(DGINFO,U,47)=2 G GROUPB
- F E=44,45,46 I $P(DGINFO,U,E)=4 G GROUPB
- PHYS S DGRUG=$S(DGSUM=3:12,DGSUM=4:13,DGSUM<8:14,DGSUM=8:15,1:16),G=5 G PRT
- QUIT K %,%Y,A,DA,DGD,DGFLAG,DGFY,DGHM,DGI,DGINFO,DGLCO,DGPAF,DGPT,DGRUG,DGSER,DGSUM,DIC,DIE,DIV,DR,E,G,I,J,T,Y Q
- GROUPR S DGRUG=$S(DGSUM<5:1,1:2),G=1 G PRT
- GROUPS S DGRUG=$S(DGSUM<8:3,1:4),G=2 G PRT
- GROUPC S DGRUG=$S(DGSUM<4:5,DGSUM<7:6,DGSUM<9:7,1:8),G=3 G PRT
- GROUPB S DGRUG=$S(DGSUM<4:9,DGSUM<8:10,1:11),G=4 G PRT
- PRT W !!,?3,"RUG-II GROUP: ",DGRUG,!!,"HIERARCHY GROUP: ",G," - ",$S(G=1:"HEAVY REHABILITATION",G=2:"SPECIAL CARE",G=3:"CLINICAL COMPLEX",G=5:"PHYSICAL",1:"BEHAVIORAL"),!?8,"ADL SUM: ",DGSUM,!
- W ?4,"RUG-II WWUs: ",$S($D(^DG(45.91,+DGRUG,"FY",DGFY,0)):$P(^(0),U,2),1:"")
- G:$D(DGPAF) DT^DGRUGTG G:$D(DGGRP) QUIT^DGRUGGR
- S DA=DGPT,DIE="^DG(45.9,",DR="71///"_DGRUG_";72///"_DGSUM_";74///"_G_";80///1" D ^DIE
- C G QUIT:'$D(^XUSEC("DG RUG CLOSE PAI",DUZ))!$S('$D(^DG(45.9,DGPT,"C")):1,+^("C")'<2:1,1:0) W !!!,"Close this record now" S %=2 D YN^DICN I '%!(%Y["?") D YN^DGRUGC G C
- I %=1 S DR="80///2;81///"_DT_";82////"_DUZ,DIE="^DG(45.9," D ^DIE W !!,"*CLOSED*"
- G QUIT
- 1 K A,DGFLAG I $S($P(DGINFO,U,14)=2:1,$P(DGINFO,U,15)=2:1,1:0)&($P(DGINFO,U,40)<5) W !,*7,"If 'TUBE FEEDING' or 'PARENTERAL FEEDING' ",!," is marked 'Y'es then question 'EATING' must be marked '5'.",! F I=14,15,40 S A(I)=I S DGFLAG=1
- I $P(DGINFO,U,14)=1&($P(DGINFO,U,15)=1)&($P(DGINFO,U,40)=5) W !,*7,"If 'TUBE FEEDING' and 'PARENTERAL FEEDING' ",!," are marked 'N'o then question 'EATING' must not be marked '5'.",! F I=14,15,40 S A(I)=I S DGFLAG=1
- Q
- 2 K A,DGFLAG I $P(DGINFO,U,14)=2&($P(DGINFO,U,21)=1) W !,*7,"If 'TUBE FEEDING' ",!," is marked 'Y'es then question 'TUBE FEEDING ROUTE' must not be marked '1'.",! F I=14,21 S A(I)=I S DGFLAG=1
- Q
- 3 K DGFLAG,A I $P(DGINFO,U,58)=1 F I=59:1:62 I $P(DGINFO,U,I)>1 S DGFLAG=1
- I $D(DGFLAG) W !,*7,"If 'CHRONIC VENTILATOR DEP. (CVD)' is marked 'N'o then all CVD related",!,"questions must be marked '1'.",!
- I $D(DGFLAG) F I=58:1:62 S A(I)=I
- Q
- 4 K DGFLAG,A F I=48:2:56 S DGHM=I+15-(I-48/2) I $P(DGINFO,U,I)=1&(($P(DGINFO,U,I+1)'=0)!($P(DGINFO,U,DGHM)'=0)) S A(I)=I,A(I+1)=I+1,A(I+1.5)=I+1.5,DGFLAG=1
- I $D(DGFLAG) W !,*7,"For each of the therapy questions,'DAYS PER WEEK' and 'HOURS PER WEEK' must be '0' if level is '1'.",!
- Q
- 5 K DGFLAG,A F I=48:2:56 S DGHM=I+15-(I-48/2) I $P(DGINFO,U,I)'=1&(($P(DGINFO,U,I+1)=0)!($P(DGINFO,U,DGHM)<30)) S A(I)=I,A(I+1)=I+1,A(I+1.5)=I+1.5,DGFLAG=1
- I $D(DGFLAG) W !,*7,"For each of the therapy questions,'DAYS PER WEEK' must be greater than 0",!,"and 'HOURS/MINUTES PER WEEK' must be greater than 29 minutes if level is",!,"greater than '1'.",!
- Q
- 6 K DGFLAG,A F I=48:2:56 I $P(DGINFO,U,I)'=1 S DGHM=I+15-(I-48/2) I $P(DGINFO,U,DGHM)>(1000*$P(DGINFO,U,I+1)) S A(I+1.5)=I+1.5,A(I+1)=I+1,DGFLAG=1
- I $D(DGFLAG) W !,*7,"Can not have more than 10 hours of therapy per day"
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGRUG1 3698 printed Feb 19, 2025@00:24:09 Page 2
- DGRUG1 ;ALB/MLI - RUG-II GROUPER ; 23 NOV 88@1600
- +1 ;;5.3;Registration;;Aug 13, 1993
- CVD IF $PIECE(DGINFO,U,58)=2
- SET DGRUG=17
- SET G=2
- GOTO PRT
- REHAB SET (DGD,DGHM)=0
- FOR E=48:2:56
- IF $PIECE(DGINFO,U,E)=3
- SET T=$PIECE(DGINFO,U,E+15-(E-48/2))
- SET DGHM=DGHM+$SELECT(T<100:T,T<1000:$EXTRACT(T,1,1)*60+$EXTRACT(T,2,3),1:$EXTRACT(T,1,2)*60+$EXTRACT(T,3,4))
- SET DGD=DGD+$PIECE(DGINFO,U,E+1)
- IF DGD>4
- IF (DGHM>149)
- GOTO GROUPR
- SPECIAL IF DGSUM>4&($PIECE(DGINFO,U,23)=4)
- GOTO GROUPS
- +1 IF DGSUM>4
- FOR E=11,14,15,24,32,33
- IF $SELECT(E'=14&($PIECE(DGINFO,U,E)=2):1,E=14&($PIECE(DGINFO,U,14)=2)&($PIECE(DGINFO,U,21)'=7):1,1:0)
- GOTO GROUPS
- CLINIC IF DGSUM<5&($PIECE(DGINFO,U,23)=4)
- GOTO GROUPC
- +1 IF DGSUM<5
- FOR E=11,14,15,24,32,33
- IF $SELECT(E'=14&($PIECE(DGINFO,U,E)=2):1,E=14&($PIECE(DGINFO,U,14)=2)&($PIECE(DGINFO,U,21)'=7):1,1:0)
- GOTO GROUPC
- +2 FOR E=12,16,17,18,19,20,25,26,27,28,34,35
- IF $PIECE(DGINFO,U,E)=2
- GOTO GROUPC
- BEHAVE IF $PIECE(DGINFO,U,47)=2
- GOTO GROUPB
- +1 FOR E=44,45,46
- IF $PIECE(DGINFO,U,E)=4
- GOTO GROUPB
- PHYS SET DGRUG=$SELECT(DGSUM=3:12,DGSUM=4:13,DGSUM<8:14,DGSUM=8:15,1:16)
- SET G=5
- GOTO PRT
- QUIT KILL %,%Y,A,DA,DGD,DGFLAG,DGFY,DGHM,DGI,DGINFO,DGLCO,DGPAF,DGPT,DGRUG,DGSER,DGSUM,DIC,DIE,DIV,DR,E,G,I,J,T,Y
- QUIT
- GROUPR SET DGRUG=$SELECT(DGSUM<5:1,1:2)
- SET G=1
- GOTO PRT
- GROUPS SET DGRUG=$SELECT(DGSUM<8:3,1:4)
- SET G=2
- GOTO PRT
- GROUPC SET DGRUG=$SELECT(DGSUM<4:5,DGSUM<7:6,DGSUM<9:7,1:8)
- SET G=3
- GOTO PRT
- GROUPB SET DGRUG=$SELECT(DGSUM<4:9,DGSUM<8:10,1:11)
- SET G=4
- GOTO PRT
- PRT WRITE !!,?3,"RUG-II GROUP: ",DGRUG,!!,"HIERARCHY GROUP: ",G," - ",$SELECT(G=1:"HEAVY REHABILITATION",G=2:"SPECIAL CARE",G=3:"CLINICAL COMPLEX",G=5:"PHYSICAL",1:"BEHAVIORAL"),!?8,"ADL SUM: ",DGSUM,!
- +1 WRITE ?4,"RUG-II WWUs: ",$SELECT($DATA(^DG(45.91,+DGRUG,"FY",DGFY,0)):$PIECE(^(0),U,2),1:"")
- +2 if $DATA(DGPAF)
- GOTO DT^DGRUGTG
- if $DATA(DGGRP)
- GOTO QUIT^DGRUGGR
- +3 SET DA=DGPT
- SET DIE="^DG(45.9,"
- SET DR="71///"_DGRUG_";72///"_DGSUM_";74///"_G_";80///1"
- DO ^DIE
- C if '$DATA(^XUSEC("DG RUG CLOSE PAI",DUZ))!$SELECT('$DATA(^DG(45.9,DGPT,"C")):1,+^("C")'<2:1,1:0)
- GOTO QUIT
- WRITE !!!,"Close this record now"
- SET %=2
- DO YN^DICN
- IF '%!(%Y["?")
- DO YN^DGRUGC
- GOTO C
- +1 IF %=1
- SET DR="80///2;81///"_DT_";82////"_DUZ
- SET DIE="^DG(45.9,"
- DO ^DIE
- WRITE !!,"*CLOSED*"
- +2 GOTO QUIT
- 1 KILL A,DGFLAG
- IF $SELECT($PIECE(DGINFO,U,14)=2:1,$PIECE(DGINFO,U,15)=2:1,1:0)&($PIECE(DGINFO,U,40)<5)
- WRITE !,*7,"If 'TUBE FEEDING' or 'PARENTERAL FEEDING' ",!," is marked 'Y'es then question 'EATING' must be marked '5'.",!
- FOR I=14,15,40
- SET A(I)=I
- SET DGFLAG=1
- +1 IF $PIECE(DGINFO,U,14)=1&($PIECE(DGINFO,U,15)=1)&($PIECE(DGINFO,U,40)=5)
- WRITE !,*7,"If 'TUBE FEEDING' and 'PARENTERAL FEEDING' ",!," are marked 'N'o then question 'EATING' must not be marked '5'.",!
- FOR I=14,15,40
- SET A(I)=I
- SET DGFLAG=1
- +2 QUIT
- 2 KILL A,DGFLAG
- IF $PIECE(DGINFO,U,14)=2&($PIECE(DGINFO,U,21)=1)
- WRITE !,*7,"If 'TUBE FEEDING' ",!," is marked 'Y'es then question 'TUBE FEEDING ROUTE' must not be marked '1'.",!
- FOR I=14,21
- SET A(I)=I
- SET DGFLAG=1
- +1 QUIT
- 3 KILL DGFLAG,A
- IF $PIECE(DGINFO,U,58)=1
- FOR I=59:1:62
- IF $PIECE(DGINFO,U,I)>1
- SET DGFLAG=1
- +1 IF $DATA(DGFLAG)
- WRITE !,*7,"If 'CHRONIC VENTILATOR DEP. (CVD)' is marked 'N'o then all CVD related",!,"questions must be marked '1'.",!
- +2 IF $DATA(DGFLAG)
- FOR I=58:1:62
- SET A(I)=I
- +3 QUIT
- 4 KILL DGFLAG,A
- FOR I=48:2:56
- SET DGHM=I+15-(I-48/2)
- IF $PIECE(DGINFO,U,I)=1&(($PIECE(DGINFO,U,I+1)'=0)!($PIECE(DGINFO,U,DGHM)'=0))
- SET A(I)=I
- SET A(I+1)=I+1
- SET A(I+1.5)=I+1.5
- SET DGFLAG=1
- +1 IF $DATA(DGFLAG)
- WRITE !,*7,"For each of the therapy questions,'DAYS PER WEEK' and 'HOURS PER WEEK' must be '0' if level is '1'.",!
- +2 QUIT
- 5 KILL DGFLAG,A
- FOR I=48:2:56
- SET DGHM=I+15-(I-48/2)
- IF $PIECE(DGINFO,U,I)'=1&(($PIECE(DGINFO,U,I+1)=0)!($PIECE(DGINFO,U,DGHM)<30))
- SET A(I)=I
- SET A(I+1)=I+1
- SET A(I+1.5)=I+1.5
- SET DGFLAG=1
- +1 IF $DATA(DGFLAG)
- WRITE !,*7,"For each of the therapy questions,'DAYS PER WEEK' must be greater than 0",!,"and 'HOURS/MINUTES PER WEEK' must be greater than 29 minutes if level is",!,"greater than '1'.",!
- +2 QUIT
- 6 KILL DGFLAG,A
- FOR I=48:2:56
- IF $PIECE(DGINFO,U,I)'=1
- SET DGHM=I+15-(I-48/2)
- IF $PIECE(DGINFO,U,DGHM)>(1000*$PIECE(DGINFO,U,I+1))
- SET A(I+1.5)=I+1.5
- SET A(I+1)=I+1
- SET DGFLAG=1
- +1 IF $DATA(DGFLAG)
- WRITE !,*7,"Can not have more than 10 hours of therapy per day"
