178 lines
8.3 KiB
Mathematica
178 lines
8.3 KiB
Mathematica
ONCPTX ;Hines OIFO/GWB - FIRST COURSE OF TREATMENT ;9/24/97
|
|
;;2.11;ONCOLOGY;**13,15,17,19,27,32,34,36,37,39,41,42,45,46**;Mar 07, 1995;Build 39
|
|
;
|
|
NCDS D FST^ONCOAIP
|
|
S CC=$P($G(^ONCO(165.5,D0,0)),U,4)
|
|
I CC=4 D
|
|
.W !," **NOTE** CLASS OF CASE = 4 (Dx/1st tx before ref date)"
|
|
.W !," The @FAC (at this facility) fields will be stuffed to"
|
|
.W !," match the primary treatment fields."
|
|
.W !,DASHES
|
|
I (CC=0)!(CC=3)!(CC=6) D
|
|
.S CCTXT=$S(CC=0:"0 (Dx here, 1st tx ew)",CC=3:"3 (Dx ew, 1st tx ew)",CC=6:"6 (Dx/1st tx in MD office)",1:CC)
|
|
.W !," **NOTE** CLASS OF CASE = ",CCTXT
|
|
.W !," The @FAC (at this facility) fields will be stuffed with the"
|
|
.W !," appropriate value indicating that no treatment was given"
|
|
.W !," at this facility."
|
|
.W !,DASHES
|
|
K CC,CCTXT
|
|
N DI,DIC,DR,DA,DIQ K ONC
|
|
S DIC="^ONCO(165.5,"
|
|
S DR="58.1;58.3;58.4;58.5"
|
|
S DA=D0,DIQ="ONC(" D EN^DIQ1
|
|
F I=58.1,58.4 S X=ONC(165.5,D0,I) D UCASE S ONC(165.5,D0,I)=X
|
|
W !," SURGICAL DIAGNOSTIC AND STAGING PROCEDURES"
|
|
W !," ------------------------------------------"
|
|
S TXT=ONC(165.5,D0,58.1),LEN=38 D TXT
|
|
W !," Surgical Dx/Staging Proc.....: ",ONC(165.5,D0,58.3),?43,TXT1
|
|
W:TXT2'="" !,?43,TXT2
|
|
S TXT=ONC(165.5,D0,58.4),LEN=38 D TXT
|
|
W !," Surg Dx/Staging Proc @fac....: ",ONC(165.5,D0,58.5),?43,TXT1 W:TXT2'="" !,?43,TXT2
|
|
W !,DASHES
|
|
Q
|
|
;
|
|
ROADS ;SURGICAL PROCEDURES (ROADS)
|
|
N DI,DIC,DR,DA,DIQ K ONC
|
|
S DIC="^ONCO(165.5,"
|
|
S DR="50;58.6;50.3;58.7;59;138:138.5;139:139.5;435;14;58;23;74;58.2;50.2;140;140.1"
|
|
S DA=D0,DIQ="ONC(" D EN^DIQ1
|
|
F I=58.6,58.7,59,138,138.1,138.4,138.5,139,139.1,139.4,139.5,435,14,58,23,74,58.2,50.2,140,140.1 S X=ONC(165.5,D0,I) D UCASE S ONC(165.5,D0,I)=X
|
|
D FST^ONCOAIP
|
|
W !," SURGICAL PROCEDURES (ROADS)"
|
|
W !," Pre-2003 cases require the following ROADS surgery items to be coded:"
|
|
W !," ---------------------------------------------------------------------"
|
|
S TXT=ONC(165.5,D0,58.2),LEN=46 D TXT
|
|
W !," Surgery of primary.........(R): ",TXT1 W:TXT2'="" !,?33,TXT2
|
|
W !," Surgical Approach..........(R): ",ONC(165.5,DA,74)
|
|
S TXT=ONC(165.5,D0,50.2),LEN=46 D TXT
|
|
W !," Surgery of primary @fac....(R): ",TXT1 W:TXT2'="" !,?33,TXT2
|
|
S TXT=ONC(165.5,D0,138),LEN=46 D TXT
|
|
W !," Scope of ln surgery........(R): ",TXT1 W:TXT2'="" !,?33,TXT2
|
|
W !," Number of LN removed...... (R): ",ONC(165.5,D0,140)
|
|
S TXT=ONC(165.5,D0,138.1),LEN=46 D TXT
|
|
W !," Scope of ln surgery @fac...(R): ",TXT1 W:TXT2'="" !,?33,TXT2
|
|
W !," Number of LN removed @fac..(R): ",ONC(165.5,D0,140.1)
|
|
S TXT=ONC(165.5,D0,139),LEN=46 D TXT
|
|
W !," Surg proc/other site.......(R): ",TXT1 W:TXT2'="" !,?33,TXT2
|
|
S TXT=ONC(165.5,D0,139.1),LEN=46 D TXT
|
|
W !," Surg proc/other site @fac..(R): ",TXT1 W:TXT2'="" !,?33,TXT2
|
|
W !,DASHES
|
|
Q
|
|
;
|
|
FORDS ;SURGICAL PROCEDURES (FORDS)
|
|
S TOPX=$P($G(^ONCO(165.5,D0,2)),U,1)
|
|
I (TOPX=67420)!(TOPX=67421)!(TOPX=67423)!(TOPX=67424)!($E(TOPX,3,4)=76)!(TOPX=67809) D
|
|
.S $P(^ONCO(165.5,D0,3.1),U,29)=1
|
|
N DI,DIC,DR,DA,DIQ K ONC
|
|
S DIC="^ONCO(165.5,"
|
|
S DR="50;58.6;50.3;58.7;59;138:138.5;139:139.5;435;14;58;23;74;58.2;50.2;140;140.1;170;46;47"
|
|
S DA=D0,DIQ="ONC(" D EN^DIQ1
|
|
F I=58.6,58.7,59,138,138.1,138.4,138.5,139,139.1,139.4,139.5,435,14,58,23,74,58.2,50.2,140,140.1 S X=ONC(165.5,D0,I) D UCASE S ONC(165.5,D0,I)=X
|
|
D FST^ONCOAIP
|
|
W !," SURGICAL PROCEDURES (FORDS)"
|
|
W !," ---------------------------"
|
|
W !," Date First Surgical Procedure.: ",$E(ONC(165.5,D0,170),1,6)_$E(ONC(165.5,D0,170),9,10)
|
|
S TXT=ONC(165.5,D0,58.6),LEN=38 D TXT
|
|
W !," Surgery of primary.........(F): ",$E(ONC(165.5,D0,50),1,6)_$E(ONC(165.5,D0,50),9,10),?42,TXT1 W:TXT2'="" !,?42,TXT2
|
|
S TXT=ONC(165.5,D0,58.7),LEN=38 D TXT
|
|
W !," Surgery of primary @fac....(F): ",$E(ONC(165.5,D0,50.3),1,6)_$E(ONC(165.5,D0,50.3),9,10),?42,TXT1 W:TXT2'="" !,?42,TXT2
|
|
W !," Surgical margins..............: ",ONC(165.5,DA,59)
|
|
S TXT=ONC(165.5,D0,138.4),LEN=38 D TXT
|
|
W !," Scope of ln surgery........(F): ",$E(ONC(165.5,D0,138.2),1,6)_$E(ONC(165.5,D0,138.2),9,10),?42,TXT1 W:TXT2'="" !,?42,TXT2
|
|
S TXT=ONC(165.5,D0,138.5),LEN=38 D TXT
|
|
W !," Scope of ln surgery @fac...(F): ",$E(ONC(165.5,D0,138.3),1,6)_$E(ONC(165.5,D0,138.3),9,10),?42,TXT1 W:TXT2'="" !,?42,TXT2
|
|
S TXT=ONC(165.5,D0,139.4),LEN=38 D TXT
|
|
W !," Surg proc/other site.......(F): ",$E(ONC(165.5,D0,139.2),1,6)_$E(ONC(165.5,D0,139.2),9,10),?42,TXT1 W:TXT2'="" !,?42,TXT2
|
|
S TXT=ONC(165.5,D0,139.5),LEN=38 D TXT
|
|
W !," Surg proc/other site @fac..(F): ",$E(ONC(165.5,D0,139.3),1,6)_$E(ONC(165.5,D0,139.3),9,10),?42,TXT1 W:TXT2'="" !,?42,TXT2
|
|
S TXT=ONC(165.5,D0,23),LEN=38 D TXT
|
|
W:DATEDX<3030000 !," Reconstruction/restoration....: ",?33,TXT1 W:TXT2'="" !,?33,TXT2
|
|
W !," Date of surgical discharge....: ",$E(ONC(165.5,D0,435),1,6)_$E(ONC(165.5,D0,435),9,10)
|
|
W !," Readmission w/i 30 days/surg..: ",ONC(165.5,D0,14)
|
|
W !," Reason no surgery of primary..: ",ONC(165.5,D0,58)
|
|
W !," CAP Protocol Review...........: ",ONC(165.5,D0,46)
|
|
W:ONC(165.5,D0,46)="Failed" !," CAP Text......................: ",ONC(165.5,D0,47)
|
|
W !,DASHES
|
|
Q
|
|
;
|
|
RAD D FST^ONCOAIP
|
|
W !," RADIATION"
|
|
W !," ---------"
|
|
N DI,DIC,DR,DA,DIQ K ONC
|
|
S DIC="^ONCO(165.5,"
|
|
S DR="51;51.2;51.3;51.4;51.5;56;75;125;126;363;442;363.1;443;361"
|
|
S DA=D0,DIQ="ONC(" D EN^DIQ1
|
|
F I=51.2,126,125,363,363.1,56,51.3,51.4,75,442,443 S X=ONC(165.5,D0,I) D UCASE S ONC(165.5,D0,I)=X
|
|
W !," Radiation.....................: ",ONC(165.5,DA,51.2)
|
|
W !," Date radiation started........: ",ONC(165.5,DA,51)
|
|
W !," Radiation @fac................: ",ONC(165.5,DA,51.5)," ",ONC(165.5,DA,51.4)
|
|
W !," Location of radiation tx......: ",ONC(165.5,DA,126)
|
|
W !," Radiation treatment volume....: ",ONC(165.5,DA,125)
|
|
W !," Regional treatment modality...: ",ONC(165.5,DA,363)
|
|
W !," Regional dose:cGy.............: ",ONC(165.5,DA,442)
|
|
W !," Boost treatment modality......: ",ONC(165.5,DA,363.1)
|
|
W !," Boost dose:cGy................: ",ONC(165.5,DA,443)
|
|
W !," Number of txs to this volume..: ",ONC(165.5,DA,56)
|
|
W !," Radiation/surgery sequence....: ",ONC(165.5,DA,51.3)
|
|
W !," Date radiation ended..........: ",ONC(165.5,DA,361)
|
|
W !," Reason for no radiation.......: ",ONC(165.5,DA,75)
|
|
W !,DASHES
|
|
Q
|
|
;
|
|
ST D FST^ONCOAIP
|
|
W !," SYSTEMIC THERAPY"
|
|
W !," ----------------"
|
|
N DI,DIC,DR,DA,DIQ K ONC
|
|
S DIC="^ONCO(165.5,"
|
|
S DR="152;53;53.2;53.3;53.4;54;54.2;54.3;54.4;55;55.2;55.3;55.4;153;153.1;15"
|
|
S DA=D0,DIQ="ONC(" D EN^DIQ1
|
|
F I=53.2,53.3,54.2,54.3,55.2,55.3,153,15 S X=ONC(165.5,D0,I) D UCASE S ONC(165.5,D0,I)=X
|
|
W !," Date systemic therapy started.: ",ONC(165.5,DA,152)
|
|
W !," Chemotherapy..................: ",ONC(165.5,DA,53),?44,$E(ONC(165.5,DA,53.2),1,34)
|
|
W !," Chemotherapy @fac.............: ",ONC(165.5,DA,53.4),?44,$E(ONC(165.5,DA,53.3),1,34)
|
|
W !," Hormone therapy...............: ",ONC(165.5,DA,54),?44,$E(ONC(165.5,DA,54.2),1,34)
|
|
W !," Hormone therapy @fac..........: ",ONC(165.5,DA,54.4),?44,$E(ONC(165.5,DA,54.3),1,34)
|
|
W !," Immunotherapy.................: ",ONC(165.5,DA,55),?44,$E(ONC(165.5,DA,55.2),1,34)
|
|
W !," Immunotherapy @fac............: ",ONC(165.5,DA,55.4),?44,$E(ONC(165.5,DA,55.3),1,34)
|
|
W !," Hema Trans/Endocrine Proc.....: ",ONC(165.5,DA,153.1),?44,$E(ONC(165.5,DA,153),1,34)
|
|
W:DATEDX>3051231 !," Systemic/Surgery Sequence.....: ",ONC(165.5,DA,15)
|
|
W !,DASHES
|
|
Q
|
|
OTH D FST^ONCOAIP
|
|
W !," OTHER TREATMENT"
|
|
W !," ---------------"
|
|
N DI,DIC,DR,DA,DIQ K ONC
|
|
S DIC="^ONCO(165.5,"
|
|
S DR="57;57.2;57.3;57.4"
|
|
S DA=D0,DIQ="ONC(" D EN^DIQ1
|
|
F I=57,57.2,57.3,57.4 S X=ONC(165.5,D0,I) D UCASE S ONC(165.5,D0,I)=X
|
|
W !," Other treatment...............: ",ONC(165.5,DA,57)," ",ONC(165.5,DA,57.2)
|
|
W !," Other treatment @fac..........: ",ONC(165.5,DA,57.4)," ",ONC(165.5,DA,57.3)
|
|
W !,DASHES
|
|
Q
|
|
PRO D FST^ONCOAIP
|
|
W !," PALLIATIVE CARE/PROTOCOL PARTICIPATION"
|
|
W !," -------------------------------------------"
|
|
N DI,DIC,DR,DA,DIQ K ONC
|
|
S DIC="^ONCO(165.5,"
|
|
S DR="133;560;154;12;13;346"
|
|
S DA=D0,DIQ="ONC(" D EN^DIQ1
|
|
F I=560,154,12,13,346 S X=ONC(165.5,D0,I) D UCASE S ONC(165.5,D0,I)=X
|
|
;W !," Pain assessment...............: ",ONC(165.5,DA,154)
|
|
W !," Palliative care...............: ",ONC(165.5,DA,12)
|
|
W !," Palliative care @fac..........: ",ONC(165.5,DA,13)
|
|
W !
|
|
W !," Protocol eligibility status...: "_ONC(165.5,DA,346)
|
|
W !," Protocol participation........: "_ONC(165.5,DA,560)
|
|
W !," Year put on protocol..........: "_ONC(165.5,DA,133)
|
|
W !,DASHES
|
|
Q
|
|
;
|
|
TXT S (TXT1,TXT2)="",LOS=$L(TXT) I LOS<LEN S TXT1=TXT Q
|
|
S NOP=$L($E(TXT,1,LEN)," ")
|
|
S TXT1=$P(TXT," ",1,NOP-1),TXT2=$P(TXT," ",NOP,999)
|
|
Q
|
|
;
|
|
UCASE S X=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
|
|
Q
|