DGRUGGR ;ALB/BOK - RUG-II GROUPER FOR A PATIENT ; 14 MAY 87  09:00
 ;;5.3;Registration;**89,173**;Aug 13, 1993
 ;
EN I '$D(DGCNH),$D(^XUSEC("DG RUG SUPERVISOR",DUZ)) S (DGFCNH,DGCNH)=""
 S DIC="^DG(45.9,",DIC(0)="AEQM",DIC("S")="I $$PTSCREEN^DGRUGU1()"
 D ^DIC G QUIT:Y'>0 S (DGPT,DA)=+Y
SET W ! S DGCON=$S('$D(^DG(43,1,"RUG")):2891002,$P(^("RUG"),"^",2):$P(^("RUG"),"^",2),1:2891002),DGINFO=^DG(45.9,DA,0) K DGFLG,A,I
 I $P(DGINFO,"^",2)<DGCON F I=1:1:20,23:1:28,32:1:35,40:1:57 I $P(DGINFO,U,I)']"" W !,"The field ",$P(^DD(45.9,I,0),U,1)," is missing data." S DGFLG=""
 G GO:$P(DGINFO,"^",2)<DGCON
 W !
 K DGFLG,A,I
 S DGINFO=^DG(45.9,DA,0)
 F I=1:1:21,23:1:28,32:1:35,40:1:62 D
 .Q:(I=9)&($P($G(^DG(45.9,DA,0)),"^",6)=3)
 .I $P(DGINFO,U,I)']"" W !,"The field ",$P(^DD(45.9,I,0),U,1)," is missing data." S DGFLG=""
 F I=49.5:2:57.5 I $P(DGINFO,U,I+13.5-(I-49.5/2))']"" W !,"The field ",$P(^DD(45.9,I,0),U,1)," is missing data." S DGFLG=""
GO G:$D(DGFLG) ERR
 I $P(DGINFO,U,2) S DGFY=$S($E($P(DGINFO,U,2),4,5)<10:($E($P(DGINFO,U,2),1,3)_"0000"),1:($E($P(DGINFO,U,2),1,3)+1_"0000"))
 S E=$P(DGINFO,U,40),E=$S(E<3:1,E=3:2,E=4:3,1:4),T=$P(DGINFO,U,42),T=$S(T<3:1,T=3:2,1:3),J=$P(DGINFO,U,43),J=$S(J<3:1,J<5:2,1:3),DGSUM=E+T+J
 S DGGRP="" G REHAB^DGRUG16:$P(DGINFO,"^",2)<DGCON,^DGRUG1
QUIT K A,DA,DFN,DGCON,DGFLG,DGFY,DGGRP,DGINFO,DGPT,DGRUG,DGSUM,DIC,DIE,DR,E,G,I,J,T,Y
 I $D(DGFCNH) K DGFCNH,DGCNH
 Q
ERR W !!,"A RUG-II GROUP CAN NOT BE DETERMINED ON THIS PATIENT ",! G QUIT