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