VistA-FOIAVistA/r/ONCOLOGY-ONC/ONCOU55.m

128 lines
6.8 KiB
Mathematica

ONCOU55 ;Hines OIFO/GWB - UTILITY ROUTINE #1;7/15/94
;;2.11;ONCOLOGY;**6,7,15,19,22,28,35,41,43,44**;Mar 07, 1995
RXTS G RXTS^ONCOU55B ;reindex TUMOR STATUS (#73) on ONCOLOGY PRIMARY (#165.5)
;
LTS(DA,NOTTHIS) ;invoked by AC cross-reference of TUMOR STATUS CODE sub-field (#.02) of TUMOR STATUS field (#73) of ONCOLOGY PRIMARY file (#165.5), sets value into LAST TUMOR STATUS field (#95)
;NOTTHIS is defined in the KILL logic - we want to skip the current TUMOR STATUS
N OX,DIE,DR,NTS,OTS
S NTS="" ;new tumor status defaults to null
S OX=$$TSLAST(DA,+$G(NOTTHIS)) ;last IEN
S:OX NTS=$P($G(^ONCO(165.5,DA,"TS",OX,0)),U,2) S OTS=$P($G(^ONCO(165.5,DA,7)),U,6),$P(^(7),U,6)=NTS ;get old data, set new data
K:$L(OTS) ^ONCO(165.5,"ACS",OTS,DA) S:$L(NTS) ^ONCO(165.5,"ACS",NTS,DA)="" ;kill old xref, set new xref
Q
;
TSLAST(DA,NOTTHIS) ;get IEN of last tumor status
N IEN S IEN=$O(^ONCO(165.5,DA,"TS","AA","")) I IEN,$D(NOTTHIS),$D(^ONCO(165.5,DA,"TS","AA",IEN,NOTTHIS)) S IEN=$O(^ONCO(165.5,DA,"TS","AA",IEN))
S:IEN IEN=$O(^ONCO(165.5,DA,"TS","AA",IEN,""))
Q IEN
;
SETTS(IEN,FOLDATE) ;Set TUMOR STATUS (165.5,73)
N PREVENT,PREVTS,PATIEN,VS,HDR,SUBENT
S PREVTS="",PREVENT=$O(^ONCO(165.5,IEN,"TS","AA",9999999-FOLDATE))
I PREVENT D
.I $P($G(^ONCO(165.5,IEN,5)),U,2)'=4 D
..S PREVENT=$O(^ONCO(165.5,IEN,"TS","AA",PREVENT,0))
..S PREVTS=$P($G(^ONCO(165.5,IEN,"TS",PREVENT,0)),U,2)
S:'$D(^ONCO(165.5,IEN,"TS",0)) ^(0)="^165.573DA" S HDR=^(0)
F SUBENT=$P(HDR,U,3)+1:1 Q:'$D(^ONCO(165.5,IEN,"TS",SUBENT))
S ^ONCO(165.5,IEN,"TS",SUBENT,0)=FOLDATE_U_PREVTS
S ^ONCO(165.5,IEN,"TS","B",FOLDATE,SUBENT)=""
S ^ONCO(165.5,IEN,"TS","AA",9999999-FOLDATE,SUBENT)=""
S $P(HDR,U,3)=SUBENT,$P(HDR,U,4)=$P(HDR,U,4)+1
S ^ONCO(165.5,IEN,"TS",0)=HDR
D LTS(IEN)
Q SUBENT
;
KILLTS(IEN,SUBENT) ;kill a tumor status subrecord
;IEN = internal entry number on ONCOLOGY PRIMARY
;SUBENT = sub-record number
N FOLDATE,HDR,II
S FOLDATE=$P($G(^ONCO(165.5,IEN,"TS",SUBENT,0)),U,1) K ^ONCO(165.5,IEN,"TS","B",FOLDATE,SUBENT),^ONCO(165.5,IEN,"TS","AA",9999999-FOLDATE,SUBENT) ;kill xrefs
K ^ONCO(165.5,IEN,"TS",SUBENT) ;kill record
S HDR=^ONCO(165.5,IEN,"TS") ;get header
I '$O(^ONCO(165.5,IEN,"TS",SUBENT)) F II=SUBENT-1:1 I $D(^ONCO(165.5,IEN,"TS",II)) S $P(HDR,U,3)=II Q ;update last subrec no
S $P(HDR,U,4)=$P(HDR,U,4)-1,^ONCO(165.5,IEN,"TS")=HDR ;update count and put header to file
D LTS(IEN) ;update last tumor status
Q
;
TNMED(IEN) ;AJCC Cancer Staging Manual edition
N YR S YR=$E($P($G(^ONCO(165.5,IEN,0)),U,16),1,3)
S TNMED=$S(YR<283:1,YR<288:2,YR<292:3,YR<298:4,YR<303:5,1:6)
I $$LYMPHOMA^ONCFUNC(IEN) G TNMEX
S TNMMO=$$HIST^ONCFUNC(IEN),TNMMO=$E(TNMMO,1,4)
S TOP=$P($G(^ONCO(165.5,IEN,2)),U,1)
I YR>295 D
.S CSG=$P($G(^ONCO(165.5,IEN,2)),U,20)
.S PSG=$P($G(^ONCO(165.5,IEN,2.1)),U,4)
.I (CSG=88)&(PSG=88) S TNMED=88
I TNMED=5 D
.I (TNMMO>9730)&(TNMMO<9990) S TNMED=88 Q
.I TNMMO=9140 S TNMED=88 Q
.I (TOP=67173)!(TOP=67254)!(TOP=67260)!(TOP=67268)!(TOP=67269)!(TOP=67300)!(TOP=67301)!(TOP=67312)!(TOP=67313)!(TOP=67318)!(TOP=67319)!(TOP=67339)!(TOP=67379)!(TOP=67390)!(TOP=67398)!(TOP=67399)!(TOP=67420)!(TOP=67421) S TNMED=88 Q
.I (TOP=67422)!(TOP=67423)!(TOP=67424)!(TOP=67571)!(TOP=67572)!(TOP=67573)!(TOP=67574)!(TOP=67577)!(TOP=67578)!(TOP=67579)!(TOP=67630)!(TOP=67631)!(TOP=67637)!(TOP=67638)!(TOP=67639)!(TOP=67691)!(TOP=67699)!(TOP=67700) S TNMED=88 Q
.I (TOP=67701)!(TOP=67709)!(TOP=67710)!(TOP=67711)!(TOP=67712)!(TOP=67713)!(TOP=67714)!(TOP=67715)!(TOP=67716)!(TOP=67717)!(TOP=67718)!(TOP=67719)!(TOP=67720)!(TOP=67721)!(TOP=67722)!(TOP=67723)!(TOP=67724)!(TOP=67725) S TNMED=88 Q
.I (TOP=67728)!(TOP=67729)!(TOP=67740)!(TOP=67741)!(TOP=67749)!(TOP=67750)!(TOP=67751)!(TOP=67752)!(TOP=67753)!(TOP=67754)!(TOP=67755)!(TOP=67758)!(TOP=67759)!(TOP=67760)!(TOP=67761)!(TOP=67762)!(TOP=67763)!(TOP=67764) S TNMED=88 Q
.I (TOP=67765)!(TOP=67767)!(TOP=67768)!(TOP=67809) S TNMED=88 Q
I TNMED=6 D
.I (TNMMO>9730)&(TNMMO<9990) S TNMED=88 Q
.I TNMMO=9140 S TNMED=88 Q
.I (TOP=67173)!(TOP=67254)!(TOP=67260)!(TOP=67268)!(TOP=67269)!(TOP=67301)!(TOP=67312)!(TOP=67313)!(TOP=67318)!(TOP=67319)!(TOP=67339)!(TOP=67379)!(TOP=67390) S TNMED=88 Q
.I (TOP=67398)!(TOP=67399)!(TOP=67420)!(TOP=67421)!(TOP=67422)!(TOP=67423)!(TOP=67424)!(TOP=67571)!(TOP=67572)!(TOP=67573)!(TOP=67574)!(TOP=67577)!(TOP=67578)!(TOP=67579) S TNMED=88 Q
.I (TOP=67630)!(TOP=67631)!(TOP=67637)!(TOP=67638)!(TOP=67639)!(TOP=67681)!(TOP=67688)!(TOP=67689)!(TOP=67691)!(TOP=67699)!(TOP=67701)!(TOP=67709)!(TOP=67710)!(TOP=67740)!(TOP=67741)!(TOP=67749) S TNMED=88 Q
.I (TOP=67750)!(TOP=67754)!(TOP=67755)!(TOP=67758)!(TOP=67759)!(TOP=67760)!(TOP=67761)!(TOP=67762)!(TOP=67763)!(TOP=67764)!(TOP=67765)!(TOP=67767)!(TOP=67768)!(TOP=67809) S TNMED=88 Q
TNMEX Q TNMED
;
PAPFOL ;characterize thyroid tumors as papillary or follicular as appropriate
N PF
MELANOMA(IEN) ;1 (TRUE) if this tumor is a melanoma, 0 (FALSE) otherwise
N XX S XX=$$HIST^ONCFUNC(IEN) Q (XX'<87200)&(XX<87910)
;
GTT(D0) ;Gestational Trophoblastic Tumors - 5th and 6th editions
N SME,TOP
S SME=$$TNMED^ONCOU55(D0)
S TOP=$P($G(^ONCO(165.5,D0,2)),U,1)
Q (SME>4)&(TOP=67589)
;
T(D0) ;Testis - 5th edition
N SME,TOP
S SME=$$TNMED^ONCOU55(D0) ;Staging manual edition
S TOP=$P($G(^ONCO(165.5,D0,2)),U,1) ;ICDO-Topography (#20)
Q (SME>4)&((TOP=67620)!(TOP=67621)!(TOP=67629))
;
PATHSTAG(IEN) ;1 (TRUE) if staging basis is pathologic, 0 (FALSE) otherwise
Q STGIND="P"
IRISCIL(IEN) ;returns I if an iris tumor, C if ciliary body, blank otherwise
Q $P($G(^ONCO(165.5,IEN,2)),U,22)
SITEGRP(IEN) ;name of the default site group for this tumor's topography
Q $P($G(^ONCO(164.2,+$P($G(^ONCO(164,+$P($G(^ONCO(165.5,IEN,2)),U),0)),U,13),0)),U)
DATEDX(IEN) ;DATE DX
Q $P($G(^ONCO(165.5,IEN,0)),U,16)
EDITION(IEN) ;SEER Extent of Disease edition
Q $S($$DATEDX(IEN)>2980000:3,$$DATEDX(IEN)>2920000:2,1:1)
LYMPHOMA(IEN) ;1 if lymphoma 0 otherwise
;check histology field in primary file extended reference
;2 c if it's in range of histology codes 4 a lymphoma
N XX S XX=$$HIST^ONCFUNC(IEN)
I (XX<95902)!(XX>99701) Q 0
Q ((XX'<95902)&(XX'>95923))!((XX'<96002)!(XX'>96333))!((XX'<96702)&(XX'>96983))!((XX'<97022)&(XX'>97043))!(XX=99701)
MYCOSIS(IEN) ;1 if lymphoma 0 otherwise
;check histology field in primary file extended reference
;2 c if it's MYCOSIS FUNGOIDES codes
N XX S XX=$$HIST^ONCFUNC(IEN)
Q ((XX=97002)!(XX=97003))
NOSTAGE(IEN) ;1 or 0 if stage overide field marked or not
Q $P($G(^ONCO(165.5,D0,24)),U)
TMARKER ;check if TUMOR MARKER fields should be prompted
S (TM1,TM2,TM3,ICDO)=0,ICDOPTR=$P($G(^ONCO(165.5,D0,2)),"^",1)
I ICDOPTR'="" S ICDO=$P($G(^ONCO(164,ICDOPTR,0)),"^",2)
I $E(ICDO,2,3)=50 S (TM1,TM2)=1 Q
I $E(ICDO,2,3)=18 S TM1=1 Q
I $E(ICDO,2,3)=19 S TM1=1 Q
I $E(ICDO,2,3)=20 S TM1=1 Q
I $E(ICDO,2,3)=22 S TM1=1 Q
I $E(ICDO,2,3)=56 S TM1=1 Q
I $E(ICDO,2,3)=61 S (TM1,TM2)=1 Q
I $E(ICDO,2,3)=62 S (TM1,TM2,TM3)=1 Q
I $$HIST^ONCFUNC(D0)=95003 S TM1=1 Q
Q