63 lines
3.2 KiB
Mathematica
63 lines
3.2 KiB
Mathematica
SPNOGRDA ;WDE/SD OUTCOME GRID STARTING POINT 8/22/02
|
|
;;2.0;Spinal Cord Dysfunction;**19,22**;01/02/1997
|
|
EN ;
|
|
;This is the starting routine for the grid displays
|
|
;in order for a grid to be displayed there must be an ASIA
|
|
;outcome on file in the episode and it must be a score type of start
|
|
;must test the current outcome as it may be a new one added
|
|
;to the current episode. On new add's it will not be in the tmp array
|
|
; spntest=1 we have an asia and it has a score type of 1 or 6
|
|
;
|
|
;
|
|
;episode must have an asia test area
|
|
S SPNTEST=0
|
|
S:'$D(DA) DA=SPNFD0
|
|
S SPND=$G(^SPNL(154.1,DA,0)) I SPND'="" D
|
|
.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)
|
|
;
|
|
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
|
|
.;test for record an ASIA and score type 1 or 6
|
|
.; being on file in the episode
|
|
.S SPND=$G(^SPNL(154.1,SPNC,0)) Q:SPND=""
|
|
.I $P(SPND,U,2)'=3 Q ;not an ASIA outcome
|
|
.S SPNE=$P($G(^SPNL(154.1,SPNC,2)),U,17) Q:SPNE=""
|
|
.I 16'[SPNE S (SPND,SPNE)="" Q
|
|
.S SPNTEST=1 S SPNASIA=SPNC,SPNIMPAR=$P($G(^SPNL(154.1,SPNC,"ASIA")),U,1),SPNNEUR=$$GET1^DIQ(154.1,SPNC_",",7.14)
|
|
;
|
|
;spntest = 1 we have an ASIA outcome with a score type of start
|
|
;in the current episode
|
|
;
|
|
;
|
|
SET ;
|
|
;if no asia on file
|
|
S SPNRTYP=$P($G(^SPNL(154.1,DA,0)),U,2)
|
|
S SPNRSCO=$P($G(^SPNL(154.1,DA,2)),U,17)
|
|
I SPNRTYP=2 I (SPNRSCO=4)!(SPNRSCO=5)!(SPNRSCO=9)!(SPNRSCO=10) D EN^SPNGFIMH
|
|
;spnrtyp & spnrsco need to be reset here. If the above code is ran
|
|
;clean up is done and the next grid will be ready to load..
|
|
S SPNRTYP=$P($G(^SPNL(154.1,DA,0)),U,2)
|
|
S SPNRSCO=$P($G(^SPNL(154.1,DA,2)),U,17)
|
|
I SPNRTYP=6 I (SPNRSCO=4)!(SPNRSCO=5)!(SPNRSCO=9)!(SPNRSCO=10) D EN^SPNGDINH D ZAP Q
|
|
I SPNRTYP=5 I (SPNRSCO=4)!(SPNRSCO=5)!(SPNRSCO=9)!(SPNRSCO=10) D EN^SPNGFAMH D ZAP Q
|
|
I SPNRTYP=4 I (SPNRSCO=4)!(SPNRSCO=5)!(SPNRSCO=9)!(SPNRSCO=10) D EN^SPNGCHRH D ZAP Q
|
|
;the following grids need to have an asia start on file
|
|
I $D(SPNIMPAR)=0 D ZAP Q
|
|
I SPNIMPAR="" D ZAP Q
|
|
I SPNASIA="" D ZAP Q
|
|
I SPNNEUR="" D ZAP Q
|
|
S SPNRTYP=$P($G(^SPNL(154.1,DA,0)),U,2)
|
|
S SPNRSCO=$P($G(^SPNL(154.1,DA,2)),U,17)
|
|
I SPNRTYP=2 I 16[SPNRSCO D EN^SPNGFIMA
|
|
I SPNRTYP=2 I 4[SPNRSCO D EN^SPNGFIMK
|
|
I SPNRTYP=6 I 16[SPNRSCO D EN^SPNGDINA
|
|
D ZAP
|
|
Q
|
|
ZAP ;
|
|
K SPNIMPAR,SPNASIA,SPNNEUR,SPNRTYP,SPNRSCO,SPNTEST,SPND,SPNE,SPNA,SPNB,SPNC,SPNIMPAR,SPNR1C1,SPNR1C2,SPNR1C3,SPNR1C4,SPNR1C5,SPNR1C6,SPNR2C1,SPNR2C2
|
|
K SPNR2C3,SPNR2C4,SPNR2C5,SPNR2C6,SPNR3C1,SPNR3C2,SPNR3C3,SPNR3C4,SPNR3C5,SPNR3C6,SPNR4C1,SPNR4C2,SPNR4C3,SPNR4C4,SPNR4C5,SPNR4C6,SPNR5C1,SPNR5C2
|
|
K SPNR5C3,SPNR5C4,SPNR5C5,SPNR5C6,SPNR6C1,SPNR6C2,SPNR6C3,SPNR6C4,SPNR6C5,SPNR6C6,SPNREAD
|
|
K SPNR4C7,SPNR5C7,SPNR6C7,SPNR7C1,SPNR7C2,SPNR7C3,SPNR7C4,SPNR7C5,SPNR7C6,SPNR7C7,SPNR7C8,SPNR8C1,SPNR8C2,SPNR8C3,SPNR8C4,SPNR8C5,SPNR8C6,SPNR8C7
|
|
K SPNR8C8,SPNR9C1,SPNR9C2,SPNR9C3,SPNR9C4,SPNR9C5,SPNR9C6,SPNR9C7,SPNR9C8
|
|
K SPNXX,SPNY,SPNYY,SPNZZ,XA,SPNZ,SPNGFIS,SPNGOAL,SPNR1C1A,SPNR1C1B,SPNR1C2A,SPNR1C3A,SPNR1C3B,SPNR1C4A,SPNR1C5A,SPNR1C5B,SPNR1C6A,SPNRD,SPNROU,SPNTAG
|
|
K SPNCLOSE,SPNZOUT
|