source: FOIAVistA/trunk/r/SPINAL_CORD_DYSFUNCTION-SPN/SPNOGRDA.m@ 1452

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

initial load of FOIAVistA 6/30/08 version
File size: 3.2 KB
Line 
1SPNOGRDA ;WDE/SD OUTCOME GRID STARTING POINT 8/22/02
2 ;;2.0;Spinal Cord Dysfunction;**19,22**;01/02/1997
3EN ;
4 ;This is the starting routine for the grid displays
5 ;in order for a grid to be displayed there must be an ASIA
6 ;outcome on file in the episode and it must be a score type of start
7 ;must test the current outcome as it may be a new one added
8 ;to the current episode. On new add's it will not be in the tmp array
9 ; spntest=1 we have an asia and it has a score type of 1 or 6
10 ;
11 ;
12 ;episode must have an asia test area
13 S SPNTEST=0
14 S:'$D(DA) DA=SPNFD0
15 S SPND=$G(^SPNL(154.1,DA,0)) I SPND'="" D
16 .I $P(SPND,U,2)=3 S SPNE=$P($G(^SPNL(154.1,DA,2)),U,17) I SPNE'="" I 16[SPNE S SPNTEST=1,SPNASIA=DA,SPNIMPAR=$P($G(^SPNL(154.1,DA,"ASIA")),U,1),SPNNEUR=$$GET1^DIQ(154.1,DA_",",7.14)
17 ;
18 I SPNTEST=0 S SPNA=0 F S SPNA=$O(^TMP($J,SPNA)) Q:SPNA="" S SPNB=0 F S SPNB=$O(^TMP($J,SPNA,SPNB)) Q:SPNB="" S SPNC=0 F S SPNC=$O(^TMP($J,SPNA,SPNB,SPNC)) Q:SPNC="" D
19 .;test for record an ASIA and score type 1 or 6
20 .; being on file in the episode
21 .S SPND=$G(^SPNL(154.1,SPNC,0)) Q:SPND=""
22 .I $P(SPND,U,2)'=3 Q ;not an ASIA outcome
23 .S SPNE=$P($G(^SPNL(154.1,SPNC,2)),U,17) Q:SPNE=""
24 .I 16'[SPNE S (SPND,SPNE)="" Q
25 .S SPNTEST=1 S SPNASIA=SPNC,SPNIMPAR=$P($G(^SPNL(154.1,SPNC,"ASIA")),U,1),SPNNEUR=$$GET1^DIQ(154.1,SPNC_",",7.14)
26 ;
27 ;spntest = 1 we have an ASIA outcome with a score type of start
28 ;in the current episode
29 ;
30 ;
31SET ;
32 ;if no asia on file
33 S SPNRTYP=$P($G(^SPNL(154.1,DA,0)),U,2)
34 S SPNRSCO=$P($G(^SPNL(154.1,DA,2)),U,17)
35 I SPNRTYP=2 I (SPNRSCO=4)!(SPNRSCO=5)!(SPNRSCO=9)!(SPNRSCO=10) D EN^SPNGFIMH
36 ;spnrtyp & spnrsco need to be reset here. If the above code is ran
37 ;clean up is done and the next grid will be ready to load..
38 S SPNRTYP=$P($G(^SPNL(154.1,DA,0)),U,2)
39 S SPNRSCO=$P($G(^SPNL(154.1,DA,2)),U,17)
40 I SPNRTYP=6 I (SPNRSCO=4)!(SPNRSCO=5)!(SPNRSCO=9)!(SPNRSCO=10) D EN^SPNGDINH D ZAP Q
41 I SPNRTYP=5 I (SPNRSCO=4)!(SPNRSCO=5)!(SPNRSCO=9)!(SPNRSCO=10) D EN^SPNGFAMH D ZAP Q
42 I SPNRTYP=4 I (SPNRSCO=4)!(SPNRSCO=5)!(SPNRSCO=9)!(SPNRSCO=10) D EN^SPNGCHRH D ZAP Q
43 ;the following grids need to have an asia start on file
44 I $D(SPNIMPAR)=0 D ZAP Q
45 I SPNIMPAR="" D ZAP Q
46 I SPNASIA="" D ZAP Q
47 I SPNNEUR="" D ZAP Q
48 S SPNRTYP=$P($G(^SPNL(154.1,DA,0)),U,2)
49 S SPNRSCO=$P($G(^SPNL(154.1,DA,2)),U,17)
50 I SPNRTYP=2 I 16[SPNRSCO D EN^SPNGFIMA
51 I SPNRTYP=2 I 4[SPNRSCO D EN^SPNGFIMK
52 I SPNRTYP=6 I 16[SPNRSCO D EN^SPNGDINA
53 D ZAP
54 Q
55ZAP ;
56 K SPNIMPAR,SPNASIA,SPNNEUR,SPNRTYP,SPNRSCO,SPNTEST,SPND,SPNE,SPNA,SPNB,SPNC,SPNIMPAR,SPNR1C1,SPNR1C2,SPNR1C3,SPNR1C4,SPNR1C5,SPNR1C6,SPNR2C1,SPNR2C2
57 K SPNR2C3,SPNR2C4,SPNR2C5,SPNR2C6,SPNR3C1,SPNR3C2,SPNR3C3,SPNR3C4,SPNR3C5,SPNR3C6,SPNR4C1,SPNR4C2,SPNR4C3,SPNR4C4,SPNR4C5,SPNR4C6,SPNR5C1,SPNR5C2
58 K SPNR5C3,SPNR5C4,SPNR5C5,SPNR5C6,SPNR6C1,SPNR6C2,SPNR6C3,SPNR6C4,SPNR6C5,SPNR6C6,SPNREAD
59 K SPNR4C7,SPNR5C7,SPNR6C7,SPNR7C1,SPNR7C2,SPNR7C3,SPNR7C4,SPNR7C5,SPNR7C6,SPNR7C7,SPNR7C8,SPNR8C1,SPNR8C2,SPNR8C3,SPNR8C4,SPNR8C5,SPNR8C6,SPNR8C7
60 K SPNR8C8,SPNR9C1,SPNR9C2,SPNR9C3,SPNR9C4,SPNR9C5,SPNR9C6,SPNR9C7,SPNR9C8
61 K SPNXX,SPNY,SPNYY,SPNZZ,XA,SPNZ,SPNGFIS,SPNGOAL,SPNR1C1A,SPNR1C1B,SPNR1C2A,SPNR1C3A,SPNR1C3B,SPNR1C4A,SPNR1C5A,SPNR1C5B,SPNR1C6A,SPNRD,SPNROU,SPNTAG
62 K SPNCLOSE,SPNZOUT
Note: See TracBrowser for help on using the repository browser.