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