ONCOCOFA.m

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 ---ONCOCOFA   1318     printed  Apr 09, 2024@21:28:14                                                                                                                                                                                                    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