141 lines
4.5 KiB
Mathematica
141 lines
4.5 KiB
Mathematica
ONCOCOF ;Hines OIFO/GWB - COMPUTED FIELDS FOR FOLLOW-UP ;12/13/99
|
|
;;2.11;ONCOLOGY;**13,25,28,39,41,45**;Mar 07, 1995
|
|
NM ;HOSPITAL NAME (160.1,.01)
|
|
S XD0=$O(^ONCO(160.1,"C",DUZ(2),0))
|
|
I XD0="" S XD0=$O(^ONCO(160.1,0))
|
|
I XD0'="" S X=$P(^ONCO(160.1,XD0,0),U,1)
|
|
G EX
|
|
;
|
|
ADD ;STREET ADDRESS (160.1,.02)
|
|
S XD0=$O(^ONCO(160.1,"C",DUZ(2),0))
|
|
I XD0="" S XD0=$O(^ONCO(160.1,0))
|
|
I XD0'="" S X=$P(^ONCO(160.1,XD0,0),U,2)
|
|
G EX
|
|
;
|
|
ZIP ;ZIPCODE (160.1,.03) Compute city and state.
|
|
S XD0=$O(^ONCO(160.1,"C",DUZ(2),0))
|
|
I XD0="" S XD0=$O(^ONCO(160.1,0))
|
|
I XD0'="" S X=$P(^ONCO(160.1,XD0,0),U,3)
|
|
S X=$G(^VIC(5.11,+X,0)) G EX:X=""
|
|
S CTP=$P(X,U,3),STP=$P(^VIC(5.1,+CTP,0),U,2) G EX:STP=""
|
|
S ST=$P(^DIC(5,+STP,0),U,2) G EX:ST=""
|
|
S X=$P(X,U,2)_","_ST_" "_$P(X,U)
|
|
G EX
|
|
;
|
|
FR ;[RS Registry Summary Reports - Follow Up]
|
|
N SITECODE,SITENAME,AA,AB,AC,AD,AE,AF,CC,AS,PP,VV,SS,SFC,PSFC
|
|
F SITENAME="CERVIX","SKIN" D
|
|
.S DIC=164.2,DIC(0)="O",X=SITENAME
|
|
.D ^DIC K DIC,X
|
|
.S SITECODE(SITENAME)=+Y
|
|
K ^TMP($J)
|
|
S (T,AB,AC,AS,AF,AN,AA,CC)=0
|
|
D TOTCASE
|
|
S T=AA+AN
|
|
S X0=0 F S X0=$O(^TMP($J,X0)) Q:X0'>0 D
|
|
.S ST=$P($G(^ONCO(165.5,X0,0)),U)
|
|
.S MO=$$HIST^ONCFUNC(X0)
|
|
.S SUMSTG=$P($G(^ONCO(165.5,X0,2)),U,17)
|
|
.S BEH=$E(MO,5)
|
|
.D SUB
|
|
S AA=AA-AB-AC-AS-CC
|
|
S FR=T_U_AB_U_AC_U_AS
|
|
S (AB,AC,AD,AE,AF)=0
|
|
S X0=0 F S X0=$O(^TMP($J,X0)) Q:X0'>0 S PP=$P(^ONCO(165.5,X0,0),U,2),VV=$G(^ONCO(160,PP,1)),ONCODF=$P(VV,U,2),AS=$P(VV,U,7),VV=$P(VV,U) D F
|
|
S AC=AA-AB
|
|
I AA S PB=$J(AB/AA,0,2)*100,PC=$J(AC/AA,0,2)*100,PD=$J(AD/AA,0,2)*100,PE=$J(AE/AA,0,2)*100
|
|
E S (PB,PC,PD,PE)="N/A" ;avoid division by zero
|
|
I AC S PA=$J(AD/AC,0,2)*100,PL=$J(AE/AC,0,2)*100
|
|
E S (PA,PL)="N/A" ;avoid division by zero
|
|
S SFC=AA-AE
|
|
S PSFC=$J(SFC/AA,0,2)*100
|
|
S FR=FR_U_AF_U_AN_U_AA_U_AB_U_AC_U_PC_U_PB_U_AD_U_PD_U_AE_U_PE_U_PA_U_PL_U_SFC_U_PSFC_U_CC
|
|
S AS=$O(^ONCO(160.1,"C",DUZ(2),0))
|
|
I AS="" S AS=$O(^ONCO(160.1,0))
|
|
S ^ONCO(160.1,AS,"FR")=FR
|
|
;
|
|
TT ;RUN FOLLOWUP RATE FORM
|
|
I ONCOS("F")=1 S DIC=160.2,DIC(0)="",X="FOLLOWUP RATE REPORT 1" D ^DIC K DIC,X
|
|
I ONCOS("F")=2 S DIC=160.2,DIC(0)="",X="FOLLOWUP RATE REPORT" D ^DIC K DIC,X
|
|
S IOP=ION
|
|
S DIWF="^ONCO(160.2,"_(+Y)_",1,",DIWF(1)="160.1"
|
|
S BY="NUMBER"
|
|
S (FR,TO)=$O(^ONCO(160.1,"C",DUZ(2),0))
|
|
I FR="" S (FR,TO)=$O(^ONCO(160.1,0))
|
|
W !!
|
|
D EN2^DIWF K DIWF,BY,FR,TO S IOP=ION D ^%ZIS
|
|
Q
|
|
;
|
|
TOTCASE ;Total cases
|
|
N VASITE,ONCOPARS,REFDATE,XD0,EOF,XD1
|
|
S VASITE=$O(^ONCO(160.1,"C",DUZ(2),0))
|
|
I VASITE="" S VASITE=$O(^ONCO(160.1,0))
|
|
S ONCOPARS=$G(^ONCO(160.1,VASITE,0))
|
|
S REFDATE=$P(ONCOPARS,U,4)
|
|
S XD0=REFDATE,EOF=0
|
|
S MINUS5=DT-50000
|
|
I ONCOS("F")=2,MINUS5>REFDATE S XD0=MINUS5
|
|
F D Q:EOF
|
|
.S XD1=""
|
|
.F S XD1=$O(^ONCO(165.5,"ADX",XD0,XD1)) Q:'XD1 I $$DIV^ONCFUNC(XD1)=DUZ(2) D
|
|
..S DATEDX=$P($G(^ONCO(165.5,XD1,0)),U,16)
|
|
..S COC=$P($G(^ONCO(165.5,XD1,0)),U,4)
|
|
..I COC>2 S AN=AN+1
|
|
..;I (COC>2)!((COC=0)&(DATEDX>3051231)) S AN=AN+1
|
|
..E S AA=AA+1,^TMP($J,XD1)=""
|
|
.S XD0=$O(^ONCO(165.5,"ADX",XD0))
|
|
.I 'XD0 S EOF=1
|
|
Q
|
|
;
|
|
SUB ;Subtract non-reportables
|
|
I ST="" S AA=AA-1 D KIL Q ;No SITE/GP
|
|
I BEH=0!(BEH=1) S AB=AB+1 D KIL Q ;Less benign/borderline
|
|
I ST=SITECODE("CERVIX"),BEH=2 S AC=AC+1 D KIL Q ;Less carcinoma in situof CERVIX
|
|
I ST=SITECODE("SKIN"),MO>80699,MO<80944,(BEH=0)!(BEH=1)!(BEH=2)!(BEH=3),(SUMSTG=0)!(SUMSTG=1) S AS=AS+1 D KIL Q ;Less in situ/localized basal and squamous cell carcinoma of skin
|
|
S DATEDX=$P($G(^ONCO(165.5,X0,0)),U,16)
|
|
S COC=$P($G(^ONCO(165.5,X0,0)),U,4)
|
|
I (COC=0)&(DATEDX>3051231) S CC=CC+1 D KIL ;Less 2006+ CLASS OF CASE 0 cases
|
|
Q
|
|
;
|
|
F ;Foreign residents and LTF
|
|
I VV&'AS S X1=$O(^ONCO(160,PP,"F","AA",0)) I X1'="" S LC=$O(^(X1,0)),FS=$P(^ONCO(160,PP,"F",LC,0),U,6) I FS=8 S AF=AF+1,AA=AA-1 D KIL Q
|
|
I 'VV S AB=AB+1 D KIL Q
|
|
S X2=ONCODF,X1=DT D ^%DTC I X<91.25 S AD=AD+1 Q
|
|
S AE=AE+1
|
|
Q
|
|
;
|
|
KIL ;Remove entry
|
|
K ^TMP($J,X0)
|
|
Q
|
|
;
|
|
SS ;Suspense Status display
|
|
S XD0=D0 D DLC^ONCOCRF,DATEOT^ONCOES S LC=X
|
|
W:X'="" ?25,"Date Last Contact: ",LC
|
|
D SDD^ONCOCOM
|
|
Q
|
|
;
|
|
MTS ;Multiple Tumor Status at Death (last followup)
|
|
N D1
|
|
G EX:$P($G(^ONCO(160,D0,1)),U) ;quit if alive
|
|
S D1=$O(^ONCO(160,D0,"F","AA",0)) I D1'="" S D1=$O(^(D1,0)) D TS:D1'="" Q
|
|
;
|
|
TS ;Display SITE/GP (165.5,.01): LAST TUMOR STATUS (165.5,95)
|
|
N ONCOJ,ONCOK,XY
|
|
I '$D(^ONCO(165.5,"C",D0)) W ?30,"No primaries defined",! Q
|
|
S PD0=0,ONCOJ=0
|
|
F S PD0=$O(^ONCO(165.5,"C",D0,PD0)) Q:PD0'>0 I $$DIV^ONCFUNC(PD0)=DUZ(2) S ONCOJ=ONCOJ+1,XY(ONCOJ)=PD0
|
|
W !
|
|
F ONCOK=1:1:ONCOJ D
|
|
.N PD0,ST,TS
|
|
.S PD0=XY(ONCOK)
|
|
.S ST=$P(^ONCO(164.2,$P(^ONCO(165.5,PD0,0),U),0),U)
|
|
.S TS=+$P($G(^ONCO(165.5,PD0,7)),U,6)
|
|
.S TS=$P($G(^ONCO(164.42,TS,0)),U)
|
|
.W !,ST_": "_TS
|
|
.W:ONCOK=ONCOJ !
|
|
Q
|
|
;
|
|
EX ;EXIT
|
|
K PA,PB,PC,PD,PE,PL,X0
|
|
Q
|