ONCOFTS ;Hines OIFO/GWB - TUMOR STATUS/CANCER STATUS OF PRIMARY ;02/02/00
;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
;
STSM ;CREATE TUMOR STATUS MULTIPLE IN 165.5
;called from "AE" cross-reference of DATE OF LAST CONTACT OR DEATH
;Sub-field (#.01) of FOLLOW-UP Field (#400) of ONCOLOGY PATIENT (#160)
;N VARIABLES
;X=CURRENT FOLLOWUP DATE
;DA=CURRENT FOLLOWUP MULTIPLE ENTRY
;TUMOR STATUS
N MH,LC,K,XD1,XY,XDA1
I '$D(^ONCO(165.5,"C",DA(1))) W:'$D(ZTQUEUED) !!,?5,"Patient ",DA(1)," has no Primaries - cannot track Tumor Status",! ;NO PRIMARIES
E D STSMSET ;Set the primaries
Q
;
STSMSET ;Patient has primaries, so set
N CURFOLDT,PRIMARY
S CURFOLDT=X ;Current Follow-Up Date
S PRIMARY=0
F S PRIMARY=$O(^ONCO(165.5,"C",DA(1),PRIMARY)) Q:PRIMARY="" I $$DIV^ONCFUNC(PRIMARY)=DUZ(2) D
.N DATEDX
.S DATEDX=$P(^ONCO(165.5,PRIMARY,0),U,16)
.I DATEDX="" W:'$D(ZTQUEUED) !,?5," Patient ",DA(1),": DATE DX MISSING for "_$P(^ONCO(164.2,$P(^ONCO(165.5,PRIMARY,0),U),0),U),!?5," NO Tumor Status Followup Created",!!
.E I DATEDX'>CURFOLDT D STSMONE
Q
;
STSMONE ;Look for a corresponding tumor status for this primary, set up if none there
I '$D(^ONCO(165.5,PRIMARY,"TS","B",CURFOLDT)) D ;not defined, set up
.N TUMSTAT
.L +^ONCO(165.5,PRIMARY,"TS"):DILOCKTM
.S:'$D(^ONCO(165.5,PRIMARY,"TS",0)) ^(0)="^165.573DA" ;set header if undefined
.F TUMSTAT=$P(^ONCO(165.5,PRIMARY,"TS",0),U,3)+1:1 Q:'$D(^(TUMSTAT)) ;get index
.S ^ONCO(165.5,PRIMARY,"TS",TUMSTAT,0)=CURFOLDT ;set data
.S ^ONCO(165.5,PRIMARY,"TS","B",CURFOLDT,TUMSTAT)="" ;date xref
.S ^ONCO(165.5,PRIMARY,"TS","AA",9999999-CURFOLDT,TUMSTAT)="" ;inverted date xref
.S $P(^ONCO(165.5,PRIMARY,"TS",0),U,3)=TUMSTAT,$P(^(0),U,4)=$P(^(0),U,4)+1 ;update header
.L -^ONCO(165.5,PRIMARY,"TS")
Q
;
KTSM ;Delete TUMOR STATUS Multiple (#73) in ONCOLOGY PRIMARY File (#165.5)
;corresponding to an entry in the FOLLOW-UP Multiple (#400) in ONCOLOGY PATIENT File (#160)
;Called by KILL Logic of AE Cross-reference of DATE OF LAST CONTACT OR DEATH Sub-field (#.01) of FOLLOW-UP Multiple
;Input DA(1) = internal entry number in ONCOLOGY PATIENT File
; X = date of follow-up to be deleted
N XD1
S XD1=0 F S XD1=$O(^ONCO(165.5,"C",DA(1),XD1)) Q:'XD1 I $$DIV^ONCFUNC(XD1)=DUZ(2) D KTSMA
Q
KTSMA I $D(^ONCO(165.5,XD1,"TS","B",X)) D
.N DIK,DR,DA
.S DA=0
.F S DA=$O(^ONCO(165.5,XD1,"TS","B",X,DA)) Q:'DA D KTSMONE ;kill
Q
;
KTSMONE ;kill a single tumor status sub-record
;DEVELOPERS NOTE: The code is written this way because FileMan blows
;up if you try to make a DIK call from within DIE. Thus this code
;should always be modified if any changes are made to the TUMOR STATUS
;multiple Field (#73) in the ONCOLOGY PRIMARY File (#165.5).
;When FileMan gets his act together, this logic can be simplified
;to a DIK call. MLH 4/14/93
;
;kill xrefs
K ^ONCO(165.5,XD1,"TS","B",X,DA) ;kill date xref (.01,B)
K ^ONCO(165.5,XD1,"TS","AA",9999999-X,DA) ;kill inverse date xref (.01,AA)
D LTS^ONCOU55(XD1,DA) ;reset LAST TUMOR STATUS Field (#95) (.02,AC)
K ^ONCO(165.5,XD1,"TS",DA) ;kill data
S $P(^ONCO(165.5,XD1,"TS",0),U,4)=$P($G(^ONCO(165.5,XD1,"TS",0)),U,4)-1 ;decrement count on header
Q
;
DX ;DATE OF LAST CONTACT OR DEATH (160.04,.01) Input Transform
;At least one DATE DX (165.5,3) must precede DATE OF LAST CONTACT OR
;DEATH
;DATE OF LAST CONTACT OR DEATH must precede DATE@TIME OF DEATH (160,29)
N ONCOF,XD1
S ONCOF=0,XD1=0 F S XD1=$O(^ONCO(165.5,"C",DA(1),XD1)) Q:XD1'>0 S DATEDXZ=$P(^ONCO(165.5,XD1,0),U,16) I (DATEDXZ'>X)!(DATEDXZ="0000000")!(DATEDXZ=8888888)!(DATEDXZ=9999999) S ONCOF=1 Q
I 'ONCOF W !,"DATE DX must precede DATE OF LAST CONTACT OR DEATH",! K X
E D
.N ONCDTD
.S ONCDTD=$P($G(^ONCO(160,D0,1)),U,8)
.I $E(ONCDTD,6,7)="00" Q
.I ONCDTD,ONCDTD<X W !,"DATE OF LAST CONTACT OR DEATH must precede DATE@TIME OF DEATH" K X
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCOFTS 3941 printed Sep 23, 2025@20:01:09 Page 2
ONCOFTS ;Hines OIFO/GWB - TUMOR STATUS/CANCER STATUS OF PRIMARY ;02/02/00
+1 ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
+2 ;
STSM ;CREATE TUMOR STATUS MULTIPLE IN 165.5
+1 ;called from "AE" cross-reference of DATE OF LAST CONTACT OR DEATH
+2 ;Sub-field (#.01) of FOLLOW-UP Field (#400) of ONCOLOGY PATIENT (#160)
+3 ;N VARIABLES
+4 ;X=CURRENT FOLLOWUP DATE
+5 ;DA=CURRENT FOLLOWUP MULTIPLE ENTRY
+6 ;TUMOR STATUS
+7 NEW MH,LC,K,XD1,XY,XDA1
+8 ;NO PRIMARIES
IF '$DATA(^ONCO(165.5,"C",DA(1)))
if '$DATA(ZTQUEUED)
WRITE !!,?5,"Patient ",DA(1)," has no Primaries - cannot track Tumor Status",!
+9 ;Set the primaries
IF '$TEST
DO STSMSET
+10 QUIT
+11 ;
STSMSET ;Patient has primaries, so set
+1 NEW CURFOLDT,PRIMARY
+2 ;Current Follow-Up Date
SET CURFOLDT=X
+3 SET PRIMARY=0
+4 FOR
SET PRIMARY=$ORDER(^ONCO(165.5,"C",DA(1),PRIMARY))
if PRIMARY=""
QUIT
IF $$DIV^ONCFUNC(PRIMARY)=DUZ(2)
Begin DoDot:1
+5 NEW DATEDX
+6 SET DATEDX=$PIECE(^ONCO(165.5,PRIMARY,0),U,16)
+7 IF DATEDX=""
if '$DATA(ZTQUEUED)
WRITE !,?5," Patient ",DA(1),": DATE DX MISSING for "_$PIECE(^ONCO(164.2,$PIECE(^ONCO(165.5,PRIMARY,0),U),0),U),!?5," NO Tumor Status Followup Created",!!
+8 IF '$TEST
IF DATEDX'>CURFOLDT
DO STSMONE
End DoDot:1
+9 QUIT
+10 ;
STSMONE ;Look for a corresponding tumor status for this primary, set up if none there
+1 ;not defined, set up
IF '$DATA(^ONCO(165.5,PRIMARY,"TS","B",CURFOLDT))
Begin DoDot:1
+2 NEW TUMSTAT
+3 LOCK +^ONCO(165.5,PRIMARY,"TS"):DILOCKTM
+4 ;set header if undefined
if '$DATA(^ONCO(165.5,PRIMARY,"TS",0))
SET ^(0)="^165.573DA"
+5 ;get index
FOR TUMSTAT=$PIECE(^ONCO(165.5,PRIMARY,"TS",0),U,3)+1:1
if '$DATA(^(TUMSTAT))
QUIT
+6 ;set data
SET ^ONCO(165.5,PRIMARY,"TS",TUMSTAT,0)=CURFOLDT
+7 ;date xref
SET ^ONCO(165.5,PRIMARY,"TS","B",CURFOLDT,TUMSTAT)=""
+8 ;inverted date xref
SET ^ONCO(165.5,PRIMARY,"TS","AA",9999999-CURFOLDT,TUMSTAT)=""
+9 ;update header
SET $PIECE(^ONCO(165.5,PRIMARY,"TS",0),U,3)=TUMSTAT
SET $PIECE(^(0),U,4)=$PIECE(^(0),U,4)+1
+10 LOCK -^ONCO(165.5,PRIMARY,"TS")
End DoDot:1
+11 QUIT
+12 ;
KTSM ;Delete TUMOR STATUS Multiple (#73) in ONCOLOGY PRIMARY File (#165.5)
+1 ;corresponding to an entry in the FOLLOW-UP Multiple (#400) in ONCOLOGY PATIENT File (#160)
+2 ;Called by KILL Logic of AE Cross-reference of DATE OF LAST CONTACT OR DEATH Sub-field (#.01) of FOLLOW-UP Multiple
+3 ;Input DA(1) = internal entry number in ONCOLOGY PATIENT File
+4 ; X = date of follow-up to be deleted
+5 NEW XD1
+6 SET XD1=0
FOR
SET XD1=$ORDER(^ONCO(165.5,"C",DA(1),XD1))
if 'XD1
QUIT
IF $$DIV^ONCFUNC(XD1)=DUZ(2)
DO KTSMA
+7 QUIT
KTSMA IF $DATA(^ONCO(165.5,XD1,"TS","B",X))
Begin DoDot:1
+1 NEW DIK,DR,DA
+2 SET DA=0
+3 ;kill
FOR
SET DA=$ORDER(^ONCO(165.5,XD1,"TS","B",X,DA))
if 'DA
QUIT
DO KTSMONE
End DoDot:1
+4 QUIT
+5 ;
KTSMONE ;kill a single tumor status sub-record
+1 ;DEVELOPERS NOTE: The code is written this way because FileMan blows
+2 ;up if you try to make a DIK call from within DIE. Thus this code
+3 ;should always be modified if any changes are made to the TUMOR STATUS
+4 ;multiple Field (#73) in the ONCOLOGY PRIMARY File (#165.5).
+5 ;When FileMan gets his act together, this logic can be simplified
+6 ;to a DIK call. MLH 4/14/93
+7 ;
+8 ;kill xrefs
+9 ;kill date xref (.01,B)
KILL ^ONCO(165.5,XD1,"TS","B",X,DA)
+10 ;kill inverse date xref (.01,AA)
KILL ^ONCO(165.5,XD1,"TS","AA",9999999-X,DA)
+11 ;reset LAST TUMOR STATUS Field (#95) (.02,AC)
DO LTS^ONCOU55(XD1,DA)
+12 ;kill data
KILL ^ONCO(165.5,XD1,"TS",DA)
+13 ;decrement count on header
SET $PIECE(^ONCO(165.5,XD1,"TS",0),U,4)=$PIECE($GET(^ONCO(165.5,XD1,"TS",0)),U,4)-1
+14 QUIT
+15 ;
DX ;DATE OF LAST CONTACT OR DEATH (160.04,.01) Input Transform
+1 ;At least one DATE DX (165.5,3) must precede DATE OF LAST CONTACT OR
+2 ;DEATH
+3 ;DATE OF LAST CONTACT OR DEATH must precede DATE@TIME OF DEATH (160,29)
+4 NEW ONCOF,XD1
+5 SET ONCOF=0
SET XD1=0
FOR
SET XD1=$ORDER(^ONCO(165.5,"C",DA(1),XD1))
if XD1'>0
QUIT
SET DATEDXZ=$PIECE(^ONCO(165.5,XD1,0),U,16)
IF (DATEDXZ'>X)!(DATEDXZ="0000000")!(DATEDXZ=8888888)!(DATEDXZ=9999999)
SET ONCOF=1
QUIT
+6 IF 'ONCOF
WRITE !,"DATE DX must precede DATE OF LAST CONTACT OR DEATH",!
KILL X
+7 IF '$TEST
Begin DoDot:1
+8 NEW ONCDTD
+9 SET ONCDTD=$PIECE($GET(^ONCO(160,D0,1)),U,8)
+10 IF $EXTRACT(ONCDTD,6,7)="00"
QUIT
+11 IF ONCDTD
IF ONCDTD<X
WRITE !,"DATE OF LAST CONTACT OR DEATH must precede DATE@TIME OF DEATH"
KILL X
End DoDot:1
+12 QUIT
