Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ONCNTX

ONCNTX.m

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