source: FOIAVistA/trunk/r/SPINAL_CORD_DYSFUNCTION-SPN/SPNGFIMI.m@ 1722

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

initial load of FOIAVistA 6/30/08 version
File size: 4.6 KB
Line 
1SPNGFIMI ;WDE/SD OUTCOME GRID FOR FIM'S 9/19/2002
2 ;;2.0;Spinal Cord Dysfunction;**19**;01/02/1997
3CALC ; Create the values
4 ;called from spngfimh gets the scores to plug into the grids
5 ; da = the current fim with a score of 4,5,9 or 10
6 ; now get the goal fim SPNGFIM
7 S SPNGOAL=""
8 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
9 .I $P(^SPNL(154.1,SPNZZ,0),U,2)=2 I 27[$P(^SPNL(154.1,SPNZZ,2),U,17) S SPNGOAL=SPNZZ
10 I SPNGOAL="" S SPNMSG="There is no FIM goal on file !"
11 ;get eating
12 Q:$D(SPNGOAL)=0
13 Q:$G(SPNGOAL)=""
14 S SPNR1C1=$P($G(^SPNL(154.1,DA,0)),U,5) I SPNR1C1="" S SPNR1C1=0
15 S SPNR2C1=$P($G(^SPNL(154.1,SPNGOAL,0)),U,5) I SPNR2C1="" S SPNR2C1=0
16 S SPNR3C1=SPNR1C1-SPNR2C1
17 ;get groming
18 S SPNR1C2=$P($G(^SPNL(154.1,DA,0)),U,6) I SPNR1C2="" S SPNR1C2=0
19 S SPNR2C2=$P($G(^SPNL(154.1,SPNGOAL,0)),U,6) I SPNR2C2="" S SPNR2C2=0
20 S SPNR3C2=SPNR1C2-SPNR2C2
21 ;bathing
22 S SPNR1C3=$P($G(^SPNL(154.1,DA,0)),U,7) I SPNR1C3="" S SPNR1C3=0
23 S SPNR2C3=$P($G(^SPNL(154.1,SPNGOAL,0)),U,7) I SPNR2C3="" S SPNR2C3=0
24 S SPNR3C3=SPNR1C3-SPNR2C3
25 ;DUB dressing upper body
26 S SPNR1C4=$P($G(^SPNL(154.1,DA,0)),U,8) I SPNR1C4="" S SPNR1C4=0
27 S SPNR2C4=$P($G(^SPNL(154.1,SPNGOAL,0)),U,8) I SPNR2C4="" S SPNR2C4=0
28 S SPNR3C4=SPNR1C4-SPNR2C4
29 ;DLB dressing lower body
30 S SPNR1C5=$P($G(^SPNL(154.1,DA,0)),U,9) I SPNR1C5="" S SPNR1C5=0
31 S SPNR2C5=$P($G(^SPNL(154.1,SPNGOAL,0)),U,9) I SPNR2C5="" S SPNR2C5=0
32 S SPNR3C5=SPNR1C5-SPNR2C5
33 ;Toileting
34 S SPNR1C6=$P($G(^SPNL(154.1,DA,0)),U,10) I SPNR1C6="" S SPNR1C6=0
35 S SPNR2C6=$P($G(^SPNL(154.1,SPNGOAL,0)),U,10) I SPNR2C6="" S SPNR2C6=0
36 S SPNR3C6=SPNR1C6-SPNR2C6
37 ;Bladder
38 S SPNR4C1=$P($G(^SPNL(154.1,DA,0)),U,11) I SPNR4C1="" S SPNR4C1=0
39 S SPNR5C1=$P($G(^SPNL(154.1,SPNGOAL,0)),U,11) I SPNR5C1="" S SPNR5C1=0
40 S SPNR6C1=SPNR4C1-SPNR5C1
41 ;BWL
42 S SPNR4C2=$P($G(^SPNL(154.1,DA,0)),U,12) I SPNR4C2="" S SPNR4C2=0
43 S SPNR5C2=$P($G(^SPNL(154.1,SPNGOAL,0)),U,12) I SPNR5C2="" S SPNR5C2=0
44 S SPNR6C2=SPNR4C2-SPNR5C2
45 ;BC WC TXFR ?
46 S SPNR4C3=$P($G(^SPNL(154.1,DA,0)),U,13) I SPNR4C3="" S SPNR4C3=0
47 S SPNR5C3=$P($G(^SPNL(154.1,SPNGOAL,0)),U,13) I SPNR5C3="" S SPNR5C3=0
48 S SPNR6C3=SPNR4C3-SPNR5C3
49 ;Toilet txfr
50 S SPNR4C4=$P($G(^SPNL(154.1,DA,0)),U,14) I SPNR4C4="" S SPNR4C4=0
51 S SPNR5C4=$P($G(^SPNL(154.1,SPNGOAL,0)),U,14) I SPNR5C4="" S SPNR5C4=0
52 S SPNR6C4=SPNR4C4-SPNR5C4
53 ;TUB SHW XFER
54 S SPNR4C5=$P($G(^SPNL(154.1,DA,0)),U,15) I SPNR4C5="" S SPNR4C5=0
55 S SPNR5C5=$P($G(^SPNL(154.1,SPNGOAL,0)),U,15) I SPNR5C5="" S SPNR5C5=0
56 S SPNR6C5=SPNR4C5-SPNR5C5
57 ;WALK W/C
58 S SPNR4C6=$P($G(^SPNL(154.1,DA,0)),U,16) I SPNR4C6="" S SPNR4C6=0
59 S SPNR5C6=$P($G(^SPNL(154.1,SPNGOAL,0)),U,16) I SPNR5C6="" S SPNR5C6=0
60 S SPNR6C6=SPNR4C6-SPNR5C6
61 ;Stairs
62 S SPNR4C7=$P($G(^SPNL(154.1,DA,0)),U,17) I SPNR4C7="" S SPNR4C7=0
63 S SPNR5C7=$P($G(^SPNL(154.1,SPNGOAL,0)),U,17) I SPNR5C7="" S SPNR5C7=0
64 S SPNR6C7=SPNR4C7-SPNR5C7
65 ;COMP
66 S SPNR7C1=$P($G(^SPNL(154.1,DA,0)),U,18)
67 I +SPNR7C1 S SPNR7C1=$P($G(^SPNL(154.11,SPNR7C1,0)),U,1)
68 I SPNR7C1="" S SPNR7C1=0
69 S SPNR8C1=$P($G(^SPNL(154.1,SPNGOAL,0)),U,18)
70 I +SPNR8C1 S SPNR8C1=$P($G(^SPNL(154.11,SPNR8C1,0)),U,1)
71 I SPNR8C1="" S SPNR8C1=0
72 S SPNR9C1=SPNR7C1-SPNR8C1
73 ;EXPR
74 S SPNR7C2=$P($G(^SPNL(154.1,DA,0)),U,19)
75 I +SPNR7C2 S SPNR7C2=$P($G(^SPNL(154.11,SPNR7C2,0)),U,1)
76 I SPNR7C2="" S SPNR7C2=0
77 S SPNR8C2=$P($G(^SPNL(154.1,SPNGOAL,0)),U,19)
78 I +SPNR8C2 S SPNR8C2=$P($G(^SPNL(154.11,SPNR8C2,0)),U,1)
79 I SPNR8C2="" S SPNR8C2=0
80 S SPNR9C2=SPNR7C2-SPNR8C2
81 ;SOCIAL INT
82 S SPNR7C3=$P($G(^SPNL(154.1,DA,0)),U,20)
83 I +SPNR7C3 S SPNR7C3=$P($G(^SPNL(154.11,SPNR7C3,0)),U,1)
84 I SPNR7C3="" S SPNR7C3=0
85 S SPNR8C3=$P($G(^SPNL(154.1,SPNGOAL,0)),U,20)
86 I +SPNR8C3 S SPNR8C3=$P($G(^SPNL(154.11,SPNR8C3,0)),U,1)
87 I SPNR8C3="" S SPNR8C3=0
88 S SPNR9C3=SPNR7C3-SPNR8C3
89 ;Problem solv
90 S SPNR7C4=$P($G(^SPNL(154.1,DA,0)),U,21)
91 I +SPNR7C4 S SPNR7C4=$P($G(^SPNL(154.11,SPNR7C4,0)),U,1)
92 I SPNR7C4="" S SPNR7C4=0
93 S SPNR8C4=$P($G(^SPNL(154.1,SPNGOAL,0)),U,21)
94 I +SPNR8C4 S SPNR8C4=$P($G(^SPNL(154.11,SPNR8C4,0)),U,1)
95 I SPNR8C4="" S SPNR8C4=0
96 S SPNR9C4=SPNR7C4-SPNR8C4
97 ;MEM
98 S SPNR7C5=$P($G(^SPNL(154.1,DA,0)),U,22)
99 I +SPNR7C5 S SPNR7C5=$P($G(^SPNL(154.11,SPNR7C5,0)),U,1)
100 I SPNR7C5="" S SPNR7C5=0
101 S SPNR8C5=$P($G(^SPNL(154.1,SPNGOAL,0)),U,22)
102 I +SPNR8C5 S SPNR8C5=$P($G(^SPNL(154.11,SPNR8C5,0)),U,1)
103 I SPNR8C5="" S SPNR8C5=0
104 S SPNR9C5=SPNR7C5-SPNR8C5
105 ;MOTOR
106 S SPNR7C6=$$EN1^SPNFUTL0(DA)
107 S SPNR8C6=$$EN1^SPNFUTL0(SPNGOAL)
108 S SPNR9C6=SPNR7C6-SPNR8C6
109 ;CONG
110 S SPNR7C7=$$EN2^SPNFUTL0(DA)
111 S SPNR8C7=$$EN2^SPNFUTL0(SPNGOAL)
112 S SPNR9C7=SPNR7C7-SPNR8C7
113 ;TOTAL
114 S SPNR7C8=$$EN3^SPNFUTL0(DA)
115 S SPNR8C8=$$EN3^SPNFUTL0(SPNGOAL)
116 S SPNR9C8=SPNR7C8-SPNR8C8
Note: See TracBrowser for help on using the repository browser.