source: WorldVistAEHR/trunk/r/SPINAL_CORD_DYSFUNCTION-SPN/SPNGDINH.m@ 1724

Last change on this file since 1724 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.7 KB
Line 
1SPNGDINH ;WDE/SD OUTCOME GRID FOR DIENER 9/19/2002
2 ;;2.0;Spinal Cord Dysfunction;**19**;01/02/1997
3EN ;
4 D CALC
5 I SPNGOAL="" Q
6REASK 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"
10ASK ;
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
30CALC ;
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
40ZAP ;
Note: See TracBrowser for help on using the repository browser.