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

ONCOCC.m

Go to the documentation of this file. 
  1. ONCOCC ;HINES OIFO/GWB - CLASS OF CASE stuffing and @FAC defaults ;06/23/10
  1.  ;;2.2;ONCOLOGY;**1,5**;Jul 31, 2013;Build 6
  1.  ;
  1.  ;CLASS OF CASE (165.5,.04) = 38 (Dx by autopsy at reporting facility)
  1.  N COC,NTX,PAUSE
  1.  S COC=$E($$GET1^DIQ(165.5,DA,.04,"E"),1,2)
  1.  I COC=38 D  S Y=$S(PAUSE[U:"",ONCOANS="A":"@7",1:"@0")
  1.  .W !?5,"CLASS OF CASE = 38 (Dx by autopsy at reporting facility)"
  1.  .W !!?5,"All treatment fields will be stuffed with the appropriate"
  1.  .W !?5,"value indicating no treatment.",!
  1.  .D PAUSE I PAUSE[U Q
  1.  .S NTX="" D NTX^ONCNTX
  1.  .D HDR^ONCNTX
  1.  .S $P(^ONCO(165.5,DA,3.1),U,26)=0
  1.  .S $P(^ONCO(165.5,DA,3.1),U,27)=0
  1.  .S $P(^ONCO(165.5,DA,"BLA2"),U,1)=0
  1.  .S $P(^ONCO(165.5,DA,"STS"),U,31)="00"
  1.  .S $P(^ONCO(165.5,DA,3.1),U,4)="0000"
  1.  .W !,"PALLIATIVE CARE................: No palliative care"
  1.  .W !,"PALLIATIVE CARE @FAC...........: No palliative care"
  1.  .W !
  1.  .W !,"PROTOCOL ELIGIBILITY STATUS....: Not available"
  1.  .W !,"PROTOCOL PARTICIPATION.........: Not on/NA"
  1.  .W !,"YEAR PUT ON PROTOCOL...........: 0000"
  1.  .W !
  1.  .D PAUSE
  1.  Q
  1.  ;
  1. PAUSE ;Enter RETURN to coninue" prompt
  1.  W ! R "Enter RETURN to continue or '^' to exit: ",PAUSE:30
  1.  I PAUSE="" Q
  1.  I PAUSE=U Q
  1.  G PAUSE
  1.  ;
  1. DNTDEL ;Delete DATE OF NO TREATMENT (165.5,124)
  1.  N TXDT
  1.  I $P($G(^ONCO(165.5,DA,2.1)),U,11)'="" D
  1.  .S TXDT=$P(^ONCO(165.5,DA,2.1),U,11)_"N"
  1.  .S $P(^ONCO(165.5,DA,2.1),U,11)=""
  1.  .K ^ONCO(165.5,"ATX",DA,TXDT)
  1.  Q
  1.  ;
  1. SATFDFR ;SURGERY OF PRIMARY @FAC (R) (165.5,50.2) default
  1.  N SGRP,SPS,TPG
  1.  S SPS=$P($G(^ONCO(165.5,D0,3)),U,38)
  1.  D SGROUP I TPG="" Q
  1.  I (SPS="00")!(SPS=1)!($G(^ONCO(164,SGRP,"SPS",SPS,0))["Unknown") S Y="@427" Q
  1.  S SPSDF="" I (COC=10)!(COC=11)!(COC=12)!(COC=13)!(COC=14)!(COC=20)!(COC=21)!(COC=22) D  Q
  1.  .S SPSDF=$P($G(^ONCO(164,SGRP,"SPS",SPS,0)),U,1)
  1.  .S:$P($G(^ONCO(165.5,D0,0)),U,16)<2980000 SPSDF=""
  1.  Q
  1.  ;
  1. SATFDEF ;SURGERY OF PRIMARY @FAC (F) (165.5,58.7) default
  1.  N SGRP,SPS,TPG
  1.  S SPS=$P($G(^ONCO(165.5,D0,3.1)),U,29)
  1.  I SPS="" Q
  1.  D SGROUP I TPG="" Q
  1.  I (SPS="00")!(SPS=1)!($G(^ONCO(164,SGRP,"SPS",SPS,0))["Unknown") S Y="@43" Q
  1.  S (SPSDF,SPSDTDF)="" I (COC=10)!(COC=11)!(COC=12)!(COC=13)!(COC=14)!(COC=20)!(COC=21)!(COC=22) D  Q
  1.  .S SPSDF=$P($G(^ONCO(164,SGRP,"SPS",SPS,0)),U,1)
  1.  .S SPSDTDF=$$GET1^DIQ(165.5,D0,50,"E")
  1.  .S:$P($G(^ONCO(165.5,D0,0)),U,16)<2980000 (SPSDF,SPSDTDF)=""
  1.  Q
  1.  ;
  1. RATFDEF ;RADIATION @FACILITY (165.5,51.4) default
  1.  N RD,XX,YY
  1.  S RD=$P($G(^ONCO(165.5,D0,3)),U,6)
  1.  S RADDF="",RADDTDF="" I (COC=10)!(COC=11)!(COC=12)!(COC=13)!(COC=14)!(COC=20)!(COC=21)!(COC=22) D  Q
  1.  .I RD'="" D
  1.  ..S XX=$F(^DD(165.5,51.2,0),RD_":")
  1.  ..S YY=$F(^DD(165.5,51.2,0),";",XX)
  1.  ..S RADDF=$E(^DD(165.5,51.2,0),XX,YY-2)
  1.  .S RADDTDF=$P($G(^ONCO(165.5,D0,3)),U,4)
  1.  Q
  1.  ;
  1. CATFDEF ;CHEMOTHERAPY @FAC (165.5,53.3) default
  1.  N CH
  1.  S CH=$P($G(^ONCO(165.5,D0,3)),U,13)
  1.  S CHEMDF="",CHMDTDF="" I (COC=10)!(COC=11)!(COC=12)!(COC=13)!(COC=14)!(COC=20)!(COC=21)!(COC=22) D  Q
  1.  .I CH'="" D
  1.  ..S XX=$F(^DD(165.5,53.2,0),CH_":")
  1.  ..S YY=$F(^DD(165.5,53.2,0),";",XX)
  1.  ..S CHEMDF=$E(^DD(165.5,53.2,0),XX,YY-2)
  1.  .S CHMDTDF=$P($G(^ONCO(165.5,D0,3)),U,11)
  1.  Q
  1.  ;
  1. HATFDEF ;HORMONE THERAPY @FAC (165.5,54.3) default
  1.  N HT
  1.  S HT=$P($G(^ONCO(165.5,D0,3)),U,16)
  1.  S HTDF="",HTDTDF="" I (COC=10)!(COC=11)!(COC=12)!(COC=13)!(COC=14)!(COC=20)!(COC=21)!(COC=22) D  Q
  1.  .I HT'="" D
  1.  ..S XX=$F(^DD(165.5,54.2,0),HT_":")
  1.  ..S YY=$F(^DD(165.5,54.2,0),";",XX)
  1.  ..S HTDF=$E(^DD(165.5,54.2,0),XX,YY-2)
  1.  .S HTDTDF=$P($G(^ONCO(165.5,D0,3)),U,14)
  1.  Q
  1.  ;
  1. IATFDEF ;IMMUNOTHERAPY @FAC (165.5,55.3) default
  1.  N IMM
  1.  S IMM=$P($G(^ONCO(165.5,D0,3)),U,19)
  1.  S IMMDF="",IMMDTDF="" I (COC=10)!(COC=11)!(COC=12)!(COC=13)!(COC=14)!(COC=20)!(COC=21)!(COC=22) D  Q
  1.  .I IMM'="" D
  1.  ..S XX=$F(^DD(165.5,55.2,0),IMM_":")
  1.  ..S YY=$F(^DD(165.5,55.2,0),";",XX)
  1.  ..S IMMDF=$E(^DD(165.5,55.2,0),XX,YY-2)
  1.  .S IMMDTDF=$P($G(^ONCO(165.5,D0,3)),U,17)
  1.  Q
  1.  ;
  1. HEATFDEF ;HEMA TRANS/ENDOCRINE PROC @FAC (165.5,153.2) default
  1.  N HTEP
  1.  S HTEP=$P($G(^ONCO(165.5,D0,3.1)),U,36)
  1.  S HTEPDF="",HTEPDTDF="" I (COC=10)!(COC=11)!(COC=12)!(COC=13)!(COC=14)!(COC=20)!(COC=21)!(COC=22) D  Q
  1.  .I HTEP'="" D
  1.  ..S HTEPDF=$S(HTEP=1:"00",HTEP=2:10,HTEP=3:11,HTEP=4:12,HTEP=5:20,HTEP=6:30,HTEP=7:40,HTEP=8:82,HTEP=9:85,HTEP=10:86,HTEP=11:87,HTEP=12:88,HTEP=13:99,1:"")
  1.  ..S HTEPDTDF=$P($G(^ONCO(165.5,D0,3.1)),U,35)
  1.  Q
  1.  ;
  1. OATFDEF ;OTHER TREATMENT @FAC (165.5,57.3) default
  1.  N OTH
  1.  S OTH=$P($G(^ONCO(165.5,D0,3)),U,25)
  1.  S OTHDF="",OTHDTDF="" I (COC=10)!(COC=11)!(COC=12)!(COC=13)!(COC=14)!(COC=20)!(COC=21)!(COC=22) D  Q
  1.  .I OTH'="" D
  1.  ..S XX=$F(^DD(165.5,57.2,0),OTH_":")
  1.  ..S YY=$F(^DD(165.5,57.2,0),";",XX)
  1.  ..S OTHDF=$E(^DD(165.5,57.2,0),XX,YY-2)
  1.  .S OTHDTDF=$P($G(^ONCO(165.5,D0,3)),U,23)
  1.  Q
  1.  ;
  1. PATFDEF ;PALLIATIVE PROCEDURE @FAC (165.5,13) default
  1.  N COC,PP
  1.  S COC=$E($$GET1^DIQ(165.5,DA,.04,"E"),1,2)
  1.  S PP=$P($G(^ONCO(165.5,D0,3.1)),U,26)
  1.  S PPDF="" I (COC=10)!(COC=11)!(COC=12)!(COC=13)!(COC=14)!(COC=20)!(COC=21)!(COC=22) D  Q
  1.  .I PP'="" D
  1.  ..S XX=$F(^DD(165.5,12,0),PP_":")
  1.  ..S YY=$F(^DD(165.5,12,0),";",XX)
  1.  ..S PPDF=$E(^DD(165.5,12,0),XX,YY-2)
  1.  Q
  1.  ;
  1. SCOPER ;SCOPE OF LN SURGERY @FAC (R) (165.5,138.1) default
  1.  N SGRP,SCOPE,TPG
  1.  S SCOPE=$P($G(^ONCO(165.5,D0,3)),U,40) I SCOPE="" Q
  1.  D SGROUP I TPG="" Q
  1.  S SCPDF="" I (COC=10)!(COC=11)!(COC=12)!(COC=13)!(COC=14)!(COC=20)!(COC=21)!(COC=22) D  Q
  1.  .S SCPDF=$P($G(^ONCO(164,SGRP,"SC5",SCOPE,0)),U,1)
  1.  Q
  1.  ;
  1. SCOPE ;SCOPE OF LN SURGERY @FAC (F) (165.5,138.5) default
  1.  ;SCOPE OF LN SURGERY @FAC DATE (165.5,138.3) default
  1.  N SCOPE
  1.  S SCOPE=$P($G(^ONCO(165.5,D0,3.1)),U,31) I SCOPE="" Q
  1.  S (SCPDF,SCPDTDF)="" I (COC=10)!(COC=11)!(COC=12)!(COC=13)!(COC=14)!(COC=20)!(COC=21)!(COC=22) D  Q
  1.  .I SCOPE'="" D
  1.  ..S XX=$F(^DD(165.5,138.5,0),SCOPE_":")
  1.  ..S YY=$F(^DD(165.5,138.5,0),";",XX)
  1.  ..S SCPDF=$E(^DD(165.5,138.5,0),XX,YY-2)
  1.  .S SCPDTDF=$P($G(^ONCO(165.5,D0,3.1)),U,22)
  1.  Q
  1.  ;
  1. NUMN ;NUMBER OF LN REMOVED @FAC (R) (165.5,140.1) default
  1.  N NODES
  1.  S NODES=$P($G(^ONCO(165.5,D0,3)),U,42)
  1.  S NUMDF="" I (COC=10)!(COC=11)!(COC=12)!(COC=13)!(COC=14)!(COC=20)!(COC=21)!(COC=22) D  Q
  1.  .S NUMDF=NODES
  1.  .I NUMDF="00" S NUMDF=NUMDF_"  No nodes removed"
  1.  .I NUMDF="90" S NUMDF=NUMDF_"  90 or more nodes removed"
  1.  .I NUMDF="95" S NUMDF=NUMDF_"  No nodes removed, aspiration performed"
  1.  .I NUMDF="96" S NUMDF=NUMDF_"  Node removal as a sampling, number unknown"
  1.  .I NUMDF="97" S NUMDF=NUMDF_"  Node removal as dissection, number unknown"
  1.  .I NUMDF="98" S NUMDF=NUMDF_"  Nodes surgically removed, number unknown"
  1.  .I NUMDF="99" S NUMDF=NUMDF_"  Unknown, not stated, death cert ONLY"
  1.  Q
  1.  ;
  1. SOSNR ;SURG PROC/OTHER SITE @FAC (R) (165.5,139.1) default
  1.  N SGRP,SOSN,TPG
  1.  S SOSN=$P($G(^ONCO(165.5,D0,3)),U,41) I SOSN="" Q
  1.  D SGROUP I TPG="" Q
  1.  S SOSNDF="" I (COC=10)!(COC=11)!(COC=12)!(COC=13)!(COC=14)!(COC=20)!(COC=21)!(COC=22) D  Q
  1.  .S SOSNDF=$P($G(^ONCO(164,SGRP,"SO5",SOSN,0)),U,1)
  1.  Q
  1.  ;
  1. SOSN ;SURG PROC/OTHER SITE @FAC (F) (165.5,139.5) default
  1.  N SOSN
  1.  S SOSN=$P($G(^ONCO(165.5,D0,3.1)),U,33) I SOSN="" Q
  1.  S (SOSNDF,SOSNDTDF)="" I (COC=10)!(COC=11)!(COC=12)!(COC=13)!(COC=14)!(COC=20)!(COC=21)!(COC=22) D  Q
  1.  .I SOSN'="" D
  1.  ..S XX=$F(^DD(165.5,139.5,0),SOSN_":")
  1.  ..S YY=$F(^DD(165.5,139.5,0),";",XX)
  1.  ..S SOSNDF=$E(^DD(165.5,139.5,0),XX,YY-2)
  1.  .S SOSNDTDF=$P($G(^ONCO(165.5,D0,3.1)),U,24)
  1.  Q
  1.  ;
  1. SGROUP S TPG=$P($G(^ONCO(165.5,D0,2)),U,1) I TPG="" Q
  1.  S SGRP=$P($G(^ONCO(164,TPG,0)),U,16)
  1.  Q
  1.  ;
  1. CLEANUP ;Cleanup
  1.  K CHEMDF,CHMDTDF,D0,DA,HTDF,HTDTDF,IMMDF,IMMDTDF,NUMDF,OTHDF,OTHDTDF
  1.  K PPDF,RADDF,RADDTDF,SCPDF,SCPDTDF,SOSNDF,SOSNDTDF,SPSDF,SPSDTDF,Y
  1.  K HTEPDF,HTEPDTDF