ONCOU55A.m

ONCOU55A ;Hines OIFO/GWB,RTK-UTILITY ROUTINE 2 ;12/15/99

 ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8

 Q  ;no direct invocations

 ;

RSTG(ONCDDX) ;restage all primaries diagnosed from year YEAR1 forward - called by STAGEM

 ;ONCDDX:optional parameter - date from which to begin

 ;default = beginning of time

 W !!,"This option is no longer available." Q

 N DXDATE,WRTFLG,SYBIX,SYBIX1,COUNT,COUNTCHG

 D INIT ;initialize our variables

 D PROCESS ;process the primaries

 Q

 ;

INIT ;initialize our variables - called by RSTG

 S (COUNT,COUNTCHG)=0

 S WRTFLG=0 ;    suppress interaction with the stager

 S SYBIX=$G(^ONCO("RESTAGE",0))+1,^(0)=SYBIX,^(SYBIX,0)=$H,SYBIX1=0 ;    indices for use in saving old stage

 I '$D(ONCDDX) S ONCDDX=0 ;    date dx index - will be used in PROC

 I ONCDDX S ONCDDX=ONCDDX-1E10 ;    to catch the first one if we're not starting at the top

 Q

 ;

PROCESS ;Process the primaries - called by RSTG

 F  S ONCDDX=$O(^ONCO(165.5,"ADX",ONCDDX)) Q:ONCDDX=""  D

 .N PRIMIX S PRIMIX=0

 .F  S PRIMIX=$O(^ONCO(165.5,"ADX",ONCDDX,PRIMIX)) Q:PRIMIX=""  I $$DIV^ONCFUNC(PRIMIX)=DUZ(2) D PROC1(PRIMIX)

 ;

 W !,"Number of primaries processed :  ",$J(COUNT,6)

 W !,"Number of primaries restaged  :  ",$J(COUNTCHG,6),!!

 S $P(^ONCO("RESTAGE",SYBIX,0),U,2)=COUNT

 Q

 ;

PROC1(D0) ;process a single primary D0 - called by PROCESS

 ;save off the old value, calculate and store the new value

 ;(not user override of stage) AND (tumor not a Lymphoma)

 I '$$NOSTAGE^ONCOU55(D0),'$$LYMPHOMA^ONCFUNC(D0),'$$MYCOSIS^ONCOU55(D0) D

 .N OLDSTAGE S OLDSTAGE=$P($G(^ONCO(165.5,D0,2)),U,20) ;    get old stage

 .S SYBIX1=$G(SYBIX1)+1,^ONCO("RESTAGE",SYBIX,SYBIX1,0)=D0_U_OLDSTAGE ;    save old stage

 .S DA=D0 D ES^ONCOTN ;    do the staging - returns variable SG

 .S COUNT=$G(COUNT)+1 ;    number processed

 .I $P($G(^ONCO(165.5,+D0,2)),U,20)'=OLDSTAGE S COUNTCHG=$G(COUNTCHG)+1 ;    number changed

 .W:$R(50)=0 "."

 Q

 ;

STAGEM ;Interact with user to restage primaries

 ;Called by routine ONCOPOS

 ;Called by option ONCO #SITE-RESTAGE PRIMARY

 N FIRST S FIRST=$$RSTGASK()

 I FIRST<0 W !!,*7,"Restaging aborted - no data changed - continuing...",!!

 E  D RSTG(FIRST) ;    start with date returned in Y

 Q

 ;

RSTGASK() ;Function to determine initial restaging date/time

 N DIR,DTOUT,DUOUT,Y

 S DIR(0)="DO^2880101:"_DT_":EP",DIR("A")="Beginning date for restaging",DIR("B")="1/1/88",DIR("?")="Enter the date from which to restage all primaries (just the year is fine)"

 D ^DIR ;    returns result in Y

 I $D(DTOUT)!$D(DUOUT) S Y=-1 ;    they bailed out or fell asleep

 QUIT +Y

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---ONCOU55A   2619     printed  Feb 18, 2025@23:52:37                                                                                                                                                                                                    Page 2

ONCOU55A  ;Hines OIFO/GWB,RTK-UTILITY ROUTINE 2 ;12/15/99

 +1       ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8

 +2       ;no direct invocations

           QUIT 

 +3       ;

RSTG(ONCDDX) ;restage all primaries diagnosed from year YEAR1 forward - called by STAGEM

 +1       ;ONCDDX:optional parameter - date from which to begin

 +2       ;default = beginning of time

 +3        WRITE !!,"This option is no longer available."

           QUIT 

 +4        NEW DXDATE,WRTFLG,SYBIX,SYBIX1,COUNT,COUNTCHG

 +5       ;initialize our variables

           DO INIT

 +6       ;process the primaries

           DO PROCESS

 +7        QUIT 

 +8       ;

INIT      ;initialize our variables - called by RSTG

 +1        SET (COUNT,COUNTCHG)=0

 +2       ;    suppress interaction with the stager

           SET WRTFLG=0

 +3       ;    indices for use in saving old stage

           SET SYBIX=$GET(^ONCO("RESTAGE",0))+1

           SET ^(0)=SYBIX

           SET ^(SYBIX,0)=$HOROLOG

           SET SYBIX1=0

 +4       ;    date dx index - will be used in PROC

           IF '$DATA(ONCDDX)

               SET ONCDDX=0

 +5       ;    to catch the first one if we're not starting at the top

           IF ONCDDX

               SET ONCDDX=ONCDDX-1E10

 +6        QUIT 

 +7       ;

PROCESS   ;Process the primaries - called by RSTG

 +1        FOR 

               SET ONCDDX=$ORDER(^ONCO(165.5,"ADX",ONCDDX))

               if ONCDDX=""

                   QUIT 

               Begin DoDot:1

 +2                NEW PRIMIX

                   SET PRIMIX=0

 +3                FOR 

                       SET PRIMIX=$ORDER(^ONCO(165.5,"ADX",ONCDDX,PRIMIX))

                       if PRIMIX=""

                           QUIT 

                       IF $$DIV^ONCFUNC(PRIMIX)=DUZ(2)

                           DO PROC1(PRIMIX)

               End DoDot:1

 +4       ;

 +5        WRITE !,"Number of primaries processed :  ",$JUSTIFY(COUNT,6)

 +6        WRITE !,"Number of primaries restaged  :  ",$JUSTIFY(COUNTCHG,6),!!

 +7        SET $PIECE(^ONCO("RESTAGE",SYBIX,0),U,2)=COUNT

 +8        QUIT 

 +9       ;

PROC1(D0) ;process a single primary D0 - called by PROCESS

 +1       ;save off the old value, calculate and store the new value

 +2       ;(not user override of stage) AND (tumor not a Lymphoma)

 +3        IF '$$NOSTAGE^ONCOU55(D0)

               IF '$$LYMPHOMA^ONCFUNC(D0)

                   IF '$$MYCOSIS^ONCOU55(D0)

                       Begin DoDot:1

 +4       ;    get old stage

                           NEW OLDSTAGE

                           SET OLDSTAGE=$PIECE($GET(^ONCO(165.5,D0,2)),U,20)

 +5       ;    save old stage

                           SET SYBIX1=$GET(SYBIX1)+1

                           SET ^ONCO("RESTAGE",SYBIX,SYBIX1,0)=D0_U_OLDSTAGE

 +6       ;    do the staging - returns variable SG

                           SET DA=D0

                           DO ES^ONCOTN

 +7       ;    number processed

                           SET COUNT=$GET(COUNT)+1

 +8       ;    number changed

                           IF $PIECE($GET(^ONCO(165.5,+D0,2)),U,20)'=OLDSTAGE

                               SET COUNTCHG=$GET(COUNTCHG)+1

 +9                        if $RANDOM(50)=0

                               WRITE "."

                       End DoDot:1

 +10       QUIT 

 +11      ;

STAGEM    ;Interact with user to restage primaries

 +1       ;Called by routine ONCOPOS

 +2       ;Called by option ONCO #SITE-RESTAGE PRIMARY

 +3        NEW FIRST

           SET FIRST=$$RSTGASK()

 +4        IF FIRST<0

               WRITE !!,*7,"Restaging aborted - no data changed - continuing...",!!

 +5       ;    start with date returned in Y

          IF '$TEST

               DO RSTG(FIRST)

 +6        QUIT 

 +7       ;

RSTGASK() ;Function to determine initial restaging date/time

 +1        NEW DIR,DTOUT,DUOUT,Y

 +2        SET DIR(0)="DO^2880101:"_DT_":EP"

           SET DIR("A")="Beginning date for restaging"

           SET DIR("B")="1/1/88"

           SET DIR("?")="Enter the date from which to restage all primaries (just the year is fine)"

 +3       ;    returns result in Y

           DO ^DIR

 +4       ;    they bailed out or fell asleep

           IF $DATA(DTOUT)!$DATA(DUOUT)

               SET Y=-1

 +5        QUIT +Y