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 ;
|
---|