ONCTXSM ;HINES OIFO/GWB - Treatment Summary ;06/23/10
;;2.2;ONCOLOGY;**1,20**;Jul 31, 2013;Build 5
;
N COC,DFCODE,DFSP,DFTXT,DIC,DR,DA,DIQ,LEN,RRDF,SCG,SITE,SUB,SURGPS,TPG
S SAVEY=Y
K ONC
D CHECKCC
D DEFAULT
S DR="49:58.9;124;133;346;560"
S DIC="^ONCO(165.5,"
S DA=D0,DIQ="ONC(" D EN^DIQ1
W !," Date of 1st course of tx....: ",$E(ONC(165.5,D0,49),1,6)_$E(ONC(165.5,D0,49),9,10)
S DFSP=$$DS^ONCACDU2(D0)
W !," Date of 1st Surgical Proc...: ",$E(DFSP,1,2)_"/"_$E(DFSP,3,4)_"/"_$E(DFSP,7,8)
S TXT=ONC(165.5,D0,58.6),LEN=40 D TXT^ONCPTX
W !," RX Summ--Surg Primsite 03-2022: ",$E(ONC(165.5,D0,50),1,6)_$E(ONC(165.5,D0,50),9,10),?40,TXT1
W:TXT2'="" !,?43,TXT2
S TXT=ONC(165.5,D0,58.7),LEN=40 D TXT^ONCPTX
I DATEDX>2971231 D
.W !," RX Hosp--Surg Primsite 03-2022: ",$E(ONC(165.5,D0,50.3),1,6)_$E(ONC(165.5,D0,50.3),9,10),?40,TXT1
.W:TXT2'="" !,?43,TXT2
W !," Radiation...................: ",$E(ONC(165.5,D0,51),1,6)_$E(ONC(165.5,D0,51),9,10),?40,ONC(165.5,D0,51.2)
W:DATEDX>2971231 !," Radiation @fac..............: ",$E(ONC(165.5,D0,51.5),1,6)_$E(ONC(165.5,D0,51.5),9,10),?40,ONC(165.5,DA,51.4)
W:DATEDX<2960000 !," Radiation therapy to CNS....: ",$E(ONC(165.5,D0,52),1,6)_$E(ONC(165.5,D0,52),9,10),?40,ONC(165.5,D0,52.2)
W !," Chemotherapy................: ",$E(ONC(165.5,D0,53),1,6)_$E(ONC(165.5,D0,53),9,10),?40,ONC(165.5,D0,53.2)
W:DATEDX>2971231 !," Chemotherapy @fac...........: ",$E(ONC(165.5,D0,53.4),1,6)_$E(ONC(165.5,D0,53.4),9,10),?40,ONC(165.5,DA,53.3)
W !," Hormone therapy.............: ",$E(ONC(165.5,D0,54),1,6)_$E(ONC(165.5,D0,54),9,10),?40,ONC(165.5,D0,54.2)
W:DATEDX>2971231 !," Hormone therapy @fac........: ",$E(ONC(165.5,D0,54.4),1,6)_$E(ONC(165.5,D0,54.4),9,10),?40,ONC(165.5,DA,54.3)
W !," Immunotherapy...............: ",$E(ONC(165.5,D0,55),1,6)_$E(ONC(165.5,D0,55),9,10),?40,ONC(165.5,D0,55.2)
W:DATEDX>2971231 !," Immunotherapy @fac..........: ",$E(ONC(165.5,D0,55.4),1,6)_$E(ONC(165.5,D0,55.4),9,10),?40,ONC(165.5,DA,55.3)
W !," Other treatment.............: ",$E(ONC(165.5,D0,57),1,6)_$E(ONC(165.5,D0,57),9,10),?40,ONC(165.5,D0,57.2)
W:DATEDX>2971231 !," Other treatment @fac........: ",$E(ONC(165.5,D0,57.4),1,6)_$E(ONC(165.5,D0,57.4),9,10),?40,ONC(165.5,DA,57.3)
W !,DASHES
K TXT,TXT1,TXT2
K DIR S DIR(0)="E" D ^DIR I Y=0 S Y="@0" K SAVEY Q
S Y=SAVEY K SAVEY
Q
;
CHECKCC ;Check CLASS OF CASE
S DATEDX=$P($G(^ONCO(165.5,DA,0)),U,16) I DATEDX<2980000 Q
S COC=$E($$GET1^DIQ(165.5,DA,.04),1,2)
I (COC="00")!(COC=30)!(COC=31)!(COC=32)!(COC=33)!(COC=40)!(COC=41) D
.S $P(^ONCO(165.5,DA,3.1),U,11)="00"
.F PP=7,9,10 S $P(^ONCO(165.5,DA,3.1),U,PP)=1
.F PP=12:2:20 S $P(^ONCO(165.5,DA,3.1),U,PP)=0
.F PP=8,13:2:25 S $P(^ONCO(165.5,DA,3.1),U,PP)="0000000"
I (COC=20)!(COC=21)!(COC=22)!(COC=30)!(COC=31)!(COC=32)!(COC=33)!(COC=36)!(COC=37) D
.S $P(^ONCO(165.5,DA,3.1),U,5)="00"
.S $P(^ONCO(165.5,DA,3.1),U,6)="0000000"
K PP Q
;
DEFAULT ;RECONSTRUCTION/RESTORATION (165.5,23) default
S RRDF="",SURGPS=$P($G(^ONCO(165.5,D0,3.1)),U,29),CONTFLG=0
S SITE=$P($G(^ONCO(165.5,D0,0)),U,1)
D SETVARS I TPG="" Q
I (SITE=35)!($$LEUKEMIA^ONCOAIP2(D0))!((SITE>65)&(SITE<70)) D Q
.S RRDF="NA"
I DATEDX<2980000,SURGPS="00" S CONTFLG=1
I DATEDX>2971231,SURGPS=1 S CONTFLG=1
I CONTFLG=0 Q
S RRDF="No reconstruction/restoration"
I SCG=67141!(SCG=67250)!(SCG=67422)!(SCG=67700)!(SCG=67739)!(SCG=67770) S RRDF="NA"
Q
;
RRDEFIT ;Special default code for field #23 called from input transform
I X="No reconstruction/restoration" S X=0 Q
I X="NA"!(X["Unknown; not stated") S X=9 Q
Q
SPSDFIT ;Special default code for field #50.2 called from input transform
D SETVARS I TPG="" Q
I X?1.2N Q
F SUB=0:0 S SUB=$O(^ONCO(164,SCG,"SPS",SUB)) Q:SUB'>0!(DFCODE'="") D
.I DFTXT=$P($G(^ONCO(164,SCG,"SPS",SUB,0)),U,1) S DFCODE=SUB Q
S X=DFCODE,SPSFLG=1 Q
SCPDFIT ;Special default code for field #138.1 called from input transform
D SETVARS I TPG="" Q
I X?1N Q
F SUB=0:0 S SUB=$O(^ONCO(164,SCG,"SC5",SUB)) Q:SUB'>0!(DFCODE'="") D
.I DFTXT=$P($G(^ONCO(164,SCG,"SC5",SUB,0)),U,1) S DFCODE=SUB Q
S X=DFCODE,SCPFLG=1 Q
Q
NUMDFIT ;Special default code for field #140.1 called from input transform
S X=+X
Q
SOSDFIT ;Special default code for field #139.1 called from input transform
D SETVARS I TPG="" Q
I X?1.2N Q
F SUB=0:0 S SUB=$O(^ONCO(164,SCG,"SO5",SUB)) Q:SUB'>0!(DFCODE'="") D
.I DFTXT=$P($G(^ONCO(164,SCG,"SO5",SUB,0)),U,1) S DFCODE=SUB Q
S X=DFCODE,SOSFLG=1 Q
Q
SETVARS ;
S SCG="",TPG=$P($G(^ONCO(165.5,D0,2)),U,1) I TPG="" Q
S SCG=$P($G(^ONCO(164,TPG,0)),U,16)
S DFTXT=X,DFCODE=""
Q
;
CLEANUP ;Cleanup
K CONTFLG,D0,DASHES,DATEDX,SCPFLG,SOSFLG,SPSFLG,X,Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCTXSM 4727 printed Sep 23, 2025@20:05:15 Page 2
ONCTXSM ;HINES OIFO/GWB - Treatment Summary ;06/23/10
+1 ;;2.2;ONCOLOGY;**1,20**;Jul 31, 2013;Build 5
+2 ;
+3 NEW COC,DFCODE,DFSP,DFTXT,DIC,DR,DA,DIQ,LEN,RRDF,SCG,SITE,SUB,SURGPS,TPG
+4 SET SAVEY=Y
+5 KILL ONC
+6 DO CHECKCC
+7 DO DEFAULT
+8 SET DR="49:58.9;124;133;346;560"
+9 SET DIC="^ONCO(165.5,"
+10 SET DA=D0
SET DIQ="ONC("
DO EN^DIQ1
+11 WRITE !," Date of 1st course of tx....: ",$EXTRACT(ONC(165.5,D0,49),1,6)_$EXTRACT(ONC(165.5,D0,49),9,10)
+12 SET DFSP=$$DS^ONCACDU2(D0)
+13 WRITE !," Date of 1st Surgical Proc...: ",$EXTRACT(DFSP,1,2)_"/"_$EXTRACT(DFSP,3,4)_"/"_$EXTRACT(DFSP,7,8)
+14 SET TXT=ONC(165.5,D0,58.6)
SET LEN=40
DO TXT^ONCPTX
+15 WRITE !," RX Summ--Surg Primsite 03-2022: ",$EXTRACT(ONC(165.5,D0,50),1,6)_$EXTRACT(ONC(165.5,D0,50),9,10),?40,TXT1
+16 if TXT2'=""
WRITE !,?43,TXT2
+17 SET TXT=ONC(165.5,D0,58.7)
SET LEN=40
DO TXT^ONCPTX
+18 IF DATEDX>2971231
Begin DoDot:1
+19 WRITE !," RX Hosp--Surg Primsite 03-2022: ",$EXTRACT(ONC(165.5,D0,50.3),1,6)_$EXTRACT(ONC(165.5,D0,50.3),9,10),?40,TXT1
+20 if TXT2'=""
WRITE !,?43,TXT2
End DoDot:1
+21 WRITE !," Radiation...................: ",$EXTRACT(ONC(165.5,D0,51),1,6)_$EXTRACT(ONC(165.5,D0,51),9,10),?40,ONC(165.5,D0,51.2)
+22 if DATEDX>2971231
WRITE !," Radiation @fac..............: ",$EXTRACT(ONC(165.5,D0,51.5),1,6)_$EXTRACT(ONC(165.5,D0,51.5),9,10),?40,ONC(165.5,DA,51.4)
+23 if DATEDX<2960000
WRITE !," Radiation therapy to CNS....: ",$EXTRACT(ONC(165.5,D0,52),1,6)_$EXTRACT(ONC(165.5,D0,52),9,10),?40,ONC(165.5,D0,52.2)
+24 WRITE !," Chemotherapy................: ",$EXTRACT(ONC(165.5,D0,53),1,6)_$EXTRACT(ONC(165.5,D0,53),9,10),?40,ONC(165.5,D0,53.2)
+25 if DATEDX>2971231
WRITE !," Chemotherapy @fac...........: ",$EXTRACT(ONC(165.5,D0,53.4),1,6)_$EXTRACT(ONC(165.5,D0,53.4),9,10),?40,ONC(165.5,DA,53.3)
+26 WRITE !," Hormone therapy.............: ",$EXTRACT(ONC(165.5,D0,54),1,6)_$EXTRACT(ONC(165.5,D0,54),9,10),?40,ONC(165.5,D0,54.2)
+27 if DATEDX>2971231
WRITE !," Hormone therapy @fac........: ",$EXTRACT(ONC(165.5,D0,54.4),1,6)_$EXTRACT(ONC(165.5,D0,54.4),9,10),?40,ONC(165.5,DA,54.3)
+28 WRITE !," Immunotherapy...............: ",$EXTRACT(ONC(165.5,D0,55),1,6)_$EXTRACT(ONC(165.5,D0,55),9,10),?40,ONC(165.5,D0,55.2)
+29 if DATEDX>2971231
WRITE !," Immunotherapy @fac..........: ",$EXTRACT(ONC(165.5,D0,55.4),1,6)_$EXTRACT(ONC(165.5,D0,55.4),9,10),?40,ONC(165.5,DA,55.3)
+30 WRITE !," Other treatment.............: ",$EXTRACT(ONC(165.5,D0,57),1,6)_$EXTRACT(ONC(165.5,D0,57),9,10),?40,ONC(165.5,D0,57.2)
+31 if DATEDX>2971231
WRITE !," Other treatment @fac........: ",$EXTRACT(ONC(165.5,D0,57.4),1,6)_$EXTRACT(ONC(165.5,D0,57.4),9,10),?40,ONC(165.5,DA,57.3)
+32 WRITE !,DASHES
+33 KILL TXT,TXT1,TXT2
+34 KILL DIR
SET DIR(0)="E"
DO ^DIR
IF Y=0
SET Y="@0"
KILL SAVEY
QUIT
+35 SET Y=SAVEY
KILL SAVEY
+36 QUIT
+37 ;
CHECKCC ;Check CLASS OF CASE
+1 SET DATEDX=$PIECE($GET(^ONCO(165.5,DA,0)),U,16)
IF DATEDX<2980000
QUIT
+2 SET COC=$EXTRACT($$GET1^DIQ(165.5,DA,.04),1,2)
+3 IF (COC="00")!(COC=30)!(COC=31)!(COC=32)!(COC=33)!(COC=40)!(COC=41)
Begin DoDot:1
+4 SET $PIECE(^ONCO(165.5,DA,3.1),U,11)="00"
+5 FOR PP=7,9,10
SET $PIECE(^ONCO(165.5,DA,3.1),U,PP)=1
+6 FOR PP=12:2:20
SET $PIECE(^ONCO(165.5,DA,3.1),U,PP)=0
+7 FOR PP=8,13:2:25
SET $PIECE(^ONCO(165.5,DA,3.1),U,PP)="0000000"
End DoDot:1
+8 IF (COC=20)!(COC=21)!(COC=22)!(COC=30)!(COC=31)!(COC=32)!(COC=33)!(COC=36)!(COC=37)
Begin DoDot:1
+9 SET $PIECE(^ONCO(165.5,DA,3.1),U,5)="00"
+10 SET $PIECE(^ONCO(165.5,DA,3.1),U,6)="0000000"
End DoDot:1
+11 KILL PP
QUIT
+12 ;
DEFAULT ;RECONSTRUCTION/RESTORATION (165.5,23) default
+1 SET RRDF=""
SET SURGPS=$PIECE($GET(^ONCO(165.5,D0,3.1)),U,29)
SET CONTFLG=0
+2 SET SITE=$PIECE($GET(^ONCO(165.5,D0,0)),U,1)
+3 DO SETVARS
IF TPG=""
QUIT
+4 IF (SITE=35)!($$LEUKEMIA^ONCOAIP2(D0))!((SITE>65)&(SITE<70))
Begin DoDot:1
+5 SET RRDF="NA"
End DoDot:1
QUIT
+6 IF DATEDX<2980000
IF SURGPS="00"
SET CONTFLG=1
+7 IF DATEDX>2971231
IF SURGPS=1
SET CONTFLG=1
+8 IF CONTFLG=0
QUIT
+9 SET RRDF="No reconstruction/restoration"
+10 IF SCG=67141!(SCG=67250)!(SCG=67422)!(SCG=67700)!(SCG=67739)!(SCG=67770)
SET RRDF="NA"
+11 QUIT
+12 ;
RRDEFIT ;Special default code for field #23 called from input transform
+1 IF X="No reconstruction/restoration"
SET X=0
QUIT
+2 IF X="NA"!(X["Unknown; not stated")
SET X=9
QUIT
+3 QUIT
SPSDFIT ;Special default code for field #50.2 called from input transform
+1 DO SETVARS
IF TPG=""
QUIT
+2 IF X?1.2N
QUIT
+3 FOR SUB=0:0
SET SUB=$ORDER(^ONCO(164,SCG,"SPS",SUB))
if SUB'>0!(DFCODE'="")
QUIT
Begin DoDot:1
+4 IF DFTXT=$PIECE($GET(^ONCO(164,SCG,"SPS",SUB,0)),U,1)
SET DFCODE=SUB
QUIT
End DoDot:1
+5 SET X=DFCODE
SET SPSFLG=1
QUIT
SCPDFIT ;Special default code for field #138.1 called from input transform
+1 DO SETVARS
IF TPG=""
QUIT
+2 IF X?1N
QUIT
+3 FOR SUB=0:0
SET SUB=$ORDER(^ONCO(164,SCG,"SC5",SUB))
if SUB'>0!(DFCODE'="")
QUIT
Begin DoDot:1
+4 IF DFTXT=$PIECE($GET(^ONCO(164,SCG,"SC5",SUB,0)),U,1)
SET DFCODE=SUB
QUIT
End DoDot:1
+5 SET X=DFCODE
SET SCPFLG=1
QUIT
+6 QUIT
NUMDFIT ;Special default code for field #140.1 called from input transform
+1 SET X=+X
+2 QUIT
SOSDFIT ;Special default code for field #139.1 called from input transform
+1 DO SETVARS
IF TPG=""
QUIT
+2 IF X?1.2N
QUIT
+3 FOR SUB=0:0
SET SUB=$ORDER(^ONCO(164,SCG,"SO5",SUB))
if SUB'>0!(DFCODE'="")
QUIT
Begin DoDot:1
+4 IF DFTXT=$PIECE($GET(^ONCO(164,SCG,"SO5",SUB,0)),U,1)
SET DFCODE=SUB
QUIT
End DoDot:1
+5 SET X=DFCODE
SET SOSFLG=1
QUIT
+6 QUIT
SETVARS ;
+1 SET SCG=""
SET TPG=$PIECE($GET(^ONCO(165.5,D0,2)),U,1)
IF TPG=""
QUIT
+2 SET SCG=$PIECE($GET(^ONCO(164,TPG,0)),U,16)
+3 SET DFTXT=X
SET DFCODE=""
+4 QUIT
+5 ;
CLEANUP ;Cleanup
+1 KILL CONTFLG,D0,DASHES,DATEDX,SCPFLG,SOSFLG,SPSFLG,X,Y
