source: FOIAVistA/tag/r/SPINAL_CORD_DYSFUNCTION-SPN/SPNGFIMA.m@ 628

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

initial load of FOIAVistA 6/30/08 version
File size: 5.4 KB
Line 
1SPNGFIMA ;WDE/SD OUTCOME GRID FOR FIM'S 8/22/2002
2 ;;2.0;Spinal Cord Dysfunction;**19**;01/02/1997
3 ;this routine is called from SPNOGRDA
4 ;to display the header information and to route the user to
5 ;the right display.
6ASK ;
7REASK W !,"You have entered an INPT START or OUTPT START FIM for a patient with a"
8 W !,SPNNEUR," spinal cord injury level and a motor complete ASIA Impairment Scale of"
9 W !,SPNIMPAR,". Do you want to see a goal setting template you can copy"
10 W !,"and paste into a CPRS progress note "
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 Q
17EN ;
18 I "C01C02C03"[SPNNEUR I "AB"[SPNIMPAR S SPNNEUR="C1-C3",SPNIMPAR="A or B" S SPNROU="SPNGFIMB" S SPNTAG="FIM1" D ASK I %=1 D SHOW
19 ;
20 I "C04"[SPNNEUR I "AB"[SPNIMPAR S SPNNEUR="C4",SPNIMPAR="A or B" S SPNROU="SPNGFIMB" S SPNTAG="FIM2" D ASK I %=1 D SHOW
21 ;
22 I "C05"[SPNNEUR I "AB"[SPNIMPAR S SPNNEUR="C5",SPNIMPAR="A or B" S SPNROU="SPNGFIMB" S SPNTAG="FIM3" D ASK I %=1 D SHOW
23 ;
24 I "C06"[SPNNEUR I "AB"[SPNIMPAR S SPNNEUR="C6",SPNIMPAR="A or B" S SPNROU="SPNGFIMB" S SPNTAG="FIM4" D ASK I %=1 D SHOW
25 ;
26 I "C07C08"[SPNNEUR I "AB"[SPNIMPAR S SPNNEUR="C7-C8",SPNIMPAR="A or B" S SPNROU="SPNGFIMC" S SPNTAG="FIM5" D ASK I %=1 D SHOW
27 ;
28 I "T01T02T03T04T05T06T07T08T09"[SPNNEUR I "AB"[SPNIMPAR S SPNNEUR="T1-T9",SPNIMPAR="A or B" S SPNROU="SPNGFIMC" S SPNTAG="FIM6" D ASK I %=1 D SHOW
29 ;
30 I "T10T11T12L1"[SPNNEUR I "AB"[SPNIMPAR S SPNNEUR="T10-L1",SPNIMPAR="A or B" S SPNROU="SPNGFIMC" S SPNTAG="FIM7" D ASK I %=1 D SHOW
31 ;
32 I "L2L3L4L5S1S2S3S4S5"[SPNNEUR I "AB"[SPNIMPAR S SPNNEUR="T10-L1",SPNIMPAR="A or B" S SPNROU="SPNGFIMC" S SPNTAG="FIM8" D ASK I %=1 D SHOW2
33 ;
34 I "C01C02C03"[SPNNEUR I "C"[SPNIMPAR S SPNNEUR="C1-C3",SPNIMPAR="C" S SPNROU="SPNGFIMC" S SPNTAG="FIM9" D ASK I %=1 D SHOW2
35 ;
36 I "C04"[SPNNEUR I "C"[SPNIMPAR S SPNNEUR="C4",SPNIMPAR="C" S SPNROU="SPNGFIMD" S SPNTAG="FIM10" D ASK I %=1 D SHOW2
37 ;
38 I "C05"[SPNNEUR I "C"[SPNIMPAR S SPNNEUR="C5",SPNIMPAR="C" S SPNROU="SPNGFIMD" S SPNTAG="FIM11" D ASK I %=1 D SHOW2
39 ;
40 I "C06"[SPNNEUR I "C"[SPNIMPAR S SPNNEUR="C6",SPNIMPAR="C" S SPNROU="SPNGFIMD" S SPNTAG="FIM12" D ASK I %=1 D SHOW2
41 ;
42 I "C07C08"[SPNNEUR I "C"[SPNIMPAR S SPNNEUR="C7-C8",SPNIMPAR="C" S SPNROU="SPNGFIMD" S SPNTAG="FIM13" D ASK I %=1 D SHOW2
43 ;
44 I "T01T02T03T04T05T06T07T08T09"[SPNNEUR I "C"[SPNIMPAR S SPNNEUR="T1-T9",SPNIMPAR="C" S SPNROU="SPNGFIME" S SPNTAG="FIM14" D ASK I %=1 D SHOW2
45 ;
46 I "T10T11T12L01"[SPNNEUR I "C"[SPNIMPAR S SPNNEUR="T10-L1",SPNIMPAR="C" S SPNROU="SPNGFIME" S SPNTAG="FIM15" D ASK I %=1 D SHOW2
47 ;
48 I "L02L03L04L05S01S02S03S04S05"[SPNNEUR I "C"[SPNIMPAR S SPNNEUR="L2-S5",SPNIMPAR="C" S SPNROU="SPNGFIME" S SPNTAG="FIM16" D ASK I %=1 D SHOW2
49 ;
50 I "C01C02C03"[SPNNEUR I "D"[SPNIMPAR S SPNNEUR="C1-C3",SPNIMPAR="D" S SPNROU="SPNGFIMF" S SPNTAG="FIM17" D ASK I %=1 D SHOW2
51 ;
52 I "C04"[SPNNEUR I "D"[SPNIMPAR S SPNNEUR="C4",SPNIMPAR="D" S SPNROU="SPNGFIMF" S SPNTAG="FIM18" D ASK I %=1 D SHOW2
53 ;
54 I "C05"[SPNNEUR I "D"[SPNIMPAR S SPNNEUR="C5",SPNIMPAR="D" S SPNROU="SPNGFIMF" S SPNTAG="FIM19" D ASK I %=1 D SHOW2
55 ;
56 I "C06"[SPNNEUR I "D"[SPNIMPAR S SPNNEUR="C6",SPNIMPAR="D" S SPNROU="SPNGFIMF" S SPNTAG="FIM20" D ASK I %=1 D SHOW2
57 ;
58 I "C07C08"[SPNNEUR I "D"[SPNIMPAR S SPNNEUR="C7-C8",SPNIMPAR="D" S SPNROU="SPNGFIMG" S SPNTAG="FIM21" D ASK I %=1 D SHOW2
59 ;
60 I "T01T02T03T04T05T06T07T08T09"[SPNNEUR I "D"[SPNIMPAR S SPNNEUR="T1-T9",SPNIMPAR="D" S SPNROU="SPNGFIMG" S SPNTAG="FIM22" D ASK I %=1 D SHOW2
61 ;
62 I "T10T11T12L01"[SPNNEUR I "D"[SPNIMPAR S SPNNEUR="T10-L1",SPNIMPAR="D",SPNROU="SPNGFIMG" S SPNTAG="FIM23" D ASK I %=1 D SHOW2
63 ;
64 I "L02L03L04L05S01S02S03S04S05"[SPNNEUR I "D"[SPNIMPAR S SPNNEUR="L2-S5",SPNIMPAR="D" S SPNROU="SPNGFIMG" S SPNTAG="FIM24" D ASK I %=1 D SHOW2
65 Q
66ZAP ;
67 Q
68SHOW ;
69 ;
70 S SPNX=""
71 D COPY1^SPNGCOPY ;display the copy right's
72 I $D(IOF) W @IOF
73 W "-------------------------------------------------------------------------"
74 W !,"| | Bwl | Bldr | Trnsfr | Eat | DUB | DLB | Grmng | Bathe | WC Prp |"
75 W !,"-------------------------------------------------------------------------"
76 W !,"|Start |"
77 S X=$P($G(^SPNL(154.1,DA,0)),U,12) S:X="" X=0 ;bwl
78 W ?10,X
79 S X=$P($G(^SPNL(154.1,DA,0)),U,11) S:X="" X=0 ;bldr
80 W ?13,"|",?16,X
81 S X=$P($G(^SPNL(154.1,DA,0)),U,13) S:X="" X=0 ;trnsfr
82 W ?20,"|",?24,X
83 S X=$P($G(^SPNL(154.1,DA,0)),U,5) S:X="" X=0 ;eating
84 W ?29,"|",?32,X
85 S X=$P($G(^SPNL(154.1,DA,0)),U,8) S:X="" X=0 ;DUB
86 W ?35,"|",?38,X
87 S X=$P($G(^SPNL(154.1,DA,0)),U,9) S:X="" X=0 ;DLB
88 W ?41,"|",?44,X
89 S X=$P($G(^SPNL(154.1,DA,0)),U,6) S:X="" X=0 ;grmmg
90 W ?47,"|",?51,X
91 S X=$P($G(^SPNL(154.1,DA,0)),U,7) S:X="" X=0 ;bathing
92 W ?55,"|",?59,X
93 S X=$P($G(^SPNL(154.1,DA,0)),U,13) S:X="" X=0 ;Walk/wheel chair
94 W ?63,"|",?67,X
95 W ?72,"|"
96 K X
97 F SPNLINE=1:1 D Q:SPNX["EOR999"
98 .S X="S SPNX=$T("_SPNTAG_"+"_SPNLINE_"^"_SPNROU_")"
99 .X X
100 .Q:SPNX["EOR999"
101 .W !,$P(SPNX,";;",2)
102 R !?10,"Press Return to continue",SPNRD:DTIME
103 Q
104SHOW2 ;DISPLAY GRIDS WITH ASIA'S FIM'S 9-24
105 S SPNX=""
106 D COPY1^SPNGCOPY ;display the copy right's
107 I $D(IOF) W @IOF
108 W !,"----------------------------------------------------------"
109 W !,"| | Raw FIM Motor Score |"
110 W !,"----------------------------------------------------------"
111 W !,"|Start |",?40,$$EN1^SPNFUTL0(DA),?57,"|"
112 F SPNLINE=1:1 D Q:SPNX["EOR999"
113 .S X="S SPNX=$T("_SPNTAG_"+"_SPNLINE_"^"_SPNROU_")"
114 .X X
115 .Q:SPNX["EOR999"
116 .W !,$P(SPNX,";;",2)
117 R !?10,"Press Return to continue",SPNRD:DTIME
118 Q
Note: See TracBrowser for help on using the repository browser.