source: FOIAVistA/trunk/r/SPINAL_CORD_DYSFUNCTION-SPN/SPNGFAMI.m@ 1800

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

initial load of FOIAVistA 6/30/08 version
File size: 4.1 KB
Line 
1SPNGFAMI ;WDE/SD OUTCOME GRID FOR FAM 9/19/2002
2 ;;2.0;Spinal Cord Dysfunction;**19**;01/02/1997
3CALC ;
4 S SPNGOAL=""
5 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
6 .I $P(^SPNL(154.1,SPNZZ,0),U,2)=5 I 27[$P(^SPNL(154.1,SPNZZ,2),U,17) S SPNGOAL=SPNZZ
7 I SPNGOAL="" D ZAP Q
8 S XA=$S(SPNRSCO=4:"Finish",SPNRSCO=5:"F/U (END)",SPNRSCO=9:"Finish",SPNRSCO=10:"F/U (END)",1:"ERROR")
9 ;Swallowing
10 S SPNR1C1=$P($G(^SPNL(154.1,DA,"FAM")),U,1)
11 I +SPNR1C1 S SPNR1C1=$P($G(^SPNL(154.11,SPNR1C1,0)),U,1)
12 I SPNR1C1="" S SPNR1C1=0
13 S SPNR2C1=$P($G(^SPNL(154.1,SPNGOAL,"FAM")),U,1)
14 I +SPNR2C1 S SPNR2C1=$P($G(^SPNL(154.11,SPNR2C1,0)),U,1)
15 I SPNR2C1="" S SPNR2C1=0
16 S SPNR3C1=SPNR1C1-SPNR2C1
17 ;Car Transfers
18 S SPNR1C2=$P($G(^SPNL(154.1,DA,"FAM")),U,2)
19 I +SPNR1C2 S SPNR1C2=$P($G(^SPNL(154.11,SPNR1C2,0)),U,1)
20 I SPNR1C2="" S SPNR1C2=0
21 S SPNR2C2=$P($G(^SPNL(154.1,SPNGOAL,"FAM")),U,2)
22 I +SPNR2C2 S SPNR2C2=$P($G(^SPNL(154.11,SPNR2C2,0)),U,1)
23 I SPNR2C2="" S SPNR2C2=0
24 S SPNR3C2=SPNR1C2-SPNR2C2
25 ;Community
26 S SPNR1C3=$P($G(^SPNL(154.1,DA,"FAM")),U,3)
27 I +SPNR1C3 S SPNR1C3=$P($G(^SPNL(154.11,SPNR1C3,0)),U,1)
28 I SPNR1C3="" S SPNR1C3=0
29 S SPNR2C3=$P($G(^SPNL(154.1,SPNGOAL,"FAM")),U,3)
30 I +SPNR2C3 S SPNR2C3=$P($G(^SPNL(154.11,SPNR2C3,0)),U,1)
31 I SPNR2C3="" S SPNR2C3=0
32 S SPNR3C3=SPNR1C3-SPNR2C3
33 ;READING
34 S SPNR1C4=$P($G(^SPNL(154.1,DA,"FAM")),U,4)
35 I +SPNR1C4 S SPNR1C4=$P($G(^SPNL(154.11,SPNR1C4,0)),U,1)
36 I SPNR1C4="" S SPNR1C4=0
37 S SPNR2C4=$P($G(^SPNL(154.1,SPNGOAL,"FAM")),U,4)
38 I +SPNR2C4 S SPNR2C4=$P($G(^SPNL(154.11,SPNR2C4,0)),U,1)
39 I SPNR2C4="" S SPNR2C4=0
40 S SPNR3C4=SPNR1C4-SPNR2C4
41 ;Writing
42 S SPNR1C5=$P($G(^SPNL(154.1,DA,"FAM")),U,5)
43 I +SPNR1C5 S SPNR1C5=$P($G(^SPNL(154.11,SPNR1C5,0)),U,1)
44 I SPNR1C5="" S SPNR1C5=0
45 S SPNR2C5=$P($G(^SPNL(154.1,SPNGOAL,"FAM")),U,5)
46 I +SPNR2C5 S SPNR2C5=$P($G(^SPNL(154.11,SPNR2C5,0)),U,1)
47 I SPNR2C5="" S SPNR2C5=0
48 S SPNR3C5=SPNR1C5-SPNR2C5
49 ;SPEECH
50 S SPNR1C6=$P($G(^SPNL(154.1,DA,"FAM")),U,6)
51 I +SPNR1C6 S SPNR1C6=$P($G(^SPNL(154.11,SPNR1C6,0)),U,1)
52 I SPNR1C6="" S SPNR1C6=0
53 S SPNR2C6=$P($G(^SPNL(154.1,SPNGOAL,"FAM")),U,6)
54 I +SPNR2C6 S SPNR2C6=$P($G(^SPNL(154.11,SPNR2C6,0)),U,1)
55 I SPNR2C6="" S SPNR2C6=0
56 S SPNR3C6=SPNR1C6-SPNR2C6
57 ;
58A ;Emotional
59 S SPNR4C1=$P($G(^SPNL(154.1,DA,"FAM")),U,7)
60 I +SPNR4C1 S SPNR4C1=$P($G(^SPNL(154.11,SPNR4C1,0)),U,1)
61 I SPNR4C1="" S SPNR4C1=0
62 S SPNR5C1=$P($G(^SPNL(154.1,SPNGOAL,"FAM")),U,7)
63 I +SPNR5C1 S SPNR5C1=$P($G(^SPNL(154.11,SPNR5C1,0)),U,1)
64 I SPNR5C1="" S SPNR5C1=0
65 S SPNR6C1=SPNR4C1-SPNR5C1
66 ;adjust
67 S SPNR4C2=$P($G(^SPNL(154.1,DA,"FAM")),U,8)
68 I +SPNR4C2 S SPNR4C2=$P($G(^SPNL(154.11,SPNR4C2,0)),U,1)
69 I SPNR4C2="" S SPNR4C2=0
70 S SPNR5C2=$P($G(^SPNL(154.1,SPNGOAL,"FAM")),U,8)
71 I +SPNR5C2 S SPNR5C2=$P($G(^SPNL(154.11,SPNR5C2,0)),U,1)
72 I SPNR5C2="" S SPNR5C2=0
73 S SPNR6C2=SPNR4C2-SPNR5C2
74 ;employability
75 S SPNR4C3=$P($G(^SPNL(154.1,DA,"FAM")),U,9)
76 I +SPNR4C3 S SPNR4C3=$P($G(^SPNL(154.11,SPNR4C3,0)),U,1)
77 I SPNR4C3="" S SPNR4C3=0
78 S SPNR5C3=$P($G(^SPNL(154.1,SPNGOAL,"FAM")),U,9)
79 I +SPNR5C3 S SPNR5C3=$P($G(^SPNL(154.11,SPNR5C3,0)),U,1)
80 I SPNR5C3="" S SPNR5C3=0
81 S SPNR6C3=SPNR4C3-SPNR5C3
82 ;Orientation
83 S SPNR4C4=$P($G(^SPNL(154.1,DA,"FAM")),U,10)
84 I +SPNR4C4 S SPNR4C4=$P($G(^SPNL(154.11,SPNR4C4,0)),U,1)
85 I SPNR4C4="" S SPNR4C4=0
86 S SPNR5C4=$P($G(^SPNL(154.1,SPNGOAL,"FAM")),U,10)
87 I +SPNR5C4 S SPNR5C4=$P($G(^SPNL(154.11,SPNR5C4,0)),U,1)
88 I SPNR5C4="" S SPNR5C4=0
89 S SPNR6C4=SPNR4C4-SPNR5C4
90 ;Attention
91 S SPNR4C5=$P($G(^SPNL(154.1,DA,"FAM")),U,11)
92 I +SPNR4C5 S SPNR4C5=$P($G(^SPNL(154.11,SPNR4C5,0)),U,1)
93 I SPNR4C5="" S SPNR4C5=0
94 S SPNR5C5=$P($G(^SPNL(154.1,SPNGOAL,"FAM")),U,11)
95 I +SPNR5C5 S SPNR5C5=$P($G(^SPNL(154.11,SPNR5C5,0)),U,1)
96 I SPNR5C5="" S SPNR5C5=0
97 S SPNR6C5=SPNR4C5-SPNR5C5
98 ;Safety
99 S SPNR4C6=$P($G(^SPNL(154.1,DA,"FAM")),U,12)
100 I +SPNR4C6 S SPNR4C6=$P($G(^SPNL(154.11,SPNR4C6,0)),U,1)
101 I SPNR4C6="" S SPNR4C6=0
102 S SPNR5C6=$P($G(^SPNL(154.1,SPNGOAL,"FAM")),U,12)
103 I +SPNR5C6 S SPNR5C6=$P($G(^SPNL(154.11,SPNR5C6,0)),U,1)
104 I SPNR5C6="" S SPNR5C6=0
105 S SPNR6C6=SPNR4C6-SPNR5C6
106C ;
107 Q
108ZAP ;
109 Q
Note: See TracBrowser for help on using the repository browser.