ONCUTX ;Hines OIFO/GWB - Unknown treatment stuffing ;06/23/10
;;2.2;ONCOLOGY;**1,10**;Jul 31, 2013;Build 20
;
NCDS ;SURGICAL DX/STAGING PROC (165.5,58.1)
S $P(^ONCO(165.5,D0,3),U,31)=9999999
W !,"SURGICAL DX/STAGING PROC DATE: 99/99/9999" D NCDSDT^ONCATF
Q
;
SURR ;SURGERY OF PRIMARY (R) (165.5,58.2)
N SA,SCG,TOP
S TOP=$P($G(^ONCO(165.5,D0,2)),U,1) I TOP="" Q
S SCG=$P($G(^ONCO(164,TOP,0)),U,16) I SCG="" Q
S:$E(SCG,3,4)=77 SCG=67422
S SA=$O(^ONCO(164,SCG,"SUA","C",9,0))
S $P(^ONCO(165.5,D0,3),U,34)=SA
N DIC,DIQ,DR K ONC S DIC="^ONCO(165.5,",DA=DA,DIQ="ONC(",DIQ(0)="E"
S DR=74 D EN^DIQ1
W !,"SURGICAL APPROACH...........(R): "_ONC(165.5,DA,74,"E")
Q
;
SUR ;SURGERY OF PRIMARY (F) (165.5,58.6)
N SCG,TOP,TSDT,TXDT
S TXDT=$P(^ONCO(165.5,DA,3),U,1)_"S1"
K ^ONCO(165.5,"ATX",DA,TXDT)
S $P(^ONCO(165.5,DA,3),U,1)=9999999 D SPSDT^ONCATF
S ^ONCO(165.5,"ATX",DA,"9999999S1")=""
S TOP=$P($G(^ONCO(165.5,D0,2)),U,1) I TOP="" Q
S SCG=$P($G(^ONCO(164,TOP,0)),U,16) I SCG="" Q
;S:DATEDX>3091231 $P(^ONCO(165.5,D0,2.3),U,4)=9
S $P(^ONCO(165.5,D0,3),U,28)=9
S $P(^ONCO(165.5,DA,"THY1"),U,36)=9999999
S $P(^ONCO(165.5,D0,3.1),U,28)=9
N DIC,DIQ,DR K ONC S DIC="^ONCO(165.5,",DA=DA,DIQ="ONC(",DIQ(0)="E"
S DR="50;74;59;23;138;435;14;234" D EN^DIQ1
W !,"MOST DEFINITIVE SURG DATE......: "_ONC(165.5,DA,50,"E")
;W:DATEDX>3091231 !,"APPROACH.......................: "_$E(ONC(165.5,DA,234,"E"),1,40)
W !,"SURGICAL MARGINS...............: "_$E(ONC(165.5,DA,59,"E"),1,40)
W !,"DATE OF SURGICAL DISCHARGE.....: "_ONC(165.5,DA,435,"E")
W !,"READMISSION W/I 30 DAYS/SURG...: "_ONC(165.5,DA,14,"E")
Q
;
NODER ;SCOPE OF LN SURGERY (R) (165.5,138)
S $P(^ONCO(165.5,D0,3),U,42)=99 D NUMND^ONCATF
N DR S DR=140 D DIQ1^ONCNTX
W !,"NUMBER OF LN REMOVED........(R): "_ONC(165.5,DA,140,"E")
Q
;
NODE ;SCOPE OF LN SURGERY (F) (165.5,138.4)
N TXDT
S TXDT=$P($G(^ONCO(165.5,DA,3.1)),U,22)_"S2"
K ^ONCO(165.5,"ATX",DA,TXDT)
S $P(^ONCO(165.5,D0,3.1),U,22)="0000000" D SCPDT^ONCATF
S ^ONCO(165.5,"ATX",DA,"0000000S2")=""
N DR S DR=138.2 D DIQ1^ONCNTX
W !,"SCOPE OF LN SURGERY DATE.......: "_ONC(165.5,DA,138.2,"E")
Q
;
SOSN ;SURG PROC/OTHER SITE DATE (165.5,139.2)
N TXDT
S TXDT=$P($G(^ONCO(165.5,DA,3.1)),U,24)_"S3"
K ^ONCO(165.5,"ATX",DA,TXDT)
S $P(^ONCO(165.5,D0,3.1),U,24)=9999999 D SOSNDT^ONCATF
S ^ONCO(165.5,"ATX",DA,"9999999S3")=""
N DR S DR="139.2" D DIQ1^ONCNTX
W !,"SURGICAL PROC/OTHER SITE DATE..: "_ONC(165.5,DA,139.2,"E")
Q
;
RAD ;Radiation
N RFNR,TXDT
S RFNR=$P($G(^ONCO(165.5,DA,3)),U,35)
I RFNR=8 D ^ONCRFNR G RAD1
S TXDT=$P(^ONCO(165.5,DA,3),U,4)_"R"
K ^ONCO(165.5,"ATX",DA,TXDT)
S $P(^ONCO(165.5,DA,3),U,4)=9999999 D RADDT^ONCATF1
S ^ONCO(165.5,"ATX",DA,"9999999R")=""
RAD1 S $P(^ONCO(165.5,DA,3),U,22)=9
I $P($G(^ONCO(165.5,DA,0)),"^",16)<3180000 D
.S $P(^ONCO(165.5,DA,3),U,21)=42
.S $P(^ONCO(165.5,DA,"BLA2"),U,18)=19
.S $P(^ONCO(165.5,DA,"THY1"),U,43)=99999
.S $P(^ONCO(165.5,DA,24),U,9)=19
.S $P(^ONCO(165.5,DA,"THY1"),U,44)=99999
.S $P(^ONCO(165.5,DA,3),U,20)=999
S $P(^ONCO(165.5,DA,"BLA2"),U,16)=9999999
N DIC,DIQ K ONC S DIC="^ONCO(165.5,",DA=DA,DIQ="ONC(",DIQ(0)="E"
N DR S DR="51;126;125;363;442;363.1;443;56;361" D EN^DIQ1
W !,"DATE RADIATION STARTED.........: ",ONC(165.5,DA,51,"E")
W !,"LOCATION OF RADIATION..........: ",ONC(165.5,DA,126,"E")
I $P($G(^ONCO(165.5,DA,0)),"^",16)<3180000 D
.W !,"RADIATION TREATMENT VOLUME.....: ",ONC(165.5,DA,125,"E")
.W !,"REGIONAL TREATMENT MODALITY....: ",ONC(165.5,DA,363,"E")
.W !,"REGIONAL DOSE:cGy..............: ",ONC(165.5,DA,442,"E")
.W !,"BOOST TREATMENT MODALITY.......: ",ONC(165.5,DA,363.1,"E")
.W !,"BOOST DOSE:cGy.................: ",ONC(165.5,DA,443,"E")
.W !,"NUMBER OF TREATMENTS...........: ",ONC(165.5,DA,56,"E")
I $P($G(^ONCO(165.5,DA,0)),"^",16)>3171231 D
.S $P(^ONCO(165.5,D0,"RAD18"),"^",4)=70
.D RADSTF^ONCOAIP2
.S $P(^ONCO(165.5,DA,"NCR18B"),U,1)="99"
.S $P(^ONCO(165.5,DA,"NCR18B"),U,2)="99"
.S $P(^ONCO(165.5,DA,"NCR18B"),U,3)="999999"
.W !,"NUMBER OF PHASES RAD TX..............: 99"
.W !,"RADIATION TREATMENT DISC EARLY.......: 99"
.W !,"TOTAL DOSE...........................: 999999"
.S $P(^ONCO(165.5,D0,3),"^",7)=0 ; SET RAD/SURG SEQUENCE = 0 (YES, 0)
.S $P(^ONCO(165.5,D0,3),"^",35)=9 ; SET REASON FOR NO RAD = 9
W !,"DATE RADIATION ENDED...........: ",ONC(165.5,DA,361,"E")
I $P($G(^ONCO(165.5,DA,0)),"^",16)>3171231 W !
K ONC,TXDT Q
;
CHE ;Chemotherapy
N TXDT
S TXDT=$P(^ONCO(165.5,DA,3),U,11)_"C"
K ^ONCO(165.5,"ATX",DA,TXDT)
I X=88 D
.S $P(^ONCO(165.5,DA,3),U,11)=8888888 D CHEMDT^ONCATF1
.S ^ONCO(165.5,"ATX",DA,"8888888C")=""
I X=99 D
.S $P(^ONCO(165.5,DA,3),U,11)=9999999 D CHEMDT^ONCATF1
.S ^ONCO(165.5,"ATX",DA,"9999999C")=""
N DIC,DIQ,DR K ONC S DIC="^ONCO(165.5,",DA=DA,DIQ="ONC(",DIQ(0)="E"
S DR=53
D EN^DIQ1
W !,"CHEMOTHERAPY DATE..............: "_ONC(165.5,DA,53,"E")
K ONC Q
;
HOR ;Hormone therapy
N TXDT
S TXDT=$P(^ONCO(165.5,DA,3),U,14)_"H"
K ^ONCO(165.5,"ATX",DA,TXDT)
I X=88 D
.S $P(^ONCO(165.5,DA,3),U,14)=8888888 D HTDT^ONCATF1
.S ^ONCO(165.5,"ATX",DA,"8888888H")=""
I X=99 D
.S $P(^ONCO(165.5,DA,3),U,14)=9999999 D HTDT^ONCATF1
.S ^ONCO(165.5,"ATX",DA,"9999999H")=""
N DIC,DIQ,DR 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
N TXDT
S TXDT=$P(^ONCO(165.5,DA,3),U,17)_"B"
K ^ONCO(165.5,"ATX",DA,TXDT)
I X=88 D
.S $P(^ONCO(165.5,DA,3),U,17)=8888888 D IMMDT^ONCATF1
.S ^ONCO(165.5,"ATX",DA,"8888888B")=""
I X=99 D
.S $P(^ONCO(165.5,DA,3),U,17)=9999999 D IMMDT^ONCATF1
.S ^ONCO(165.5,"ATX",DA,"9999999B")=""
N DIC,DIQ,DR 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)
N TXDT
S TXDT=$P(^ONCO(165.5,DA,3.1),U,35)_"E"
K ^ONCO(165.5,"ATX",DA,TXDT)
I HE=88 D
.S $P(^ONCO(165.5,DA,3.1),U,35)=8888888
.S ^ONCO(165.5,"ATX",DA,"8888888E")=""
I HE=99 D
.S $P(^ONCO(165.5,DA,3.1),U,35)=9999999
.S ^ONCO(165.5,"ATX",DA,"9999999E")=""
N DIC,DIQ,DR,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 Q
;
OTH ;Other treatment
N TXDT
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)=9999999 D OTHDT^ONCATF1
S ^ONCO(165.5,"ATX",DA,"9999999O")=""
N DIC,DIQ,DR,X K ONC S DIC="^ONCO(165.5,",DA=DA,DIQ="ONC(",DIQ(0)="E"
S DR="57" D EN^DIQ1
W !,"OTHER TREATMENT DATE:..........: "_ONC(165.5,DA,57,"E")
K ONC Q
;
PRO ;Protocol
S $P(^ONCO(165.5,DA,"STS2"),U,31)=99
S $P(^ONCO(165.5,DA,3.1),U,4)=9999
N DIC,DIQ,DR 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
;
EXIT ;Exit
W ! S Y="@113"
Q
;
CLEANUP ;Cleanup
K D0,DA,DATEDX,HE,Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCUTX 7234 printed Dec 13, 2024@02:29:10 Page 2
ONCUTX ;Hines OIFO/GWB - Unknown treatment stuffing ;06/23/10
+1 ;;2.2;ONCOLOGY;**1,10**;Jul 31, 2013;Build 20
+2 ;
NCDS ;SURGICAL DX/STAGING PROC (165.5,58.1)
+1 SET $PIECE(^ONCO(165.5,D0,3),U,31)=9999999
+2 WRITE !,"SURGICAL DX/STAGING PROC DATE: 99/99/9999"
DO NCDSDT^ONCATF
+3 QUIT
+4 ;
SURR ;SURGERY OF PRIMARY (R) (165.5,58.2)
+1 NEW SA,SCG,TOP
+2 SET TOP=$PIECE($GET(^ONCO(165.5,D0,2)),U,1)
IF TOP=""
QUIT
+3 SET SCG=$PIECE($GET(^ONCO(164,TOP,0)),U,16)
IF SCG=""
QUIT
+4 if $EXTRACT(SCG,3,4)=77
SET SCG=67422
+5 SET SA=$ORDER(^ONCO(164,SCG,"SUA","C",9,0))
+6 SET $PIECE(^ONCO(165.5,D0,3),U,34)=SA
+7 NEW DIC,DIQ,DR
KILL ONC
SET DIC="^ONCO(165.5,"
SET DA=DA
SET DIQ="ONC("
SET DIQ(0)="E"
+8 SET DR=74
DO EN^DIQ1
+9 WRITE !,"SURGICAL APPROACH...........(R): "_ONC(165.5,DA,74,"E")
+10 QUIT
+11 ;
SUR ;SURGERY OF PRIMARY (F) (165.5,58.6)
+1 NEW SCG,TOP,TSDT,TXDT
+2 SET TXDT=$PIECE(^ONCO(165.5,DA,3),U,1)_"S1"
+3 KILL ^ONCO(165.5,"ATX",DA,TXDT)
+4 SET $PIECE(^ONCO(165.5,DA,3),U,1)=9999999
DO SPSDT^ONCATF
+5 SET ^ONCO(165.5,"ATX",DA,"9999999S1")=""
+6 SET TOP=$PIECE($GET(^ONCO(165.5,D0,2)),U,1)
IF TOP=""
QUIT
+7 SET SCG=$PIECE($GET(^ONCO(164,TOP,0)),U,16)
IF SCG=""
QUIT
+8 ;S:DATEDX>3091231 $P(^ONCO(165.5,D0,2.3),U,4)=9
+9 SET $PIECE(^ONCO(165.5,D0,3),U,28)=9
+10 SET $PIECE(^ONCO(165.5,DA,"THY1"),U,36)=9999999
+11 SET $PIECE(^ONCO(165.5,D0,3.1),U,28)=9
+12 NEW DIC,DIQ,DR
KILL ONC
SET DIC="^ONCO(165.5,"
SET DA=DA
SET DIQ="ONC("
SET DIQ(0)="E"
+13 SET DR="50;74;59;23;138;435;14;234"
DO EN^DIQ1
+14 WRITE !,"MOST DEFINITIVE SURG DATE......: "_ONC(165.5,DA,50,"E")
+15 ;W:DATEDX>3091231 !,"APPROACH.......................: "_$E(ONC(165.5,DA,234,"E"),1,40)
+16 WRITE !,"SURGICAL MARGINS...............: "_$EXTRACT(ONC(165.5,DA,59,"E"),1,40)
+17 WRITE !,"DATE OF SURGICAL DISCHARGE.....: "_ONC(165.5,DA,435,"E")
+18 WRITE !,"READMISSION W/I 30 DAYS/SURG...: "_ONC(165.5,DA,14,"E")
+19 QUIT
+20 ;
NODER ;SCOPE OF LN SURGERY (R) (165.5,138)
+1 SET $PIECE(^ONCO(165.5,D0,3),U,42)=99
DO NUMND^ONCATF
+2 NEW DR
SET DR=140
DO DIQ1^ONCNTX
+3 WRITE !,"NUMBER OF LN REMOVED........(R): "_ONC(165.5,DA,140,"E")
+4 QUIT
+5 ;
NODE ;SCOPE OF LN SURGERY (F) (165.5,138.4)
+1 NEW TXDT
+2 SET TXDT=$PIECE($GET(^ONCO(165.5,DA,3.1)),U,22)_"S2"
+3 KILL ^ONCO(165.5,"ATX",DA,TXDT)
+4 SET $PIECE(^ONCO(165.5,D0,3.1),U,22)="0000000"
DO SCPDT^ONCATF
+5 SET ^ONCO(165.5,"ATX",DA,"0000000S2")=""
+6 NEW DR
SET DR=138.2
DO DIQ1^ONCNTX
+7 WRITE !,"SCOPE OF LN SURGERY DATE.......: "_ONC(165.5,DA,138.2,"E")
+8 QUIT
+9 ;
SOSN ;SURG PROC/OTHER SITE DATE (165.5,139.2)
+1 NEW TXDT
+2 SET TXDT=$PIECE($GET(^ONCO(165.5,DA,3.1)),U,24)_"S3"
+3 KILL ^ONCO(165.5,"ATX",DA,TXDT)
+4 SET $PIECE(^ONCO(165.5,D0,3.1),U,24)=9999999
DO SOSNDT^ONCATF
+5 SET ^ONCO(165.5,"ATX",DA,"9999999S3")=""
+6 NEW DR
SET DR="139.2"
DO DIQ1^ONCNTX
+7 WRITE !,"SURGICAL PROC/OTHER SITE DATE..: "_ONC(165.5,DA,139.2,"E")
+8 QUIT
+9 ;
RAD ;Radiation
+1 NEW RFNR,TXDT
+2 SET RFNR=$PIECE($GET(^ONCO(165.5,DA,3)),U,35)
+3 IF RFNR=8
DO ^ONCRFNR
GOTO RAD1
+4 SET TXDT=$PIECE(^ONCO(165.5,DA,3),U,4)_"R"
+5 KILL ^ONCO(165.5,"ATX",DA,TXDT)
+6 SET $PIECE(^ONCO(165.5,DA,3),U,4)=9999999
DO RADDT^ONCATF1
+7 SET ^ONCO(165.5,"ATX",DA,"9999999R")=""
RAD1 SET $PIECE(^ONCO(165.5,DA,3),U,22)=9
+1 IF $PIECE($GET(^ONCO(165.5,DA,0)),"^",16)<3180000
Begin DoDot:1
+2 SET $PIECE(^ONCO(165.5,DA,3),U,21)=42
+3 SET $PIECE(^ONCO(165.5,DA,"BLA2"),U,18)=19
+4 SET $PIECE(^ONCO(165.5,DA,"THY1"),U,43)=99999
+5 SET $PIECE(^ONCO(165.5,DA,24),U,9)=19
+6 SET $PIECE(^ONCO(165.5,DA,"THY1"),U,44)=99999
+7 SET $PIECE(^ONCO(165.5,DA,3),U,20)=999
End DoDot:1
+8 SET $PIECE(^ONCO(165.5,DA,"BLA2"),U,16)=9999999
+9 NEW DIC,DIQ
KILL ONC
SET DIC="^ONCO(165.5,"
SET DA=DA
SET DIQ="ONC("
SET DIQ(0)="E"
+10 NEW DR
SET DR="51;126;125;363;442;363.1;443;56;361"
DO EN^DIQ1
+11 WRITE !,"DATE RADIATION STARTED.........: ",ONC(165.5,DA,51,"E")
+12 WRITE !,"LOCATION OF RADIATION..........: ",ONC(165.5,DA,126,"E")
+13 IF $PIECE($GET(^ONCO(165.5,DA,0)),"^",16)<3180000
Begin DoDot:1
+14 WRITE !,"RADIATION TREATMENT VOLUME.....: ",ONC(165.5,DA,125,"E")
+15 WRITE !,"REGIONAL TREATMENT MODALITY....: ",ONC(165.5,DA,363,"E")
+16 WRITE !,"REGIONAL DOSE:cGy..............: ",ONC(165.5,DA,442,"E")
+17 WRITE !,"BOOST TREATMENT MODALITY.......: ",ONC(165.5,DA,363.1,"E")
+18 WRITE !,"BOOST DOSE:cGy.................: ",ONC(165.5,DA,443,"E")
+19 WRITE !,"NUMBER OF TREATMENTS...........: ",ONC(165.5,DA,56,"E")
End DoDot:1
+20 IF $PIECE($GET(^ONCO(165.5,DA,0)),"^",16)>3171231
Begin DoDot:1
+21 SET $PIECE(^ONCO(165.5,D0,"RAD18"),"^",4)=70
+22 DO RADSTF^ONCOAIP2
+23 SET $PIECE(^ONCO(165.5,DA,"NCR18B"),U,1)="99"
+24 SET $PIECE(^ONCO(165.5,DA,"NCR18B"),U,2)="99"
+25 SET $PIECE(^ONCO(165.5,DA,"NCR18B"),U,3)="999999"
+26 WRITE !,"NUMBER OF PHASES RAD TX..............: 99"
+27 WRITE !,"RADIATION TREATMENT DISC EARLY.......: 99"
+28 WRITE !,"TOTAL DOSE...........................: 999999"
+29 ; SET RAD/SURG SEQUENCE = 0 (YES, 0)
SET $PIECE(^ONCO(165.5,D0,3),"^",7)=0
+30 ; SET REASON FOR NO RAD = 9
SET $PIECE(^ONCO(165.5,D0,3),"^",35)=9
End DoDot:1
+31 WRITE !,"DATE RADIATION ENDED...........: ",ONC(165.5,DA,361,"E")
+32 IF $PIECE($GET(^ONCO(165.5,DA,0)),"^",16)>3171231
WRITE !
+33 KILL ONC,TXDT
QUIT
+34 ;
CHE ;Chemotherapy
+1 NEW TXDT
+2 SET TXDT=$PIECE(^ONCO(165.5,DA,3),U,11)_"C"
+3 KILL ^ONCO(165.5,"ATX",DA,TXDT)
+4 IF X=88
Begin DoDot:1
+5 SET $PIECE(^ONCO(165.5,DA,3),U,11)=8888888
DO CHEMDT^ONCATF1
+6 SET ^ONCO(165.5,"ATX",DA,"8888888C")=""
End DoDot:1
+7 IF X=99
Begin DoDot:1
+8 SET $PIECE(^ONCO(165.5,DA,3),U,11)=9999999
DO CHEMDT^ONCATF1
+9 SET ^ONCO(165.5,"ATX",DA,"9999999C")=""
End DoDot:1
+10 NEW DIC,DIQ,DR
KILL ONC
SET DIC="^ONCO(165.5,"
SET DA=DA
SET DIQ="ONC("
SET DIQ(0)="E"
+11 SET DR=53
+12 DO EN^DIQ1
+13 WRITE !,"CHEMOTHERAPY DATE..............: "_ONC(165.5,DA,53,"E")
+14 KILL ONC
QUIT
+15 ;
HOR ;Hormone therapy
+1 NEW TXDT
+2 SET TXDT=$PIECE(^ONCO(165.5,DA,3),U,14)_"H"
+3 KILL ^ONCO(165.5,"ATX",DA,TXDT)
+4 IF X=88
Begin DoDot:1
+5 SET $PIECE(^ONCO(165.5,DA,3),U,14)=8888888
DO HTDT^ONCATF1
+6 SET ^ONCO(165.5,"ATX",DA,"8888888H")=""
End DoDot:1
+7 IF X=99
Begin DoDot:1
+8 SET $PIECE(^ONCO(165.5,DA,3),U,14)=9999999
DO HTDT^ONCATF1
+9 SET ^ONCO(165.5,"ATX",DA,"9999999H")=""
End DoDot:1
+10 NEW DIC,DIQ,DR
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
+1 NEW TXDT
+2 SET TXDT=$PIECE(^ONCO(165.5,DA,3),U,17)_"B"
+3 KILL ^ONCO(165.5,"ATX",DA,TXDT)
+4 IF X=88
Begin DoDot:1
+5 SET $PIECE(^ONCO(165.5,DA,3),U,17)=8888888
DO IMMDT^ONCATF1
+6 SET ^ONCO(165.5,"ATX",DA,"8888888B")=""
End DoDot:1
+7 IF X=99
Begin DoDot:1
+8 SET $PIECE(^ONCO(165.5,DA,3),U,17)=9999999
DO IMMDT^ONCATF1
+9 SET ^ONCO(165.5,"ATX",DA,"9999999B")=""
End DoDot:1
+10 NEW DIC,DIQ,DR
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 NEW TXDT
+2 SET TXDT=$PIECE(^ONCO(165.5,DA,3.1),U,35)_"E"
+3 KILL ^ONCO(165.5,"ATX",DA,TXDT)
+4 IF HE=88
Begin DoDot:1
+5 SET $PIECE(^ONCO(165.5,DA,3.1),U,35)=8888888
+6 SET ^ONCO(165.5,"ATX",DA,"8888888E")=""
End DoDot:1
+7 IF HE=99
Begin DoDot:1
+8 SET $PIECE(^ONCO(165.5,DA,3.1),U,35)=9999999
+9 SET ^ONCO(165.5,"ATX",DA,"9999999E")=""
End DoDot:1
+10 NEW DIC,DIQ,DR,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
QUIT
+14 ;
OTH ;Other treatment
+1 NEW TXDT
+2 SET TXDT=$PIECE(^ONCO(165.5,DA,3),U,23)_"O"
+3 KILL ^ONCO(165.5,"ATX",DA,TXDT)
+4 SET $PIECE(^ONCO(165.5,DA,3),U,23)=9999999
DO OTHDT^ONCATF1
+5 SET ^ONCO(165.5,"ATX",DA,"9999999O")=""
+6 NEW DIC,DIQ,DR,X
KILL ONC
SET DIC="^ONCO(165.5,"
SET DA=DA
SET DIQ="ONC("
SET DIQ(0)="E"
+7 SET DR="57"
DO EN^DIQ1
+8 WRITE !,"OTHER TREATMENT DATE:..........: "_ONC(165.5,DA,57,"E")
+9 KILL ONC
QUIT
+10 ;
PRO ;Protocol
+1 SET $PIECE(^ONCO(165.5,DA,"STS2"),U,31)=99
+2 SET $PIECE(^ONCO(165.5,DA,3.1),U,4)=9999
+3 NEW DIC,DIQ,DR
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 ;
EXIT ;Exit
+1 WRITE !
SET Y="@113"
+2 QUIT
+3 ;
CLEANUP ;Cleanup
+1 KILL D0,DA,DATEDX,HE,Y
