| 1 | ONCOCRFA ;WASH ISC/SRR,MLH - FOLLOWUP XREF HELPER - UPDATE VITAL STATUS ;4/23/93 10:49
|
|---|
| 2 | ;;2.11;ONCOLOGY;;Mar 07, 1995
|
|---|
| 3 | Q ;NOT A RUN ROUTINE
|
|---|
| 4 | ;
|
|---|
| 5 | UVS ; update vital status
|
|---|
| 6 | N VS,OVS,IC
|
|---|
| 7 | S VS=$P(LD,U,2),OVS=$P($G(^ONCO(160,XD0,1)),U) ; get vital status (from follow-up), old vital status (from onco pat rec)
|
|---|
| 8 | I OVS'="" K ^ONCO(160,"AS",OVS,XD0) ; kill old xref
|
|---|
| 9 | S $P(^ONCO(160,XD0,1),U)=VS ; set new vital status
|
|---|
| 10 | I VS'="" S ^ONCO(160,"AS",VS,XD0)="" ; set new xref
|
|---|
| 11 | ;
|
|---|
| 12 | D @$S(VS:"UVSALIVE",1:"UVSDEAD") ; update patient fields depending on vital status
|
|---|
| 13 | QUIT
|
|---|
| 14 | ;
|
|---|
| 15 | UVSALIVE ; clear death fields for living patient
|
|---|
| 16 | N R1,L1
|
|---|
| 17 | S R1=$G(^ONCO(160,XD0,1)) ; scalar node containing the death fields
|
|---|
| 18 | ; clear fields 19,20,21,29,23,24,24.5,18.9,22.9,24.6
|
|---|
| 19 | F I=3,4,5,8,9,10,11,12,13,14 I $L($P(R1,U,I)) S $P(R1,U,I)=""
|
|---|
| 20 | ; remove extraneous up-arrows
|
|---|
| 21 | F S L1=$L(R1) Q:$E(R1,L1)'=U S R1=$E(R1,1,L1-1)
|
|---|
| 22 | ; reset node to the file
|
|---|
| 23 | S ^ONCO(160,XD0,1)=R1
|
|---|
| 24 | ;
|
|---|
| 25 | ; clear path report WP node
|
|---|
| 26 | K ^ONCO(160,XD0,4)
|
|---|
| 27 | Q
|
|---|
| 28 | ;
|
|---|
| 29 | UVSDEAD ; update follow-up and date of death fields for dead patient
|
|---|
| 30 | N NF
|
|---|
| 31 | S NF=$P($G(^ONCO(160,XD0,1)),U,2),$P(^(1),U,2)="" ; get & clear date of next f-u (field 27)
|
|---|
| 32 | I NF'="" K ^ONCO(160,"AD",NF,XD0) ; kill f-u xref
|
|---|
| 33 | ;
|
|---|
| 34 | S $P(^ONCO(160,XD0,1),U,8)=$P(LD,U),$P(^(1),U,4)=9 ; reset date@time of death and ICD revision (fields 29, 20)
|
|---|
| 35 | ;
|
|---|
| 36 | Q
|
|---|
