[628] | 1 | SPNCTAA ;WDE/SD SCORE TYPE MAIN DRIVER ;6/27/02 05:15
|
---|
| 2 | ;;2.0;Spinal Cord Dysfunction;**19,20**;01/02/1997
|
---|
| 3 | ;
|
---|
| 4 | ; This is to select the type of data to enter for a patient.
|
---|
| 5 | ; If none of the given report are selected then SPNFEXIT is set to 1
|
---|
| 6 | ; and the program exits.
|
---|
| 7 | ; Returns SPNSCOR as a value of 1 to 12 indicating the type
|
---|
| 8 | ; of SCORE to be entered/edited
|
---|
| 9 | ;
|
---|
| 10 | ; Output:
|
---|
| 11 | ; SPNFEXIT = 1 User exited
|
---|
| 12 | ; 0 User passed
|
---|
| 13 | ; SPNSCOR = 1-12 SCORE TYPE
|
---|
| 14 | IN ;set up dir string for inpatient
|
---|
| 15 | K SPNAA,DIR S DIR(0)="SOM^"
|
---|
| 16 | S SPNXX=0 F S SPNXX=$O(^TMP($J,SPNXX)) Q:SPNXX="" W "." 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
|
---|
| 17 | .S SPNRR=$P($G(^SPNL(154.1,SPNZZ,0)),U,2) Q:SPNRR="" ;RECORD TYPE ON FILE
|
---|
| 18 | .S SPNSS=$P($G(^SPNL(154.1,SPNZZ,2)),U,17) Q:SPNSS="" ;SCORE TYPE ON FILE
|
---|
| 19 | .I SPNRR=SPNFTYPE S SPNAA(SPNSS)=0
|
---|
| 20 | ;I $D(SPNAA(A))=0 D
|
---|
| 21 | S SPNQQ=0 F A=1,2,3,4,5,6 D
|
---|
| 22 | .I $D(SPNAA(A))=0 I A=1 S DIR(0)=DIR(0)_A_":INPT START;"
|
---|
| 23 | .I $D(SPNAA(A))=0 I A=2 S DIR(0)=DIR(0)_A_":INPT GOAL;"
|
---|
| 24 | .I A=3 S DIR(0)=DIR(0)_A_":INPT INTERIM;"
|
---|
| 25 | .I $D(SPNAA(A))=0 I A=4 S DIR(0)=DIR(0)_A_":INPT REHAB FINISH;"
|
---|
| 26 | .I $D(SPNAA(A))=0 I A=5 S DIR(0)=DIR(0)_A_":INPT FOLLOW-UP (END);"
|
---|
| 27 | .I A=6 S DIR(0)=DIR(0)_A_":UNKNOWN;"
|
---|
| 28 | K A,SPNSS,SPNXX,SPNYY,SPNZZ
|
---|
| 29 | ;K DIR S DIR(0)="SOM^1:INPT START;2:INPT GOAL;3:INPT INTERIM;4:INPT REHAB FINISH;5:INPT FOLLOW-UP (END);6:UNKNOWN"
|
---|
| 30 | S DIR("?",1)=" Enter 1 for an INPT START outcome"
|
---|
| 31 | S DIR("?",2)=" Enter 2 for an INPT GOAL outcome"
|
---|
| 32 | S DIR("?",3)=" Enter 3 for an INPT INTERIM outcome"
|
---|
| 33 | S DIR("?",4)=" Enter 4 for an INPT REHAB FINISH outcome"
|
---|
| 34 | S DIR("?",5)=" Enter 5 for an INPT FOLLOW-UP (END) outcome"
|
---|
| 35 | S DIR("?",6)=" Enter 6 for UNKNOWN if the score type is not known"
|
---|
| 36 | S DIR("?")=" Enter 1,2,3,4,5 or 6."
|
---|
| 37 | D ASK
|
---|
| 38 | Q:(SPNSCOR="")!(SPNSCOR=0)!(SPNEXIT=1)
|
---|
| 39 | ; take input and convert it to proper value based on dd value
|
---|
| 40 | S SPNSCOR=$S(SPNSCOR=1:1,SPNSCOR=2:2,SPNSCOR=3:3,SPNSCOR=4:4,SPNSCOR=5:5,1:11)
|
---|
| 41 | Q
|
---|
| 42 | OUT ;set up dir string for outpatient
|
---|
| 43 | K SPNAA,DIR S DIR(0)="SOM^"
|
---|
| 44 | S SPNXX=0 F S SPNXX=$O(^TMP($J,SPNXX)) Q:SPNXX="" W "." 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
|
---|
| 45 | .S SPNRR=$P($G(^SPNL(154.1,SPNZZ,0)),U,2) Q:SPNRR="" ;RECORD TYPE
|
---|
| 46 | .S SPNSS=$P($G(^SPNL(154.1,SPNZZ,2)),U,17) Q:SPNSS="" ;SCORE TYPE
|
---|
| 47 | .I SPNRR=SPNFTYPE S SPNAA(SPNSS)=0
|
---|
| 48 | S SPNQQ=0 F A=6,7,8,9,10,11 D
|
---|
| 49 | .I $D(SPNAA(A))=0 I A=6 S DIR(0)=DIR(0)_"1:OUTPT START;"
|
---|
| 50 | .I $D(SPNAA(A))=0 I A=7 S DIR(0)=DIR(0)_"2:OUTPT GOAL;"
|
---|
| 51 | .I A=8 S DIR(0)=DIR(0)_"3:OUTPT INTERIM;"
|
---|
| 52 | .I $D(SPNAA(A))=0 I A=9 S DIR(0)=DIR(0)_"4:OUTPT REHAB FINISH;"
|
---|
| 53 | .I $D(SPNAA(A))=0 I A=10 S DIR(0)=DIR(0)_"5:OUTPT FOLLOW-UP (END);"
|
---|
| 54 | .I A=11 S DIR(0)=DIR(0)_"6:UNKNOWN;"
|
---|
| 55 | K A,SPNSS,SPNXX,SPNYY,SPNZZ
|
---|
| 56 | ;K DIR S DIR(0)="SOM^1:OUTPT START;2:OUTPT GOAL;3:OUTPT INTERIM;4:OUTPT REHAB FINISH;5:OUTPT FOLLOW-UP (END);6:UNKNOWN"
|
---|
| 57 | S DIR("?",1)=" Enter 1 for an OUTPT START outcome"
|
---|
| 58 | S DIR("?",2)=" Enter 2 for an OUTPT GOAL outcome"
|
---|
| 59 | S DIR("?",3)=" Enter 3 for an OUTPT INTERIM outcome"
|
---|
| 60 | S DIR("?",4)=" Enter 4 for an OUTPT REHAB FINISH outcome"
|
---|
| 61 | S DIR("?",5)=" Enter 5 for an OUTPT FOLLOW-UP (END) outcome"
|
---|
| 62 | S DIR("?",6)=" Enter 6 for UNKNOWN if the score type is not known"
|
---|
| 63 | S DIR("?")=" Enter 1,2,3,4,5 or 6."
|
---|
| 64 | D ASK
|
---|
| 65 | Q:(SPNSCOR="")!('+SPNSCOR)!(SPNEXIT=1)
|
---|
| 66 | ; take the input and convert it to the proper value based on
|
---|
| 67 | ; the dd value.
|
---|
| 68 | S SPNSCOR=$S(SPNSCOR=1:6,SPNSCOR=2:7,SPNSCOR=3:8,SPNSCOR=4:9,SPNSCOR=5:10,1:11)
|
---|
| 69 | Q
|
---|
| 70 | ANNUAL ;Annual eval No reason to ask for care type as it is annual eval
|
---|
| 71 | ;no score type is entered for annual eval
|
---|
| 72 | S SPNSCOR=11
|
---|
| 73 | Q
|
---|
| 74 | CONT ;continuum of care No reason to ask for care type as it is continuum
|
---|
| 75 | ;no score type is entered for continuum of care
|
---|
| 76 | K SPNAA,DIR S DIR(0)="SOM^"
|
---|
| 77 | S DIR(0)=DIR(0)_"1:CC ADMIT;"
|
---|
| 78 | S DIR(0)=DIR(0)_"2:CC GOAL;"
|
---|
| 79 | S DIR(0)=DIR(0)_"3:CC INTERIM;"
|
---|
| 80 | S DIR(0)=DIR(0)_"4:CC DISCHARGE;"
|
---|
| 81 | S DIR(0)=DIR(0)_"5:CC OUTPT;"
|
---|
| 82 | S DIR(0)=DIR(0)_"6:UNKNOWN;"
|
---|
| 83 | S DIR("?",1)=" Enter 1 for an CC ADMIT outcome"
|
---|
| 84 | S DIR("?",2)=" Enter 2 for an CC GOAL outcome"
|
---|
| 85 | S DIR("?",3)=" Enter 3 for an CC INTERIM outcome"
|
---|
| 86 | S DIR("?",4)=" Enter 4 for an CC DISCHARGE outcome"
|
---|
| 87 | S DIR("?",5)=" Enter 5 for an CC OUTPT outcome"
|
---|
| 88 | S DIR("?",6)=" Enter 6 for UNKNOWN if the score type is not known"
|
---|
| 89 | S DIR("?")=" Enter 1,2,3,4,5 or 6."
|
---|
| 90 | D ASK
|
---|
| 91 | Q:(SPNSCOR="")!('+SPNSCOR)!(SPNEXIT=1)
|
---|
| 92 | ; take the input and convert it to the proper value based on
|
---|
| 93 | ; the dd value.
|
---|
| 94 | S SPNSCOR=$S(SPNSCOR=1:12,SPNSCOR=2:13,SPNSCOR=3:14,SPNSCOR=4:15,SPNSCOR=5:16,1:11)
|
---|
| 95 | Q
|
---|
| 96 | ASK ;
|
---|
| 97 | S SPNEXIT=0
|
---|
| 98 | I $D(IOF) W @IOF
|
---|
| 99 | K DIRUT
|
---|
| 100 | I $D(IOF) W @IOF
|
---|
| 101 | S SPNSCOR=0
|
---|
| 102 | S DIR("A")="Select the Score Type for this outcome"
|
---|
| 103 | W ! D ^DIR K DIR S SPNSCOR=+Y
|
---|
| 104 | I $D(DIRUT) S SPNEXIT=1 Q
|
---|
| 105 | I $D(DIRUT) S:$D(DTOUT)!($D(DUOUT)) SPNEXIT=1 Q
|
---|
| 106 | Q:SPNSCOR<1
|
---|
| 107 | I $D(IOF) W @IOF
|
---|
| 108 | Q
|
---|