source: WorldVistAEHR/trunk/r/ONCOLOGY-ONC/ONCOU55A.m@ 1578

Last change on this file since 1578 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.5 KB
Line 
1ONCOU55A ;Hines OIFO/GWB,RTK-UTILITY ROUTINE 2 ;12/15/99
2 ;;2.11;ONCOLOGY;**6,25,28**;Mar 07, 1995
3 Q ;no direct invocations
4 ;
5RSTG(ONCDDX) ;restage all primaries diagnosed from year YEAR1 forward - called by STAGEM
6 ;ONCDDX:optional parameter - date from which to begin
7 ;default = beginning of time
8 W !!,"This option is no longer available." Q
9 N DXDATE,WRTFLG,SYBIX,SYBIX1,COUNT,COUNTCHG
10 D INIT ;initialize our variables
11 D PROCESS ;process the primaries
12 Q
13 ;
14INIT ;initialize our variables - called by RSTG
15 S (COUNT,COUNTCHG)=0
16 S WRTFLG=0 ; suppress interaction with the stager
17 S SYBIX=$G(^ONCO("RESTAGE",0))+1,^(0)=SYBIX,^(SYBIX,0)=$H,SYBIX1=0 ; indices for use in saving old stage
18 I '$D(ONCDDX) S ONCDDX=0 ; date dx index - will be used in PROC
19 I ONCDDX S ONCDDX=ONCDDX-1E10 ; to catch the first one if we're not starting at the top
20 Q
21 ;
22PROCESS ;Process the primaries - called by RSTG
23 F S ONCDDX=$O(^ONCO(165.5,"ADX",ONCDDX)) Q:ONCDDX="" D
24 .N PRIMIX S PRIMIX=0
25 .F S PRIMIX=$O(^ONCO(165.5,"ADX",ONCDDX,PRIMIX)) Q:PRIMIX="" I $$DIV^ONCFUNC(PRIMIX)=DUZ(2) D PROC1(PRIMIX)
26 ;
27 W !,"Number of primaries processed : ",$J(COUNT,6)
28 W !,"Number of primaries restaged : ",$J(COUNTCHG,6),!!
29 S $P(^ONCO("RESTAGE",SYBIX,0),U,2)=COUNT
30 Q
31 ;
32PROC1(D0) ;process a single primary D0 - called by PROCESS
33 ;save off the old value, calculate and store the new value
34 ;(not user override of stage) AND (tumor not a Lymphoma)
35 I '$$NOSTAGE^ONCOU55(D0),'$$LYMPHOMA^ONCFUNC(D0),'$$MYCOSIS^ONCOU55(D0) D
36 .N OLDSTAGE S OLDSTAGE=$P($G(^ONCO(165.5,D0,2)),U,20) ; get old stage
37 .S SYBIX1=$G(SYBIX1)+1,^ONCO("RESTAGE",SYBIX,SYBIX1,0)=D0_U_OLDSTAGE ; save old stage
38 .S DA=D0 D ES^ONCOTN ; do the staging - returns variable SG
39 .S COUNT=$G(COUNT)+1 ; number processed
40 .I $P($G(^ONCO(165.5,+D0,2)),U,20)'=OLDSTAGE S COUNTCHG=$G(COUNTCHG)+1 ; number changed
41 .W:$R(50)=0 "."
42 Q
43 ;
44STAGEM ;Interact with user to restage primaries
45 ;Called by routine ONCOPOS
46 ;Called by option ONCO #SITE-RESTAGE PRIMARY
47 N FIRST S FIRST=$$RSTGASK()
48 I FIRST<0 W !!,*7,"Restaging aborted - no data changed - continuing...",!!
49 E D RSTG(FIRST) ; start with date returned in Y
50 Q
51 ;
52RSTGASK() ;Function to determine initial restaging date/time
53 N DIR,DTOUT,DUOUT,Y
54 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)"
55 D ^DIR ; returns result in Y
56 I $D(DTOUT)!$D(DUOUT) S Y=-1 ; they bailed out or fell asleep
57 QUIT +Y
Note: See TracBrowser for help on using the repository browser.