ONCOCOFA ;Hines OIFO - COMPUTED FIELDS FOR FOLLOW-UP ;6/23/93 09:59
;;2.2;ONCOLOGY;**1,10**;Jul 31, 2013;Build 20
;
MTS ;Multiple TUMOR STATUS within FOLLOWUP
;Called by FHC^ONCODLF,FHP^ONCODLF
N JTOT,JACT,K,XY,PDIAGDT
I '$D(^ONCO(165.5,"C",D0)) W ?30,"NO Primaries Defined",! Q
S PD0=0,(JTOT,JACT)=0
F S PD0=$O(^ONCO(165.5,"C",D0,PD0)) Q:PD0'>0 I $$DIV^ONCFUNC(PD0)=DUZ(2) S PDIAGDT=$P($G(^ONCO(165.5,PD0,0)),U,16) S JTOT=JTOT+1 I PDIAGDT,PDIAGDT'>FDAT S JACT=JACT+1,XY(JACT)=PD0
D MTSWLP
Q
;
MTSWLP ;Multiple tumor status write loop - called from MTS if >1 primary
N K
F K=1:1:JACT D
.N PD0,ST,ST1,STNUM,ST1NUM,TD1,TS
.S PD0=XY(K)
.;S ST=$$GETVAL^ONCOU(165.5,PD0,.01)
.S STNUM=$P($G(^ONCO(165.5,PD0,0)),"^",1),ST=$P($G(^ONCO(164.2,STNUM,0)),"^",1)
.;S ST1=$$GETVAL^ONCOU(165.5,PD0,20) S:ST1'="" ST=ST1
.S ST1NUM=$P($G(^ONCO(165.5,PD0,2)),"^",1),ST1=$P($G(^ONCO(164,ST1NUM,0)),"^",1) S:ST1'="" ST=ST1
.S TD1=+$O(^ONCO(165.5,PD0,"TS","B",+FDAT,0))
.;S TS="" S:TD1 TS=$$GETVAL^ONCOU(165.5,PD0,73,TD1,.02)
.S TS="" S:TD1 TSNUM=$P($G(^ONCO(165.5,PD0,"TS",TD1,0)),"^",2),TS=$P($G(^ONCO(164.42,TSNUM,0)),"^",1)
.K DOTS S $P(DOTS,".",30-$L(ST))="."
.W !?2,ST,$G(DOTS),": ",$S(TS="":"Tumor Status not stated",1:TS) W:K=JACT !
Q
;
EX ;EXIT
K PA,PB,PC,PD,PE,PL,X0
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCOCOFA 1318 printed Dec 13, 2024@02:24:37 Page 2
ONCOCOFA ;Hines OIFO - COMPUTED FIELDS FOR FOLLOW-UP ;6/23/93 09:59
+1 ;;2.2;ONCOLOGY;**1,10**;Jul 31, 2013;Build 20
+2 ;
MTS ;Multiple TUMOR STATUS within FOLLOWUP
+1 ;Called by FHC^ONCODLF,FHP^ONCODLF
+2 NEW JTOT,JACT,K,XY,PDIAGDT
+3 IF '$DATA(^ONCO(165.5,"C",D0))
WRITE ?30,"NO Primaries Defined",!
QUIT
+4 SET PD0=0
SET (JTOT,JACT)=0
+5 FOR
SET PD0=$ORDER(^ONCO(165.5,"C",D0,PD0))
if PD0'>0
QUIT
IF $$DIV^ONCFUNC(PD0)=DUZ(2)
SET PDIAGDT=$PIECE($GET(^ONCO(165.5,PD0,0)),U,16)
SET JTOT=JTOT+1
IF PDIAGDT
IF PDIAGDT'>FDAT
SET JACT=JACT+1
SET XY(JACT)=PD0
+6 DO MTSWLP
+7 QUIT
+8 ;
MTSWLP ;Multiple tumor status write loop - called from MTS if >1 primary
+1 NEW K
+2 FOR K=1:1:JACT
Begin DoDot:1
+3 NEW PD0,ST,ST1,STNUM,ST1NUM,TD1,TS
+4 SET PD0=XY(K)
+5 ;S ST=$$GETVAL^ONCOU(165.5,PD0,.01)
+6 SET STNUM=$PIECE($GET(^ONCO(165.5,PD0,0)),"^",1)
SET ST=$PIECE($GET(^ONCO(164.2,STNUM,0)),"^",1)
+7 ;S ST1=$$GETVAL^ONCOU(165.5,PD0,20) S:ST1'="" ST=ST1
+8 SET ST1NUM=$PIECE($GET(^ONCO(165.5,PD0,2)),"^",1)
SET ST1=$PIECE($GET(^ONCO(164,ST1NUM,0)),"^",1)
if ST1'=""
SET ST=ST1
+9 SET TD1=+$ORDER(^ONCO(165.5,PD0,"TS","B",+FDAT,0))
+10 ;S TS="" S:TD1 TS=$$GETVAL^ONCOU(165.5,PD0,73,TD1,.02)
+11 SET TS=""
if TD1
SET TSNUM=$PIECE($GET(^ONCO(165.5,PD0,"TS",TD1,0)),"^",2)
SET TS=$PIECE($GET(^ONCO(164.42,TSNUM,0)),"^",1)
+12 KILL DOTS
SET $PIECE(DOTS,".",30-$LENGTH(ST))="."
+13 WRITE !?2,ST,$GET(DOTS),": ",$SELECT(TS="":"Tumor Status not stated",1:TS)
if K=JACT
WRITE !
End DoDot:1
+14 QUIT
+15 ;
EX ;EXIT
+1 KILL PA,PB,PC,PD,PE,PL,X0
+2 QUIT
