| 1 | SPNGDINH ;WDE/SD OUTCOME GRID FOR DIENER 9/19/2002 | 
|---|
| 2 | ;;2.0;Spinal Cord Dysfunction;**19**;01/02/1997 | 
|---|
| 3 | EN ; | 
|---|
| 4 | D CALC | 
|---|
| 5 | I SPNGOAL="" Q | 
|---|
| 6 | REASK W !,"You have entered an INPT REHAB FINISH or INPT FOLLOW/UP (END) or OUTPT" | 
|---|
| 7 | W !,"REHAB FINISH or OUTPT FOLLOW/UP (END) DIENER for a patient who has a recorded" | 
|---|
| 8 | W !,"INPT GOAL or OUTPT GOAL DIENER.  Do you want to see a comparison template you" | 
|---|
| 9 | W !,"can copy and paste into a CPRS progress note" | 
|---|
| 10 | ASK ; | 
|---|
| 11 | S %=2 | 
|---|
| 12 | D YN^DICN | 
|---|
| 13 | I %=0 W !!,"Answer with Yes or No." W !,*7 G REASK | 
|---|
| 14 | I %=-1 Q | 
|---|
| 15 | Q:%=2 | 
|---|
| 16 | ;D COPY1^SPNGCOPY  ;display the copy rights | 
|---|
| 17 | I $D(IOF) W @IOF | 
|---|
| 18 | W !,"---------------------------------" | 
|---|
| 19 | W !,"|               |    SWLS       |" | 
|---|
| 20 | W !,"---------------------------------" | 
|---|
| 21 | W !,"|",XA,?16,"|",?22,SPNR1C1,?32,"|" | 
|---|
| 22 | W !,"---------------------------------" | 
|---|
| 23 | W !,"|Goal",?16,"|",?22,SPNR2C1,?32,"|" | 
|---|
| 24 | W !,"---------------------------------" | 
|---|
| 25 | W !,"|Difference",?16,"|",?22,$J(SPNR3C1,2),?32,"|" | 
|---|
| 26 | W !,"---------------------------------" | 
|---|
| 27 | W !!,"Comments:" | 
|---|
| 28 | R !!?10,"Press Return to continue ",SPNREAD:DTIME | 
|---|
| 29 | Q | 
|---|
| 30 | CALC ; | 
|---|
| 31 | S SPNGOAL="" | 
|---|
| 32 | S SPNXX=0 F  S SPNXX=$O(^TMP($J,SPNXX)) Q:SPNXX=""  S SPNYY=0 F  S SPNYY=$O(^TMP($J,SPNXX,SPNYY)) Q:SPNYY=""  S SPNZZ=0 F  S SPNZZ=$O(^TMP($J,SPNXX,SPNYY,SPNZZ)) Q:SPNZZ=""  D  Q:+SPNGOAL | 
|---|
| 33 | .I $P(^SPNL(154.1,SPNZZ,0),U,2)=6 I 27[$P(^SPNL(154.1,SPNZZ,2),U,17) S SPNGOAL=SPNZZ | 
|---|
| 34 | I SPNGOAL="" S SPNMSG="There is no DIENER start Outcome on file." Q | 
|---|
| 35 | S XA=$S(SPNRSCO=4:"Finish",SPNRSCO=5:"F/U (END)",SPNRSCO=9:"Finish",SPNRSCO=10:"F/U (END)",1:"ERROR") | 
|---|
| 36 | S SPNR1C1=$P($G(^SPNL(154.1,DA,"SCORE")),U,1) I SPNR1C1="" S SPNR1C1=0 | 
|---|
| 37 | S SPNR2C1=$P($G(^SPNL(154.1,SPNGOAL,"SCORE")),U,1) I SPNR2C1="" S SPNR2C1=0 | 
|---|
| 38 | S SPNR3C1=SPNR1C1-SPNR2C1 | 
|---|
| 39 | Q | 
|---|
| 40 | ZAP ; | 
|---|