- ONCNTX ;HINES OIFO/GWB - No treatment stuffing ;03/31/11
- ;;2.2;ONCOLOGY;**1,6,10,15,20**;Jul 31, 2013;Build 5
- ;
- NTX ;No treatment stuffing
- N COC,PAUSE
- S COC=$E($$GET1^DIQ(165.5,DA,.04,"E"),1,2)
- ;ROADS
- N SITE
- S SITE=$P(^ONCO(165.5,DA,0),U,1)
- I DATEDX<3030000 D
- .D HDR,SURR,SURATFR^ONCNTX1,NODER
- .I (SITE=35)!(SITE=58)!(SITE=63)!(SITE=65)!($$LYMPHOMA^ONCFUNC(DA)=1) D NODATFR^ONCUTX1
- .E D NODATFR^ONCNTX1
- .D SOSNR,SOSATFR^ONCNTX1
- .W ! D PAUSE
- ;
- ;FORDS
- D HDR
- S TP=$P($G(^ONCO(165.5,DA,2)),U,1)
- S TXDT=$P($G(^ONCO(165.5,DA,3.1)),U,38)_"S0"
- K ^ONCO(165.5,"ATX",DA,TXDT)
- S $P(^ONCO(165.5,DA,3.1),U,38)="0000000"
- S ^ONCO(165.5,"ATX",DA,"0000000S0")=""
- ;D SUR,SURATF^ONCNTX1,SA,SM,NODE
- D SUR,SURATF^ONCNTX1,SA,SM
- ;Code 9 (FORDS 138-139)
- N MO S MO=$$HIST^ONCFUNC(DA)
- N TP14 S TP14=$E(TP,1,4)
- I (TP14=6770)!(TP14=6771)!(TP14=6772)!(TP=67751)!(TP=67752)!(TP=67753)!(TP14=6776)!(($$LYMPHOMA^ONCFUNC(DA)=1)&(TP14=6777))!(TP14=6776)!(TP=67809)!(TP=67420)!(TP=67421)!(TP=67423)!(TP=67424)!((MO'<97310)&(MO'>99899)) D NODEATF^ONCUTX1
- E W "" ;D NODEATF^ONCNTX1
- D SOSN,SOSNATF^ONCNTX1,RR,DSD
- D RFNS W ! S Y=138.4 Q
- ;
- NTXCONT S $P(^ONCO(165.5,DA,3),U,6)=0
- S $P(^ONCO(165.5,DA,3.1),U,12)=0
- ;S $P(^ONCO(165.5,DA,3),U,35)=""
- D HDR,RAD1,RADATF^ONCNTX1,RAD2,RSSQ^ONCNTX1,RFNR W !
- ;S $P(^ONCO(165.5,DA,3),U,13)="00"
- S $P(^ONCO(165.5,DA,3.1),U,14)="00"
- ;S $P(^ONCO(165.5,DA,3),U,16)="00"
- S $P(^ONCO(165.5,DA,3.1),U,16)="00"
- ;S $P(^ONCO(165.5,DA,3),U,19)="00"
- S $P(^ONCO(165.5,DA,3.1),U,18)="00"
- ;S $P(^ONCO(165.5,DA,3.1),U,36)=1
- ;S $P(^ONCO(165.5,DA,3),U,25)=0
- S $P(^ONCO(165.5,DA,3.1),U,20)=0
- D HDR,CHE,CHEMATF^ONCNTX1,HOR^ONCNTX1,HTATF^ONCNTX1,IMM^ONCNTX1,IMMATF^ONCNTX1,HTEP^ONCNTX1,HTEPATF^ONCNTX1,SSS^ONCNTX1
- D PAUSE
- D HDR,OTH^ONCNTX1,OTHATF^ONCNTX1
- W !
- D PAUSE
- ;
- W ! S Y="@425" G EXIT
- ;
- SURR ;SURGERY OF PRIMARY (R) (165.5,58.2)
- S $P(^ONCO(165.5,DA,3),U,38)=$S(DATEDX>2971231:1,1:"00")
- S $P(^ONCO(165.5,DA,3),U,34)=1
- S DR="58.2;74" D DIQ1
- I $D(NTX) D
- .;W !,"SURGICAL PROCEDURES (R)=ROADS"
- .;W !,"-----------------------------"
- .W !,"SURGERY OF PRIMARY..........(R): ",ONC(165.5,DA,58.2,"E")
- W !,"SURGICAL APPROACH...........(R): ",ONC(165.5,DA,74,"E")
- K ONC
- Q
- ;
- SUR ;SURGERY OF PRIMARY (F) (165.5,58.6)
- S TOPX=$P($G(^ONCO(165.5,DA,2)),U,1)
- N TOPSRCDZ S TOPSRCDZ=$P($G(^ONCO(164,TOPX,0)),U,16)
- 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,29)=1
- S $P(^ONCO(165.5,DA,3.1),U,29)=$S(DATEDX>2971231:1,1:"00")
- I DATEDX>3221231 D
- .S $P(^ONCO(165.5,DA,3.2),U,9)="A000"
- .I TOPSRCDZ=67440 S $P(^ONCO(165.5,DA,3.2),U,9)="B000"
- .I (TOPSRCDZ=67420)!(TOPSRCDZ=67760) S $P(^ONCO(165.5,DA,3.2),U,9)="A980"
- .Q
- SUR1 S TXDT=$P($G(^ONCO(165.5,DA,3)),U,1)_"S1"
- K ^ONCO(165.5,"ATX",DA,TXDT)
- S $P(^ONCO(165.5,DA,3),U,1)="0000000" D SPSDT^ONCATF
- S ^ONCO(165.5,"ATX",DA,"0000000S1")=""
- S $P(^ONCO(165.5,DA,3),U,28)=8
- ;S $P(^ONCO(165.5,DA,0),U,11)="00000000"
- S $P(^ONCO(165.5,DA,"THY1"),U,36)="0000000"
- S $P(^ONCO(165.5,DA,3.1),U,28)=0
- S DR="58.6:58.9;50;74;59;435;14;170" D DIQ1
- I $D(NTX) D
- .;W !,"SURGICAL PROCEDURES (F)=FORDS"
- .;W !,"-----------------------------"
- .W !,"DATE FIRST SURGICAL PROCEDURE..: ",ONC(165.5,DA,170,"E")
- .W:DATEDX<3230000 !,"RX SUMM--SURG PRIMSITE 03-2022.: ",ONC(165.5,DA,58.6,"E")
- .W:DATEDX>3221231 !,"RX SUMM--SURG PRIM SITE 2023...: ",ONC(165.5,DA,58.9,"E")
- W !,"MOST DEFINITIVE SURG DATE......: ",ONC(165.5,DA,50,"E")
- K ONC,TXDT,TOPX
- Q
- ;
- SA ;APPROACH (165.5,234)
- ;Q:DATEDX<3100000
- ;S $P(^ONCO(165.5,DA,2.3),U,4)=0
- ;S DR=234 D DIQ1
- ;W !,"APPROACH.......................: ",ONC(165.5,DA,234,"E")
- Q
- ;
- SM ;SURGICAL MARGINS (165.5,59)
- N HST14,MO,TPG
- S TPG=$P($G(^ONCO(165.5,DA,2)),U,1)
- S MO=$$HIST^ONCFUNC(DA)
- S HST14=$E(MO,1,4)
- S $P(^ONCO(165.5,DA,3),U,28)=8
- I $$LYMPH^ONCFUNC(DA),($E(TPG,3,4)=77) S $P(^ONCO(165.5,DA,3),U,28)=9
- I ($E(TPG,3,4)=76)!(TPG=67809)!(TPG=67420)!(TPG=67421)!(TPG=67423)!(TPG=67424) S $P(^ONCO(165.5,DA,3),U,28)=9
- I $$HEMATO^ONCFUNC(DA) S $P(^ONCO(165.5,DA,3),U,28)=9
- S DR="59" D DIQ1
- W !,"SURGICAL MARGINS...............: ",ONC(165.5,DA,59,"E")
- K ONC
- Q
- ;
- NODER ;SCOPE OF LN SURGERY (R) (165.5,138)
- ;For unknown primary, leukemia, lymphoma, & brain, code 9
- N LAST,SC,SGRP,SITE
- S SITE=$P(^ONCO(165.5,DA,0),U,1)
- I (SITE=35)!(SITE=58)!(SITE=63)!(SITE=65)!($$LYMPHOMA^ONCFUNC(DA)=1) D D NUMND^ONCATF Q
- .D SGRP^ONCUTX1
- .I ($E(TPG,3,4)=76)!(TPG=67809)!(TPG=67420)!(TPG=67421)!(TPG=67423)!(TPG=67424) S SGRP=67141
- .F SC=0:0 S SC=$O(^ONCO(164,SGRP,"SC5",SC)) Q:SC="B" S LAST=SC
- .S $P(^ONCO(165.5,DA,3),U,40)=LAST
- .W !,"SCOPE OF LN SURGERY.........(R): ",$P(^ONCO(164,SGRP,"SC5",LAST,0),U,1)
- .D NODER^ONCUTX
- S $P(^ONCO(165.5,DA,3),U,40)=1
- S $P(^ONCO(165.5,DA,3),U,42)="00"
- D NUMND^ONCATF
- S DR="138;140" D DIQ1
- W:$D(NTX) !,"SCOPE OF LN SURGERY.........(R): ",ONC(165.5,DA,138,"E")
- W !,"NUMBER OF LN REMOVED........(R): ",ONC(165.5,DA,140,"E")
- Q
- ;
- NODE ;SCOPE OF LN SURGERY (F) (165.5,138.4)
- ;Code 9 (FORDS 138-139)
- S TP=$P($G(^ONCO(165.5,DA,2)),U,1)
- N TP14 S TP14=$E(TP,1,4)
- N MO S MO=$$HIST^ONCFUNC(DA)
- I (TP14=6770)!(TP14=6771)!(TP14=6772)!(TP=67751)!(TP=67752)!(TP=67753)!(TP14=6776)!(($$LYMPHOMA^ONCFUNC(DA)=1)&(TP14=6777))!(TP14=6776)!(TP=67809)!(TP=67420)!(TP=67421)!(TP=67423)!(TP=67424)!((MO'<97310)&(MO'>99899)) D D SCPDT^ONCATF Q
- .S $P(^ONCO(165.5,DA,3.1),U,31)=9
- .W !,"SCOPE OF LN SURGERY.........(F): Unknown/NA"
- .D NODE^ONCUTX
- S $P(^ONCO(165.5,DA,3.1),U,31)=0
- 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")=""
- S DR="138.4;138.2" D DIQ1
- W:$D(NTX) !,"SCOPE OF LN SURGERY.........(F): ",ONC(165.5,DA,138.4,"E")
- W !,"SCOPE OF LN SURGERY DATE.......: ",ONC(165.5,DA,138.2,"E")
- Q
- ;
- SOSNR ;SURG PROC/OTHER SITE (R) (165.5,139)
- S $P(^ONCO(165.5,DA,3),U,41)=1
- S DR=139 D DIQ1
- W:$D(NTX) !,"SURG PROC/OTHER SITE........(R): ",ONC(165.5,DA,139,"E")
- Q
- ;
- SOSN ;SURG PROC/OTHER SITE (F) (165.5,139.4)
- S $P(^ONCO(165.5,DA,3.1),U,33)=0
- 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)="0000000" D SOSNDT^ONCATF
- S ^ONCO(165.5,"ATX",DA,"0000000S3")=""
- S DR="139.4;139.2" D DIQ1
- W:$D(NTX) !,"SURG PROC/OTHER SITE........(F): ",ONC(165.5,DA,139.4,"E")
- W !,"SURG PROC/OTHER SITE DATE......: ",ONC(165.5,DA,139.2,"E")
- Q
- ;
- RR ;RECONSTRUCTION/RESTORATION (165.5,23)
- I DATEDX>3021231 Q
- I DATEDX>2951231 D
- .S $P(^ONCO(165.5,DA,3),U,33)=$S(DATEDX>2971231:1,1:9)
- .S DR=23 D DIQ1
- .W !,"RECONSTRUCTION/RESTORATION.....: ",ONC(165.5,DA,23,"E")
- Q
- ;
- DSD ;DATE OF SURGICAL DISCHARGE (165.5,435)
- ;READMISSION W/I 30 DAYS/SURG (165.5,14)
- S $P(^ONCO(165.5,DA,"THY1"),U,36)="0000000"
- S $P(^ONCO(165.5,DA,3.1),U,28)=0
- S $P(^ONCO(165.5,DA,7),U,19)=9
- S $P(^ONCO(165.5,DA,7),U,20)=""
- S DR="435;14;46" D DIQ1
- W !,"DATE OF SURGICAL DISCHARGE.....: ",ONC(165.5,DA,435,"E")
- W !,"READMISSION W/I 30 DAYS/SURG...: ",ONC(165.5,DA,14,"E")
- W !,"CAP PROTOCOL REVIEW............: ",ONC(165.5,DA,46,"E")
- K ONC
- Q
- ;
- RFNS ;REASON NO SURGERY OF PRIMARY (165.5,58)
- I $D(NTX) W ! D Q
- .N DIE,DR,DP,DL,DQ
- .S DIE="^ONCO(165.5,",DR=58 D ^DIE
- N RFNS
- S RFNS=$$GET1^DIQ(165.5,DA,1.2)
- I (COC=38)!(RFNS="Autopsy only")!(RFNS="Death certificate only") D Q
- .S $P(^ONCO(165.5,DA,3),U,26)=9
- .W !,"REASON NO SURGERY OF PRIMARY...: Unknown"
- S RFNSDD=$P(^DD(165.5,58,0),U,3)
- W ! K DIR S DIR(0)="SA^"_RFNSDD
- S DIR("A")="REASON NO SURGERY OF PRIMARY: "
- ;S DIR("B")="Not part of 1st course"
- S DIR("??")="^D RFNSHLP^ONCNTX1"
- D ^DIR
- I Y[U Q
- S $P(^ONCO(165.5,DA,3),U,26)=Y
- K RFNSDD Q
- ;
- RAD1 ;RADIATION (165.5,51.2)
- N RFNR
- S RFNR=$P($G(^ONCO(165.5,DA,3)),U,35)
- D ^ONCRFNR
- S DR="51.2;51" D DIQ1
- W:$D(NTX) !,"RADIATION:.....................: ",ONC(165.5,DA,51.2,"E")
- W !,"DATE RADIATION STARTED.........: ",ONC(165.5,DA,51,"E")
- K ONC,TXDT Q
- ;
- RAD2 ;RADIATION (cont)
- I $P($G(^ONCO(165.5,DA,0)),"^",16)<3180000 D
- .S $P(^ONCO(165.5,DA,3),U,21)=1
- .S $P(^ONCO(165.5,DA,"BLA2"),U,18)=1
- .S $P(^ONCO(165.5,DA,"THY1"),U,43)=0
- .S $P(^ONCO(165.5,DA,24),U,9)=1
- .S $P(^ONCO(165.5,DA,"THY1"),U,44)=0
- .S $P(^ONCO(165.5,DA,3),U,20)=0
- S $P(^ONCO(165.5,DA,3),U,22)=0
- S $P(^ONCO(165.5,DA,"BLA2"),U,16)="0000000"
- S DR="126;125;363;442;363.1;443;56;361" D DIQ1
- 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)=1
- .D RADSTF^ONCOAIP2
- .S $P(^ONCO(165.5,DA,"NCR18B"),U,1)="00"
- .S $P(^ONCO(165.5,DA,"NCR18B"),U,2)="00"
- .S $P(^ONCO(165.5,DA,"NCR18B"),U,3)="000000"
- .W !,"NUMBER OF PHASES RAD TX..............: 00"
- .W !,"RADIATION TREATMENT DISC EARLY.......: 00"
- .W !,"TOTAL DOSE...........................: 000000"
- .S $P(^ONCO(165.5,D0,3),"^",7)=0 ; SET RAD/SURG SEQUENCE = 0
- .;S $P(^ONCO(165.5,D0,3),"^",35)="" ; CLEAR REASON FOR NO RAD FIELD
- 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
- ;
- RFNR ;REASON FOR NO RADIATION (165.5,75)
- I $D(NTX) W ! D Q
- .N DIE,DL,DP,DQ,DR
- .S DIE="^ONCO(165.5,",DR=75 D ^DIE
- N RFNS
- S RFNS=$$GET1^DIQ(165.5,DA,1.2)
- I (COC=38)!(RFNS="Autopsy only")!(RFNS="Death certificate only") D Q
- .S $P(^ONCO(165.5,DA,3),U,35)=9
- .W !,"REASON NO SURGERY OF PRIMARY...: Unknown"
- S RFNRDD=$P(^DD(165.5,75,0),U,3)
- W ! K DIR S DIR(0)="SA^"_RFNRDD
- S DIR("A")="REASON FOR NO RADIATION: "
- S DIR("B")="Not part of 1st course"
- S DIR("??")="^D RFNRHLP^ONCNTX1"
- D ^DIR
- I Y[U Q
- S $P(^ONCO(165.5,DA,3),U,35)=Y
- I X=8 S RFNR=8 D ^ONCRFNR D
- .W !!,"DATE RADIATION STARTED changed to 88/88/8888"
- K RFNRDD Q
- ;
- CHE ;CHEMOTHERAPY (165.5,53.2)
- I $D(NTX) D
- .N DIE,DL,DP,DQ,DR
- .S DIE="^ONCO(165.5,",DR=53.2 D ^DIE
- S TXDT=$P(^ONCO(165.5,DA,3),U,11)_"C"
- K ^ONCO(165.5,"ATX",DA,TXDT)
- S $P(^ONCO(165.5,DA,3),U,11)="0000000" D CHEMDT^ONCATF1
- S ^ONCO(165.5,"ATX",DA,"0000000C")=""
- F CMX=28,29,30,44,45 S $P(^ONCO(165.5,DA,"LUN2"),U,CMX)="" K CMX
- S DR=53 D DIQ1
- W !,"CHEMOTHERAPY DATE.............: ",ONC(165.5,DA,53,"E")
- K ONC Q
- ;
- NCDS ;SURGICAL DX/STAGING PROC (165.5,58.1)
- S $P(^ONCO(165.5,D0,3),U,31)="0000000" D NCDSDT^ONCATF
- S DR=58.3 D DIQ1
- W !,"SURGICAL DX/STAGING PROC DATE: ",ONC(165.5,DA,58.3,"E")
- Q
- ;
- HDR K DASH S $P(DASH,"-",80)="-"
- W @IOF,DASH,!,?1,PATNAM,?TAB,"First Course of Treatment",?SITTAB,SITEGP,!,?1,SSN,?TOPTAB,TOPNAM," ",TOPCOD,!,DASH
- K DASH
- Q
- ;
- DIQ1 N DIC,DIQ K ONC
- S DIC="^ONCO(165.5,",DIQ="ONC(",DIQ(0)="E" D EN^DIQ1
- Q
- ;
- PAUSE ;"Enter RETURN to continue" prompt
- W ! R "Enter RETURN to continue: ",PAUSE:30
- I PAUSE="" Q
- I PAUSE=U Q
- G PAUSE
- ;
- EXIT ;Exit
- W !
- K TP,TPG
- Q
- ;
- CLEANUP ;Cleanup
- K D0,DA,DATEDX,NTX,PATNAM,SITEGP,SITTAB,SSN,TAB,TOPCOD,TOPNAM,TOPTAB,X
- K Y
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCNTX 11541 printed Jan 18, 2025@03:25:16 Page 2
- ONCNTX ;HINES OIFO/GWB - No treatment stuffing ;03/31/11
- +1 ;;2.2;ONCOLOGY;**1,6,10,15,20**;Jul 31, 2013;Build 5
- +2 ;
- NTX ;No treatment stuffing
- +1 NEW COC,PAUSE
- +2 SET COC=$EXTRACT($$GET1^DIQ(165.5,DA,.04,"E"),1,2)
- +3 ;ROADS
- +4 NEW SITE
- +5 SET SITE=$PIECE(^ONCO(165.5,DA,0),U,1)
- +6 IF DATEDX<3030000
- Begin DoDot:1
- +7 DO HDR
- DO SURR
- DO SURATFR^ONCNTX1
- DO NODER
- +8 IF (SITE=35)!(SITE=58)!(SITE=63)!(SITE=65)!($$LYMPHOMA^ONCFUNC(DA)=1)
- DO NODATFR^ONCUTX1
- +9 IF '$TEST
- DO NODATFR^ONCNTX1
- +10 DO SOSNR
- DO SOSATFR^ONCNTX1
- +11 WRITE !
- DO PAUSE
- End DoDot:1
- +12 ;
- +13 ;FORDS
- +14 DO HDR
- +15 SET TP=$PIECE($GET(^ONCO(165.5,DA,2)),U,1)
- +16 SET TXDT=$PIECE($GET(^ONCO(165.5,DA,3.1)),U,38)_"S0"
- +17 KILL ^ONCO(165.5,"ATX",DA,TXDT)
- +18 SET $PIECE(^ONCO(165.5,DA,3.1),U,38)="0000000"
- +19 SET ^ONCO(165.5,"ATX",DA,"0000000S0")=""
- +20 ;D SUR,SURATF^ONCNTX1,SA,SM,NODE
- +21 DO SUR
- DO SURATF^ONCNTX1
- DO SA
- DO SM
- +22 ;Code 9 (FORDS 138-139)
- +23 NEW MO
- SET MO=$$HIST^ONCFUNC(DA)
- +24 NEW TP14
- SET TP14=$EXTRACT(TP,1,4)
- +25 IF (TP14=6770)!(TP14=6771)!(TP14=6772)!(TP=67751)!(TP=67752)!(TP=67753)!(TP14=6776)!(($$LYMPHOMA^ONCFUNC(DA)=1)&(TP14=6777))!(TP14=6776)!(TP=67809)!(TP=67420)!(TP=67421)!(TP=67423)!(TP=67424)!((MO'<97310)&(MO'>99899))
- DO NODEATF^ONCUTX1
- +26 ;D NODEATF^ONCNTX1
- IF '$TEST
- WRITE ""
- +27 DO SOSN
- DO SOSNATF^ONCNTX1
- DO RR
- DO DSD
- +28 DO RFNS
- WRITE !
- SET Y=138.4
- QUIT
- +29 ;
- NTXCONT SET $PIECE(^ONCO(165.5,DA,3),U,6)=0
- +1 SET $PIECE(^ONCO(165.5,DA,3.1),U,12)=0
- +2 ;S $P(^ONCO(165.5,DA,3),U,35)=""
- +3 DO HDR
- DO RAD1
- DO RADATF^ONCNTX1
- DO RAD2
- DO RSSQ^ONCNTX1
- DO RFNR
- WRITE !
- +4 ;S $P(^ONCO(165.5,DA,3),U,13)="00"
- +5 SET $PIECE(^ONCO(165.5,DA,3.1),U,14)="00"
- +6 ;S $P(^ONCO(165.5,DA,3),U,16)="00"
- +7 SET $PIECE(^ONCO(165.5,DA,3.1),U,16)="00"
- +8 ;S $P(^ONCO(165.5,DA,3),U,19)="00"
- +9 SET $PIECE(^ONCO(165.5,DA,3.1),U,18)="00"
- +10 ;S $P(^ONCO(165.5,DA,3.1),U,36)=1
- +11 ;S $P(^ONCO(165.5,DA,3),U,25)=0
- +12 SET $PIECE(^ONCO(165.5,DA,3.1),U,20)=0
- +13 DO HDR
- DO CHE
- DO CHEMATF^ONCNTX1
- DO HOR^ONCNTX1
- DO HTATF^ONCNTX1
- DO IMM^ONCNTX1
- DO IMMATF^ONCNTX1
- DO HTEP^ONCNTX1
- DO HTEPATF^ONCNTX1
- DO SSS^ONCNTX1
- +14 DO PAUSE
- +15 DO HDR
- DO OTH^ONCNTX1
- DO OTHATF^ONCNTX1
- +16 WRITE !
- +17 DO PAUSE
- +18 ;
- +19 WRITE !
- SET Y="@425"
- GOTO EXIT
- +20 ;
- SURR ;SURGERY OF PRIMARY (R) (165.5,58.2)
- +1 SET $PIECE(^ONCO(165.5,DA,3),U,38)=$SELECT(DATEDX>2971231:1,1:"00")
- +2 SET $PIECE(^ONCO(165.5,DA,3),U,34)=1
- +3 SET DR="58.2;74"
- DO DIQ1
- +4 IF $DATA(NTX)
- Begin DoDot:1
- +5 ;W !,"SURGICAL PROCEDURES (R)=ROADS"
- +6 ;W !,"-----------------------------"
- +7 WRITE !,"SURGERY OF PRIMARY..........(R): ",ONC(165.5,DA,58.2,"E")
- End DoDot:1
- +8 WRITE !,"SURGICAL APPROACH...........(R): ",ONC(165.5,DA,74,"E")
- +9 KILL ONC
- +10 QUIT
- +11 ;
- SUR ;SURGERY OF PRIMARY (F) (165.5,58.6)
- +1 SET TOPX=$PIECE($GET(^ONCO(165.5,DA,2)),U,1)
- +2 NEW TOPSRCDZ
- SET TOPSRCDZ=$PIECE($GET(^ONCO(164,TOPX,0)),U,16)
- +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,29)=1
- End DoDot:1
- GOTO SUR1
- +5 SET $PIECE(^ONCO(165.5,DA,3.1),U,29)=$SELECT(DATEDX>2971231:1,1:"00")
- +6 IF DATEDX>3221231
- Begin DoDot:1
- +7 SET $PIECE(^ONCO(165.5,DA,3.2),U,9)="A000"
- +8 IF TOPSRCDZ=67440
- SET $PIECE(^ONCO(165.5,DA,3.2),U,9)="B000"
- +9 IF (TOPSRCDZ=67420)!(TOPSRCDZ=67760)
- SET $PIECE(^ONCO(165.5,DA,3.2),U,9)="A980"
- +10 QUIT
- End DoDot:1
- SUR1 SET TXDT=$PIECE($GET(^ONCO(165.5,DA,3)),U,1)_"S1"
- +1 KILL ^ONCO(165.5,"ATX",DA,TXDT)
- +2 SET $PIECE(^ONCO(165.5,DA,3),U,1)="0000000"
- DO SPSDT^ONCATF
- +3 SET ^ONCO(165.5,"ATX",DA,"0000000S1")=""
- +4 SET $PIECE(^ONCO(165.5,DA,3),U,28)=8
- +5 ;S $P(^ONCO(165.5,DA,0),U,11)="00000000"
- +6 SET $PIECE(^ONCO(165.5,DA,"THY1"),U,36)="0000000"
- +7 SET $PIECE(^ONCO(165.5,DA,3.1),U,28)=0
- +8 SET DR="58.6:58.9;50;74;59;435;14;170"
- DO DIQ1
- +9 IF $DATA(NTX)
- Begin DoDot:1
- +10 ;W !,"SURGICAL PROCEDURES (F)=FORDS"
- +11 ;W !,"-----------------------------"
- +12 WRITE !,"DATE FIRST SURGICAL PROCEDURE..: ",ONC(165.5,DA,170,"E")
- +13 if DATEDX<3230000
- WRITE !,"RX SUMM--SURG PRIMSITE 03-2022.: ",ONC(165.5,DA,58.6,"E")
- +14 if DATEDX>3221231
- WRITE !,"RX SUMM--SURG PRIM SITE 2023...: ",ONC(165.5,DA,58.9,"E")
- End DoDot:1
- +15 WRITE !,"MOST DEFINITIVE SURG DATE......: ",ONC(165.5,DA,50,"E")
- +16 KILL ONC,TXDT,TOPX
- +17 QUIT
- +18 ;
- SA ;APPROACH (165.5,234)
- +1 ;Q:DATEDX<3100000
- +2 ;S $P(^ONCO(165.5,DA,2.3),U,4)=0
- +3 ;S DR=234 D DIQ1
- +4 ;W !,"APPROACH.......................: ",ONC(165.5,DA,234,"E")
- +5 QUIT
- +6 ;
- SM ;SURGICAL MARGINS (165.5,59)
- +1 NEW HST14,MO,TPG
- +2 SET TPG=$PIECE($GET(^ONCO(165.5,DA,2)),U,1)
- +3 SET MO=$$HIST^ONCFUNC(DA)
- +4 SET HST14=$EXTRACT(MO,1,4)
- +5 SET $PIECE(^ONCO(165.5,DA,3),U,28)=8
- +6 IF $$LYMPH^ONCFUNC(DA)
- IF ($EXTRACT(TPG,3,4)=77)
- SET $PIECE(^ONCO(165.5,DA,3),U,28)=9
- +7 IF ($EXTRACT(TPG,3,4)=76)!(TPG=67809)!(TPG=67420)!(TPG=67421)!(TPG=67423)!(TPG=67424)
- SET $PIECE(^ONCO(165.5,DA,3),U,28)=9
- +8 IF $$HEMATO^ONCFUNC(DA)
- SET $PIECE(^ONCO(165.5,DA,3),U,28)=9
- +9 SET DR="59"
- DO DIQ1
- +10 WRITE !,"SURGICAL MARGINS...............: ",ONC(165.5,DA,59,"E")
- +11 KILL ONC
- +12 QUIT
- +13 ;
- NODER ;SCOPE OF LN SURGERY (R) (165.5,138)
- +1 ;For unknown primary, leukemia, lymphoma, & brain, code 9
- +2 NEW LAST,SC,SGRP,SITE
- +3 SET SITE=$PIECE(^ONCO(165.5,DA,0),U,1)
- +4 IF (SITE=35)!(SITE=58)!(SITE=63)!(SITE=65)!($$LYMPHOMA^ONCFUNC(DA)=1)
- Begin DoDot:1
- +5 DO SGRP^ONCUTX1
- +6 IF ($EXTRACT(TPG,3,4)=76)!(TPG=67809)!(TPG=67420)!(TPG=67421)!(TPG=67423)!(TPG=67424)
- SET SGRP=67141
- +7 FOR SC=0:0
- SET SC=$ORDER(^ONCO(164,SGRP,"SC5",SC))
- if SC="B"
- QUIT
- SET LAST=SC
- +8 SET $PIECE(^ONCO(165.5,DA,3),U,40)=LAST
- +9 WRITE !,"SCOPE OF LN SURGERY.........(R): ",$PIECE(^ONCO(164,SGRP,"SC5",LAST,0),U,1)
- +10 DO NODER^ONCUTX
- End DoDot:1
- DO NUMND^ONCATF
- QUIT
- +11 SET $PIECE(^ONCO(165.5,DA,3),U,40)=1
- +12 SET $PIECE(^ONCO(165.5,DA,3),U,42)="00"
- +13 DO NUMND^ONCATF
- +14 SET DR="138;140"
- DO DIQ1
- +15 if $DATA(NTX)
- WRITE !,"SCOPE OF LN SURGERY.........(R): ",ONC(165.5,DA,138,"E")
- +16 WRITE !,"NUMBER OF LN REMOVED........(R): ",ONC(165.5,DA,140,"E")
- +17 QUIT
- +18 ;
- NODE ;SCOPE OF LN SURGERY (F) (165.5,138.4)
- +1 ;Code 9 (FORDS 138-139)
- +2 SET TP=$PIECE($GET(^ONCO(165.5,DA,2)),U,1)
- +3 NEW TP14
- SET TP14=$EXTRACT(TP,1,4)
- +4 NEW MO
- SET MO=$$HIST^ONCFUNC(DA)
- +5 IF (TP14=6770)!(TP14=6771)!(TP14=6772)!(TP=67751)!(TP=67752)!(TP=67753)!(TP14=6776)!(($$LYMPHOMA^ONCFUNC(DA)=1)&(TP14=6777))!(TP14=6776)!(TP=67809)!(TP=67420)!(TP=67421)!(TP=67423)!(TP=67424)!((MO'<97310)&(MO'>99899))
- Begin DoDot:1
- +6 SET $PIECE(^ONCO(165.5,DA,3.1),U,31)=9
- +7 WRITE !,"SCOPE OF LN SURGERY.........(F): Unknown/NA"
- +8 DO NODE^ONCUTX
- End DoDot:1
- DO SCPDT^ONCATF
- QUIT
- +9 SET $PIECE(^ONCO(165.5,DA,3.1),U,31)=0
- +10 SET TXDT=$PIECE($GET(^ONCO(165.5,DA,3.1)),U,22)_"S2"
- +11 KILL ^ONCO(165.5,"ATX",DA,TXDT)
- +12 SET $PIECE(^ONCO(165.5,D0,3.1),U,22)="0000000"
- DO SCPDT^ONCATF
- +13 SET ^ONCO(165.5,"ATX",DA,"0000000S2")=""
- +14 SET DR="138.4;138.2"
- DO DIQ1
- +15 if $DATA(NTX)
- WRITE !,"SCOPE OF LN SURGERY.........(F): ",ONC(165.5,DA,138.4,"E")
- +16 WRITE !,"SCOPE OF LN SURGERY DATE.......: ",ONC(165.5,DA,138.2,"E")
- +17 QUIT
- +18 ;
- SOSNR ;SURG PROC/OTHER SITE (R) (165.5,139)
- +1 SET $PIECE(^ONCO(165.5,DA,3),U,41)=1
- +2 SET DR=139
- DO DIQ1
- +3 if $DATA(NTX)
- WRITE !,"SURG PROC/OTHER SITE........(R): ",ONC(165.5,DA,139,"E")
- +4 QUIT
- +5 ;
- SOSN ;SURG PROC/OTHER SITE (F) (165.5,139.4)
- +1 SET $PIECE(^ONCO(165.5,DA,3.1),U,33)=0
- +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)="0000000"
- DO SOSNDT^ONCATF
- +5 SET ^ONCO(165.5,"ATX",DA,"0000000S3")=""
- +6 SET DR="139.4;139.2"
- DO DIQ1
- +7 if $DATA(NTX)
- WRITE !,"SURG PROC/OTHER SITE........(F): ",ONC(165.5,DA,139.4,"E")
- +8 WRITE !,"SURG PROC/OTHER SITE DATE......: ",ONC(165.5,DA,139.2,"E")
- +9 QUIT
- +10 ;
- RR ;RECONSTRUCTION/RESTORATION (165.5,23)
- +1 IF DATEDX>3021231
- QUIT
- +2 IF DATEDX>2951231
- Begin DoDot:1
- +3 SET $PIECE(^ONCO(165.5,DA,3),U,33)=$SELECT(DATEDX>2971231:1,1:9)
- +4 SET DR=23
- DO DIQ1
- +5 WRITE !,"RECONSTRUCTION/RESTORATION.....: ",ONC(165.5,DA,23,"E")
- End DoDot:1
- +6 QUIT
- +7 ;
- DSD ;DATE OF SURGICAL DISCHARGE (165.5,435)
- +1 ;READMISSION W/I 30 DAYS/SURG (165.5,14)
- +2 SET $PIECE(^ONCO(165.5,DA,"THY1"),U,36)="0000000"
- +3 SET $PIECE(^ONCO(165.5,DA,3.1),U,28)=0
- +4 SET $PIECE(^ONCO(165.5,DA,7),U,19)=9
- +5 SET $PIECE(^ONCO(165.5,DA,7),U,20)=""
- +6 SET DR="435;14;46"
- DO DIQ1
- +7 WRITE !,"DATE OF SURGICAL DISCHARGE.....: ",ONC(165.5,DA,435,"E")
- +8 WRITE !,"READMISSION W/I 30 DAYS/SURG...: ",ONC(165.5,DA,14,"E")
- +9 WRITE !,"CAP PROTOCOL REVIEW............: ",ONC(165.5,DA,46,"E")
- +10 KILL ONC
- +11 QUIT
- +12 ;
- RFNS ;REASON NO SURGERY OF PRIMARY (165.5,58)
- +1 IF $DATA(NTX)
- WRITE !
- Begin DoDot:1
- +2 NEW DIE,DR,DP,DL,DQ
- +3 SET DIE="^ONCO(165.5,"
- SET DR=58
- DO ^DIE
- End DoDot:1
- QUIT
- +4 NEW RFNS
- +5 SET RFNS=$$GET1^DIQ(165.5,DA,1.2)
- +6 IF (COC=38)!(RFNS="Autopsy only")!(RFNS="Death certificate only")
- Begin DoDot:1
- +7 SET $PIECE(^ONCO(165.5,DA,3),U,26)=9
- +8 WRITE !,"REASON NO SURGERY OF PRIMARY...: Unknown"
- End DoDot:1
- QUIT
- +9 SET RFNSDD=$PIECE(^DD(165.5,58,0),U,3)
- +10 WRITE !
- KILL DIR
- SET DIR(0)="SA^"_RFNSDD
- +11 SET DIR("A")="REASON NO SURGERY OF PRIMARY: "
- +12 ;S DIR("B")="Not part of 1st course"
- +13 SET DIR("??")="^D RFNSHLP^ONCNTX1"
- +14 DO ^DIR
- +15 IF Y[U
- QUIT
- +16 SET $PIECE(^ONCO(165.5,DA,3),U,26)=Y
- +17 KILL RFNSDD
- QUIT
- +18 ;
- RAD1 ;RADIATION (165.5,51.2)
- +1 NEW RFNR
- +2 SET RFNR=$PIECE($GET(^ONCO(165.5,DA,3)),U,35)
- +3 DO ^ONCRFNR
- +4 SET DR="51.2;51"
- DO DIQ1
- +5 if $DATA(NTX)
- WRITE !,"RADIATION:.....................: ",ONC(165.5,DA,51.2,"E")
- +6 WRITE !,"DATE RADIATION STARTED.........: ",ONC(165.5,DA,51,"E")
- +7 KILL ONC,TXDT
- QUIT
- +8 ;
- RAD2 ;RADIATION (cont)
- +1 IF $PIECE($GET(^ONCO(165.5,DA,0)),"^",16)<3180000
- Begin DoDot:1
- +2 SET $PIECE(^ONCO(165.5,DA,3),U,21)=1
- +3 SET $PIECE(^ONCO(165.5,DA,"BLA2"),U,18)=1
- +4 SET $PIECE(^ONCO(165.5,DA,"THY1"),U,43)=0
- +5 SET $PIECE(^ONCO(165.5,DA,24),U,9)=1
- +6 SET $PIECE(^ONCO(165.5,DA,"THY1"),U,44)=0
- +7 SET $PIECE(^ONCO(165.5,DA,3),U,20)=0
- End DoDot:1
- +8 SET $PIECE(^ONCO(165.5,DA,3),U,22)=0
- +9 SET $PIECE(^ONCO(165.5,DA,"BLA2"),U,16)="0000000"
- +10 SET DR="126;125;363;442;363.1;443;56;361"
- DO DIQ1
- +11 WRITE !,"LOCATION OF RADIATION..........: ",ONC(165.5,DA,126,"E")
- +12 IF $PIECE($GET(^ONCO(165.5,DA,0)),"^",16)<3180000
- Begin DoDot:1
- +13 WRITE !,"RADIATION TREATMENT VOLUME.....: ",ONC(165.5,DA,125,"E")
- +14 WRITE !,"REGIONAL TREATMENT MODALITY....: ",ONC(165.5,DA,363,"E")
- +15 WRITE !,"REGIONAL DOSE:cGy..............: ",ONC(165.5,DA,442,"E")
- +16 WRITE !,"BOOST TREATMENT MODALITY.......: ",ONC(165.5,DA,363.1,"E")
- +17 WRITE !,"BOOST DOSE:cGy.................: ",ONC(165.5,DA,443,"E")
- +18 WRITE !,"NUMBER OF TREATMENTS...........: ",ONC(165.5,DA,56,"E")
- End DoDot:1
- +19 IF $PIECE($GET(^ONCO(165.5,DA,0)),"^",16)>3171231
- Begin DoDot:1
- +20 SET $PIECE(^ONCO(165.5,D0,"RAD18"),"^",4)=1
- +21 DO RADSTF^ONCOAIP2
- +22 SET $PIECE(^ONCO(165.5,DA,"NCR18B"),U,1)="00"
- +23 SET $PIECE(^ONCO(165.5,DA,"NCR18B"),U,2)="00"
- +24 SET $PIECE(^ONCO(165.5,DA,"NCR18B"),U,3)="000000"
- +25 WRITE !,"NUMBER OF PHASES RAD TX..............: 00"
- +26 WRITE !,"RADIATION TREATMENT DISC EARLY.......: 00"
- +27 WRITE !,"TOTAL DOSE...........................: 000000"
- +28 ; SET RAD/SURG SEQUENCE = 0
- SET $PIECE(^ONCO(165.5,D0,3),"^",7)=0
- +29 ;S $P(^ONCO(165.5,D0,3),"^",35)="" ; CLEAR REASON FOR NO RAD FIELD
- End DoDot:1
- +30 WRITE !,"DATE RADIATION ENDED...........: ",ONC(165.5,DA,361,"E")
- +31 IF $PIECE($GET(^ONCO(165.5,DA,0)),"^",16)>3171231
- WRITE !
- +32 KILL ONC,TXDT
- QUIT
- +33 ;
- RFNR ;REASON FOR NO RADIATION (165.5,75)
- +1 IF $DATA(NTX)
- WRITE !
- Begin DoDot:1
- +2 NEW DIE,DL,DP,DQ,DR
- +3 SET DIE="^ONCO(165.5,"
- SET DR=75
- DO ^DIE
- End DoDot:1
- QUIT
- +4 NEW RFNS
- +5 SET RFNS=$$GET1^DIQ(165.5,DA,1.2)
- +6 IF (COC=38)!(RFNS="Autopsy only")!(RFNS="Death certificate only")
- Begin DoDot:1
- +7 SET $PIECE(^ONCO(165.5,DA,3),U,35)=9
- +8 WRITE !,"REASON NO SURGERY OF PRIMARY...: Unknown"
- End DoDot:1
- QUIT
- +9 SET RFNRDD=$PIECE(^DD(165.5,75,0),U,3)
- +10 WRITE !
- KILL DIR
- SET DIR(0)="SA^"_RFNRDD
- +11 SET DIR("A")="REASON FOR NO RADIATION: "
- +12 SET DIR("B")="Not part of 1st course"
- +13 SET DIR("??")="^D RFNRHLP^ONCNTX1"
- +14 DO ^DIR
- +15 IF Y[U
- QUIT
- +16 SET $PIECE(^ONCO(165.5,DA,3),U,35)=Y
- +17 IF X=8
- SET RFNR=8
- DO ^ONCRFNR
- Begin DoDot:1
- +18 WRITE !!,"DATE RADIATION STARTED changed to 88/88/8888"
- End DoDot:1
- +19 KILL RFNRDD
- QUIT
- +20 ;
- CHE ;CHEMOTHERAPY (165.5,53.2)
- +1 IF $DATA(NTX)
- Begin DoDot:1
- +2 NEW DIE,DL,DP,DQ,DR
- +3 SET DIE="^ONCO(165.5,"
- SET DR=53.2
- DO ^DIE
- End DoDot:1
- +4 SET TXDT=$PIECE(^ONCO(165.5,DA,3),U,11)_"C"
- +5 KILL ^ONCO(165.5,"ATX",DA,TXDT)
- +6 SET $PIECE(^ONCO(165.5,DA,3),U,11)="0000000"
- DO CHEMDT^ONCATF1
- +7 SET ^ONCO(165.5,"ATX",DA,"0000000C")=""
- +8 FOR CMX=28,29,30,44,45
- SET $PIECE(^ONCO(165.5,DA,"LUN2"),U,CMX)=""
- KILL CMX
- +9 SET DR=53
- DO DIQ1
- +10 WRITE !,"CHEMOTHERAPY DATE.............: ",ONC(165.5,DA,53,"E")
- +11 KILL ONC
- QUIT
- +12 ;
- NCDS ;SURGICAL DX/STAGING PROC (165.5,58.1)
- +1 SET $PIECE(^ONCO(165.5,D0,3),U,31)="0000000"
- DO NCDSDT^ONCATF
- +2 SET DR=58.3
- DO DIQ1
- +3 WRITE !,"SURGICAL DX/STAGING PROC DATE: ",ONC(165.5,DA,58.3,"E")
- +4 QUIT
- +5 ;
- HDR KILL DASH
- SET $PIECE(DASH,"-",80)="-"
- +1 WRITE @IOF,DASH,!,?1,PATNAM,?TAB,"First Course of Treatment",?SITTAB,SITEGP,!,?1,SSN,?TOPTAB,TOPNAM," ",TOPCOD,!,DASH
- +2 KILL DASH
- +3 QUIT
- +4 ;
- DIQ1 NEW DIC,DIQ
- KILL ONC
- +1 SET DIC="^ONCO(165.5,"
- SET DIQ="ONC("
- SET DIQ(0)="E"
- DO EN^DIQ1
- +2 QUIT
- +3 ;
- PAUSE ;"Enter RETURN to continue" prompt
- +1 WRITE !
- READ "Enter RETURN to continue: ",PAUSE:30
- +2 IF PAUSE=""
- QUIT
- +3 IF PAUSE=U
- QUIT
- +4 GOTO PAUSE
- +5 ;
- EXIT ;Exit
- +1 WRITE !
- +2 KILL TP,TPG
- +3 QUIT
- +4 ;
- CLEANUP ;Cleanup
- +1 KILL D0,DA,DATEDX,NTX,PATNAM,SITEGP,SITTAB,SSN,TAB,TOPCOD,TOPNAM,TOPTAB,X
- +2 KILL Y