source: WorldVistAEHR/trunk/r/ONCOLOGY-ONC/ONCOU55.m@ 691

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

initial load of WorldVistAEHR
File size: 6.8 KB
RevLine 
[613]1ONCOU55 ;Hines OIFO/GWB - UTILITY ROUTINE #1;7/15/94
2 ;;2.11;ONCOLOGY;**6,7,15,19,22,28,35,41,43,44**;Mar 07, 1995
3RXTS G RXTS^ONCOU55B ;reindex TUMOR STATUS (#73) on ONCOLOGY PRIMARY (#165.5)
4 ;
5LTS(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)
6 ;NOTTHIS is defined in the KILL logic - we want to skip the current TUMOR STATUS
7 N OX,DIE,DR,NTS,OTS
8 S NTS="" ;new tumor status defaults to null
9 S OX=$$TSLAST(DA,+$G(NOTTHIS)) ;last IEN
10 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
11 K:$L(OTS) ^ONCO(165.5,"ACS",OTS,DA) S:$L(NTS) ^ONCO(165.5,"ACS",NTS,DA)="" ;kill old xref, set new xref
12 Q
13 ;
14TSLAST(DA,NOTTHIS) ;get IEN of last tumor status
15 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))
16 S:IEN IEN=$O(^ONCO(165.5,DA,"TS","AA",IEN,""))
17 Q IEN
18 ;
19SETTS(IEN,FOLDATE) ;Set TUMOR STATUS (165.5,73)
20 N PREVENT,PREVTS,PATIEN,VS,HDR,SUBENT
21 S PREVTS="",PREVENT=$O(^ONCO(165.5,IEN,"TS","AA",9999999-FOLDATE))
22 I PREVENT D
23 .I $P($G(^ONCO(165.5,IEN,5)),U,2)'=4 D
24 ..S PREVENT=$O(^ONCO(165.5,IEN,"TS","AA",PREVENT,0))
25 ..S PREVTS=$P($G(^ONCO(165.5,IEN,"TS",PREVENT,0)),U,2)
26 S:'$D(^ONCO(165.5,IEN,"TS",0)) ^(0)="^165.573DA" S HDR=^(0)
27 F SUBENT=$P(HDR,U,3)+1:1 Q:'$D(^ONCO(165.5,IEN,"TS",SUBENT))
28 S ^ONCO(165.5,IEN,"TS",SUBENT,0)=FOLDATE_U_PREVTS
29 S ^ONCO(165.5,IEN,"TS","B",FOLDATE,SUBENT)=""
30 S ^ONCO(165.5,IEN,"TS","AA",9999999-FOLDATE,SUBENT)=""
31 S $P(HDR,U,3)=SUBENT,$P(HDR,U,4)=$P(HDR,U,4)+1
32 S ^ONCO(165.5,IEN,"TS",0)=HDR
33 D LTS(IEN)
34 Q SUBENT
35 ;
36KILLTS(IEN,SUBENT) ;kill a tumor status subrecord
37 ;IEN = internal entry number on ONCOLOGY PRIMARY
38 ;SUBENT = sub-record number
39 N FOLDATE,HDR,II
40 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
41 K ^ONCO(165.5,IEN,"TS",SUBENT) ;kill record
42 S HDR=^ONCO(165.5,IEN,"TS") ;get header
43 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
44 S $P(HDR,U,4)=$P(HDR,U,4)-1,^ONCO(165.5,IEN,"TS")=HDR ;update count and put header to file
45 D LTS(IEN) ;update last tumor status
46 Q
47 ;
48TNMED(IEN) ;AJCC Cancer Staging Manual edition
49 N YR S YR=$E($P($G(^ONCO(165.5,IEN,0)),U,16),1,3)
50 S TNMED=$S(YR<283:1,YR<288:2,YR<292:3,YR<298:4,YR<303:5,1:6)
51 I $$LYMPHOMA^ONCFUNC(IEN) G TNMEX
52 S TNMMO=$$HIST^ONCFUNC(IEN),TNMMO=$E(TNMMO,1,4)
53 S TOP=$P($G(^ONCO(165.5,IEN,2)),U,1)
54 I YR>295 D
55 .S CSG=$P($G(^ONCO(165.5,IEN,2)),U,20)
56 .S PSG=$P($G(^ONCO(165.5,IEN,2.1)),U,4)
57 .I (CSG=88)&(PSG=88) S TNMED=88
58 I TNMED=5 D
59 .I (TNMMO>9730)&(TNMMO<9990) S TNMED=88 Q
60 .I TNMMO=9140 S TNMED=88 Q
61 .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
62 .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
63 .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
64 .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
65 .I (TOP=67765)!(TOP=67767)!(TOP=67768)!(TOP=67809) S TNMED=88 Q
66 I TNMED=6 D
67 .I (TNMMO>9730)&(TNMMO<9990) S TNMED=88 Q
68 .I TNMMO=9140 S TNMED=88 Q
69 .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
70 .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
71 .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
72 .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
73TNMEX Q TNMED
74 ;
75PAPFOL ;characterize thyroid tumors as papillary or follicular as appropriate
76 N PF
77MELANOMA(IEN) ;1 (TRUE) if this tumor is a melanoma, 0 (FALSE) otherwise
78 N XX S XX=$$HIST^ONCFUNC(IEN) Q (XX'<87200)&(XX<87910)
79 ;
80GTT(D0) ;Gestational Trophoblastic Tumors - 5th and 6th editions
81 N SME,TOP
82 S SME=$$TNMED^ONCOU55(D0)
83 S TOP=$P($G(^ONCO(165.5,D0,2)),U,1)
84 Q (SME>4)&(TOP=67589)
85 ;
86T(D0) ;Testis - 5th edition
87 N SME,TOP
88 S SME=$$TNMED^ONCOU55(D0) ;Staging manual edition
89 S TOP=$P($G(^ONCO(165.5,D0,2)),U,1) ;ICDO-Topography (#20)
90 Q (SME>4)&((TOP=67620)!(TOP=67621)!(TOP=67629))
91 ;
92PATHSTAG(IEN) ;1 (TRUE) if staging basis is pathologic, 0 (FALSE) otherwise
93 Q STGIND="P"
94IRISCIL(IEN) ;returns I if an iris tumor, C if ciliary body, blank otherwise
95 Q $P($G(^ONCO(165.5,IEN,2)),U,22)
96SITEGRP(IEN) ;name of the default site group for this tumor's topography
97 Q $P($G(^ONCO(164.2,+$P($G(^ONCO(164,+$P($G(^ONCO(165.5,IEN,2)),U),0)),U,13),0)),U)
98DATEDX(IEN) ;DATE DX
99 Q $P($G(^ONCO(165.5,IEN,0)),U,16)
100EDITION(IEN) ;SEER Extent of Disease edition
101 Q $S($$DATEDX(IEN)>2980000:3,$$DATEDX(IEN)>2920000:2,1:1)
102LYMPHOMA(IEN) ;1 if lymphoma 0 otherwise
103 ;check histology field in primary file extended reference
104 ;2 c if it's in range of histology codes 4 a lymphoma
105 N XX S XX=$$HIST^ONCFUNC(IEN)
106 I (XX<95902)!(XX>99701) Q 0
107 Q ((XX'<95902)&(XX'>95923))!((XX'<96002)!(XX'>96333))!((XX'<96702)&(XX'>96983))!((XX'<97022)&(XX'>97043))!(XX=99701)
108MYCOSIS(IEN) ;1 if lymphoma 0 otherwise
109 ;check histology field in primary file extended reference
110 ;2 c if it's MYCOSIS FUNGOIDES codes
111 N XX S XX=$$HIST^ONCFUNC(IEN)
112 Q ((XX=97002)!(XX=97003))
113NOSTAGE(IEN) ;1 or 0 if stage overide field marked or not
114 Q $P($G(^ONCO(165.5,D0,24)),U)
115TMARKER ;check if TUMOR MARKER fields should be prompted
116 S (TM1,TM2,TM3,ICDO)=0,ICDOPTR=$P($G(^ONCO(165.5,D0,2)),"^",1)
117 I ICDOPTR'="" S ICDO=$P($G(^ONCO(164,ICDOPTR,0)),"^",2)
118 I $E(ICDO,2,3)=50 S (TM1,TM2)=1 Q
119 I $E(ICDO,2,3)=18 S TM1=1 Q
120 I $E(ICDO,2,3)=19 S TM1=1 Q
121 I $E(ICDO,2,3)=20 S TM1=1 Q
122 I $E(ICDO,2,3)=22 S TM1=1 Q
123 I $E(ICDO,2,3)=56 S TM1=1 Q
124 I $E(ICDO,2,3)=61 S (TM1,TM2)=1 Q
125 I $E(ICDO,2,3)=62 S (TM1,TM2,TM3)=1 Q
126 I $$HIST^ONCFUNC(D0)=95003 S TM1=1 Q
127 Q
Note: See TracBrowser for help on using the repository browser.