source: FOIAVistA/trunk/r/ONCOLOGY-ONC/ONCOTNS.m@ 1794

ONCOTNS ;Hines OIFO/GWB - AJCC TNM STAGING ;07/29/05
 ;;2.11;ONCOLOGY;**6,7,11,13,28,36,37,44**;Mar 07, 1995
 ;CLINICAL STAGE GROUP   (165.5,38)
 ;PATHOLOGIC STAGE GROUP (165.5,88)
 ;OTHER STAGE GROUP      (165.5,117)
 ;
IN ;Input transform 
 N ONCOS S ONCOS=$P($G(^ONCO(165.5,D0,0)),U,1)
 N ONCOH S ONCOH=$$HIST^ONCFUNC(D0)
 I STGIND="X" G IN1
 I $$LYMPHOMA^ONCFUNC(D0)!(ONCOS=62)!(ONCOS=63) D
 .S STGIND="L"
 ;
IN1 S DIC="^ONCO(164.45,",DIC(0)="EMQ",DIC("S")="I $P(^(0),U,3)[STGIND"
 D ^DIC
 I (X["(A)")!(X["(B)") D
 .W !!,"Enter systemic symptom suffixes at the LYMPH NODES prompt."
 I Y=-1 K X Q
 S X=$P(^ONCO(164.45,+Y,0),U,2)
 Q
 ;
INNUM S X=$S(X["NA":88,X["Unk":99,X["Occ":"0C",X="0a":"0A",X="0is":"0S",1:X)
 I X="IIIE+S" S X="3ES" Q
 I X="V" S X=5 Q
 I $E(X,1,2)="IV" S X=4_$E(X,3) Q
 I $E(X,1,3)="III" S X=3_$E(X,4) Q
 I $E(X,1,2)="II" S X=2_$E(X,3) Q
 I $E(X,1)="I" S X=1_$E(X,2) Q
 Q
 ;
HP ;HELP
 N ONCOI,ONCOX,ONCOXS,ONCOH,ONCOS,SG1,SG2,SGT
 S ONCOI=0,ONCOXS=""
 I STGIND="X" G HP1
 N ONCOS S ONCOS=$P($G(^ONCO(165.5,D0,0)),U,1)
 N ONCOH S ONCOH=$$HIST^ONCFUNC(D0)
 I $$LYMPHOMA^ONCFUNC(D0)!(ONCOS=62)!(ONCOS=63) D
 .S STGIND="L"
HP1 W !,"Select one of the following:",!
 F  S ONCOXS=$O(^ONCO(164.45,"B",ONCOXS)) Q:ONCOXS=""  D
 .S ONCOI=$O(^ONCO(164.45,"B",ONCOXS,0)),ONCOX=^ONCO(164.45,ONCOI,0)
 .S SG1=$P(ONCOX,U,1),SG2=$P(ONCOX,U,2),SGT=$P(ONCOX,U,3)
 .W:SGT[STGIND !?5,SG1,?10,SG2
 Q
OT ;Output transform 
 I Y'="" D
 .S STG=$O(^ONCO(164.45,"B",Y,""))
 .I STG'="" S Y=$P($G(^ONCO(164.45,STG,0)),U,2)
 .S ONCS=$P($G(^ONCO(165.5,D0,0)),U,1)
 .S ONCH=$$HIST^ONCFUNC(D0)
 .I $$LYMPHOMA^ONCFUNC(D0)!(ONCS=62)!(ONCS=63) D
 ..S SSIN=$P($G(^ONCO(165.5,D0,2)),U,11),SSOT=""
 ..I SSIN=0 S SSOT="(A)"
 ..I (SSIN=1)!(SSIN=2)!(SSIN=3) S SSOT="(B)"
 ..I SSIN'=9 S Y=Y_" "_SSOT
 K STG,ONCS,ONCH,SSIN,SSOT Q
RS S XX=$G(^ONCO(165.5,D0,2)),TX=$P(XX,U) G EX:TX="",EX:$P(^ONCO(164,+TX,0),U,11)="" S N=$E(Y),N=$S(N=1:"I",N=2:"II",N=3:"III",N=4:"IV",1:N),Y=N_$E(Y,2,4),Y=Y_" (T"_$P(XX,U,25)_" N"_$P(XX,U,26)_" M"_$P(XX,U,27)_")" G EX
 ;
OT1 ;'COMPUTED EXPRESSION' for AJJC STAGE (165.5,40) and BEST STAGE (165.5,40.1)
 S PATHSG=$P($G(^ONCO(165.5,D0,2.1)),U,4)
 S PATHT=$P($G(^ONCO(165.5,D0,2.1)),U,1)
 S PATHN=$P($G(^ONCO(165.5,D0,2.1)),U,2)
 S PATHM=$P($G(^ONCO(165.5,D0,2.1)),U,3)
 S CLINSG=$P($G(^ONCO(165.5,D0,2)),U,20)
 S CLINT=$P($G(^ONCO(165.5,D0,2)),U,25)
 S CLINN=$P($G(^ONCO(165.5,D0,2)),U,26)
 S CLINM=$P($G(^ONCO(165.5,D0,2)),U,27)
 S (AJSG,HIERT,HIERN,HIERM,HIERFLG)=""
 S AJSG=PATHSG,HIERFLG="P"
 I "88^99"[PATHSG,CLINSG<6,CLINSG'="" S AJSG=CLINSG,HIERFLG="C"
 I PATHSG="",CLINSG'="" S AJSG=CLINSG,HIERFLG="C"
 I "88^99"[PATHSG!(PATHSG="") D
 .I CLINSG<6,CLINSG'="" Q
 .I PATHT'="X",PATHT'=88,PATHT'="" Q
 .I PATHN'="X",PATHN'=88,PATHN'="" Q
 .I PATHM'="X",PATHM'=88,PATHM'="" Q
 .I CLINT'="X",CLINT'=88,CLINT'="" S HIERFLG="C" Q
 .I CLINN'="X",CLINN'=88,CLINN'="" S HIERFLG="C" Q
 .I CLINM'="X",CLINM'=88,CLINM'="" S HIERFLG="C" Q
 I HIERFLG="P" D
 .S HIERT=$P($G(^ONCO(165.5,D0,2.1)),U,1)
 .S HIERN=$P($G(^ONCO(165.5,D0,2.1)),U,2)
 .S HIERM=$P($G(^ONCO(165.5,D0,2.1)),U,3)
 .S HIERTNM=$$GET1^DIQ(165.5,D0,89.1)
 I HIERFLG="C" D
 .S HIERT=$P($G(^ONCO(165.5,D0,2)),U,25)
 .S HIERN=$P($G(^ONCO(165.5,D0,2)),U,26)
 .S HIERM=$P($G(^ONCO(165.5,D0,2)),U,27)
 .S HIERTNM=$$GET1^DIQ(165.5,D0,37)
 I AJSG'="" S Y=AJSG D OT S X=Y
 K AJSG,CLINM,CLINN,CLINT,CLINSG,PATHM,PATHN,PATHT,PATHSG Q
 ;
STGBY ;STAGED BY (165.5,40.2)
 D OT1
 I HIERFLG'="" S Y=$S(HIERFLG="C":$P($G(^ONCO(165.5,D0,3)),U,32),1:$P($G(^ONCO(165.5,D0,2.1)),U,5))
 D STGBOT S X=Y
 Q
 ;
STGBOT ;STAGED BY (165.5,40.2) OUTPUT TRANSFORM
 I Y'="" D
 .I Y=0 S Y="Not staged" Q
 .I Y=1 S Y="Managing MD" Q
 .I Y=2 S Y="Pathologist" Q
 .I Y=3 S Y="Pathologist & managing MD" Q
 .I Y=4 S Y="Committee chair, liaison MD, registry advisor" Q
 .I Y=5 S Y="Registrar" Q
 .I Y=6 S Y="Registrar & MD" Q
 .I Y=7 S Y="Another facility" Q
 .I Y=8 S Y="NA" Q
 .I Y=9 S Y="Unknown" Q
 Q
 ;
TR ;Translate code
 S XS=$P(XX,U,20),XG=$P(XX,U,28),X=XG_$E(XS,2,5)
EX ;EXIT
 K ST,SC,XD0,ONCOX,XX,ONCOYR