ONCOCRFA ;WASH ISC/SRR,MLH - FOLLOWUP XREF HELPER - UPDATE VITAL STATUS ;4/23/93 10:49
;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
Q ;NOT A RUN ROUTINE
;
UVS ; update vital status
N VS,OVS,IC
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)
I OVS'="" K ^ONCO(160,"AS",OVS,XD0) ; kill old xref
S $P(^ONCO(160,XD0,1),U)=VS ; set new vital status
I VS'="" S ^ONCO(160,"AS",VS,XD0)="" ; set new xref
;
D @$S(VS:"UVSALIVE",1:"UVSDEAD") ; update patient fields depending on vital status
QUIT
;
UVSALIVE ; clear death fields for living patient
N R1,L1
S R1=$G(^ONCO(160,XD0,1)) ; scalar node containing the death fields
; clear fields 19,20,21,29,23,24,24.5,18.9,22.9,24.6
F I=3,4,5,8,9,10,11,12,13,14 I $L($P(R1,U,I)) S $P(R1,U,I)=""
; remove extraneous up-arrows
F S L1=$L(R1) Q:$E(R1,L1)'=U S R1=$E(R1,1,L1-1)
; reset node to the file
S ^ONCO(160,XD0,1)=R1
;
; clear path report WP node
K ^ONCO(160,XD0,4)
Q
;
UVSDEAD ; update follow-up and date of death fields for dead patient
N NF
S NF=$P($G(^ONCO(160,XD0,1)),U,2),$P(^(1),U,2)="" ; get & clear date of next f-u (field 27)
I NF'="" K ^ONCO(160,"AD",NF,XD0) ; kill f-u xref
;
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)
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCOCRFA 1428 printed Nov 22, 2024@17:34:48 Page 2
ONCOCRFA ;WASH ISC/SRR,MLH - FOLLOWUP XREF HELPER - UPDATE VITAL STATUS ;4/23/93 10:49
+1 ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
+2 ;NOT A RUN ROUTINE
QUIT
+3 ;
UVS ; update vital status
+1 NEW VS,OVS,IC
+2 ; get vital status (from follow-up), old vital status (from onco pat rec)
SET VS=$PIECE(LD,U,2)
SET OVS=$PIECE($GET(^ONCO(160,XD0,1)),U)
+3 ; kill old xref
IF OVS'=""
KILL ^ONCO(160,"AS",OVS,XD0)
+4 ; set new vital status
SET $PIECE(^ONCO(160,XD0,1),U)=VS
+5 ; set new xref
IF VS'=""
SET ^ONCO(160,"AS",VS,XD0)=""
+6 ;
+7 ; update patient fields depending on vital status
DO @$SELECT(VS:"UVSALIVE",1:"UVSDEAD")
+8 QUIT
+9 ;
UVSALIVE ; clear death fields for living patient
+1 NEW R1,L1
+2 ; scalar node containing the death fields
SET R1=$GET(^ONCO(160,XD0,1))
+3 ; clear fields 19,20,21,29,23,24,24.5,18.9,22.9,24.6
+4 FOR I=3,4,5,8,9,10,11,12,13,14
IF $LENGTH($PIECE(R1,U,I))
SET $PIECE(R1,U,I)=""
+5 ; remove extraneous up-arrows
+6 FOR
SET L1=$LENGTH(R1)
if $EXTRACT(R1,L1)'=U
QUIT
SET R1=$EXTRACT(R1,1,L1-1)
+7 ; reset node to the file
+8 SET ^ONCO(160,XD0,1)=R1
+9 ;
+10 ; clear path report WP node
+11 KILL ^ONCO(160,XD0,4)
+12 QUIT
+13 ;
UVSDEAD ; update follow-up and date of death fields for dead patient
+1 NEW NF
+2 ; get & clear date of next f-u (field 27)
SET NF=$PIECE($GET(^ONCO(160,XD0,1)),U,2)
SET $PIECE(^(1),U,2)=""
+3 ; kill f-u xref
IF NF'=""
KILL ^ONCO(160,"AD",NF,XD0)
+4 ;
+5 ; reset date@time of death and ICD revision (fields 29, 20)
SET $PIECE(^ONCO(160,XD0,1),U,8)=$PIECE(LD,U)
SET $PIECE(^(1),U,4)=9
+6 ;
+7 QUIT
