ONCOAIS ;HINES OIFO/GWB - POST FOLLOW-UP UPDATE PRIMARY CANCER STATUS ;07/12/00
;;2.2;ONCOLOGY;**1,10,17,18**;Jul 31, 2013;Build 5
;
PRI ;TUMOR STATUS - from template [ONCO FOLLOWUP]
I $D(^ONCO(165.5,"C",DA(1))) D
.N XDA1,XY,K S XDA1=DA(1)
.D FINDEM,EDITEM
.S DA(1)=XDA1
E W !,"Patient has no primary registered",!!
Q
;
FINDEM ;Setup/fetch the tumor status subentries from the primary file
N FOLDAT,PRIMIEN
S K=0,PRIMIEN=0,FOLDAT=$P($G(^ONCO(160,DA(1),"F",DA,0)),U,1)
F S PRIMIEN=$O(^ONCO(165.5,"C",DA(1),PRIMIEN)) Q:PRIMIEN="" D
.N DATEDX,TOPOG,TSIEN
.S TOPOG=$P($G(^ONCO(165.5,PRIMIEN,0)),U)
.S DATEDX=$P($G(^ONCO(165.5,PRIMIEN,0)),U,16)
.I TOPOG,DATEDX,DATEDX'>FOLDAT D FINDSET
Q
;
FINDSET ;Find/setup tumor status corresponding to this follow-up
N TSIEN S TSIEN=$O(^ONCO(165.5,PRIMIEN,"TS","B",FOLDAT,0))
I TSIEN,$D(^ONCO(165.5,PRIMIEN,"TS",TSIEN,0))
E S TSIEN=$$SETTS^ONCOU55(PRIMIEN,FOLDAT)
S K=K+1,XY(K)=PRIMIEN_U_TSIEN
Q
;
EDITEM ;Edit Tumor Status for each primary during a follow-up
N Q,XD0,DIE,DR,KK
S Q=0,XD0=DA(1)
S DIE("NO^")=1
S DR=.02
F KK=1:1:K D EDITONE
Q
;
EDITONE ;CANCER STATUS (165.573,.02)
S DR=".02;.03;.04"
N DA
S DA(1)=$P(XY(KK),U),DA=$P(XY(KK),U,2)
I $P($G(^ONCO(165.5,DA(1),0)),"^",16)>3221231 S DR=".02;.03;" ;p17
I DUZ(2)'=$P($G(^ONCO(165.5,DA(1),"DIV")),U,1) Q
S DIE="^ONCO(165.5,"_DA(1)_",""TS"","
W !!,"Updating CANCER STATUS for "_$P($G(^ONCO(164,+$P($G(^ONCO(165.5,DA(1),2)),U),0)),U)_"..."
N DG,DIC,DI,%,DP,DM,DK,DH,DQ,DIEL,DL,DC,X,Y
L +^ONCO(165.5,DA(1)):0 I $T D ^DIE L -^ONCO(165.5,DA(1)) D Q
.Q
;S TOFRE=$$GET1^DIQ(165.5,DA(1),71,"E")
;S TOFR=$$GET1^DIQ(165.5,DA(1),71,"I")
;I TOFR'="" S TOFR=$P($G(^ONCO(160.12,TOFR,0)),U,1)
;S LTS=$$GET1^DIQ(165.5,DA(1),95,"I")
;I TOFR="00",LTS'=1 D W ! D ERRMSG^ONCEDIT
;S MSG(1)="TYPE OF FIRST RECURRENCE = 00 ("_TOFRE_")"
;S MSG(2)="CANCER STATUS must be 1 (No evidence of this tumor)"
;I TOFR=70,LTS'=2 D W ! D ERRMSG^ONCEDIT
;S MSG(1)="TYPE OF FIRST RECURRENCE = 70 ("_TOFRE_")"
;S MSG(2)="CANCER STATUS must be 2 (Evidence of this tumor)"
;I TOFR=99,LTS'=9 D W ! D ERRMSG^ONCEDIT
;S MSG(1)="TYPE OF FIRST RECURRENCE = 99 ("_TOFRE_")"
;S MSG(2)="CANCER STATUS must be 9 (Unknown if recurred or disease-free"
W !,"This primary is being edited by another user."
Q
;
TEMP451 ;Point of entry from input template [ONCO FOLLOWUP]
S (ONCOVS,VS)=X
D PRI
S Y="@1001"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCOAIS 2480 printed Sep 23, 2025@20:00:23 Page 2
ONCOAIS ;HINES OIFO/GWB - POST FOLLOW-UP UPDATE PRIMARY CANCER STATUS ;07/12/00
+1 ;;2.2;ONCOLOGY;**1,10,17,18**;Jul 31, 2013;Build 5
+2 ;
PRI ;TUMOR STATUS - from template [ONCO FOLLOWUP]
+1 IF $DATA(^ONCO(165.5,"C",DA(1)))
Begin DoDot:1
+2 NEW XDA1,XY,K
SET XDA1=DA(1)
+3 DO FINDEM
DO EDITEM
+4 SET DA(1)=XDA1
End DoDot:1
+5 IF '$TEST
WRITE !,"Patient has no primary registered",!!
+6 QUIT
+7 ;
FINDEM ;Setup/fetch the tumor status subentries from the primary file
+1 NEW FOLDAT,PRIMIEN
+2 SET K=0
SET PRIMIEN=0
SET FOLDAT=$PIECE($GET(^ONCO(160,DA(1),"F",DA,0)),U,1)
+3 FOR
SET PRIMIEN=$ORDER(^ONCO(165.5,"C",DA(1),PRIMIEN))
if PRIMIEN=""
QUIT
Begin DoDot:1
+4 NEW DATEDX,TOPOG,TSIEN
+5 SET TOPOG=$PIECE($GET(^ONCO(165.5,PRIMIEN,0)),U)
+6 SET DATEDX=$PIECE($GET(^ONCO(165.5,PRIMIEN,0)),U,16)
+7 IF TOPOG
IF DATEDX
IF DATEDX'>FOLDAT
DO FINDSET
End DoDot:1
+8 QUIT
+9 ;
FINDSET ;Find/setup tumor status corresponding to this follow-up
+1 NEW TSIEN
SET TSIEN=$ORDER(^ONCO(165.5,PRIMIEN,"TS","B",FOLDAT,0))
+2 IF TSIEN
IF $DATA(^ONCO(165.5,PRIMIEN,"TS",TSIEN,0))
+3 IF '$TEST
SET TSIEN=$$SETTS^ONCOU55(PRIMIEN,FOLDAT)
+4 SET K=K+1
SET XY(K)=PRIMIEN_U_TSIEN
+5 QUIT
+6 ;
EDITEM ;Edit Tumor Status for each primary during a follow-up
+1 NEW Q,XD0,DIE,DR,KK
+2 SET Q=0
SET XD0=DA(1)
+3 SET DIE("NO^")=1
+4 SET DR=.02
+5 FOR KK=1:1:K
DO EDITONE
+6 QUIT
+7 ;
EDITONE ;CANCER STATUS (165.573,.02)
+1 SET DR=".02;.03;.04"
+2 NEW DA
+3 SET DA(1)=$PIECE(XY(KK),U)
SET DA=$PIECE(XY(KK),U,2)
+4 ;p17
IF $PIECE($GET(^ONCO(165.5,DA(1),0)),"^",16)>3221231
SET DR=".02;.03;"
+5 IF DUZ(2)'=$PIECE($GET(^ONCO(165.5,DA(1),"DIV")),U,1)
QUIT
+6 SET DIE="^ONCO(165.5,"_DA(1)_",""TS"","
+7 WRITE !!,"Updating CANCER STATUS for "_$PIECE($GET(^ONCO(164,+$PIECE($GET(^ONCO(165.5,DA(1),2)),U),0)),U)_"..."
+8 NEW DG,DIC,DI,%,DP,DM,DK,DH,DQ,DIEL,DL,DC,X,Y
+9 LOCK +^ONCO(165.5,DA(1)):0
IF $TEST
DO ^DIE
LOCK -^ONCO(165.5,DA(1))
Begin DoDot:1
+10 QUIT
End DoDot:1
QUIT
+11 ;S TOFRE=$$GET1^DIQ(165.5,DA(1),71,"E")
+12 ;S TOFR=$$GET1^DIQ(165.5,DA(1),71,"I")
+13 ;I TOFR'="" S TOFR=$P($G(^ONCO(160.12,TOFR,0)),U,1)
+14 ;S LTS=$$GET1^DIQ(165.5,DA(1),95,"I")
+15 ;I TOFR="00",LTS'=1 D W ! D ERRMSG^ONCEDIT
+16 ;S MSG(1)="TYPE OF FIRST RECURRENCE = 00 ("_TOFRE_")"
+17 ;S MSG(2)="CANCER STATUS must be 1 (No evidence of this tumor)"
+18 ;I TOFR=70,LTS'=2 D W ! D ERRMSG^ONCEDIT
+19 ;S MSG(1)="TYPE OF FIRST RECURRENCE = 70 ("_TOFRE_")"
+20 ;S MSG(2)="CANCER STATUS must be 2 (Evidence of this tumor)"
+21 ;I TOFR=99,LTS'=9 D W ! D ERRMSG^ONCEDIT
+22 ;S MSG(1)="TYPE OF FIRST RECURRENCE = 99 ("_TOFRE_")"
+23 ;S MSG(2)="CANCER STATUS must be 9 (Unknown if recurred or disease-free"
+24 WRITE !,"This primary is being edited by another user."
+25 QUIT
+26 ;
TEMP451 ;Point of entry from input template [ONCO FOLLOWUP]
+1 SET (ONCOVS,VS)=X
+2 DO PRI
+3 SET Y="@1001"
+4 QUIT
