ONCNTX1 ;HINES OIFO/GWB - No treatment stuffing ;09/09/10
;;2.2;ONCOLOGY;**1,5,15**;Jul 31, 2013;Build 5
;
NCDSATF ;SURG DX/STAGING PROC @FAC (165.5,58.4)
S $P(^ONCO(165.5,DA,3.1),U,5)="00"
S $P(^ONCO(165.5,D0,3.1),U,6)="0000000"
S DR="58.4;58.5" D DIQ1^ONCNTX
W:$D(NTX) !,"SURG DX/STAGING PROC @FAC.....: "_ONC(165.5,DA,58.4,"E")
W !,"SURG DX/STAGING PROC @FAC DATE: ",ONC(165.5,DA,58.5,"E")
Q
;
SURATFR ;SURGERY OF PRIMARY @FAC (R) (165.5,50.2)
S $P(^ONCO(165.5,DA,3.1),U,7)=$S(DATEDX>2971231:1,1:"00")
S DR=50.2 D DIQ1^ONCNTX
W:$D(NTX) !,"SURGERY OF PRIMARY @FAC.....(R): ",ONC(165.5,DA,50.2,"E")
K ONC
Q
;
SURATF ;SURGERY OF PRIMARY @FAC (F) (165.5,58.7)
N TOPX
S TOPX=$P($G(^ONCO(165.5,DA,2)),U,1)
I (TOPX=67420)!(TOPX=67421)!(TOPX=67423)!(TOPX=67424)!($E(TOPX,3,4)=76)!(TOPX=67809) D G SUR1
.S $P(^ONCO(165.5,DA,3.1),U,30)=1
S $P(^ONCO(165.5,DA,3.1),U,30)=$S(DATEDX>2971231:1,1:"00")
SUR1 S $P(^ONCO(165.5,DA,3.1),U,8)="0000000"
S $P(^ONCO(165.5,DA,2.3),U,4)=0
I DATEDX>3201231 D
.I (TOPX=67420)!(TOPX=67421)!(TOPX=67423)!(TOPX=67424)!(TOPX=67809)!($E(TOPX,3,4)=76) S $P(^ONCO(165.5,DA,2.3),U,4)=9
S DR="58.7;50.3;234" D DIQ1^ONCNTX
W:$D(NTX) !,"SURGERY OF PRIMARY @FAC.....(F): ",ONC(165.5,DA,58.7,"E")
W !,"RX HOSP--SURG APP 2010.........: ",ONC(165.5,DA,234,"E")
W !,"MOST DEFINITIVE SURG @FAC DATE.: ",ONC(165.5,DA,50.3,"E")
K ONC,TXDT Q
;
NODATFR ;SCOPE OF LN SURGERY @FAC (R) (165.5,138.1)
S $P(^ONCO(165.5,DA,3.1),U,9)=1
S $P(^ONCO(165.5,DA,3.1),U,11)="00"
S DR="138.1;140.1" D DIQ1^ONCNTX
W:$D(NTX) !,"SCOPE OF LN SURGERY @FAC....(R): ",ONC(165.5,DA,138.1,"E")
W !,"NUMBER OF LN REMOVED @FAC...(R): ",ONC(165.5,DA,140.1,"E")
Q
;
NODEATF ;SCOPE OF LN SURGERY @FAC (F) (165.5,138.5)
S $P(^ONCO(165.5,DA,3.1),U,32)=0
S $P(^ONCO(165.5,D0,3.1),U,23)="0000000"
S DR="138.5;138.3" D DIQ1^ONCNTX
W:$D(NTX) !,"SCOPE OF LN SURGERY @FAC....(F): ",ONC(165.5,DA,138.5,"E")
W !,"SCOPE OF LN SURGERY @FAC DATE..: ",ONC(165.5,DA,138.3,"E")
Q
;
SPOATFR ;SURG PROC/OTHER SITE @FAC (R) (165.5,139.1)
S $P(^ONCO(165.5,DA,3.1),U,10)=1
S DR=139.1 D DIQ1^ONCNTX
W:$D(NTX) !,"SURG PROC/OTHER SITE @FAC...(R): ",ONC(165.5,DA,139.1,"E")
Q
;
SOSATFR ;SURG PROC/OTHER SITE @FAC (R) (165.5,139.1)
S $P(^ONCO(165.5,DA,3.1),U,10)=1
S DR=139.1 D DIQ1^ONCNTX
W:$D(NTX) !,"SURG PROC/OTHER SITE @FAC...(R): ",ONC(165.5,DA,139.1,"E")
Q
;
SOSNATF ;SURG PROC/OTHER SITE @FAC (F) (165.5,139.5)
S $P(^ONCO(165.5,DA,3.1),U,34)=0
S $P(^ONCO(165.5,D0,3.1),U,25)="0000000"
S DR="139.5;139.3" D DIQ1^ONCNTX
W:$D(NTX) !,"SURG PROC/OTHER SITE @FAC...(F): ",ONC(165.5,DA,139.5,"E")
W !,"SURG PROC/OTHER SITE @FAC DATE.: ",ONC(165.5,DA,139.3,"E")
Q
;
RADATF ;RADIATION @FAC (165.5,51.4)
N RFNR
S $P(^ONCO(165.5,DA,3.1),U,12)=0
S RFNR=$P($G(^ONCO(165.5,DA,3)),U,35)
I RFNR'=8 D
.S $P(^ONCO(165.5,DA,3.1),U,13)="0000000"
I RFNR=8 D
.S $P(^ONCO(165.5,DA,3.1),U,13)=8888888
S DR="51.4;51.5" D DIQ1^ONCNTX
W:$D(NTX) !,"RADIATION @FAC.................: "_ONC(165.5,DA,51.4,"E")
W !,"RADIATION @FAC DATE............: ",ONC(165.5,DA,51.5,"E")
Q
;
S $P(^ONCO(165.5,DA,3),U,7)=0
W !,"RADIATION/SURGERY SEQUENCE.....: No rad and/or surg"
Q
;
CHEMATF ;CHEMOTHERAPY @FAC (165.5,53.3)
S $P(^ONCO(165.5,DA,3.1),U,14)="00"
I $D(NTX) D
.N DIE,DL,DP,DQ,DR
.I COC=38 D
..W !,"CHEMOTHERAPY @FAC.............: None"
.E S DIE="^ONCO(165.5,",DR=53.3 D ^DIE
CMATFDT S $P(^ONCO(165.5,DA,3.1),U,15)="0000000"
S DR=53.4 D DIQ1^ONCNTX
W !,"CHEMOTHERAPY @FAC DATE........: ",ONC(165.5,DA,53.4,"E")
W !
Q
;
HTATF ;HORMONE THERAPY @FAC (165.5,54.3)
S $P(^ONCO(165.5,DA,3.1),U,16)="00"
I $D(NTX) D
.N DIE,DR,DP,DL,DQ
.I COC=38 D
..W !,"HORMONE THERAPY @FAC..........: None"
.E S DIE="^ONCO(165.5,",DR=54.3 D ^DIE
HTATFDT S $P(^ONCO(165.5,DA,3.1),U,17)="0000000"
S DR=54.4 D DIQ1^ONCNTX
W !,"HORMONE THERAPY @FAC DATE.....: ",ONC(165.5,DA,54.4,"E")
W !
Q
;
IMMATF ;IMMUNOTHERAPY @FAC (165.5,55.3)
S $P(^ONCO(165.5,DA,3.1),U,18)="00"
I $D(NTX) D
.N DIE,DR,DP,DL,DQ
.I COC=38 D
..W !,"IMMUNOTHERAPY @FAC............: None"
.E S DIE="^ONCO(165.5,",DR=55.3 D ^DIE
IMATFDT S $P(^ONCO(165.5,DA,3.1),U,19)="0000000"
S DR=55.4 D DIQ1^ONCNTX
W !,"IMMUNOTHERAPY @FAC DATE.......: ",ONC(165.5,DA,55.4,"E")
W !
Q
;
HTEPATF ;HEMA TRANS/ENDOCRINE PROC @FAC (165.5,153.2)
S $P(^ONCO(165.5,DA,3.2),U,2)=1
I $D(NTX) D
.N DIE,DR,DP,DL,DQ
.I COC=38 D
..W !,"HEMA TRANS/ENDOCRINE PROC @FAC............: None"
.E S DIE="^ONCO(165.5,",DR=153.2 D ^DIE
HEATFDT S $P(^ONCO(165.5,DA,3.2),U,3)="0000000"
S DR=153.3 D DIQ1^ONCNTX
W !,"HEMA TRANS/ENDOCRINE PROC @FAC DATE.......: ",ONC(165.5,DA,153.3,"E")
W !
Q
;
OTHATF ;OTHER TREATMENT @FAC (165.5,57.3)
I $G(X)'=7 S $P(^ONCO(165.5,DA,3.1),U,20)=0
S $P(^ONCO(165.5,DA,3.1),U,21)="0000000"
S DR="57.3;57.4" D DIQ1^ONCNTX
W:$D(NTX) !,"OTHER TREATMENT @FAC..........: "_ONC(165.5,DA,57.3,"E")
W !,"OTHER TREATMENT @FAC DATE.....: ",ONC(165.5,DA,57.4,"E")
Q
;
HOR ;HORMONE THERAPY (165.5,54.2)
I $D(NTX) D
.N DIE,DR,DP,DL,DQ
.I COC=38 D
..W !,"HORMONE THERAPY...............: None"
.E S DIE="^ONCO(165.5,",DR=54.2 D ^DIE
S TXDT=$P(^ONCO(165.5,DA,3),U,14)_"H"
K ^ONCO(165.5,"ATX",DA,TXDT)
S $P(^ONCO(165.5,DA,3),U,14)="0000000" D HTDT^ONCATF1
S ^ONCO(165.5,"ATX",DA,"0000000H")=""
N DI,DIC,DIQ K ONC S DIC="^ONCO(165.5,",DA=DA,DIQ="ONC(",DIQ(0)="E"
S DR=54 D EN^DIQ1
W !,"HORMONE THERAPY DATE..........: ",ONC(165.5,DA,54,"E")
K ONC Q
;
IMM ;IMMUNOTHERAPY (165.5,55.2)
I $D(NTX) D
.N DIE,DR,DP,DL,DQ
.I COC=38 D
..W !,"IMMUNOTHERAPY.................: None"
.E S DIE="^ONCO(165.5,",DR=55.2 D ^DIE
S TXDT=$P(^ONCO(165.5,DA,3),U,17)_"B"
K ^ONCO(165.5,"ATX",DA,TXDT)
S $P(^ONCO(165.5,DA,3),U,17)="0000000" D IMMDT^ONCATF1
S ^ONCO(165.5,"ATX",DA,"0000000B")=""
N DI,DIC,DIQ,X K ONC S DIC="^ONCO(165.5,",DA=DA,DIQ="ONC(",DIQ(0)="E"
S DR=55 D EN^DIQ1
W !,"IMMUNOTHERAPY DATE:...........: ",ONC(165.5,DA,55,"E")
K ONC Q
;
HTEP ;HEMA TRANS/ENDOCRINE PROC (165.5,153)
I $D(NTX) D
.N DIE,DR,DP,DL,DQ
.I COC=38 D
..W !,"HEMA TRANS/ENDOCRINE PROC.....: No transplant proc/endocrine tx"
.E S DIE="^ONCO(165.5,",DR=153 D ^DIE
S TXDT=$P(^ONCO(165.5,DA,3.1),U,35)_"E"
K ^ONCO(165.5,"ATX",DA,TXDT)
S $P(^ONCO(165.5,DA,3.1),U,35)="0000000"
S ^ONCO(165.5,"ATX",DA,"0000000E")=""
N DI,DIC,DIQ,X K ONC S DIC="^ONCO(165.5,",DA=DA,DIQ="ONC(",DIQ(0)="E"
S DR=153.1 D EN^DIQ1
W !,"HEMA TRANS/ENDOCRINE PROC DATE: ",ONC(165.5,DA,153.1,"E")
K ONC W ! Q
;
SSS ;SYSTEMIC/SURGERY SEQUENCE (165.5,15)
S $P(^ONCO(165.5,DA,3.1),U,39)=0
W !,"SYSTEMIC/SURGERY SEQUENCE.....: No systemic and/or surgery"
W !
Q
;
OTH ;OTHER TREATMENT (165.5,57.2)
S TXDT=$P(^ONCO(165.5,DA,3),U,23)_"O"
K ^ONCO(165.5,"ATX",DA,TXDT)
S $P(^ONCO(165.5,DA,3),U,23)="0000000" D OTHDT^ONCATF1
S ^ONCO(165.5,"ATX",DA,"0000000O")=""
N DI,DIC,DIQ,X K ONC S DIC="^ONCO(165.5,",DA=DA,DIQ="ONC(",DIQ(0)="E"
S DR="57.2;57" D EN^DIQ1
W:$D(NTX) !,"OTHER TREATMENT...............: ",ONC(165.5,DA,57.2,"E")
W !,"OTHER TREATMENT DATE:.........: ",ONC(165.5,DA,57,"E")
K ONC Q
;
PRO ;PROTOCOL PARTICIPATION (165.5,560)
S $P(^ONCO(165.5,DA,"STS2"),U,31)="00"
S $P(^ONCO(165.5,DA,3.1),U,4)="0000"
N DI,DIC,DIQ K ONC S DIC="^ONCO(165.5,",DA=DA,DIQ="ONC(",DIQ(0)="E"
S DR="133;560" D EN^DIQ1
W !,"PROTOCOL PARTICIPATION........: ",ONC(165.5,DA,560,"E")
W !,"YEAR PUT ON PROTOCOL..........: ",ONC(165.5,DA,133,"E")
K ONC Q
;
RR ;RECONSTRUCTION/RESTORATION (165.5,23)
N LAST,NUM,RR,RTK
F RTK=0:0 S RTK=$O(^ONCO(164,RTK)) Q:RTK'>0 D
.I '$D(^ONCO(164,RTK,"RR5",0)) Q
.W !,RTK
.S NUM=$O(^ONCO(164,RTK,"RR5",0))
.W !?3,"FIRST:",?11,NUM,?14,$G(^ONCO(164,RTK,"RR5",NUM,0))
.F RR=0:0 S RR=$O(^ONCO(164,RTK,"RR5",RR)) Q:RR="B" S LAST=RR
.W !?3,"LAST :",?11,LAST,?14,$G(^ONCO(164,RTK,"RR5",LAST,0))
Q
;
RRDEFIT ;RECONSTRUCTION/RESTORATION default (165.5,23)
I X="No reconstruction/restoration" S X=0 Q
I X="NA"!(X["Unknown; not stated") S X=9 Q
Q
;
RFNSHLP ;REASON NO SURGERY OF PRIMARY (165.5,58) help
W !," Record the reason that no surgery was perforned on the primary site."
Q
;
RFNRHLP ;REASON FOR NO RADIATION (165.5,75) help
W !," Records the reason that no regional radiation"
W !," therapy was administered to the primary site."
W !
W !," For further information see FORDS page 168."
Q
;
EXIT W ! S Y="@424"
Q
;
CLEANUP ;Cleanup
K COC,D0,DA,DATEDX,NTX,Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCNTX1 8656 printed Apr 09, 2024@21:30:54 Page 2
ONCNTX1 ;HINES OIFO/GWB - No treatment stuffing ;09/09/10
+1 ;;2.2;ONCOLOGY;**1,5,15**;Jul 31, 2013;Build 5
+2 ;
NCDSATF ;SURG DX/STAGING PROC @FAC (165.5,58.4)
+1 SET $PIECE(^ONCO(165.5,DA,3.1),U,5)="00"
+2 SET $PIECE(^ONCO(165.5,D0,3.1),U,6)="0000000"
+3 SET DR="58.4;58.5"
DO DIQ1^ONCNTX
+4 if $DATA(NTX)
WRITE !,"SURG DX/STAGING PROC @FAC.....: "_ONC(165.5,DA,58.4,"E")
+5 WRITE !,"SURG DX/STAGING PROC @FAC DATE: ",ONC(165.5,DA,58.5,"E")
+6 QUIT
+7 ;
SURATFR ;SURGERY OF PRIMARY @FAC (R) (165.5,50.2)
+1 SET $PIECE(^ONCO(165.5,DA,3.1),U,7)=$SELECT(DATEDX>2971231:1,1:"00")
+2 SET DR=50.2
DO DIQ1^ONCNTX
+3 if $DATA(NTX)
WRITE !,"SURGERY OF PRIMARY @FAC.....(R): ",ONC(165.5,DA,50.2,"E")
+4 KILL ONC
+5 QUIT
+6 ;
SURATF ;SURGERY OF PRIMARY @FAC (F) (165.5,58.7)
+1 NEW TOPX
+2 SET TOPX=$PIECE($GET(^ONCO(165.5,DA,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,DA,3.1),U,30)=1
End DoDot:1
GOTO SUR1
+5 SET $PIECE(^ONCO(165.5,DA,3.1),U,30)=$SELECT(DATEDX>2971231:1,1:"00")
SUR1 SET $PIECE(^ONCO(165.5,DA,3.1),U,8)="0000000"
+1 SET $PIECE(^ONCO(165.5,DA,2.3),U,4)=0
+2 IF DATEDX>3201231
Begin DoDot:1
+3 IF (TOPX=67420)!(TOPX=67421)!(TOPX=67423)!(TOPX=67424)!(TOPX=67809)!($EXTRACT(TOPX,3,4)=76)
SET $PIECE(^ONCO(165.5,DA,2.3),U,4)=9
End DoDot:1
+4 SET DR="58.7;50.3;234"
DO DIQ1^ONCNTX
+5 if $DATA(NTX)
WRITE !,"SURGERY OF PRIMARY @FAC.....(F): ",ONC(165.5,DA,58.7,"E")
+6 WRITE !,"RX HOSP--SURG APP 2010.........: ",ONC(165.5,DA,234,"E")
+7 WRITE !,"MOST DEFINITIVE SURG @FAC DATE.: ",ONC(165.5,DA,50.3,"E")
+8 KILL ONC,TXDT
QUIT
+9 ;
NODATFR ;SCOPE OF LN SURGERY @FAC (R) (165.5,138.1)
+1 SET $PIECE(^ONCO(165.5,DA,3.1),U,9)=1
+2 SET $PIECE(^ONCO(165.5,DA,3.1),U,11)="00"
+3 SET DR="138.1;140.1"
DO DIQ1^ONCNTX
+4 if $DATA(NTX)
WRITE !,"SCOPE OF LN SURGERY @FAC....(R): ",ONC(165.5,DA,138.1,"E")
+5 WRITE !,"NUMBER OF LN REMOVED @FAC...(R): ",ONC(165.5,DA,140.1,"E")
+6 QUIT
+7 ;
NODEATF ;SCOPE OF LN SURGERY @FAC (F) (165.5,138.5)
+1 SET $PIECE(^ONCO(165.5,DA,3.1),U,32)=0
+2 SET $PIECE(^ONCO(165.5,D0,3.1),U,23)="0000000"
+3 SET DR="138.5;138.3"
DO DIQ1^ONCNTX
+4 if $DATA(NTX)
WRITE !,"SCOPE OF LN SURGERY @FAC....(F): ",ONC(165.5,DA,138.5,"E")
+5 WRITE !,"SCOPE OF LN SURGERY @FAC DATE..: ",ONC(165.5,DA,138.3,"E")
+6 QUIT
+7 ;
SPOATFR ;SURG PROC/OTHER SITE @FAC (R) (165.5,139.1)
+1 SET $PIECE(^ONCO(165.5,DA,3.1),U,10)=1
+2 SET DR=139.1
DO DIQ1^ONCNTX
+3 if $DATA(NTX)
WRITE !,"SURG PROC/OTHER SITE @FAC...(R): ",ONC(165.5,DA,139.1,"E")
+4 QUIT
+5 ;
SOSATFR ;SURG PROC/OTHER SITE @FAC (R) (165.5,139.1)
+1 SET $PIECE(^ONCO(165.5,DA,3.1),U,10)=1
+2 SET DR=139.1
DO DIQ1^ONCNTX
+3 if $DATA(NTX)
WRITE !,"SURG PROC/OTHER SITE @FAC...(R): ",ONC(165.5,DA,139.1,"E")
+4 QUIT
+5 ;
SOSNATF ;SURG PROC/OTHER SITE @FAC (F) (165.5,139.5)
+1 SET $PIECE(^ONCO(165.5,DA,3.1),U,34)=0
+2 SET $PIECE(^ONCO(165.5,D0,3.1),U,25)="0000000"
+3 SET DR="139.5;139.3"
DO DIQ1^ONCNTX
+4 if $DATA(NTX)
WRITE !,"SURG PROC/OTHER SITE @FAC...(F): ",ONC(165.5,DA,139.5,"E")
+5 WRITE !,"SURG PROC/OTHER SITE @FAC DATE.: ",ONC(165.5,DA,139.3,"E")
+6 QUIT
+7 ;
RADATF ;RADIATION @FAC (165.5,51.4)
+1 NEW RFNR
+2 SET $PIECE(^ONCO(165.5,DA,3.1),U,12)=0
+3 SET RFNR=$PIECE($GET(^ONCO(165.5,DA,3)),U,35)
+4 IF RFNR'=8
Begin DoDot:1
+5 SET $PIECE(^ONCO(165.5,DA,3.1),U,13)="0000000"
End DoDot:1
+6 IF RFNR=8
Begin DoDot:1
+7 SET $PIECE(^ONCO(165.5,DA,3.1),U,13)=8888888
End DoDot:1
+8 SET DR="51.4;51.5"
DO DIQ1^ONCNTX
+9 if $DATA(NTX)
WRITE !,"RADIATION @FAC.................: "_ONC(165.5,DA,51.4,"E")
+10 WRITE !,"RADIATION @FAC DATE............: ",ONC(165.5,DA,51.5,"E")
+11 QUIT
+12 ;
+1 SET $PIECE(^ONCO(165.5,DA,3),U,7)=0
+2 WRITE !,"RADIATION/SURGERY SEQUENCE.....: No rad and/or surg"
+3 QUIT
+4 ;
CHEMATF ;CHEMOTHERAPY @FAC (165.5,53.3)
+1 SET $PIECE(^ONCO(165.5,DA,3.1),U,14)="00"
+2 IF $DATA(NTX)
Begin DoDot:1
+3 NEW DIE,DL,DP,DQ,DR
+4 IF COC=38
Begin DoDot:2
+5 WRITE !,"CHEMOTHERAPY @FAC.............: None"
End DoDot:2
+6 IF '$TEST
SET DIE="^ONCO(165.5,"
SET DR=53.3
DO ^DIE
End DoDot:1
CMATFDT SET $PIECE(^ONCO(165.5,DA,3.1),U,15)="0000000"
+1 SET DR=53.4
DO DIQ1^ONCNTX
+2 WRITE !,"CHEMOTHERAPY @FAC DATE........: ",ONC(165.5,DA,53.4,"E")
+3 WRITE !
+4 QUIT
+5 ;
HTATF ;HORMONE THERAPY @FAC (165.5,54.3)
+1 SET $PIECE(^ONCO(165.5,DA,3.1),U,16)="00"
+2 IF $DATA(NTX)
Begin DoDot:1
+3 NEW DIE,DR,DP,DL,DQ
+4 IF COC=38
Begin DoDot:2
+5 WRITE !,"HORMONE THERAPY @FAC..........: None"
End DoDot:2
+6 IF '$TEST
SET DIE="^ONCO(165.5,"
SET DR=54.3
DO ^DIE
End DoDot:1
HTATFDT SET $PIECE(^ONCO(165.5,DA,3.1),U,17)="0000000"
+1 SET DR=54.4
DO DIQ1^ONCNTX
+2 WRITE !,"HORMONE THERAPY @FAC DATE.....: ",ONC(165.5,DA,54.4,"E")
+3 WRITE !
+4 QUIT
+5 ;
IMMATF ;IMMUNOTHERAPY @FAC (165.5,55.3)
+1 SET $PIECE(^ONCO(165.5,DA,3.1),U,18)="00"
+2 IF $DATA(NTX)
Begin DoDot:1
+3 NEW DIE,DR,DP,DL,DQ
+4 IF COC=38
Begin DoDot:2
+5 WRITE !,"IMMUNOTHERAPY @FAC............: None"
End DoDot:2
+6 IF '$TEST
SET DIE="^ONCO(165.5,"
SET DR=55.3
DO ^DIE
End DoDot:1
IMATFDT SET $PIECE(^ONCO(165.5,DA,3.1),U,19)="0000000"
+1 SET DR=55.4
DO DIQ1^ONCNTX
+2 WRITE !,"IMMUNOTHERAPY @FAC DATE.......: ",ONC(165.5,DA,55.4,"E")
+3 WRITE !
+4 QUIT
+5 ;
HTEPATF ;HEMA TRANS/ENDOCRINE PROC @FAC (165.5,153.2)
+1 SET $PIECE(^ONCO(165.5,DA,3.2),U,2)=1
+2 IF $DATA(NTX)
Begin DoDot:1
+3 NEW DIE,DR,DP,DL,DQ
+4 IF COC=38
Begin DoDot:2
+5 WRITE !,"HEMA TRANS/ENDOCRINE PROC @FAC............: None"
End DoDot:2
+6 IF '$TEST
SET DIE="^ONCO(165.5,"
SET DR=153.2
DO ^DIE
End DoDot:1
HEATFDT SET $PIECE(^ONCO(165.5,DA,3.2),U,3)="0000000"
+1 SET DR=153.3
DO DIQ1^ONCNTX
+2 WRITE !,"HEMA TRANS/ENDOCRINE PROC @FAC DATE.......: ",ONC(165.5,DA,153.3,"E")
+3 WRITE !
+4 QUIT
+5 ;
OTHATF ;OTHER TREATMENT @FAC (165.5,57.3)
+1 IF $GET(X)'=7
SET $PIECE(^ONCO(165.5,DA,3.1),U,20)=0
+2 SET $PIECE(^ONCO(165.5,DA,3.1),U,21)="0000000"
+3 SET DR="57.3;57.4"
DO DIQ1^ONCNTX
+4 if $DATA(NTX)
WRITE !,"OTHER TREATMENT @FAC..........: "_ONC(165.5,DA,57.3,"E")
+5 WRITE !,"OTHER TREATMENT @FAC DATE.....: ",ONC(165.5,DA,57.4,"E")
+6 QUIT
+7 ;
HOR ;HORMONE THERAPY (165.5,54.2)
+1 IF $DATA(NTX)
Begin DoDot:1
+2 NEW DIE,DR,DP,DL,DQ
+3 IF COC=38
Begin DoDot:2
+4 WRITE !,"HORMONE THERAPY...............: None"
End DoDot:2
+5 IF '$TEST
SET DIE="^ONCO(165.5,"
SET DR=54.2
DO ^DIE
End DoDot:1
+6 SET TXDT=$PIECE(^ONCO(165.5,DA,3),U,14)_"H"
+7 KILL ^ONCO(165.5,"ATX",DA,TXDT)
+8 SET $PIECE(^ONCO(165.5,DA,3),U,14)="0000000"
DO HTDT^ONCATF1
+9 SET ^ONCO(165.5,"ATX",DA,"0000000H")=""
+10 NEW DI,DIC,DIQ
KILL ONC
SET DIC="^ONCO(165.5,"
SET DA=DA
SET DIQ="ONC("
SET DIQ(0)="E"
+11 SET DR=54
DO EN^DIQ1
+12 WRITE !,"HORMONE THERAPY DATE..........: ",ONC(165.5,DA,54,"E")
+13 KILL ONC
QUIT
+14 ;
IMM ;IMMUNOTHERAPY (165.5,55.2)
+1 IF $DATA(NTX)
Begin DoDot:1
+2 NEW DIE,DR,DP,DL,DQ
+3 IF COC=38
Begin DoDot:2
+4 WRITE !,"IMMUNOTHERAPY.................: None"
End DoDot:2
+5 IF '$TEST
SET DIE="^ONCO(165.5,"
SET DR=55.2
DO ^DIE
End DoDot:1
+6 SET TXDT=$PIECE(^ONCO(165.5,DA,3),U,17)_"B"
+7 KILL ^ONCO(165.5,"ATX",DA,TXDT)
+8 SET $PIECE(^ONCO(165.5,DA,3),U,17)="0000000"
DO IMMDT^ONCATF1
+9 SET ^ONCO(165.5,"ATX",DA,"0000000B")=""
+10 NEW DI,DIC,DIQ,X
KILL ONC
SET DIC="^ONCO(165.5,"
SET DA=DA
SET DIQ="ONC("
SET DIQ(0)="E"
+11 SET DR=55
DO EN^DIQ1
+12 WRITE !,"IMMUNOTHERAPY DATE:...........: ",ONC(165.5,DA,55,"E")
+13 KILL ONC
QUIT
+14 ;
HTEP ;HEMA TRANS/ENDOCRINE PROC (165.5,153)
+1 IF $DATA(NTX)
Begin DoDot:1
+2 NEW DIE,DR,DP,DL,DQ
+3 IF COC=38
Begin DoDot:2
+4 WRITE !,"HEMA TRANS/ENDOCRINE PROC.....: No transplant proc/endocrine tx"
End DoDot:2
+5 IF '$TEST
SET DIE="^ONCO(165.5,"
SET DR=153
DO ^DIE
End DoDot:1
+6 SET TXDT=$PIECE(^ONCO(165.5,DA,3.1),U,35)_"E"
+7 KILL ^ONCO(165.5,"ATX",DA,TXDT)
+8 SET $PIECE(^ONCO(165.5,DA,3.1),U,35)="0000000"
+9 SET ^ONCO(165.5,"ATX",DA,"0000000E")=""
+10 NEW DI,DIC,DIQ,X
KILL ONC
SET DIC="^ONCO(165.5,"
SET DA=DA
SET DIQ="ONC("
SET DIQ(0)="E"
+11 SET DR=153.1
DO EN^DIQ1
+12 WRITE !,"HEMA TRANS/ENDOCRINE PROC DATE: ",ONC(165.5,DA,153.1,"E")
+13 KILL ONC
WRITE !
QUIT
+14 ;
SSS ;SYSTEMIC/SURGERY SEQUENCE (165.5,15)
+1 SET $PIECE(^ONCO(165.5,DA,3.1),U,39)=0
+2 WRITE !,"SYSTEMIC/SURGERY SEQUENCE.....: No systemic and/or surgery"
+3 WRITE !
+4 QUIT
+5 ;
OTH ;OTHER TREATMENT (165.5,57.2)
+1 SET TXDT=$PIECE(^ONCO(165.5,DA,3),U,23)_"O"
+2 KILL ^ONCO(165.5,"ATX",DA,TXDT)
+3 SET $PIECE(^ONCO(165.5,DA,3),U,23)="0000000"
DO OTHDT^ONCATF1
+4 SET ^ONCO(165.5,"ATX",DA,"0000000O")=""
+5 NEW DI,DIC,DIQ,X
KILL ONC
SET DIC="^ONCO(165.5,"
SET DA=DA
SET DIQ="ONC("
SET DIQ(0)="E"
+6 SET DR="57.2;57"
DO EN^DIQ1
+7 if $DATA(NTX)
WRITE !,"OTHER TREATMENT...............: ",ONC(165.5,DA,57.2,"E")
+8 WRITE !,"OTHER TREATMENT DATE:.........: ",ONC(165.5,DA,57,"E")
+9 KILL ONC
QUIT
+10 ;
PRO ;PROTOCOL PARTICIPATION (165.5,560)
+1 SET $PIECE(^ONCO(165.5,DA,"STS2"),U,31)="00"
+2 SET $PIECE(^ONCO(165.5,DA,3.1),U,4)="0000"
+3 NEW DI,DIC,DIQ
KILL ONC
SET DIC="^ONCO(165.5,"
SET DA=DA
SET DIQ="ONC("
SET DIQ(0)="E"
+4 SET DR="133;560"
DO EN^DIQ1
+5 WRITE !,"PROTOCOL PARTICIPATION........: ",ONC(165.5,DA,560,"E")
+6 WRITE !,"YEAR PUT ON PROTOCOL..........: ",ONC(165.5,DA,133,"E")
+7 KILL ONC
QUIT
+8 ;
RR ;RECONSTRUCTION/RESTORATION (165.5,23)
+1 NEW LAST,NUM,RR,RTK
+2 FOR RTK=0:0
SET RTK=$ORDER(^ONCO(164,RTK))
if RTK'>0
QUIT
Begin DoDot:1
+3 IF '$DATA(^ONCO(164,RTK,"RR5",0))
QUIT
+4 WRITE !,RTK
+5 SET NUM=$ORDER(^ONCO(164,RTK,"RR5",0))
+6 WRITE !?3,"FIRST:",?11,NUM,?14,$GET(^ONCO(164,RTK,"RR5",NUM,0))
+7 FOR RR=0:0
SET RR=$ORDER(^ONCO(164,RTK,"RR5",RR))
if RR="B"
QUIT
SET LAST=RR
+8 WRITE !?3,"LAST :",?11,LAST,?14,$GET(^ONCO(164,RTK,"RR5",LAST,0))
End DoDot:1
+9 QUIT
+10 ;
RRDEFIT ;RECONSTRUCTION/RESTORATION default (165.5,23)
+1 IF X="No reconstruction/restoration"
SET X=0
QUIT
+2 IF X="NA"!(X["Unknown; not stated")
SET X=9
QUIT
+3 QUIT
+4 ;
RFNSHLP ;REASON NO SURGERY OF PRIMARY (165.5,58) help
+1 WRITE !," Record the reason that no surgery was perforned on the primary site."
+2 QUIT
+3 ;
RFNRHLP ;REASON FOR NO RADIATION (165.5,75) help
+1 WRITE !," Records the reason that no regional radiation"
+2 WRITE !," therapy was administered to the primary site."
+3 WRITE !
+4 WRITE !," For further information see FORDS page 168."
+5 QUIT
+6 ;
EXIT WRITE !
SET Y="@424"
+1 QUIT
+2 ;
CLEANUP ;Cleanup
+1 KILL COC,D0,DA,DATEDX,NTX,Y
