ONCPTX ;HINES OIFO/GWB - First Course of Treatment ;10/05/11
;;2.2;ONCOLOGY;**1,5,6,10,15**;Jul 31, 2013;Build 5
;
N DATEDX
S DATEDX=$P($G(^ONCO(165.5,D0,0)),U,16)
;
NCDS ;Surgical Diagnostic and Staging Procedure
N COC,TXDT
S COC=$E($$GET1^DIQ(165.5,D0,.04,"E"),1,2)
I COC=38 D
.S $P(^ONCO(165.5,D0,3),U,27)="00"
.S $P(^ONCO(165.5,D0,3.1),U,5)="00"
.S $P(^ONCO(165.5,D0,3),U,31)="0000000"
.S $P(^ONCO(165.5,D0,3.1),U,6)="0000000"
.S:$P($G(^ONCO(165.5,D0,0)),U,16)>3091239 $P(^ONCO(165.5,D0,2.3),U,5)=0
.I $P(^ONCO(165.5,D0,2.1),U,11)'="" D
..S TXDT=$P(^ONCO(165.5,D0,2.1),U,11)_"N"
..S $P(^ONCO(165.5,D0,2.1),U,11)=""
..K ^ONCO(165.5,"ATX",D0,TXDT)
N DASHES S $P(DASHES,"-",80)="-"
N DA,DI,DIC,DIQ,DR K ONC
S DIC="^ONCO(165.5,"
S DR="58.1;58.3;58.4;58.5;235;281;228;229;230;231;232;124"
S DA=D0,DIQ="ONC(" D EN^DIQ1
F I=58.1,58.4,235,281 S X=ONC(165.5,D0,I) D UCASE S ONC(165.5,D0,I)=X
D FST^ONCOAIP
W !," SURGICAL DIAGNOSTIC AND STAGING PROCEDURE"
W !," -----------------------------------------"
S TXT=ONC(165.5,D0,58.1),LEN=38 D TXT
W !," Surgical Dx/Staging Proc.....: ",$E(ONC(165.5,D0,58.3),1,6)_$E(ONC(165.5,D0,58.3),9,10),?41,TXT1
W:TXT2'="" !?41,TXT2
S TXT=ONC(165.5,D0,58.4),LEN=38 D TXT
W !," Surg Dx/Staging Proc @fac....: ",$E(ONC(165.5,D0,58.5),1,6)_$E(ONC(165.5,D0,58.5),9,10),?41,TXT1
W:TXT2'="" !?41,TXT2
W !!," Tx Guidelines Discussion.....: ",ONC(165.5,D0,281)
S TXGL=""
I ONC(165.5,D0,228)'="" S TXGL=ONC(165.5,D0,228)
I ONC(165.5,D0,229)'="" S TXGL=TXGL_"/"_ONC(165.5,D0,229)
I ONC(165.5,D0,230)'="" S TXGL=TXGL_"/"_ONC(165.5,D0,230)
W !," Treatment Guideline(s).......: ",TXGL
W:TXGL'="" !," Treatment Guideline Location.: ",ONC(165.5,D0,231)
W:TXGL'="" !," Treatment Guideline Doc Date.: ",ONC(165.5,D0,232)
W:DATEDX>3091231 !!," Treatment Status.............: ",ONC(165.5,D0,235)
W:ONC(165.5,D0,124)'="" !," Date of No Treatment.........: ",ONC(165.5,D0,124)
W !,DASHES
I COC=38 D ^ONCOCC
D EXIT
Q
;
ROADS ;Surgical Procedures (ROADS)
N DASHES S $P(DASHES,"-",80)="-"
N DI,DIC,DR,DA,DIQ K ONC
S DIC="^ONCO(165.5,"
S DR="50;58.6;50.3;58.7;59;138:138.5;139:139.5;435;14;58;23;74;58.2;50.2;140;140.1"
S DA=D0,DIQ="ONC(" D EN^DIQ1
F I=58.6,58.7,59,138,138.1,138.4,138.5,139,139.1,139.4,139.5,435,14,58,23,74,58.2,50.2,140,140.1 S X=ONC(165.5,D0,I) D UCASE S ONC(165.5,D0,I)=X
D FST^ONCOAIP
;W !," SURGICAL PROCEDURES (ROADS)"
W !," Pre-2003 cases require the following ROADS surgery items to be coded:"
W !,DASHES
S TXT=ONC(165.5,D0,58.2),LEN=48 D TXT
W !," Surgery of primary........(R): ",TXT1 W:TXT2'="" !?32,TXT2
W !," Surgical Approach.........(R): ",ONC(165.5,DA,74)
S TXT=ONC(165.5,D0,50.2),LEN=48 D TXT
W !," Surgery of primary @fac...(R): ",TXT1 W:TXT2'="" !?32,TXT2
S TXT=ONC(165.5,D0,138),LEN=48 D TXT
W !," Scope of ln surgery.......(R): ",TXT1 W:TXT2'="" !?32,TXT2
W !," Number of LN removed..... (R): ",ONC(165.5,D0,140)
S TXT=ONC(165.5,D0,138.1),LEN=48 D TXT
W !," Scope of ln surgery @fac..(R): ",TXT1 W:TXT2'="" !?32,TXT2
W !," Number of LN removed @fac.(R): ",ONC(165.5,D0,140.1)
S TXT=ONC(165.5,D0,139),LEN=48 D TXT
W !," Surg proc/other site......(R): ",TXT1 W:TXT2'="" !?32,TXT2
S TXT=ONC(165.5,D0,139.1),LEN=48 D TXT
W !," Surg proc/other site @fac.(R): ",TXT1 W:TXT2'="" !?32,TXT2
W !,DASHES
D EXIT
Q
;
FORDS ;Surgical Procedures (FORDS)
N DASHES S $P(DASHES,"-",80)="-"
S TOPX=$P($G(^ONCO(165.5,D0,2)),U,1)
I (TOPX=67420)!(TOPX=67421)!(TOPX=67423)!(TOPX=67424)!($E(TOPX,3,4)=76)!(TOPX=67809) D
.S $P(^ONCO(165.5,D0,3.1),U,29)=1
.S $P(^ONCO(165.5,D0,3),U,1)="0000000"
N DI,DIC,DR,DA,DIQ K ONC
S DIC="^ONCO(165.5,"
S DR="50;58.6;50.3;58.7;59;138:138.5;139:139.7;435;14;58;23;74;58.2;50.2;140;140.1;170;46;47;234"
S DA=D0,DIQ="ONC(" D EN^DIQ1
F I=58.6,58.7,59,138,138.1,138.4,138.5,139,139.1,139.4,139.5,139.6,435,14,58,23,74,58.2,50.2,140,140.1,234,46,47 S X=ONC(165.5,D0,I) D UCASE S ONC(165.5,D0,I)=X
D FST^ONCOAIP
;W !," SURGICAL PROCEDURES (FORDS)"
;W !," ---------------------------"
S TXT=ONC(165.5,D0,58.6),LEN=38 D TXT
W !," Surgery of primary........(F): ",$E(ONC(165.5,D0,50),1,6)_$E(ONC(165.5,D0,50),9,10),?41,TXT1
W:TXT2'="" !?41,TXT2
S TXT=ONC(165.5,D0,58.7),LEN=38 D TXT
W !," Surgery of primary @fac...(F): ",$E(ONC(165.5,D0,50.3),1,6)_$E(ONC(165.5,D0,50.3),9,10),?41,TXT1
W:TXT2'="" !?41,TXT2
W !," Surgical margins.............: ",ONC(165.5,DA,59)
W:DATEDX>3091231 !," RX Hosp--Surg App 2010.......: ",ONC(165.5,DA,234)
S TXT=ONC(165.5,D0,138.4),LEN=38 D TXT
W !," Scope of ln surgery.......(F): ",$E(ONC(165.5,D0,138.2),1,6)_$E(ONC(165.5,D0,138.2),9,10),?41,TXT1
W:TXT2'="" !?41,TXT2
S TXT=ONC(165.5,D0,138.5),LEN=38 D TXT
W !," Scope of ln surgery @fac..(F): ",$E(ONC(165.5,D0,138.3),1,6)_$E(ONC(165.5,D0,138.3),9,10),?41,TXT1
W:TXT2'="" !?41,TXT2
S TXT=ONC(165.5,D0,139.4),LEN=38 D TXT
W !," Surg proc/other site......(F): ",$E(ONC(165.5,D0,139.2),1,6)_$E(ONC(165.5,D0,139.2),9,10),?41,TXT1
W:TXT2'="" !?41,TXT2
S TXT=ONC(165.5,D0,139.6),LEN=38 D TXT
W !," METS site resected...........: ",$E(ONC(165.5,D0,139.7),1,6)_$E(ONC(165.5,D0,139.7),9,10),?41,TXT1
W:TXT2'="" !?41,TXT2
S TXT=ONC(165.5,D0,139.5),LEN=38 D TXT
W !," Surg proc/other site @fac.(F): ",$E(ONC(165.5,D0,139.3),1,6)_$E(ONC(165.5,D0,139.3),9,10),?41,TXT1
W:TXT2'="" !?41,TXT2
W !," Date First Surgical Procedure: ",$E(ONC(165.5,D0,170),1,6)_$E(ONC(165.5,D0,170),9,10)
S TXT=ONC(165.5,D0,23),LEN=38 D TXT
W:DATEDX<3030000 !," Reconstruction/restoration...: ",TXT1
W:TXT2'="" !?41,TXT2
W !," Date of surgical discharge...: ",$E(ONC(165.5,D0,435),1,6)_$E(ONC(165.5,D0,435),9,10)
W !," Readmission w/i 30 days/surg.: ",ONC(165.5,D0,14)
W !," Reason no surgery of primary.: ",ONC(165.5,D0,58)
W !," CAP Protocol Review..........: ",ONC(165.5,D0,46)
W:ONC(165.5,D0,46)="FAILED" !," CAP Text.....................: ",ONC(165.5,D0,47)
W !,DASHES
D EXIT
Q
;
RAD ;Radiation
D FST^ONCOAIP
N DASHES S $P(DASHES,"-",80)="-"
N DI,DIC,DR,DA,DIQ K ONC
S DIC="^ONCO(165.5,"
S DR="51;51.2;51.3;51.4;51.5;56;75;125;126;363;442;363.1;443;361;5501:5527;7024:7026"
S DA=D0,DIQ="ONC(" D EN^DIQ1
F I=51.2,126,125,363,363.1,56,51.3,51.4,75,442,443 S X=ONC(165.5,D0,I) D UCASE S ONC(165.5,D0,I)=X
F I=5501,5502,5503,5504,5505,5506,5507,5511,5512,5513,5514,5515,5516,5517,5521,5522,5523,5524,5525,5526,5527,7024,7025,7026 S X=ONC(165.5,D0,I) D UCASE S ONC(165.5,D0,I)=X
I $P($G(^ONCO(165.5,D0,0)),"^",16)<3180101 W !," Radiation....................: ",ONC(165.5,DA,51.2)
W !," Date radiation started.......: ",ONC(165.5,DA,51)
I $P($G(^ONCO(165.5,D0,0)),"^",16)<3180101 W !," Radiation @fac...............: ",ONC(165.5,DA,51.5)," ",ONC(165.5,DA,51.4)
W !," Location of radiation tx.....: ",ONC(165.5,DA,126)
I $P($G(^ONCO(165.5,D0,0)),"^",16)<3180101 D
.W !," Radiation treatment volume...: ",ONC(165.5,DA,125)
.W !," Regional treatment modality..: ",ONC(165.5,DA,363)
.W !," Regional dose:cGy............: ",ONC(165.5,DA,442)
.W !," Boost treatment modality.....: ",ONC(165.5,DA,363.1)
.W !," Boost dose:cGy...............: ",ONC(165.5,DA,443)
.W !," Number of txs to this volume.: ",ONC(165.5,DA,56)
I $P($G(^ONCO(165.5,D0,0)),"^",16)>3171231 D
.W !," Phase I rad treatment volume...........: ",ONC(165.5,DA,5504)
.W !," Phase I rad to draining lymph nodes....: ",ONC(165.5,DA,5505)
.W !," Phase I treatment modality.............: ",ONC(165.5,DA,5506)
.W !," Phase I rad external beam planning.....: ",ONC(165.5,DA,5502)
.W !," Phase I dose per fraction..............: ",ONC(165.5,DA,5501)
.W !," Phase I number of fractions............: ",ONC(165.5,DA,5503)
.W !," Phase I total dose.....................: ",ONC(165.5,DA,5507)
.I ONC(165.5,DA,5514)'="" W !," Phase II rad treatment volume..........: ",ONC(165.5,DA,5514)
.I ONC(165.5,DA,5515)'="" W !," Phase II rad to draining lymph nodes...: ",ONC(165.5,DA,5515)
.I ONC(165.5,DA,5516)'="" W !," Phase II treatment modality............: ",ONC(165.5,DA,5516)
.I ONC(165.5,DA,5512)'="" W !," Phase II rad external beam planning....: ",ONC(165.5,DA,5512)
.I ONC(165.5,DA,5511)'="" W !," Phase II dose per fraction.............: ",ONC(165.5,DA,5511)
.I ONC(165.5,DA,5513)'="" W !," Phase II number of fractions...........: ",ONC(165.5,DA,5513)
.I ONC(165.5,DA,5517)'="" W !," Phase II total dose....................: ",ONC(165.5,DA,5517)
.I ONC(165.5,DA,5524)'="" W !," Phase III rad treatment volume.........: ",ONC(165.5,DA,5524)
.I ONC(165.5,DA,5525)'="" W !," Phase III rad to draining lymph nodes..: ",ONC(165.5,DA,5525)
.I ONC(165.5,DA,5526)'="" W !," Phase III treatment modality...........: ",ONC(165.5,DA,5526)
.I ONC(165.5,DA,5522)'="" W !," Phase III rad external beam planning...: ",ONC(165.5,DA,5522)
.I ONC(165.5,DA,5521)'="" W !," Phase III dose per fraction............: ",ONC(165.5,DA,5521)
.I ONC(165.5,DA,5523)'="" W !," Phase III number of fractions..........: ",ONC(165.5,DA,5523)
.I ONC(165.5,DA,5527)'="" W !," Phase III total dose...................: ",ONC(165.5,DA,5527)
.W !," Number of Phases Rad TX to this Volume.: ",ONC(165.5,DA,7024)
.W !," Radiation Treatment Disc Early.........: ",ONC(165.5,DA,7025)
.W !," Total Dose.............................: ",ONC(165.5,DA,7026)
W !," Radiation/surgery sequence...: ",ONC(165.5,DA,51.3)
W !," Date radiation ended.........: ",ONC(165.5,DA,361)
W !," Reason for no radiation......: ",ONC(165.5,DA,75)
W !,DASHES
D EXIT
Q
;
ST ;Systemic Therapy
D FST^ONCOAIP
N DASHES S $P(DASHES,"-",80)="-"
;W !," SYSTEMIC THERAPY"
;W !," ----------------"
N DI,DIC,DR,DA,DIQ K ONC
S DIC="^ONCO(165.5,"
S DR="152;53;53.2;53.3;53.4;54;54.2;54.3;54.4;55;55.2;55.3;55.4;153:153.3;15;1423:1423.4"
S DA=D0,DIQ="ONC(" D EN^DIQ1
F I=53.2,53.3,54.2,54.3,55.2,55.3,153,153.2,15 S X=ONC(165.5,D0,I) D UCASE S ONC(165.5,D0,I)=X
W !," Date systemic therapy started.: ",ONC(165.5,DA,152)
W !," Chemotherapy..................: ",ONC(165.5,DA,53)," ",$E(ONC(165.5,DA,53.2),1,34)
W !," Chemotherapy @fac.............: ",ONC(165.5,DA,53.4)," ",$E(ONC(165.5,DA,53.3),1,34)
W:ONC(165.5,DA,1423)'="" !," Chemotherapeutic agent #1.....: ",ONC(165.5,DA,1423)
W:ONC(165.5,DA,1423.1)'="" !," Chemotherapeutic agent #2.....: ",ONC(165.5,DA,1423.1)
W:ONC(165.5,DA,1423.2)'="" !," Chemotherapeutic agent #3.....: ",ONC(165.5,DA,1423.2)
W:ONC(165.5,DA,1423.3)'="" !," Chemotherapeutic agent #4.....: ",ONC(165.5,DA,1423.3)
W:ONC(165.5,DA,1423.4)'="" !," Chemotherapeutic agent #5.....: ",ONC(165.5,DA,1423.4)
W !," Hormone therapy...............: ",ONC(165.5,DA,54)," ",$E(ONC(165.5,DA,54.2),1,34)
W !," Hormone therapy @fac..........: ",ONC(165.5,DA,54.4)," ",$E(ONC(165.5,DA,54.3),1,34)
W !," Immunotherapy.................: ",ONC(165.5,DA,55)," ",$E(ONC(165.5,DA,55.2),1,34)
W !," Immunotherapy @fac............: ",ONC(165.5,DA,55.4)," ",$E(ONC(165.5,DA,55.3),1,34)
W !," Hema Trans/Endocrine Proc.....: ",ONC(165.5,DA,153.1)," ",$E(ONC(165.5,DA,153),1,34)
W !," Hema Trans/Endocrine Proc @fac: ",ONC(165.5,DA,153.3)," ",$E(ONC(165.5,DA,153.2),1,34)
W:DATEDX>3051231 !," Systemic/Surgery Sequence.....: ",ONC(165.5,DA,15)
W !,DASHES
D EXIT
Q
;
OTH ;Other Treatment
D FST^ONCOAIP
N DASHES S $P(DASHES,"-",80)="-"
;W !," OTHER TREATMENT"
;W !," ---------------"
N DI,DIC,DR,DA,DIQ K ONC
S DIC="^ONCO(165.5,"
S DR="57;57.2;57.3;57.4"
S DA=D0,DIQ="ONC(" D EN^DIQ1
F I=57,57.2,57.3,57.4 S X=ONC(165.5,D0,I) D UCASE S ONC(165.5,D0,I)=X
W !," Other treatment...............: ",ONC(165.5,DA,57)," ",ONC(165.5,DA,57.2)
W !," Other treatment @fac..........: ",ONC(165.5,DA,57.4)," ",ONC(165.5,DA,57.3)
W !,DASHES
D EXIT
Q
;
PRO ;Palliative Care/Protocol Participation
D FST^ONCOAIP
N DASHES S $P(DASHES,"-",80)="-"
;W !," PALLIATIVE CARE/PROTOCOL PARTICIPATION"
;W !," -------------------------------------------"
N DI,DIC,DR,DA,DIQ K ONC
S DIC="^ONCO(165.5,"
S DR="133;560;154;12;13;346;279"
S DA=D0,DIQ="ONC(" D EN^DIQ1
F I=560,154,12,13,346,279 S X=ONC(165.5,D0,I) D UCASE S ONC(165.5,D0,I)=X
W !," Palliative care...............: ",ONC(165.5,DA,12)
W !," Palliative care @fac..........: ",ONC(165.5,DA,13)
W !
W !," Clinical Trials Discussion....: "_ONC(165.5,DA,279)
W !
W !," Protocol eligibility status...: "_ONC(165.5,DA,346)
W !," Protocol participation........: "_ONC(165.5,DA,560)
W !," Year put on protocol..........: "_ONC(165.5,DA,133)
W !,DASHES
D EXIT
Q
;
TXT ;Text formatting
N LOS,NOP
S (TXT1,TXT2)="",LOS=$L(TXT) I LOS<LEN S TXT1=TXT Q
S NOP=$L($E(TXT,1,LEN)," ")
S TXT1=$P(TXT," ",1,NOP-1),TXT2=$P(TXT," ",NOP,999)
Q
;
UCASE ;Mixed case to upper case conversion
S X=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
Q
;
EXIT ;KILL local varibles
K I,LEN,ONC,TOPX,TXGL,TXT,TXT1,TXT2,X
Q
;
CLEANUP ;Cleanup
K D0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCPTX 13036 printed Oct 16, 2024@18:28:18 Page 2
ONCPTX ;HINES OIFO/GWB - First Course of Treatment ;10/05/11
+1 ;;2.2;ONCOLOGY;**1,5,6,10,15**;Jul 31, 2013;Build 5
+2 ;
+3 NEW DATEDX
+4 SET DATEDX=$PIECE($GET(^ONCO(165.5,D0,0)),U,16)
+5 ;
NCDS ;Surgical Diagnostic and Staging Procedure
+1 NEW COC,TXDT
+2 SET COC=$EXTRACT($$GET1^DIQ(165.5,D0,.04,"E"),1,2)
+3 IF COC=38
Begin DoDot:1
+4 SET $PIECE(^ONCO(165.5,D0,3),U,27)="00"
+5 SET $PIECE(^ONCO(165.5,D0,3.1),U,5)="00"
+6 SET $PIECE(^ONCO(165.5,D0,3),U,31)="0000000"
+7 SET $PIECE(^ONCO(165.5,D0,3.1),U,6)="0000000"
+8 if $PIECE($GET(^ONCO(165.5,D0,0)),U,16)>3091239
SET $PIECE(^ONCO(165.5,D0,2.3),U,5)=0
+9 IF $PIECE(^ONCO(165.5,D0,2.1),U,11)'=""
Begin DoDot:2
+10 SET TXDT=$PIECE(^ONCO(165.5,D0,2.1),U,11)_"N"
+11 SET $PIECE(^ONCO(165.5,D0,2.1),U,11)=""
+12 KILL ^ONCO(165.5,"ATX",D0,TXDT)
End DoDot:2
End DoDot:1
+13 NEW DASHES
SET $PIECE(DASHES,"-",80)="-"
+14 NEW DA,DI,DIC,DIQ,DR
KILL ONC
+15 SET DIC="^ONCO(165.5,"
+16 SET DR="58.1;58.3;58.4;58.5;235;281;228;229;230;231;232;124"
+17 SET DA=D0
SET DIQ="ONC("
DO EN^DIQ1
+18 FOR I=58.1,58.4,235,281
SET X=ONC(165.5,D0,I)
DO UCASE
SET ONC(165.5,D0,I)=X
+19 DO FST^ONCOAIP
+20 WRITE !," SURGICAL DIAGNOSTIC AND STAGING PROCEDURE"
+21 WRITE !," -----------------------------------------"
+22 SET TXT=ONC(165.5,D0,58.1)
SET LEN=38
DO TXT
+23 WRITE !," Surgical Dx/Staging Proc.....: ",$EXTRACT(ONC(165.5,D0,58.3),1,6)_$EXTRACT(ONC(165.5,D0,58.3),9,10),?41,TXT1
+24 if TXT2'=""
WRITE !?41,TXT2
+25 SET TXT=ONC(165.5,D0,58.4)
SET LEN=38
DO TXT
+26 WRITE !," Surg Dx/Staging Proc @fac....: ",$EXTRACT(ONC(165.5,D0,58.5),1,6)_$EXTRACT(ONC(165.5,D0,58.5),9,10),?41,TXT1
+27 if TXT2'=""
WRITE !?41,TXT2
+28 WRITE !!," Tx Guidelines Discussion.....: ",ONC(165.5,D0,281)
+29 SET TXGL=""
+30 IF ONC(165.5,D0,228)'=""
SET TXGL=ONC(165.5,D0,228)
+31 IF ONC(165.5,D0,229)'=""
SET TXGL=TXGL_"/"_ONC(165.5,D0,229)
+32 IF ONC(165.5,D0,230)'=""
SET TXGL=TXGL_"/"_ONC(165.5,D0,230)
+33 WRITE !," Treatment Guideline(s).......: ",TXGL
+34 if TXGL'=""
WRITE !," Treatment Guideline Location.: ",ONC(165.5,D0,231)
+35 if TXGL'=""
WRITE !," Treatment Guideline Doc Date.: ",ONC(165.5,D0,232)
+36 if DATEDX>3091231
WRITE !!," Treatment Status.............: ",ONC(165.5,D0,235)
+37 if ONC(165.5,D0,124)'=""
WRITE !," Date of No Treatment.........: ",ONC(165.5,D0,124)
+38 WRITE !,DASHES
+39 IF COC=38
DO ^ONCOCC
+40 DO EXIT
+41 QUIT
+42 ;
ROADS ;Surgical Procedures (ROADS)
+1 NEW DASHES
SET $PIECE(DASHES,"-",80)="-"
+2 NEW DI,DIC,DR,DA,DIQ
KILL ONC
+3 SET DIC="^ONCO(165.5,"
+4 SET DR="50;58.6;50.3;58.7;59;138:138.5;139:139.5;435;14;58;23;74;58.2;50.2;140;140.1"
+5 SET DA=D0
SET DIQ="ONC("
DO EN^DIQ1
+6 FOR I=58.6,58.7,59,138,138.1,138.4,138.5,139,139.1,139.4,139.5,435,14,58,23,74,58.2,50.2,140,140.1
SET X=ONC(165.5,D0,I)
DO UCASE
SET ONC(165.5,D0,I)=X
+7 DO FST^ONCOAIP
+8 ;W !," SURGICAL PROCEDURES (ROADS)"
+9 WRITE !," Pre-2003 cases require the following ROADS surgery items to be coded:"
+10 WRITE !,DASHES
+11 SET TXT=ONC(165.5,D0,58.2)
SET LEN=48
DO TXT
+12 WRITE !," Surgery of primary........(R): ",TXT1
if TXT2'=""
WRITE !?32,TXT2
+13 WRITE !," Surgical Approach.........(R): ",ONC(165.5,DA,74)
+14 SET TXT=ONC(165.5,D0,50.2)
SET LEN=48
DO TXT
+15 WRITE !," Surgery of primary @fac...(R): ",TXT1
if TXT2'=""
WRITE !?32,TXT2
+16 SET TXT=ONC(165.5,D0,138)
SET LEN=48
DO TXT
+17 WRITE !," Scope of ln surgery.......(R): ",TXT1
if TXT2'=""
WRITE !?32,TXT2
+18 WRITE !," Number of LN removed..... (R): ",ONC(165.5,D0,140)
+19 SET TXT=ONC(165.5,D0,138.1)
SET LEN=48
DO TXT
+20 WRITE !," Scope of ln surgery @fac..(R): ",TXT1
if TXT2'=""
WRITE !?32,TXT2
+21 WRITE !," Number of LN removed @fac.(R): ",ONC(165.5,D0,140.1)
+22 SET TXT=ONC(165.5,D0,139)
SET LEN=48
DO TXT
+23 WRITE !," Surg proc/other site......(R): ",TXT1
if TXT2'=""
WRITE !?32,TXT2
+24 SET TXT=ONC(165.5,D0,139.1)
SET LEN=48
DO TXT
+25 WRITE !," Surg proc/other site @fac.(R): ",TXT1
if TXT2'=""
WRITE !?32,TXT2
+26 WRITE !,DASHES
+27 DO EXIT
+28 QUIT
+29 ;
FORDS ;Surgical Procedures (FORDS)
+1 NEW DASHES
SET $PIECE(DASHES,"-",80)="-"
+2 SET TOPX=$PIECE($GET(^ONCO(165.5,D0,2)),U,1)
+3 IF (TOPX=67420)!(TOPX=67421)!(TOPX=67423)!(TOPX=67424)!($EXTRACT(TOPX,3,4)=76)!(TOPX=67809)
Begin DoDot:1
+4 SET $PIECE(^ONCO(165.5,D0,3.1),U,29)=1
+5 SET $PIECE(^ONCO(165.5,D0,3),U,1)="0000000"
End DoDot:1
+6 NEW DI,DIC,DR,DA,DIQ
KILL ONC
+7 SET DIC="^ONCO(165.5,"
+8 SET DR="50;58.6;50.3;58.7;59;138:138.5;139:139.7;435;14;58;23;74;58.2;50.2;140;140.1;170;46;47;234"
+9 SET DA=D0
SET DIQ="ONC("
DO EN^DIQ1
+10 FOR I=58.6,58.7,59,138,138.1,138.4,138.5,139,139.1,139.4,139.5,139.6,435,14,58,23,74,58.2,50.2,140,140.1,234,46,47
SET X=ONC(165.5,D0,I)
DO UCASE
SET ONC(165.5,D0,I)=X
+11 DO FST^ONCOAIP
+12 ;W !," SURGICAL PROCEDURES (FORDS)"
+13 ;W !," ---------------------------"
+14 SET TXT=ONC(165.5,D0,58.6)
SET LEN=38
DO TXT
+15 WRITE !," Surgery of primary........(F): ",$EXTRACT(ONC(165.5,D0,50),1,6)_$EXTRACT(ONC(165.5,D0,50),9,10),?41,TXT1
+16 if TXT2'=""
WRITE !?41,TXT2
+17 SET TXT=ONC(165.5,D0,58.7)
SET LEN=38
DO TXT
+18 WRITE !," Surgery of primary @fac...(F): ",$EXTRACT(ONC(165.5,D0,50.3),1,6)_$EXTRACT(ONC(165.5,D0,50.3),9,10),?41,TXT1
+19 if TXT2'=""
WRITE !?41,TXT2
+20 WRITE !," Surgical margins.............: ",ONC(165.5,DA,59)
+21 if DATEDX>3091231
WRITE !," RX Hosp--Surg App 2010.......: ",ONC(165.5,DA,234)
+22 SET TXT=ONC(165.5,D0,138.4)
SET LEN=38
DO TXT
+23 WRITE !," Scope of ln surgery.......(F): ",$EXTRACT(ONC(165.5,D0,138.2),1,6)_$EXTRACT(ONC(165.5,D0,138.2),9,10),?41,TXT1
+24 if TXT2'=""
WRITE !?41,TXT2
+25 SET TXT=ONC(165.5,D0,138.5)
SET LEN=38
DO TXT
+26 WRITE !," Scope of ln surgery @fac..(F): ",$EXTRACT(ONC(165.5,D0,138.3),1,6)_$EXTRACT(ONC(165.5,D0,138.3),9,10),?41,TXT1
+27 if TXT2'=""
WRITE !?41,TXT2
+28 SET TXT=ONC(165.5,D0,139.4)
SET LEN=38
DO TXT
+29 WRITE !," Surg proc/other site......(F): ",$EXTRACT(ONC(165.5,D0,139.2),1,6)_$EXTRACT(ONC(165.5,D0,139.2),9,10),?41,TXT1
+30 if TXT2'=""
WRITE !?41,TXT2
+31 SET TXT=ONC(165.5,D0,139.6)
SET LEN=38
DO TXT
+32 WRITE !," METS site resected...........: ",$EXTRACT(ONC(165.5,D0,139.7),1,6)_$EXTRACT(ONC(165.5,D0,139.7),9,10),?41,TXT1
+33 if TXT2'=""
WRITE !?41,TXT2
+34 SET TXT=ONC(165.5,D0,139.5)
SET LEN=38
DO TXT
+35 WRITE !," Surg proc/other site @fac.(F): ",$EXTRACT(ONC(165.5,D0,139.3),1,6)_$EXTRACT(ONC(165.5,D0,139.3),9,10),?41,TXT1
+36 if TXT2'=""
WRITE !?41,TXT2
+37 WRITE !," Date First Surgical Procedure: ",$EXTRACT(ONC(165.5,D0,170),1,6)_$EXTRACT(ONC(165.5,D0,170),9,10)
+38 SET TXT=ONC(165.5,D0,23)
SET LEN=38
DO TXT
+39 if DATEDX<3030000
WRITE !," Reconstruction/restoration...: ",TXT1
+40 if TXT2'=""
WRITE !?41,TXT2
+41 WRITE !," Date of surgical discharge...: ",$EXTRACT(ONC(165.5,D0,435),1,6)_$EXTRACT(ONC(165.5,D0,435),9,10)
+42 WRITE !," Readmission w/i 30 days/surg.: ",ONC(165.5,D0,14)
+43 WRITE !," Reason no surgery of primary.: ",ONC(165.5,D0,58)
+44 WRITE !," CAP Protocol Review..........: ",ONC(165.5,D0,46)
+45 if ONC(165.5,D0,46)="FAILED"
WRITE !," CAP Text.....................: ",ONC(165.5,D0,47)
+46 WRITE !,DASHES
+47 DO EXIT
+48 QUIT
+49 ;
RAD ;Radiation
+1 DO FST^ONCOAIP
+2 NEW DASHES
SET $PIECE(DASHES,"-",80)="-"
+3 NEW DI,DIC,DR,DA,DIQ
KILL ONC
+4 SET DIC="^ONCO(165.5,"
+5 SET DR="51;51.2;51.3;51.4;51.5;56;75;125;126;363;442;363.1;443;361;5501:5527;7024:7026"
+6 SET DA=D0
SET DIQ="ONC("
DO EN^DIQ1
+7 FOR I=51.2,126,125,363,363.1,56,51.3,51.4,75,442,443
SET X=ONC(165.5,D0,I)
DO UCASE
SET ONC(165.5,D0,I)=X
+8 FOR I=5501,5502,5503,5504,5505,5506,5507,5511,5512,5513,5514,5515,5516,5517,5521,5522,5523,5524,5525,5526,5527,7024,7025,7026
SET X=ONC(165.5,D0,I)
DO UCASE
SET ONC(165.5,D0,I)=X
+9 IF $PIECE($GET(^ONCO(165.5,D0,0)),"^",16)<3180101
WRITE !," Radiation....................: ",ONC(165.5,DA,51.2)
+10 WRITE !," Date radiation started.......: ",ONC(165.5,DA,51)
+11 IF $PIECE($GET(^ONCO(165.5,D0,0)),"^",16)<3180101
WRITE !," Radiation @fac...............: ",ONC(165.5,DA,51.5)," ",ONC(165.5,DA,51.4)
+12 WRITE !," Location of radiation tx.....: ",ONC(165.5,DA,126)
+13 IF $PIECE($GET(^ONCO(165.5,D0,0)),"^",16)<3180101
Begin DoDot:1
+14 WRITE !," Radiation treatment volume...: ",ONC(165.5,DA,125)
+15 WRITE !," Regional treatment modality..: ",ONC(165.5,DA,363)
+16 WRITE !," Regional dose:cGy............: ",ONC(165.5,DA,442)
+17 WRITE !," Boost treatment modality.....: ",ONC(165.5,DA,363.1)
+18 WRITE !," Boost dose:cGy...............: ",ONC(165.5,DA,443)
+19 WRITE !," Number of txs to this volume.: ",ONC(165.5,DA,56)
End DoDot:1
+20 IF $PIECE($GET(^ONCO(165.5,D0,0)),"^",16)>3171231
Begin DoDot:1
+21 WRITE !," Phase I rad treatment volume...........: ",ONC(165.5,DA,5504)
+22 WRITE !," Phase I rad to draining lymph nodes....: ",ONC(165.5,DA,5505)
+23 WRITE !," Phase I treatment modality.............: ",ONC(165.5,DA,5506)
+24 WRITE !," Phase I rad external beam planning.....: ",ONC(165.5,DA,5502)
+25 WRITE !," Phase I dose per fraction..............: ",ONC(165.5,DA,5501)
+26 WRITE !," Phase I number of fractions............: ",ONC(165.5,DA,5503)
+27 WRITE !," Phase I total dose.....................: ",ONC(165.5,DA,5507)
+28 IF ONC(165.5,DA,5514)'=""
WRITE !," Phase II rad treatment volume..........: ",ONC(165.5,DA,5514)
+29 IF ONC(165.5,DA,5515)'=""
WRITE !," Phase II rad to draining lymph nodes...: ",ONC(165.5,DA,5515)
+30 IF ONC(165.5,DA,5516)'=""
WRITE !," Phase II treatment modality............: ",ONC(165.5,DA,5516)
+31 IF ONC(165.5,DA,5512)'=""
WRITE !," Phase II rad external beam planning....: ",ONC(165.5,DA,5512)
+32 IF ONC(165.5,DA,5511)'=""
WRITE !," Phase II dose per fraction.............: ",ONC(165.5,DA,5511)
+33 IF ONC(165.5,DA,5513)'=""
WRITE !," Phase II number of fractions...........: ",ONC(165.5,DA,5513)
+34 IF ONC(165.5,DA,5517)'=""
WRITE !," Phase II total dose....................: ",ONC(165.5,DA,5517)
+35 IF ONC(165.5,DA,5524)'=""
WRITE !," Phase III rad treatment volume.........: ",ONC(165.5,DA,5524)
+36 IF ONC(165.5,DA,5525)'=""
WRITE !," Phase III rad to draining lymph nodes..: ",ONC(165.5,DA,5525)
+37 IF ONC(165.5,DA,5526)'=""
WRITE !," Phase III treatment modality...........: ",ONC(165.5,DA,5526)
+38 IF ONC(165.5,DA,5522)'=""
WRITE !," Phase III rad external beam planning...: ",ONC(165.5,DA,5522)
+39 IF ONC(165.5,DA,5521)'=""
WRITE !," Phase III dose per fraction............: ",ONC(165.5,DA,5521)
+40 IF ONC(165.5,DA,5523)'=""
WRITE !," Phase III number of fractions..........: ",ONC(165.5,DA,5523)
+41 IF ONC(165.5,DA,5527)'=""
WRITE !," Phase III total dose...................: ",ONC(165.5,DA,5527)
+42 WRITE !," Number of Phases Rad TX to this Volume.: ",ONC(165.5,DA,7024)
+43 WRITE !," Radiation Treatment Disc Early.........: ",ONC(165.5,DA,7025)
+44 WRITE !," Total Dose.............................: ",ONC(165.5,DA,7026)
End DoDot:1
+45 WRITE !," Radiation/surgery sequence...: ",ONC(165.5,DA,51.3)
+46 WRITE !," Date radiation ended.........: ",ONC(165.5,DA,361)
+47 WRITE !," Reason for no radiation......: ",ONC(165.5,DA,75)
+48 WRITE !,DASHES
+49 DO EXIT
+50 QUIT
+51 ;
ST ;Systemic Therapy
+1 DO FST^ONCOAIP
+2 NEW DASHES
SET $PIECE(DASHES,"-",80)="-"
+3 ;W !," SYSTEMIC THERAPY"
+4 ;W !," ----------------"
+5 NEW DI,DIC,DR,DA,DIQ
KILL ONC
+6 SET DIC="^ONCO(165.5,"
+7 SET DR="152;53;53.2;53.3;53.4;54;54.2;54.3;54.4;55;55.2;55.3;55.4;153:153.3;15;1423:1423.4"
+8 SET DA=D0
SET DIQ="ONC("
DO EN^DIQ1
+9 FOR I=53.2,53.3,54.2,54.3,55.2,55.3,153,153.2,15
SET X=ONC(165.5,D0,I)
DO UCASE
SET ONC(165.5,D0,I)=X
+10 WRITE !," Date systemic therapy started.: ",ONC(165.5,DA,152)
+11 WRITE !," Chemotherapy..................: ",ONC(165.5,DA,53)," ",$EXTRACT(ONC(165.5,DA,53.2),1,34)
+12 WRITE !," Chemotherapy @fac.............: ",ONC(165.5,DA,53.4)," ",$EXTRACT(ONC(165.5,DA,53.3),1,34)
+13 if ONC(165.5,DA,1423)'=""
WRITE !," Chemotherapeutic agent #1.....: ",ONC(165.5,DA,1423)
+14 if ONC(165.5,DA,1423.1)'=""
WRITE !," Chemotherapeutic agent #2.....: ",ONC(165.5,DA,1423.1)
+15 if ONC(165.5,DA,1423.2)'=""
WRITE !," Chemotherapeutic agent #3.....: ",ONC(165.5,DA,1423.2)
+16 if ONC(165.5,DA,1423.3)'=""
WRITE !," Chemotherapeutic agent #4.....: ",ONC(165.5,DA,1423.3)
+17 if ONC(165.5,DA,1423.4)'=""
WRITE !," Chemotherapeutic agent #5.....: ",ONC(165.5,DA,1423.4)
+18 WRITE !," Hormone therapy...............: ",ONC(165.5,DA,54)," ",$EXTRACT(ONC(165.5,DA,54.2),1,34)
+19 WRITE !," Hormone therapy @fac..........: ",ONC(165.5,DA,54.4)," ",$EXTRACT(ONC(165.5,DA,54.3),1,34)
+20 WRITE !," Immunotherapy.................: ",ONC(165.5,DA,55)," ",$EXTRACT(ONC(165.5,DA,55.2),1,34)
+21 WRITE !," Immunotherapy @fac............: ",ONC(165.5,DA,55.4)," ",$EXTRACT(ONC(165.5,DA,55.3),1,34)
+22 WRITE !," Hema Trans/Endocrine Proc.....: ",ONC(165.5,DA,153.1)," ",$EXTRACT(ONC(165.5,DA,153),1,34)
+23 WRITE !," Hema Trans/Endocrine Proc @fac: ",ONC(165.5,DA,153.3)," ",$EXTRACT(ONC(165.5,DA,153.2),1,34)
+24 if DATEDX>3051231
WRITE !," Systemic/Surgery Sequence.....: ",ONC(165.5,DA,15)
+25 WRITE !,DASHES
+26 DO EXIT
+27 QUIT
+28 ;
OTH ;Other Treatment
+1 DO FST^ONCOAIP
+2 NEW DASHES
SET $PIECE(DASHES,"-",80)="-"
+3 ;W !," OTHER TREATMENT"
+4 ;W !," ---------------"
+5 NEW DI,DIC,DR,DA,DIQ
KILL ONC
+6 SET DIC="^ONCO(165.5,"
+7 SET DR="57;57.2;57.3;57.4"
+8 SET DA=D0
SET DIQ="ONC("
DO EN^DIQ1
+9 FOR I=57,57.2,57.3,57.4
SET X=ONC(165.5,D0,I)
DO UCASE
SET ONC(165.5,D0,I)=X
+10 WRITE !," Other treatment...............: ",ONC(165.5,DA,57)," ",ONC(165.5,DA,57.2)
+11 WRITE !," Other treatment @fac..........: ",ONC(165.5,DA,57.4)," ",ONC(165.5,DA,57.3)
+12 WRITE !,DASHES
+13 DO EXIT
+14 QUIT
+15 ;
PRO ;Palliative Care/Protocol Participation
+1 DO FST^ONCOAIP
+2 NEW DASHES
SET $PIECE(DASHES,"-",80)="-"
+3 ;W !," PALLIATIVE CARE/PROTOCOL PARTICIPATION"
+4 ;W !," -------------------------------------------"
+5 NEW DI,DIC,DR,DA,DIQ
KILL ONC
+6 SET DIC="^ONCO(165.5,"
+7 SET DR="133;560;154;12;13;346;279"
+8 SET DA=D0
SET DIQ="ONC("
DO EN^DIQ1
+9 FOR I=560,154,12,13,346,279
SET X=ONC(165.5,D0,I)
DO UCASE
SET ONC(165.5,D0,I)=X
+10 WRITE !," Palliative care...............: ",ONC(165.5,DA,12)
+11 WRITE !," Palliative care @fac..........: ",ONC(165.5,DA,13)
+12 WRITE !
+13 WRITE !," Clinical Trials Discussion....: "_ONC(165.5,DA,279)
+14 WRITE !
+15 WRITE !," Protocol eligibility status...: "_ONC(165.5,DA,346)
+16 WRITE !," Protocol participation........: "_ONC(165.5,DA,560)
+17 WRITE !," Year put on protocol..........: "_ONC(165.5,DA,133)
+18 WRITE !,DASHES
+19 DO EXIT
+20 QUIT
+21 ;
TXT ;Text formatting
+1 NEW LOS,NOP
+2 SET (TXT1,TXT2)=""
SET LOS=$LENGTH(TXT)
IF LOS<LEN
SET TXT1=TXT
QUIT
+3 SET NOP=$LENGTH($EXTRACT(TXT,1,LEN)," ")
+4 SET TXT1=$PIECE(TXT," ",1,NOP-1)
SET TXT2=$PIECE(TXT," ",NOP,999)
+5 QUIT
+6 ;
UCASE ;Mixed case to upper case conversion
+1 SET X=$TRANSLATE(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+2 QUIT
+3 ;
EXIT ;KILL local varibles
+1 KILL I,LEN,ONC,TOPX,TXGL,TXT,TXT1,TXT2,X
+2 QUIT
+3 ;
CLEANUP ;Cleanup
+1 KILL D0
