source: FOIAVistA/tag/r/ONCOLOGY-ONC/ONCTXSM.m@ 995

ONCTXSM ;Hines OIFO/GWB - TREATMENT SUMMARY SCREEN;10/14/98
 ;;2.11;ONCOLOGY;**19,26,27,32,34,36,37**;Mar 07, 1995
 D CHECKCC
 D DEFAULT
 N DI,DIC,DR,DA,DIQ S SAVEY=Y K ONC
 S DR="49:58.7;124;133;346;560"
 S DIC="^ONCO(165.5,"
 S DA=D0,DIQ="ONC(" D EN^DIQ1
 W !," Date of 1st course of tx....: ",$E(ONC(165.5,D0,49),1,6)_$E(ONC(165.5,D0,49),9,10)
 S DFSP=$$DS^ONCACDU2(D0)
 W !," Date of 1st Surgical Proc...: ",$E(DFSP,1,2)_"/"_$E(DFSP,3,4)_"/"_$E(DFSP,7,8)
 S TXT=ONC(165.5,D0,58.6),LEN=40 D TXT^ONCPTX
 W !," Surgery of primary site F...: ",$E(ONC(165.5,D0,50),1,6)_$E(ONC(165.5,D0,50),9,10),?40,TXT1
 W:TXT2'="" !,?43,TXT2
 S TXT=ONC(165.5,D0,58.7),LEN=40 D TXT^ONCPTX
 I DATEDX>2971231 D
 .W !," Surgery of primary site @fac F: ",$E(ONC(165.5,D0,50.3),1,6)_$E(ONC(165.5,D0,50.3),9,10),?40,TXT1
 .W:TXT2'="" !,?43,TXT2
 W !," Radiation...................: ",$E(ONC(165.5,D0,51),1,6)_$E(ONC(165.5,D0,51),9,10),?40,ONC(165.5,D0,51.2)
 W:DATEDX>2971231 !," Radiation @fac..............: ",$E(ONC(165.5,D0,51.5),1,6)_$E(ONC(165.5,D0,51.5),9,10),?40,ONC(165.5,DA,51.4)
 W:DATEDX<2960000 !," Radiation therapy to CNS....: ",$E(ONC(165.5,D0,52),1,6)_$E(ONC(165.5,D0,52),9,10),?40,ONC(165.5,D0,52.2)
 W !," Chemotherapy................: ",$E(ONC(165.5,D0,53),1,6)_$E(ONC(165.5,D0,53),9,10),?40,ONC(165.5,D0,53.2)
 W:DATEDX>2971231 !," Chemotherapy @fac...........: ",$E(ONC(165.5,D0,53.4),1,6)_$E(ONC(165.5,D0,53.4),9,10),?40,ONC(165.5,DA,53.3)
 W !," Hormone therapy.............: ",$E(ONC(165.5,D0,54),1,6)_$E(ONC(165.5,D0,54),9,10),?40,ONC(165.5,D0,54.2)
 W:DATEDX>2971231 !," Hormone therapy @fac........: ",$E(ONC(165.5,D0,54.4),1,6)_$E(ONC(165.5,D0,54.4),9,10),?40,ONC(165.5,DA,54.3)
 W !," Immunotherapy...............: ",$E(ONC(165.5,D0,55),1,6)_$E(ONC(165.5,D0,55),9,10),?40,ONC(165.5,D0,55.2)
 W:DATEDX>2971231 !," Immunotherapy @fac..........: ",$E(ONC(165.5,D0,55.4),1,6)_$E(ONC(165.5,D0,55.4),9,10),?40,ONC(165.5,DA,55.3)
 W !," Other treatment.............: ",$E(ONC(165.5,D0,57),1,6)_$E(ONC(165.5,D0,57),9,10),?40,ONC(165.5,D0,57.2)
 W:DATEDX>2971231 !," Other treatment @fac........: ",$E(ONC(165.5,D0,57.4),1,6)_$E(ONC(165.5,D0,57.4),9,10),?40,ONC(165.5,DA,57.3)
 W !,DASHES
 K TXT,TXT1,TXT2
 K DIR S DIR(0)="E" D ^DIR I Y=0 S Y="@0" K SAVEY Q
 S Y=SAVEY K SAVEY
 Q
 ;
CHECKCC ;Check the class of case - if 0,3,6 stuff @FAC fields with zeroes
 S DATEDX=$P($G(^ONCO(165.5,DA,0)),U,16) I DATEDX<2980000 Q
 S COC=$P($G(^ONCO(165.5,D0,0)),U,4)
 I COC=0!(COC=3)!(COC=6) D
 .S $P(^ONCO(165.5,DA,3.1),U,11)="00"
 .F PP=7,9,10 S $P(^ONCO(165.5,DA,3.1),U,PP)=1
 .F PP=12:2:20 S $P(^ONCO(165.5,DA,3.1),U,PP)=0
 .F PP=8,13:2:25 S $P(^ONCO(165.5,DA,3.1),U,PP)="0000000"
 I COC=2!(COC=3) D
 .S $P(^ONCO(165.5,DA,3.1),U,5)="00"
 .S $P(^ONCO(165.5,DA,3.1),U,6)="0000000"
 K PP Q
 ;
DEFAULT ;RECONSTRUCTION/RESTORATION (165.5,23) default
 S RRDF="",SURGPS=$P($G(^ONCO(165.5,D0,3.1)),U,29),CONTFLG=0
 S SITE=$P($G(^ONCO(165.5,D0,0)),U,1)
 D SETVARS I TPG="" Q
 I (SITE=35)!($$LEUKEMIA^ONCOAIP2(D0))!((SITE>65)&(SITE<70)) D  Q
 .S RRDF="NA"
 I DATEDX<2980000,SURGPS="00" S CONTFLG=1
 I DATEDX>2971231,SURGPS=1 S CONTFLG=1
 I CONTFLG=0 Q
 S RRDF="No reconstruction/restoration"
 I SCG=67141!(SCG=67250)!(SCG=67422)!(SCG=67700)!(SCG=67739)!(SCG=67770) S RRDF="NA"
 Q
 ;
RRDEFIT ;Special default code for field #23 called from input transform
 I X="No reconstruction/restoration" S X=0 Q
 I X="NA"!(X["Unknown; not stated") S X=9 Q
 Q
SPSDFIT ;Special default code for field #50.2 called from input transform
 D SETVARS I TPG="" Q
 I X?1.2N Q
 F SUB=0:0 S SUB=$O(^ONCO(164,SCG,"SPS",SUB)) Q:SUB'>0!(DFCODE'="")  D
 .I DFTXT=$P($G(^ONCO(164,SCG,"SPS",SUB,0)),U,1) S DFCODE=SUB Q
 S X=DFCODE,SPSFLG=1 Q
SCPDFIT ;Special default code for field #138.1 called from input transform
 D SETVARS I TPG="" Q
 I X?1N Q
 F SUB=0:0 S SUB=$O(^ONCO(164,SCG,"SC5",SUB)) Q:SUB'>0!(DFCODE'="")  D
 .I DFTXT=$P($G(^ONCO(164,SCG,"SC5",SUB,0)),U,1) S DFCODE=SUB Q
 S X=DFCODE,SCPFLG=1 Q
 Q
NUMDFIT ;Special default code for field #140.1 called from input transform
 S X=+X
 Q
SOSDFIT ;Special default code for field #139.1 called from input transform
 D SETVARS I TPG="" Q
 I X?1.2N Q
 F SUB=0:0 S SUB=$O(^ONCO(164,SCG,"SO5",SUB)) Q:SUB'>0!(DFCODE'="")  D
 .I DFTXT=$P($G(^ONCO(164,SCG,"SO5",SUB,0)),U,1) S DFCODE=SUB Q
 S X=DFCODE,SOSFLG=1 Q
 Q
SETVARS ;
 S SCG="",TPG=$P($G(^ONCO(165.5,D0,2)),U,1) I TPG="" Q
 S SCG=$P($G(^ONCO(164,TPG,0)),U,16)
 S DFTXT=X,DFCODE="" Q