ONCOCRFA.m

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 ---ONCOCRFA   1428     printed  Apr 09, 2024@21:28:52                                                                                                                                                                                                    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