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 ---[H[J[2J[HONCOU55A 2619 printed Dec 13, 2024@02:26:07 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
