SPNGFIMA ;WDE/SD OUTCOME GRID FOR FIM'S 8/22/2002
 ;;2.0;Spinal Cord Dysfunction;**19**;01/02/1997
 ;this routine is called from SPNOGRDA
 ;to display the header information and to route the user to
 ;the right display.
ASK ;
REASK W !,"You have entered an INPT START or OUTPT START FIM for a patient with a"
 W !,SPNNEUR," spinal cord injury level and a motor complete ASIA Impairment Scale of"
 W !,SPNIMPAR,".  Do you want to see a goal setting template you can copy"
 W !,"and paste into a CPRS progress note "
 S %=2
 D YN^DICN
 I %=0 W !!,"Answer with Yes or No." W !,*7 G REASK
 I %=-1 Q
 Q:%=2
 Q
EN ;
 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
 ;
 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
 ;
 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
 ;
 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
 ;
 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
 ;
 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
 ;
 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
 ;
 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
 ;
 I "C01C02C03"[SPNNEUR I "C"[SPNIMPAR S SPNNEUR="C1-C3",SPNIMPAR="C" S SPNROU="SPNGFIMC" S SPNTAG="FIM9" D ASK I %=1 D SHOW2
 ;
 I "C04"[SPNNEUR I "C"[SPNIMPAR S SPNNEUR="C4",SPNIMPAR="C" S SPNROU="SPNGFIMD" S SPNTAG="FIM10" D ASK I %=1 D SHOW2
 ;
 I "C05"[SPNNEUR I "C"[SPNIMPAR S SPNNEUR="C5",SPNIMPAR="C" S SPNROU="SPNGFIMD" S SPNTAG="FIM11" D ASK I %=1 D SHOW2
 ;
 I "C06"[SPNNEUR I "C"[SPNIMPAR S SPNNEUR="C6",SPNIMPAR="C" S SPNROU="SPNGFIMD" S SPNTAG="FIM12" D ASK I %=1 D SHOW2
 ;
 I "C07C08"[SPNNEUR I "C"[SPNIMPAR S SPNNEUR="C7-C8",SPNIMPAR="C" S SPNROU="SPNGFIMD" S SPNTAG="FIM13" D ASK I %=1 D SHOW2
 ;
 I "T01T02T03T04T05T06T07T08T09"[SPNNEUR I "C"[SPNIMPAR S SPNNEUR="T1-T9",SPNIMPAR="C" S SPNROU="SPNGFIME" S SPNTAG="FIM14" D ASK I %=1 D SHOW2
 ;
 I "T10T11T12L01"[SPNNEUR I "C"[SPNIMPAR S SPNNEUR="T10-L1",SPNIMPAR="C" S SPNROU="SPNGFIME" S SPNTAG="FIM15" D ASK I %=1 D SHOW2
 ;
 I "L02L03L04L05S01S02S03S04S05"[SPNNEUR I "C"[SPNIMPAR S SPNNEUR="L2-S5",SPNIMPAR="C" S SPNROU="SPNGFIME" S SPNTAG="FIM16" D ASK I %=1 D SHOW2
 ;
 I "C01C02C03"[SPNNEUR I "D"[SPNIMPAR S SPNNEUR="C1-C3",SPNIMPAR="D" S SPNROU="SPNGFIMF" S SPNTAG="FIM17" D ASK I %=1 D SHOW2
 ;
 I "C04"[SPNNEUR I "D"[SPNIMPAR S SPNNEUR="C4",SPNIMPAR="D" S SPNROU="SPNGFIMF" S SPNTAG="FIM18" D ASK I %=1 D SHOW2
 ;
 I "C05"[SPNNEUR I "D"[SPNIMPAR S SPNNEUR="C5",SPNIMPAR="D" S SPNROU="SPNGFIMF" S SPNTAG="FIM19" D ASK I %=1 D SHOW2
 ;
 I "C06"[SPNNEUR I "D"[SPNIMPAR S SPNNEUR="C6",SPNIMPAR="D" S SPNROU="SPNGFIMF" S SPNTAG="FIM20" D ASK I %=1 D SHOW2
 ;
 I "C07C08"[SPNNEUR I "D"[SPNIMPAR S SPNNEUR="C7-C8",SPNIMPAR="D" S SPNROU="SPNGFIMG" S SPNTAG="FIM21" D ASK I %=1 D SHOW2
 ;
 I "T01T02T03T04T05T06T07T08T09"[SPNNEUR I "D"[SPNIMPAR S SPNNEUR="T1-T9",SPNIMPAR="D" S SPNROU="SPNGFIMG" S SPNTAG="FIM22" D ASK I %=1 D SHOW2
 ;
 I "T10T11T12L01"[SPNNEUR I "D"[SPNIMPAR S SPNNEUR="T10-L1",SPNIMPAR="D",SPNROU="SPNGFIMG" S SPNTAG="FIM23" D ASK I %=1 D SHOW2
 ;
 I "L02L03L04L05S01S02S03S04S05"[SPNNEUR I "D"[SPNIMPAR S SPNNEUR="L2-S5",SPNIMPAR="D" S SPNROU="SPNGFIMG" S SPNTAG="FIM24" D ASK I %=1 D SHOW2
 Q
ZAP ;
 Q
SHOW ;
 ;
 S SPNX=""
 D COPY1^SPNGCOPY  ;display the copy right's
 I $D(IOF) W @IOF
 W "-------------------------------------------------------------------------"
 W !,"|      | Bwl | Bldr | Trnsfr | Eat | DUB | DLB | Grmng | Bathe | WC Prp |"
 W !,"-------------------------------------------------------------------------"
 W !,"|Start |"
 S X=$P($G(^SPNL(154.1,DA,0)),U,12) S:X="" X=0  ;bwl
 W ?10,X
 S X=$P($G(^SPNL(154.1,DA,0)),U,11) S:X="" X=0  ;bldr
 W ?13,"|",?16,X
 S X=$P($G(^SPNL(154.1,DA,0)),U,13) S:X="" X=0  ;trnsfr
 W ?20,"|",?24,X
 S X=$P($G(^SPNL(154.1,DA,0)),U,5) S:X="" X=0  ;eating
 W ?29,"|",?32,X
 S X=$P($G(^SPNL(154.1,DA,0)),U,8) S:X="" X=0  ;DUB
 W ?35,"|",?38,X
 S X=$P($G(^SPNL(154.1,DA,0)),U,9) S:X="" X=0  ;DLB
 W ?41,"|",?44,X
 S X=$P($G(^SPNL(154.1,DA,0)),U,6) S:X="" X=0  ;grmmg
 W ?47,"|",?51,X
 S X=$P($G(^SPNL(154.1,DA,0)),U,7) S:X="" X=0  ;bathing
 W ?55,"|",?59,X
 S X=$P($G(^SPNL(154.1,DA,0)),U,13) S:X="" X=0  ;Walk/wheel chair
 W ?63,"|",?67,X
 W ?72,"|"
 K X
 F SPNLINE=1:1 D  Q:SPNX["EOR999"
 .S X="S SPNX=$T("_SPNTAG_"+"_SPNLINE_"^"_SPNROU_")"
 .X X
 .Q:SPNX["EOR999"
 .W !,$P(SPNX,";;",2)
 R !?10,"Press Return to continue",SPNRD:DTIME
 Q
SHOW2 ;DISPLAY GRIDS WITH ASIA'S FIM'S 9-24
 S SPNX=""
 D COPY1^SPNGCOPY  ;display the copy right's
 I $D(IOF) W @IOF
 W !,"----------------------------------------------------------"
 W !,"|                           |     Raw FIM Motor Score    |"
 W !,"----------------------------------------------------------"
 W !,"|Start                      |",?40,$$EN1^SPNFUTL0(DA),?57,"|"
 F SPNLINE=1:1 D  Q:SPNX["EOR999"
 .S X="S SPNX=$T("_SPNTAG_"+"_SPNLINE_"^"_SPNROU_")"
 .X X
 .Q:SPNX["EOR999"
 .W !,$P(SPNX,";;",2)
 R !?10,"Press Return to continue",SPNRD:DTIME
 Q