ONCOSUR2 ;HINES OIFO/RTK - ONCOSUR continued ;10/31/11
;;2.2;ONCOLOGY;**1,10,13**;Jul 31, 2013;Build 7
;
D TMK,EXT,LYM,TNM,CS,SSDI,SUR,SCT,PM W !
Q
;
TMK ;TUMOR MARKER 1 (165.5,25.1)
;TUMOR MARKER 2 (165.5,25.2)
;TUMOR MARKER 3 (165.5,25.3)
N SITE,SITESUB
F SITESUB=67500:1:67509 S SITE(SITESUB)="BREAST"
F SITESUB=67180:1:67189 S SITE(SITESUB)="COLORECTAL"
S SITE(67199)="COLORECTAL"
S SITE(67220)="LIVER"
S SITE(67221)="LIVER"
S SITE(67569)="OVARY"
S SITE(67619)="PROSTATE"
S SITE(67620)="TESTIS"
S SITE(67621)="TESTIS"
S SITE(67629)="TESTIS"
I $G(SITE(OLDTOP))=$G(SITE(X)) Q
D MESSAGE
W !?5,"TUMOR MARKERS"
S $P(^ONCO(165.5,D0,24),U,2)=""
S $P(^ONCO(165.5,D0,24),U,3)=""
S $P(^ONCO(165.5,D0,24),U,7)=""
Q
;
EXT ;EXTENSION (165.5,30)
N NEWEXT,OLDEXT,ONCOT,ONCOX
S ONCOX="E",ONCOT=OLDTOP S OLDEXT=$$GETLIST^ONCODEL(D0,ONCOX,ONCOT)
S ONCOX="E",ONCOT=X S NEWEXT=$$GETLIST^ONCODEL(D0,ONCOX,ONCOT)
I OLDEXT=NEWEXT Q
D MESSAGE
W !?5,"EXTENSION"
S $P(^ONCO(165.5,D0,2),U,10)=""
Q
;
LYM ;LYMPH NODES (165.5,31)
N NEWLYM,OLDLYM,ONCOT,ONCOX
S ONCOX="L",ONCOT=OLDTOP S OLDLYM=$$GETLIST^ONCODEL(D0,ONCOX,ONCOT)
S ONCOX="L",ONCOT=X S NEWLYM=$$GETLIST^ONCODEL(D0,ONCOX,ONCOT)
I OLDLYM=NEWLYM Q
D MESSAGE
W !?5,"LYMPH NODES"
S $P(^ONCO(165.5,D0,2),U,11)=""
Q
;
TNM ;CLINICAL STAGING
;PATHOLOGIC STAGING
N NEWTNM,OLDTNM
S OLDTNM=$P($G(^ONCO(164,OLDTOP,0)),U,11) I OLDTNM="" Q
S NEWTNM=$P($G(^ONCO(164,X,0)),U,11) I NEWTNM="" Q
I OLDTNM=NEWTNM Q
D MESSAGE
W !?5,"CLINICAL STAGING",?36,"(all fields)"
W !?5,"PATHOLOGIC STAGING",?36,"(all fields)"
I $P($G(^ONCO(165.5,D0,0)),U,16)>3171231 W !?5,"POST-THERAPY STAGING",?36,"(all fields)"
F PIECE=1:1:19 S $P(^ONCO(165.5,D0,"AJCC8"),U,PIECE)="" ;8TH ED FIELDS
S $P(^ONCO(165.5,D0,2),U,25)="" ;37.1 ;CLINICAL T
S $P(^ONCO(165.5,D0,2),U,26)="" ;37.2 ;CLINICAL N
S $P(^ONCO(165.5,D0,2),U,27)="" ;37.3 ;CLINICAL M
S $P(^ONCO(165.5,D0,2),U,20)="" ;38 ;CLINICAL STAGE GROUP
S $P(^ONCO(165.5,D0,3),U,32)="" ;19 ;STAGED BY (CLINICAL STAGE)
S $P(^ONCO(165.5,D0,2.1),U,12)="" ;134 ;CLINICAL RISK FACTORS
S $P(^ONCO(165.5,D0,24),U,8)="" ;136 ;SERUM TUMOR MARKERS
S $P(^ONCO(165.5,D0,2.1),U,1)="" ;85 ;PATHOLOGIC T
S $P(^ONCO(165.5,D0,2.1),U,2)="" ;86 ;PATHOLOGIC N
S $P(^ONCO(165.5,D0,2.1),U,3)="" ;87 ;PATHOLOGIC M
S $P(^ONCO(165.5,D0,2.1),U,4)="" ;88 ;PATHOLOGIC STAGE GROUP
S $P(^ONCO(165.5,D0,2.1),U,5)="" ;89 ;STAGED BY (PATHOLOGIC STAGE)
S $P(^ONCO(165.5,D0,2.1),U,13)="" ;135 ;PATHOLOGIC RISK FACTORS
S $P(^ONCO(165.5,D0,24),U,5)="" ;30.5 ;PERIPHERAL BLOOD INVOLVEMENT
Q
;
SUR ;SURGICAL PROCEDURES
N NEWSCG,OLDSCG,TXDT
S OLDSCG=$P($G(^ONCO(164,OLDTOP,0)),U,16) I OLDSCG="" Q
S NEWSCG=$P($G(^ONCO(164,X,0)),U,16) I NEWSCG="" Q
I OLDSCG=NEWSCG Q
D MESSAGE
W !?5,"SURGICAL PROCEDURES",?36,"(all fields)"
;
S $P(^ONCO(165.5,D0,3),U,34)="" ;74 ;SURGICAL APPROACH (R)
S $P(^ONCO(165.5,D0,3),U,38)="" ;58.2 ;SURGERY OF PRIMARY (R)
S $P(^ONCO(165.5,D0,3.1),U,7)="" ;50.2 ;SURGERY OF PRIMARY @FAC (R)
S $P(^ONCO(165.5,DA,3),U,40)="" ;138 ;SCOPE OF LN SURGERY (R)
S $P(^ONCO(165.5,DA,3.1),U,9)="" ;138.1;SCOPE OF LN SURGERY @FAC (R)
S $P(^ONCO(165.5,DA,3),U,42)="" ;140 ;NUMBER OF LN REMOVED (R)
S $P(^ONCO(165.5,DA,3.1),U,11)="" ;140.1;NUMBER OF LN REMOVED @FAC(R)
S $P(^ONCO(165.5,DA,3),U,41)="" ;139 ;SURG PROC/OTHER SITE (R)
S $P(^ONCO(165.5,DA,3.1),U,10)="" ;139.1;SURG PROC/OTHER SITE @FAC(R)
;
S $P(^ONCO(165.5,D0,3.1),U,29)="" ;58.6 ;SURGERY OF PRIMARY (F)
S TXDT=$P(^ONCO(165.5,DA,3),U,1)_"S1"
S $P(^ONCO(165.5,DA,3),U,1)="" ;50 ;MOST DEFINITIVE SURG DATE
K ^ONCO(165.5,"ATX",DA,TXDT)
S $P(^ONCO(165.5,DA,3),U,28)="" ;59 ;SURGICAL MARGINS
S $P(^ONCO(165.5,D0,3.1),U,30)="" ;58.7 ;SURGERY OF PRIMARY @FAC (F)
S $P(^ONCO(165.5,DA,3.1),U,8)="" ;50.3 ;MOST DEFINITIVE SURG @FAC DATE
;
S $P(^ONCO(165.5,DA,3.1),U,31)="" ;138.4;SCOPE OF LN SURGERY (F)
S TXDT=$P($G(^ONCO(165.5,DA,3.1)),U,22)_"S2"
S $P(^ONCO(165.5,DA,3.1),U,22)="" ;138.2;SCOPE OF LN SURGERY DATE
K ^ONCO(165.5,"ATX",DA,TXDT)
S $P(^ONCO(165.5,DA,3.1),U,32)="" ;138.5;SCOPE OF LN SURGERY @FAC (F)
S $P(^ONCO(165.5,DA,3.1),U,23)="" ;138.2;SCOPE OF LN SURGERY @FAC DT
;
S $P(^ONCO(165.5,DA,3.1),U,33)="" ;139.4;SURG PROC/OTHER SITE (F)
S TXDT=$P(^ONCO(165.5,DA,3.1),U,24)_"S3"
S $P(^ONCO(165.5,DA,3.1),U,24)="" ;139.2;SURG PROC/OTHER SITE DATE
K ^ONCO(165.5,"ATX",DA,TXDT)
S $P(^ONCO(165.5,DA,3.1),U,34)="" ;139.5;SURG PROC/OTHER SITE @FAC(F)
S $P(^ONCO(165.5,DA,3.1),U,25)="" ;139.3;SURG PROC/OTHER SITE @FAC DT
S $P(^ONCO(165.5,DA,3),U,33)="" ;23 ;RECONSTRUCTION/RESTORATION
S $P(^ONCO(165.5,DA,"THY1"),U,36)="" ;435 ;DATE OF SURGICAL DISCHARGE
S $P(^ONCO(165.5,DA,3.1),U,28)="" ;14 ;READMISSION W/I 30 DAYS/SURG
K ^ONCO(165.5,DA,14) ;108 ;TEXT-RX-SURGERY
S $P(^ONCO(165.5,DA,3),U,26)="" ;58 ;REASON NO SURGERY OF PRIMARY
Q
SCT ;
N SCT
S OLDSCG=$P($G(^ONCO(164,OLDTOP,0)),U,16) I OLDSCG="" Q
S NEWSCG=$P($G(^ONCO(164,X,0)),U,16) I NEWSCG="" Q
I OLDSCG=NEWSCG Q
D MESSAGE
W !?5,"SUBSEQUENT COURSE OF TREATMENT",?36,"(all surgery fields)"
F SCT=0:0 S SCT=$O(^ONCO(165.5,DA,4,SCT)) Q:SCT'>0 D
.S $P(^ONCO(165.5,DA,4,SCT,0),U,4)="" ;.04 ;SURGERY OF PRIMARY
.S $P(^ONCO(165.5,DA,4,SCT,0),U,11)="" ;.041;SURGERY OF PRIMARY DATE
.S $P(^ONCO(165.5,DA,4,SCT,2),U,32)="" ;35 ;SCOPE OF LN SURGERY
.S $P(^ONCO(165.5,DA,4,SCT,2),U,34)="" ;37 ;NUMBER OF LN REMOVED
.S $P(^ONCO(165.5,DA,4,SCT,2),U,33)="" ;36 ;SURG PROC/OTHER SITE
.S $P(^ONCO(165.5,DA,4,SCT,2),U,30)="" ;33 ;RECON/RESTORE DELAYED
.S $P(^ONCO(165.5,DA,4,SCT,2),U,31)="" ;34 ;RECON/RESTORE DELAY DATE
Q
;
CS ;COLLABORATIVE STAGING
N PIECE
S OLDSCG=$P($G(^ONCO(164,OLDTOP,0)),U,16) I OLDSCG="" Q
S NEWSCG=$P($G(^ONCO(164,X,0)),U,16) I NEWSCG="" Q
I OLDSCG=NEWSCG Q
D MESSAGE
I $P($G(^ONCO(165.5,D0,0)),U,16)<3180000 W !?5,"COLLABORATIVE STAGING",?36,"(all fields)"
F PIECE=1:1:12 S $P(^ONCO(165.5,D0,"CS"),U,PIECE)=""
F PIECE=1:1:11 S $P(^ONCO(165.5,D0,"CS1"),U,PIECE)=""
F PIECE=13:1:19 S $P(^ONCO(165.5,D0,"CS1"),U,PIECE)=""
F PIECE=1:1:19 S $P(^ONCO(165.5,D0,"CS2"),U,PIECE)=""
S $P(^ONCO(165.5,D0,"CS3"),U,1)=""
Q
;
SSDI ;SITE SPECIFIC DATA ITEMS
N PIECE
;S OLDSCG=$P($G(^ONCO(164,OLDTOP,0)),U,16) I OLDSCG="" Q
;S NEWSCG=$P($G(^ONCO(164,X,0)),U,16) I NEWSCG="" Q
;I OLDSCG=NEWSCG Q
D MESSAGE
I $P($G(^ONCO(165.5,D0,0)),U,16)>3171231 W !?5,"SITE-SPECIFIC DATA ITEMS",?36,"(all fields)"
F PIECE=12:1:14 S $P(^ONCO(165.5,D0,2.3),U,PIECE)=""
F PIECE=1:1:35 S $P(^ONCO(165.5,D0,"SSD1"),U,PIECE)=""
F PIECE=1:1:36 S $P(^ONCO(165.5,D0,"SSD2"),U,PIECE)=""
F PIECE=1:1:34 S $P(^ONCO(165.5,D0,"SSD3"),U,PIECE)=""
F PIECE=1:1:33 S $P(^ONCO(165.5,D0,"SSD4"),U,PIECE)=""
Q
PM ;PERFORMANCE MEASURES
N PIECE
S OLDSCG=$P($G(^ONCO(164,OLDTOP,0)),U,16) I OLDSCG="" Q
S NEWSCG=$P($G(^ONCO(164,X,0)),U,16) I NEWSCG="" Q
I OLDSCG=NEWSCG Q
D MESSAGE
W !?5,"PERFORMANCE MEASURES",?36,"(all fields)"
F PIECE=1:1:28 S $P(^ONCO(165.5,D0,"PM"),U,PIECE)=""
S $P(^ONCO(165.5,D0,3),U,29)=""
S $P(^ONCO(165.5,D0,"BLA2"),U,41)=""
Q
;
MESSAGE ;
I MSSG=1 Q
W !!?3,"You have changed the PRIMARY SITE. The new topography is"
W !?3,"outside of the old topography's site group. This change"
W !?3,"may affect the validity of all site-specific fields. Therefore,"
W !?3,"these fields have been initialized and need to be re-entered:"
W ! S MSSG=1 Q
Q
;
CLEANUP ;Cleanup
K D0,DA,MSSG,OLDTOP,X
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCOSUR2 7741 printed Apr 09, 2024@21:29:06 Page 2
ONCOSUR2 ;HINES OIFO/RTK - ONCOSUR continued ;10/31/11
+1 ;;2.2;ONCOLOGY;**1,10,13**;Jul 31, 2013;Build 7
+2 ;
+3 DO TMK
DO EXT
DO LYM
DO TNM
DO CS
DO SSDI
DO SUR
DO SCT
DO PM
WRITE !
+4 QUIT
+5 ;
TMK ;TUMOR MARKER 1 (165.5,25.1)
+1 ;TUMOR MARKER 2 (165.5,25.2)
+2 ;TUMOR MARKER 3 (165.5,25.3)
+3 NEW SITE,SITESUB
+4 FOR SITESUB=67500:1:67509
SET SITE(SITESUB)="BREAST"
+5 FOR SITESUB=67180:1:67189
SET SITE(SITESUB)="COLORECTAL"
+6 SET SITE(67199)="COLORECTAL"
+7 SET SITE(67220)="LIVER"
+8 SET SITE(67221)="LIVER"
+9 SET SITE(67569)="OVARY"
+10 SET SITE(67619)="PROSTATE"
+11 SET SITE(67620)="TESTIS"
+12 SET SITE(67621)="TESTIS"
+13 SET SITE(67629)="TESTIS"
+14 IF $GET(SITE(OLDTOP))=$GET(SITE(X))
QUIT
+15 DO MESSAGE
+16 WRITE !?5,"TUMOR MARKERS"
+17 SET $PIECE(^ONCO(165.5,D0,24),U,2)=""
+18 SET $PIECE(^ONCO(165.5,D0,24),U,3)=""
+19 SET $PIECE(^ONCO(165.5,D0,24),U,7)=""
+20 QUIT
+21 ;
EXT ;EXTENSION (165.5,30)
+1 NEW NEWEXT,OLDEXT,ONCOT,ONCOX
+2 SET ONCOX="E"
SET ONCOT=OLDTOP
SET OLDEXT=$$GETLIST^ONCODEL(D0,ONCOX,ONCOT)
+3 SET ONCOX="E"
SET ONCOT=X
SET NEWEXT=$$GETLIST^ONCODEL(D0,ONCOX,ONCOT)
+4 IF OLDEXT=NEWEXT
QUIT
+5 DO MESSAGE
+6 WRITE !?5,"EXTENSION"
+7 SET $PIECE(^ONCO(165.5,D0,2),U,10)=""
+8 QUIT
+9 ;
LYM ;LYMPH NODES (165.5,31)
+1 NEW NEWLYM,OLDLYM,ONCOT,ONCOX
+2 SET ONCOX="L"
SET ONCOT=OLDTOP
SET OLDLYM=$$GETLIST^ONCODEL(D0,ONCOX,ONCOT)
+3 SET ONCOX="L"
SET ONCOT=X
SET NEWLYM=$$GETLIST^ONCODEL(D0,ONCOX,ONCOT)
+4 IF OLDLYM=NEWLYM
QUIT
+5 DO MESSAGE
+6 WRITE !?5,"LYMPH NODES"
+7 SET $PIECE(^ONCO(165.5,D0,2),U,11)=""
+8 QUIT
+9 ;
TNM ;CLINICAL STAGING
+1 ;PATHOLOGIC STAGING
+2 NEW NEWTNM,OLDTNM
+3 SET OLDTNM=$PIECE($GET(^ONCO(164,OLDTOP,0)),U,11)
IF OLDTNM=""
QUIT
+4 SET NEWTNM=$PIECE($GET(^ONCO(164,X,0)),U,11)
IF NEWTNM=""
QUIT
+5 IF OLDTNM=NEWTNM
QUIT
+6 DO MESSAGE
+7 WRITE !?5,"CLINICAL STAGING",?36,"(all fields)"
+8 WRITE !?5,"PATHOLOGIC STAGING",?36,"(all fields)"
+9 IF $PIECE($GET(^ONCO(165.5,D0,0)),U,16)>3171231
WRITE !?5,"POST-THERAPY STAGING",?36,"(all fields)"
+10 ;8TH ED FIELDS
FOR PIECE=1:1:19
SET $PIECE(^ONCO(165.5,D0,"AJCC8"),U,PIECE)=""
+11 ;37.1 ;CLINICAL T
SET $PIECE(^ONCO(165.5,D0,2),U,25)=""
+12 ;37.2 ;CLINICAL N
SET $PIECE(^ONCO(165.5,D0,2),U,26)=""
+13 ;37.3 ;CLINICAL M
SET $PIECE(^ONCO(165.5,D0,2),U,27)=""
+14 ;38 ;CLINICAL STAGE GROUP
SET $PIECE(^ONCO(165.5,D0,2),U,20)=""
+15 ;19 ;STAGED BY (CLINICAL STAGE)
SET $PIECE(^ONCO(165.5,D0,3),U,32)=""
+16 ;134 ;CLINICAL RISK FACTORS
SET $PIECE(^ONCO(165.5,D0,2.1),U,12)=""
+17 ;136 ;SERUM TUMOR MARKERS
SET $PIECE(^ONCO(165.5,D0,24),U,8)=""
+18 ;85 ;PATHOLOGIC T
SET $PIECE(^ONCO(165.5,D0,2.1),U,1)=""
+19 ;86 ;PATHOLOGIC N
SET $PIECE(^ONCO(165.5,D0,2.1),U,2)=""
+20 ;87 ;PATHOLOGIC M
SET $PIECE(^ONCO(165.5,D0,2.1),U,3)=""
+21 ;88 ;PATHOLOGIC STAGE GROUP
SET $PIECE(^ONCO(165.5,D0,2.1),U,4)=""
+22 ;89 ;STAGED BY (PATHOLOGIC STAGE)
SET $PIECE(^ONCO(165.5,D0,2.1),U,5)=""
+23 ;135 ;PATHOLOGIC RISK FACTORS
SET $PIECE(^ONCO(165.5,D0,2.1),U,13)=""
+24 ;30.5 ;PERIPHERAL BLOOD INVOLVEMENT
SET $PIECE(^ONCO(165.5,D0,24),U,5)=""
+25 QUIT
+26 ;
SUR ;SURGICAL PROCEDURES
+1 NEW NEWSCG,OLDSCG,TXDT
+2 SET OLDSCG=$PIECE($GET(^ONCO(164,OLDTOP,0)),U,16)
IF OLDSCG=""
QUIT
+3 SET NEWSCG=$PIECE($GET(^ONCO(164,X,0)),U,16)
IF NEWSCG=""
QUIT
+4 IF OLDSCG=NEWSCG
QUIT
+5 DO MESSAGE
+6 WRITE !?5,"SURGICAL PROCEDURES",?36,"(all fields)"
+7 ;
+8 ;74 ;SURGICAL APPROACH (R)
SET $PIECE(^ONCO(165.5,D0,3),U,34)=""
+9 ;58.2 ;SURGERY OF PRIMARY (R)
SET $PIECE(^ONCO(165.5,D0,3),U,38)=""
+10 ;50.2 ;SURGERY OF PRIMARY @FAC (R)
SET $PIECE(^ONCO(165.5,D0,3.1),U,7)=""
+11 ;138 ;SCOPE OF LN SURGERY (R)
SET $PIECE(^ONCO(165.5,DA,3),U,40)=""
+12 ;138.1;SCOPE OF LN SURGERY @FAC (R)
SET $PIECE(^ONCO(165.5,DA,3.1),U,9)=""
+13 ;140 ;NUMBER OF LN REMOVED (R)
SET $PIECE(^ONCO(165.5,DA,3),U,42)=""
+14 ;140.1;NUMBER OF LN REMOVED @FAC(R)
SET $PIECE(^ONCO(165.5,DA,3.1),U,11)=""
+15 ;139 ;SURG PROC/OTHER SITE (R)
SET $PIECE(^ONCO(165.5,DA,3),U,41)=""
+16 ;139.1;SURG PROC/OTHER SITE @FAC(R)
SET $PIECE(^ONCO(165.5,DA,3.1),U,10)=""
+17 ;
+18 ;58.6 ;SURGERY OF PRIMARY (F)
SET $PIECE(^ONCO(165.5,D0,3.1),U,29)=""
+19 SET TXDT=$PIECE(^ONCO(165.5,DA,3),U,1)_"S1"
+20 ;50 ;MOST DEFINITIVE SURG DATE
SET $PIECE(^ONCO(165.5,DA,3),U,1)=""
+21 KILL ^ONCO(165.5,"ATX",DA,TXDT)
+22 ;59 ;SURGICAL MARGINS
SET $PIECE(^ONCO(165.5,DA,3),U,28)=""
+23 ;58.7 ;SURGERY OF PRIMARY @FAC (F)
SET $PIECE(^ONCO(165.5,D0,3.1),U,30)=""
+24 ;50.3 ;MOST DEFINITIVE SURG @FAC DATE
SET $PIECE(^ONCO(165.5,DA,3.1),U,8)=""
+25 ;
+26 ;138.4;SCOPE OF LN SURGERY (F)
SET $PIECE(^ONCO(165.5,DA,3.1),U,31)=""
+27 SET TXDT=$PIECE($GET(^ONCO(165.5,DA,3.1)),U,22)_"S2"
+28 ;138.2;SCOPE OF LN SURGERY DATE
SET $PIECE(^ONCO(165.5,DA,3.1),U,22)=""
+29 KILL ^ONCO(165.5,"ATX",DA,TXDT)
+30 ;138.5;SCOPE OF LN SURGERY @FAC (F)
SET $PIECE(^ONCO(165.5,DA,3.1),U,32)=""
+31 ;138.2;SCOPE OF LN SURGERY @FAC DT
SET $PIECE(^ONCO(165.5,DA,3.1),U,23)=""
+32 ;
+33 ;139.4;SURG PROC/OTHER SITE (F)
SET $PIECE(^ONCO(165.5,DA,3.1),U,33)=""
+34 SET TXDT=$PIECE(^ONCO(165.5,DA,3.1),U,24)_"S3"
+35 ;139.2;SURG PROC/OTHER SITE DATE
SET $PIECE(^ONCO(165.5,DA,3.1),U,24)=""
+36 KILL ^ONCO(165.5,"ATX",DA,TXDT)
+37 ;139.5;SURG PROC/OTHER SITE @FAC(F)
SET $PIECE(^ONCO(165.5,DA,3.1),U,34)=""
+38 ;139.3;SURG PROC/OTHER SITE @FAC DT
SET $PIECE(^ONCO(165.5,DA,3.1),U,25)=""
+39 ;23 ;RECONSTRUCTION/RESTORATION
SET $PIECE(^ONCO(165.5,DA,3),U,33)=""
+40 ;435 ;DATE OF SURGICAL DISCHARGE
SET $PIECE(^ONCO(165.5,DA,"THY1"),U,36)=""
+41 ;14 ;READMISSION W/I 30 DAYS/SURG
SET $PIECE(^ONCO(165.5,DA,3.1),U,28)=""
+42 ;108 ;TEXT-RX-SURGERY
KILL ^ONCO(165.5,DA,14)
+43 ;58 ;REASON NO SURGERY OF PRIMARY
SET $PIECE(^ONCO(165.5,DA,3),U,26)=""
+44 QUIT
SCT ;
+1 NEW SCT
+2 SET OLDSCG=$PIECE($GET(^ONCO(164,OLDTOP,0)),U,16)
IF OLDSCG=""
QUIT
+3 SET NEWSCG=$PIECE($GET(^ONCO(164,X,0)),U,16)
IF NEWSCG=""
QUIT
+4 IF OLDSCG=NEWSCG
QUIT
+5 DO MESSAGE
+6 WRITE !?5,"SUBSEQUENT COURSE OF TREATMENT",?36,"(all surgery fields)"
+7 FOR SCT=0:0
SET SCT=$ORDER(^ONCO(165.5,DA,4,SCT))
if SCT'>0
QUIT
Begin DoDot:1
+8 ;.04 ;SURGERY OF PRIMARY
SET $PIECE(^ONCO(165.5,DA,4,SCT,0),U,4)=""
+9 ;.041;SURGERY OF PRIMARY DATE
SET $PIECE(^ONCO(165.5,DA,4,SCT,0),U,11)=""
+10 ;35 ;SCOPE OF LN SURGERY
SET $PIECE(^ONCO(165.5,DA,4,SCT,2),U,32)=""
+11 ;37 ;NUMBER OF LN REMOVED
SET $PIECE(^ONCO(165.5,DA,4,SCT,2),U,34)=""
+12 ;36 ;SURG PROC/OTHER SITE
SET $PIECE(^ONCO(165.5,DA,4,SCT,2),U,33)=""
+13 ;33 ;RECON/RESTORE DELAYED
SET $PIECE(^ONCO(165.5,DA,4,SCT,2),U,30)=""
+14 ;34 ;RECON/RESTORE DELAY DATE
SET $PIECE(^ONCO(165.5,DA,4,SCT,2),U,31)=""
End DoDot:1
+15 QUIT
+16 ;
CS ;COLLABORATIVE STAGING
+1 NEW PIECE
+2 SET OLDSCG=$PIECE($GET(^ONCO(164,OLDTOP,0)),U,16)
IF OLDSCG=""
QUIT
+3 SET NEWSCG=$PIECE($GET(^ONCO(164,X,0)),U,16)
IF NEWSCG=""
QUIT
+4 IF OLDSCG=NEWSCG
QUIT
+5 DO MESSAGE
+6 IF $PIECE($GET(^ONCO(165.5,D0,0)),U,16)<3180000
WRITE !?5,"COLLABORATIVE STAGING",?36,"(all fields)"
+7 FOR PIECE=1:1:12
SET $PIECE(^ONCO(165.5,D0,"CS"),U,PIECE)=""
+8 FOR PIECE=1:1:11
SET $PIECE(^ONCO(165.5,D0,"CS1"),U,PIECE)=""
+9 FOR PIECE=13:1:19
SET $PIECE(^ONCO(165.5,D0,"CS1"),U,PIECE)=""
+10 FOR PIECE=1:1:19
SET $PIECE(^ONCO(165.5,D0,"CS2"),U,PIECE)=""
+11 SET $PIECE(^ONCO(165.5,D0,"CS3"),U,1)=""
+12 QUIT
+13 ;
SSDI ;SITE SPECIFIC DATA ITEMS
+1 NEW PIECE
+2 ;S OLDSCG=$P($G(^ONCO(164,OLDTOP,0)),U,16) I OLDSCG="" Q
+3 ;S NEWSCG=$P($G(^ONCO(164,X,0)),U,16) I NEWSCG="" Q
+4 ;I OLDSCG=NEWSCG Q
+5 DO MESSAGE
+6 IF $PIECE($GET(^ONCO(165.5,D0,0)),U,16)>3171231
WRITE !?5,"SITE-SPECIFIC DATA ITEMS",?36,"(all fields)"
+7 FOR PIECE=12:1:14
SET $PIECE(^ONCO(165.5,D0,2.3),U,PIECE)=""
+8 FOR PIECE=1:1:35
SET $PIECE(^ONCO(165.5,D0,"SSD1"),U,PIECE)=""
+9 FOR PIECE=1:1:36
SET $PIECE(^ONCO(165.5,D0,"SSD2"),U,PIECE)=""
+10 FOR PIECE=1:1:34
SET $PIECE(^ONCO(165.5,D0,"SSD3"),U,PIECE)=""
+11 FOR PIECE=1:1:33
SET $PIECE(^ONCO(165.5,D0,"SSD4"),U,PIECE)=""
+12 QUIT
PM ;PERFORMANCE MEASURES
+1 NEW PIECE
+2 SET OLDSCG=$PIECE($GET(^ONCO(164,OLDTOP,0)),U,16)
IF OLDSCG=""
QUIT
+3 SET NEWSCG=$PIECE($GET(^ONCO(164,X,0)),U,16)
IF NEWSCG=""
QUIT
+4 IF OLDSCG=NEWSCG
QUIT
+5 DO MESSAGE
+6 WRITE !?5,"PERFORMANCE MEASURES",?36,"(all fields)"
+7 FOR PIECE=1:1:28
SET $PIECE(^ONCO(165.5,D0,"PM"),U,PIECE)=""
+8 SET $PIECE(^ONCO(165.5,D0,3),U,29)=""
+9 SET $PIECE(^ONCO(165.5,D0,"BLA2"),U,41)=""
+10 QUIT
+11 ;
MESSAGE ;
+1 IF MSSG=1
QUIT
+2 WRITE !!?3,"You have changed the PRIMARY SITE. The new topography is"
+3 WRITE !?3,"outside of the old topography's site group. This change"
+4 WRITE !?3,"may affect the validity of all site-specific fields. Therefore,"
+5 WRITE !?3,"these fields have been initialized and need to be re-entered:"
+6 WRITE !
SET MSSG=1
QUIT
+7 QUIT
+8 ;
CLEANUP ;Cleanup
+1 KILL D0,DA,MSSG,OLDTOP,X
