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

ONCATF.m

Go to the documentation of this file. 
  1. ONCATF ;HINES OIFO/GWB - Treatment @FAC (at this facility) stuffing ;06/15/11
  1.  ;;2.2;ONCOLOGY;**1,20**;Jul 31, 2013;Build 5
  1.  ;
  1. NCDS ;SURG DX/STAGING PROC @FAC (165.5,58.4) 
  1.  N COC D CHKCOC I (COC="00")!(COC=10)!(COC=11)!(COC=12)!(COC=13)!(COC=14)!(COC=34)!(COC=35) D
  1.  .S $P(^ONCO(165.5,D0,3.1),U,5)=$P($G(^ONCO(165.5,D0,3)),U,27)
  1.  Q
  1.  ;
  1. NCDSDT ;SURG DX/STAGING PROC @FAC DATE (165.5,58.5)
  1.  N COC D CHKCOC I (COC="00")!(COC=10)!(COC=11)!(COC=12)!(COC=13)!(COC=14)!(COC=34)!(COC=35) D
  1.  .S $P(^ONCO(165.5,D0,3.1),U,6)=$P($G(^ONCO(165.5,D0,3)),U,31)
  1.  Q
  1.  ;
  1. DSPNCDS ;Display SURG DX/STAGING PROC @FAC (165.5,58.4)
  1.  ;N COC D CHKCOC I (COC=20)!(COC=21)!(COC=22)!(COC=31)!(COC=32)!(COC=33)!(COC=36)!(COC=37) D  K TXNO,TXUNK,TXNUL S Y="@36" Q
  1.  N COC D CHKCOC I (COC=31)!(COC=32)!(COC=33)!(COC=36)!(COC=37) D  K TXNO,TXUNK,TXNUL S Y="@36" Q   ;Patch 56 change
  1.  .S NTX=1 W ! D NCDSATF^ONCNTX1 K NTX
  1.  .I $G(DNCATF)=1 K DNCATF,TXNUL Q
  1.  I $G(DNCATF)=1 K DNCATF,TXNUL S Y="@36" Q
  1.  I (COC="00")!(COC=10)!(COC=11)!(COC=12)!(COC=13)!(COC=14)!(COC=34)!(COC=35) G DIQ1
  1.  I $G(TXNO)=1 S NTX=1 W ! D NCDSATF^ONCNTX1 K NTX,TXNO S Y="@36" Q
  1.  I $G(TXUNK)=1 S NTX=1 W ! D NCDSATF^ONCUTX1 K NTX,TXUNK S Y="@36" Q
  1.  I $G(TXNUL)=1 K TXNUL S Y="@36"
  1.  Q
  1.  ;
  1. DIQ1 N DI,DIC,DA,DR,DIQ,ONC
  1.  S DA=D0,DIC="^ONCO(165.5,",DIQ="ONC(",DIQ(0)="E",DR="58.4;58.5"
  1.  D EN^DIQ1
  1.  W !!,$P(^DD(165.5,58.4,0),U,1),".....: "_$E(ONC(165.5,DA,58.4,"E"),1,47)
  1.  W !,$P(^DD(165.5,58.5,0),U,1),": "_ONC(165.5,DA,58.5,"E")
  1.  K TXNO,TXUNK,TXNUL S Y="@36"
  1.  Q
  1.  ;
  1. SPSR ;SURGERY OF PRIMARY @FAC (R) (165.5,50.2)
  1.  D CHKCOC I COC'=37 Q
  1.  S $P(^ONCO(165.5,D0,3.1),U,7)=$P($G(^ONCO(165.5,D0,3)),U,38)
  1.  Q
  1.  ;
  1. DSPSPSR ;Display SURGERY OF PRIMARY @FAC (R) (165.5,50.2)
  1.  D CHKCOC I (COC="00")!(COC=30)!(COC=31)!(COC=32)!(COC=33)!(COC=40)!(COC=41) D  K TXNO,TXUNK,TXNUL S Y="@427" Q
  1.  .S NTX=1 W ! D SURATFR^ONCNTX1 K NTX
  1.  .I $G(DSATF)=1 K DSATF,TXNUL Q
  1.  I $G(DSATF)=1 K DSATF,TXNUL S Y="@427" Q
  1.  I COC'=37 D  Q
  1.  .I $G(TXNO)=1 S NTX=1 W ! D SURATFR^ONCNTX1 K NTX,TXNO S Y="@427" Q
  1.  .I $G(TXUNK)=1 S NTX=1 W ! D SURATFR^ONCUTX1 K NTX,TXUNK S Y="@427" Q
  1.  .I $G(TXNUL)=1 K TXNUL S Y="@427" Q
  1.  N DI,DIC,DA,DR,DIQ,ONC
  1.  S DA=D0,DIC="^ONCO(165.5,",DIQ="ONC(",DIQ(0)="E"
  1.  S DR=50.2
  1.  D EN^DIQ1
  1.  I $G(DSATF)'=1 D
  1.  .W !!,$P(^DD(165.5,50.2,0),U,1),"....: "_$E(ONC(165.5,DA,50.2,"E"),1,48)
  1.  K DSATF,TXNO,TXUNK,TXNUL S Y="@427"
  1.  Q
  1.  ;
  1. SPS ;SURGERY OF PRIMARY @FAC (F) (165.5,58.7)
  1.  N SUUP
  1.  S SUUP=1 D RFNS^ONCATF1
  1.  D CHKCOC I COC'=37 Q
  1.  S $P(^ONCO(165.5,D0,3.1),U,30)=$P($G(^ONCO(165.5,D0,3.1)),U,29)
  1.  Q
  1.  ;
  1. SPSDT ;MOST DEFINITIVE SURG @FAC DATE (165.5,50.3)
  1.  D CHKCOC I COC'=37 Q
  1.  S $P(^ONCO(165.5,D0,3.1),U,8)=$P($G(^ONCO(165.5,D0,3)),U,1)
  1.  Q
  1.  ;
  1. DSPSPS ;Display SURGERY OF PRIMARY @FAC (F) (165.5,58.7)
  1.  D CHKCOC I (COC="00")!(COC=30)!(COC=31)!(COC=32)!(COC=33)!(COC=40)!(COC=41) D  K TXNO,TXUNK,TXNUL S Y="@43" Q
  1.  .S NTX=1 W ! D SURATF^ONCNTX1 K NTX
  1.  .I $G(DSATF)=1 K DSATF,TXNUL Q
  1.  I $G(DSATF)=1 K DSATF,TXNUL S Y="@43" Q
  1.  I COC'=37 D  Q
  1.  .I $G(TXNO)=1 S NTX=1 W ! D SURATF^ONCNTX1 K NTX,TXNO S Y="@43" Q
  1.  .I $G(TXUNK)=1 S NTX=1 W ! D SURATF^ONCUTX1 K NTX,TXUNK S Y="@43" Q
  1.  .I $G(TXNUL)=1 K TXNUL S Y="@43" Q
  1.  N DI,DIC,DA,DR,DIQ,ONC
  1.  S DA=D0,DIC="^ONCO(165.5,",DIQ="ONC(",DIQ(0)="E"
  1.  S DR="58.7;50.3"
  1.  D EN^DIQ1
  1.  I $G(DSATF)'=1 D
  1.  .;W !!,"SURGERY OF PRIMARY @FAC.....(F): "_$E(ONC(165.5,DA,58.7,"E"),1,48)
  1.  .W !!,"RX HOSP--SURG PRIMSITE 03-2022...: "_$E(ONC(165.5,DA,58.7,"E"),1,48)
  1.  .W !,"MOST DEFINITIVE SURG @FAC DATE.: "_ONC(165.5,DA,50.3,"E") Q
  1.  K DSATF,TXNO,TXUNK,TXNUL S Y="@43"
  1.  Q
  1.  ;
  1. SCPR ;SCOPE OF LN SURGERY @FAC (R) (165.5,138.1)
  1.  D CHKCOC I COC'=37 Q
  1.  S $P(^ONCO(165.5,D0,3.1),U,9)=$P($G(^ONCO(165.5,D0,3)),U,40)
  1.  Q
  1.  ;
  1. SCP ;SCOPE OF LN SURGERY @FAC (F) (165.5,138.5)
  1.  D CHKCOC I COC'=37 Q
  1.  S $P(^ONCO(165.5,D0,3.1),U,32)=$P($G(^ONCO(165.5,D0,3.1)),U,31)
  1.  Q
  1.  ;
  1. SCPDT ;SCOPE OF LN SURGERY @FAC DATE (165.5,138.3)
  1.  D CHKCOC I COC'=37 Q
  1.  S $P(^ONCO(165.5,D0,3.1),U,23)=$P($G(^ONCO(165.5,D0,3.1)),U,22)
  1.  Q
  1.  ;
  1. NUMND ;NUMBER OF LN REMOVED @FAC (R) (165.5,140.1)
  1.  D CHKCOC I COC'=37 Q
  1.  S $P(^ONCO(165.5,D0,3.1),U,11)=$P($G(^ONCO(165.5,D0,3)),U,42)
  1.  Q
  1.  ;
  1. DSPSCPR ;Display SCOPE OF LN SURGERY @FAC (R) (165.5,138.1)
  1.  D CHKCOC I (COC="00")!(COC=30)!(COC=31)!(COC=32)!(COC=33)!(COC=40)!(COC=41) D  K TXNO,TXUNK,TXNUL S Y="@139" Q
  1.  .S NTX=1 W ! D NODATFR^ONCNTX1 K NTX
  1.  .I $G(DSCATF)=1 K DSCATF,TXNUL Q
  1.  I $G(DSCATF)=1 K DSCATF,TXNUL S Y="@139" Q
  1.  I COC'=37 D  Q
  1.  .I $G(TXNO)=1 S NTX=1 W ! D NODATFR^ONCNTX1 K NTX,TXNO S Y="@139" Q
  1.  .I $G(TXUNK)=1 S NTX=1 W ! D NODATFR^ONCUTX1 K NTX,TXUNK S Y="@139" Q
  1.  .I $G(TXNUL)=1 K TXNUL S Y="@139" Q
  1.  N DI,DIC,DA,DR,DIQ,ONC
  1.  S DA=D0,DIC="^ONCO(165.5,",DIQ="ONC(",DIQ(0)="E"
  1.  S DR="138.1;140.1"
  1.  D EN^DIQ1
  1.  I $G(DSCATF)'=1 D
  1.  .W !!,$P(^DD(165.5,138.1,0),U,1),"...: "_$E(ONC(165.5,DA,138.1,"E"),1,48)
  1.  .W !,$P(^DD(165.5,140.1,0),U,1),"..: "_ONC(165.5,DA,140.1,"E")
  1.  K DSCATF,TXNO,TXUNK,TXNUL S Y="@139" Q
  1.  ;
  1. DSPSCP ;Display SCOPE OF LN SURGERY @FAC (F) (165.5,138.5)
  1.  D CHKCOC I (COC="00")!(COC=30)!(COC=31)!(COC=32)!(COC=33)!(COC=40)!(COC=41) D  K TXNO,TXUNK,TXNUL S Y="@46" Q
  1.  .I $D(NTX),NTX=1 D  Q
  1.  ..W ! D NODEATF^ONCNTX1
  1.  ..I $G(DSCATF)=1 K DSCATF,TXNUL Q
  1.  .S NTX=1 W ! D NODEATF^ONCNTX1 K NTX
  1.  .I $G(DSCATF)=1 K DSCATF,TXNUL Q
  1.  I $G(DSCATF)=1 K DSCATF,TXNUL S Y="@46" Q
  1.  I COC'=37 D  Q
  1.  .I $D(NTX),NTX=1 D  Q
  1.  ..I $G(TXNO)=1 W ! D NODEATF^ONCNTX1 K TXNO S Y="@46" Q
  1.  ..I $G(TXUNK)=1 W ! D NODEATF^ONCUTX1 K TXUNK S Y="@46" Q
  1.  .I $G(TXNO)=1 S NTX=1 W ! D NODEATF^ONCNTX1 K NTX,TXNO S Y="@46" Q
  1.  .I $G(TXUNK)=1 S NTX=1 W ! D NODEATF^ONCUTX1 K NTX,TXUNK S Y="@46" Q
  1.  .I $G(TXNUL)=1 K TXNUL S Y="@46" Q
  1.  N DI,DIC,DA,DR,DIQ,ONC
  1.  S DA=D0,DIC="^ONCO(165.5,",DIQ="ONC(",DIQ(0)="E"
  1.  S DR="138.5;138.3"
  1.  D EN^DIQ1
  1.  I $G(DSCATF)'=1 D
  1.  .W !!,$P(^DD(165.5,138.5,0),U,1),"....: "_$E(ONC(165.5,DA,138.5,"E"),1,48)
  1.  .W !,$P(^DD(165.5,138.3,0),U,1),".: "_ONC(165.5,DA,138.3,"E")
  1.  K DSCATF,TXNO,TXUNK,TXNUL S Y="@46" Q
  1.  ;
  1. SOSNR ;SURG PROC/OTHER SITE @FAC (R) (165.5,139)
  1.  D CHKCOC I COC'=37 Q
  1.  S $P(^ONCO(165.5,D0,3.1),U,10)=$P($G(^ONCO(165.5,D0,3)),U,41)
  1.  Q
  1.  ;
  1. SOSN ;SURG PROC/OTHER SITE @FAC (F) (165.5,139.5)
  1.  D CHKCOC I COC'=37 Q
  1.  S $P(^ONCO(165.5,D0,3.1),U,34)=$P($G(^ONCO(165.5,D0,3.1)),U,33)
  1.  Q
  1.  ;
  1. SOSNDT ;SURG PROC/OTHER SITE @FAC DATE (165.5,139.3)
  1.  D CHKCOC I COC'=37 Q
  1.  S $P(^ONCO(165.5,D0,3.1),U,25)=$P($G(^ONCO(165.5,D0,3.1)),U,24)
  1.  Q
  1.  ;
  1. DSPSOSR ;Display SURG PPROC/OTHER SITE @FAC (R) (165.5,139.1)
  1.  D CHKCOC I (COC="00")!(COC=30)!(COC=31)!(COC=32)!(COC=33)!(COC=40)!(COC=41) D  K TXNO,TXUNK,TXNUL S Y="@428" Q
  1.  .S NTX=1 W ! D SOSATFR^ONCNTX1 K NTX
  1.  .I $G(DSOATF)=1 K DSOATF,TXNUL Q
  1.  I $G(DSOATF)=1 K DSOATF,TXNUL S Y="@428" Q
  1.  I COC'=37 D  Q
  1.  .I $G(TXNO)=1 S NTX=1 W ! D SOSATFR^ONCNTX1 K NTX,TXNO S Y="@428" Q
  1.  .I $G(TXUNK)=1 S NTX=1 W ! D SOSATFR^ONCUTX1 K NTX,TXUNK S Y="@428" Q
  1.  .I $G(TXNUL)=1 K TXNUL S Y="@428" Q
  1.  N DI,DIC,DA,DR,DIQ,ONC
  1.  S DA=D0,DIC="^ONCO(165.5,",DIQ="ONC(",DIQ(0)="E"
  1.  S DR=139.1
  1.  D EN^DIQ1
  1.  I $G(DSOATF)'=1 D
  1.  .W !,$P(^DD(165.5,139.1,0),U,1),": "_ONC(165.5,DA,139.1,"E") Q
  1.  K DSOATF,TXNO,TXUNK,TXNUL S Y="@428" Q
  1.  ;
  1. DSPSOSN ;Display SURG PPROC/OTHER SITE @FAC (F) (165.5,139.5)
  1.  D CHKCOC I (COC="00")!(COC=30)!(COC=31)!(COC=32)!(COC=33)!(COC=40)!(COC=41) D  K TXNO,TXUNK,TXNUL S Y="@48" Q
  1.  .S NTX=1 W ! D SOSNATF^ONCNTX1 K NTX
  1.  .I $G(DSOATF)=1 K DSOATF,TXNUL Q
  1.  I $G(DSOATF)=1 K DSOATF,TXNUL S Y="@48" Q
  1.  I COC'=37 D  Q
  1.  .I $G(TXNO)=1 S NTX=1 W ! D SOSNATF^ONCNTX1 K NTX,TXNO S Y="@48" Q
  1.  .I $G(TXUNK)=1 S NTX=1 W ! D SOSNATF^ONCUTX1 K NTX,TXUNK S Y="@48" Q
  1.  .I $G(TXNUL)=1 K TXNUL S Y="@48" Q
  1.  N DI,DIC,DA,DR,DIQ,ONC
  1.  S DA=D0,DIC="^ONCO(165.5,",DIQ="ONC(",DIQ(0)="E"
  1.  S DR="139.5;139.3"
  1.  D EN^DIQ1
  1.  I $G(DSOATF)'=1 D
  1.  .W !!,$P(^DD(165.5,139.5,0),U,1),": "_$E(ONC(165.5,DA,139.5,"E"),1,48)
  1.  .W !,$P(^DD(165.5,139.3,0),U,1),": "_ONC(165.5,DA,139.3,"E") Q
  1.  K DSOATF,TXNO,TXUNK,TXNUL S Y="@48" Q
  1.  ;
  1. CHKCOC ;CLASS OF CASE
  1.  S COC=$E($$GET1^DIQ(165.5,DA,.04),1,2)
  1.  Q
  1.  ;
  1. CLEANUP ;Cleanup
  1.  K D0,Y