ONCOEOD1 ;HINES OIFO/RTK - Extent of Disease EOD Code tables ;01/29/19
;;2.2;ONCOLOGY;**10,13,18,20,21**;Jul 31, 2013;Build 6
;
;EOD FIELDS-HELP AND INPUT TRANSFORM CODE
PTHLP ;EOD PRIMARY TUMOR (#1772) FIELD HELP
D ^ONCSCHMA I '$D(ONCSCMA)!(ONCSCMA=0) Q
N ONCTMP S ONCSCM9=ONCSCMA D CHKV9
S EODIEN=$O(^ONCO(165.9,"B",ONCSCM9,"")) Q:EODIEN'>0
S EODSCID=$P($G(^ONCO(165.9,EODIEN,0)),"^",1) S EODDSPID=EODSCID
S EODSCNM=$P($G(^ONCO(165.9,EODIEN,0)),"^",2)
S ONCTMP=$P($G(^ONCO(165.5,D0,"SSD1")),U,1) I ONCTMP'="" S EODDSPID=ONCTMP
D HDR W !,"EOD Schema ID: ",EODDSPID
W ?23,"EOD Schema Name: ",$E(EODSCNM,1,40),! I $L(EODSCNM)>40 W ?40,$E(EODSCNM,51,80),!
S EX=""
N IEN F IEN=0:0 S IEN=$O(^ONCO(165.9,EODIEN,1,IEN)) Q:IEN'>0!(EX=U) D
.S ONCEODCD=$P($G(^ONCO(165.9,EODIEN,1,IEN,0)),U,1) W ONCEODCD
.N DIEN F DIEN=0:0 S DIEN=$O(^ONCO(165.9,EODIEN,1,IEN,1,DIEN)) Q:DIEN'>0!(EX=U) D
..S ONCEODTX=$P($G(^ONCO(165.9,EODIEN,1,IEN,1,DIEN,0)),U,1)
..W ?8,ONCEODTX,! D P Q:EX=U
K EX Q
;
PTIT ;EOD PRIMARY TUMOR (#1772) FIELD INPUT TRANSFORM
I X=0!(X="00") S X="000"
I X=9!(X=99) S X=999
D ^ONCSCHMA I '$D(ONCSCMA)!(ONCSCMA=0) K X Q
S ONCSCM9=ONCSCMA D CHKV9
S ONCEDIEN=$O(^ONCO(165.9,"B",ONCSCM9,"")) I ONCEDIEN="" K X Q
S ONCEDVAL=""
N IEN F IEN=0:0 S IEN=$O(^ONCO(165.9,ONCEDIEN,1,IEN)) Q:IEN'>0 D
.S ONCEDVAL=ONCEDVAL_"^"_$P($G(^ONCO(165.9,ONCEDIEN,1,IEN,0)),U,1)
I ONCEDVAL'[X K X Q
S ONCCDIEN=$O(^ONCO(165.9,ONCEDIEN,1,"B",X,"")) I ONCCDIEN="" W "??" K X Q
W " ",$P($G(^ONCO(165.9,ONCEDIEN,1,ONCCDIEN,1,1,0)),U,1)
K ONCEDVAL Q
;
RNHLP ;EOD REGIONAL NODES (#1774) FIELD HELP
D ^ONCSCHMA I '$D(ONCSCMA)!(ONCSCMA=0) Q
N ONCTMP S ONCSCM9=ONCSCMA D CHKV9
S EODIEN=$O(^ONCO(165.9,"B",ONCSCM9,"")) Q:EODIEN'>0
S EODSCID=$P($G(^ONCO(165.9,EODIEN,0)),"^",1) S EODDSPID=EODSCID
S EODSCNM=$P($G(^ONCO(165.9,EODIEN,0)),"^",2)
S ONCTMP=$P($G(^ONCO(165.5,D0,"SSD1")),U,1) I ONCTMP'="" S EODDSPID=ONCTMP
D HDR W !,"EOD Schema ID: ",EODDSPID
W ?23,"EOD Schema Name: ",$E(EODSCNM,1,40),! I $L(EODSCNM)>40 W ?40,$E(EODSCNM,51,80),!
S EX=""
N IEN F IEN=0:0 S IEN=$O(^ONCO(165.9,EODIEN,2,IEN)) Q:IEN'>0!(EX=U) D
.S ONCEODCD=$P($G(^ONCO(165.9,EODIEN,2,IEN,0)),U,1) W ONCEODCD
.N DIEN F DIEN=0:0 S DIEN=$O(^ONCO(165.9,EODIEN,2,IEN,1,DIEN)) Q:DIEN'>0!(EX=U) D
..S ONCEODTX=$P($G(^ONCO(165.9,EODIEN,2,IEN,1,DIEN,0)),U,1)
..W ?8,ONCEODTX,! D P Q:EX=U
K EX Q
;
RNIT ;EOD REGIONAL NODES (#1774) FIELD INPUT TRANSFORM
I X=0!(X="00") S X="000"
I X=9!(X=99) S X=999
D ^ONCSCHMA I '$D(ONCSCMA)!(ONCSCMA=0) K X Q
S ONCSCM9=ONCSCMA D CHKV9
S ONCEDIEN=$O(^ONCO(165.9,"B",ONCSCM9,"")) I ONCEDIEN="" K X Q
S ONCEDVAL=""
N IEN F IEN=0:0 S IEN=$O(^ONCO(165.9,ONCEDIEN,2,IEN)) Q:IEN'>0 D
.S ONCEDVAL=ONCEDVAL_"^"_$P($G(^ONCO(165.9,ONCEDIEN,2,IEN,0)),U,1)
I ONCEDVAL'[X K X Q
S ONCCDIEN=$O(^ONCO(165.9,ONCEDIEN,2,"B",X,"")) I ONCCDIEN="" W "??" K X Q
W " ",$P($G(^ONCO(165.9,ONCEDIEN,2,ONCCDIEN,1,1,0)),U,1)
K ONCEDVAL Q
;
MTHLP ;EOD METS (#1776) FIELD HELP
D ^ONCSCHMA I '$D(ONCSCMA)!(ONCSCMA=0) Q
N ONCTMP S ONCSCM9=ONCSCMA D CHKV9
S EODIEN=$O(^ONCO(165.9,"B",ONCSCM9,"")) Q:EODIEN'>0
S EODSCID=$P($G(^ONCO(165.9,EODIEN,0)),"^",1) S EODDSPID=EODSCID
S EODSCNM=$P($G(^ONCO(165.9,EODIEN,0)),"^",2)
S ONCTMP=$P($G(^ONCO(165.5,D0,"SSD1")),U,1) I ONCTMP'="" S EODDSPID=ONCTMP
D HDR W !,"EOD Schema ID: ",EODDSPID
W ?23,"EOD Schema Name: ",$E(EODSCNM,1,40),! I $L(EODSCNM)>40 W ?40,$E(EODSCNM,51,80),!
S EX=""
N IEN F IEN=0:0 S IEN=$O(^ONCO(165.9,EODIEN,3,IEN)) Q:IEN'>0!(EX=U) D
.S ONCEODCD=$P($G(^ONCO(165.9,EODIEN,3,IEN,0)),U,1) W ONCEODCD
.N DIEN F DIEN=0:0 S DIEN=$O(^ONCO(165.9,EODIEN,3,IEN,1,DIEN)) Q:DIEN'>0!(EX=U) D
..S ONCEODTX=$P($G(^ONCO(165.9,EODIEN,3,IEN,1,DIEN,0)),U,1)
..W ?8,ONCEODTX,! D P Q:EX=U
K EX Q
;
MTIT ;EOD METS (#1776) FIELD INPUT TRANSFORM
I X=0!(X="00") S X="00"
I X=9 S X=99
D ^ONCSCHMA I '$D(ONCSCMA)!(ONCSCMA=0) K X Q
S ONCSCM9=ONCSCMA D CHKV9
S ONCEDIEN=$O(^ONCO(165.9,"B",ONCSCM9,"")) I ONCEDIEN="" K X Q
S ONCEDVAL=""
N IEN F IEN=0:0 S IEN=$O(^ONCO(165.9,ONCEDIEN,3,IEN)) Q:IEN'>0 D
.S ONCEDVAL=ONCEDVAL_"^"_$P($G(^ONCO(165.9,ONCEDIEN,3,IEN,0)),U,1)
I ONCEDVAL'[X K X Q
S ONCCDIEN=$O(^ONCO(165.9,ONCEDIEN,3,"B",X,"")) I ONCCDIEN="" W "??" K X Q
W " ",$P($G(^ONCO(165.9,ONCEDIEN,3,ONCCDIEN,1,1,0)),U,1)
K ONCEDVAL Q
;
CHKV9 ;check for v9 (09190,09210,09721,09722,09723,09724)
I ONCSCM9="09190" S ONCSCM9="00190"
I ONCSCM9="09210" S ONCSCM9="00210"
I ONCSCM9="09290" S ONCSCM9="00290"
I ONCSCM9="09301" S ONCSCM9="00301"
I ONCSCM9="09302" S ONCSCM9="00302"
I ONCSCM9="09310" S ONCSCM9="00310"
I ONCSCM9="09320" S ONCSCM9="00320"
I ONCSCM9="09330" S ONCSCM9="00330"
I ONCSCM9="09340" S ONCSCM9="00340"
I ONCSCM9="09500" S ONCSCM9="00500"
I ONCSCM9="09721" S ONCSCM9="00721"
I ONCSCM9="09722" S ONCSCM9="00722"
I ONCSCM9="09723" S ONCSCM9="00723"
;I ONCSCM9="09724" S ONCSCM9="00724" ;new/separate codes for 09520/Cervix
;I ONCSCM9="09724" S ONCSCM9="00724" ;new/separate codes for 09724/Medull
Q
NEOHLP ;NEOADJUVANT THERAPY TREATMENT EFFECT (#1634) FIELD HELP
D ^ONCSCHMA I '$D(ONCSCMA)!(ONCSCMA=0) Q
N ONC1659,ONC1676,NEOIEN,NEISCID,NEOSCNM
S ONCNEOSC=$P($G(^ONCO(165.5,D0,"SSD1")),"^",1) I ONCNEOSC="" Q
S ONC1659=$O(^ONCO(165.9,"B",ONCNEOSC,"")) Q:ONC1659'>0
S ONC1676=$P($G(^ONCO(165.9,ONC1659,0)),"^",3) I ONC1676="" S ONC1676=9
S NEOSCID=$P($G(^ONCO(167.6,ONC1676,0)),"^",1)
S NEOSCNM=$P($G(^ONCO(167.6,ONC1676,0)),"^",2)
D HDR W !,"Neoadjuvant Schema ID: ",NEOSCID,!,"Schemas: ",NEOSCNM,!!
S EX=""
N IEN F IEN=0:0 S IEN=$O(^ONCO(167.6,ONC1676,1,IEN)) Q:IEN'>0!(EX=U) D
.S ONCNEOCD=$P($G(^ONCO(167.6,ONC1676,1,IEN,0)),U,1) W ONCNEOCD
.N DIEN F DIEN=0:0 S DIEN=$O(^ONCO(167.6,ONC1676,1,IEN,1,DIEN)) Q:DIEN'>0!(EX=U) D
..S ONCNEOTX=$P($G(^ONCO(167.6,ONC1676,1,IEN,1,DIEN,0)),U,1)
..W ?4,ONCNEOTX,! D P Q:EX=U
K EX,ONCNEOS Q
;
NEOIT ;NEOADJUVANT THERAPY TREATMENT EFFECT (#1634) FIELD INPUT TRANSFORM
D ^ONCSCHMA I '$D(ONCSCMA)!(ONCSCMA=0) K X Q
N ONC1659,ONC1676
S ONCNEOSC=$P($G(^ONCO(165.5,D0,"SSD1")),"^",1) I ONCNEOSC="" Q
S ONC1659=$O(^ONCO(165.9,"B",ONCNEOSC,"")) Q:ONC1659'>0
S ONC1676=$P($G(^ONCO(165.9,ONC1659,0)),"^",3) I ONC1676="" S ONC1676=9
S ONCNEOVL=""
N IEN F IEN=0:0 S IEN=$O(^ONCO(167.6,ONC1676,1,IEN)) Q:IEN'>0 D
.S ONCNEOVL=ONCNEOVL_"^"_$P($G(^ONCO(167.6,ONC1676,1,IEN,0)),U,1)
I ONCNEOVL'[X K X Q
S ONCCDIEN=$O(^ONCO(167.6,ONC1676,1,"B",X,"")) I ONCCDIEN="" W "??" K X Q
W " ",$P($G(^ONCO(167.6,ONC1676,1,ONCCDIEN,1,1,0)),U,1)
K ONCNEOVL Q
;
NEODSP ;NEOADJUVANT THERAPY - TX EFFECT DISPLAY CALLED FROM ONCOPA2
I NEOXVAL="" Q
N ONC1659,ONC1676
S ONCNEOSC=$P($G(^ONCO(165.5,IEN,"SSD1")),"^",1) I ONCNEOSC="" Q
S ONC1659=$O(^ONCO(165.9,"B",ONCNEOSC,"")) Q:ONC1659'>0
S ONC1676=$P($G(^ONCO(165.9,ONC1659,0)),"^",3) I ONC1676="" S ONC1676=9
S ONCCDIEN=$O(^ONCO(167.6,ONC1676,1,"B",NEOXVAL,"")) I ONCCDIEN="" W "??" Q
W " ",$P($G(^ONCO(167.6,ONC1676,1,ONCCDIEN,1,1,0)),"^",1)
K ONC1659,ONC1676,ONCNEOSC,ONCNEOVL
Q
;
P ;Enter RETURN to continue
I $Y>(IOSL-4) D Q:EX=U W !
.I $E(IOST,1,2)="C-" W ! K DIR S DIR(0)="E",DIR("A")="Enter RETURN to see more or '^' to exit Help" D ^DIR I 'Y S EX=U Q
.D HDR Q
Q
;
HDR ;Header
W @IOF
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCOEOD1 7365 printed Sep 23, 2025@20:01:05 Page 2
ONCOEOD1 ;HINES OIFO/RTK - Extent of Disease EOD Code tables ;01/29/19
+1 ;;2.2;ONCOLOGY;**10,13,18,20,21**;Jul 31, 2013;Build 6
+2 ;
+3 ;EOD FIELDS-HELP AND INPUT TRANSFORM CODE
PTHLP ;EOD PRIMARY TUMOR (#1772) FIELD HELP
+1 DO ^ONCSCHMA
IF '$DATA(ONCSCMA)!(ONCSCMA=0)
QUIT
+2 NEW ONCTMP
SET ONCSCM9=ONCSCMA
DO CHKV9
+3 SET EODIEN=$ORDER(^ONCO(165.9,"B",ONCSCM9,""))
if EODIEN'>0
QUIT
+4 SET EODSCID=$PIECE($GET(^ONCO(165.9,EODIEN,0)),"^",1)
SET EODDSPID=EODSCID
+5 SET EODSCNM=$PIECE($GET(^ONCO(165.9,EODIEN,0)),"^",2)
+6 SET ONCTMP=$PIECE($GET(^ONCO(165.5,D0,"SSD1")),U,1)
IF ONCTMP'=""
SET EODDSPID=ONCTMP
+7 DO HDR
WRITE !,"EOD Schema ID: ",EODDSPID
+8 WRITE ?23,"EOD Schema Name: ",$EXTRACT(EODSCNM,1,40),!
IF $LENGTH(EODSCNM)>40
WRITE ?40,$EXTRACT(EODSCNM,51,80),!
+9 SET EX=""
+10 NEW IEN
FOR IEN=0:0
SET IEN=$ORDER(^ONCO(165.9,EODIEN,1,IEN))
if IEN'>0!(EX=U)
QUIT
Begin DoDot:1
+11 SET ONCEODCD=$PIECE($GET(^ONCO(165.9,EODIEN,1,IEN,0)),U,1)
WRITE ONCEODCD
+12 NEW DIEN
FOR DIEN=0:0
SET DIEN=$ORDER(^ONCO(165.9,EODIEN,1,IEN,1,DIEN))
if DIEN'>0!(EX=U)
QUIT
Begin DoDot:2
+13 SET ONCEODTX=$PIECE($GET(^ONCO(165.9,EODIEN,1,IEN,1,DIEN,0)),U,1)
+14 WRITE ?8,ONCEODTX,!
DO P
if EX=U
QUIT
End DoDot:2
End DoDot:1
+15 KILL EX
QUIT
+16 ;
PTIT ;EOD PRIMARY TUMOR (#1772) FIELD INPUT TRANSFORM
+1 IF X=0!(X="00")
SET X="000"
+2 IF X=9!(X=99)
SET X=999
+3 DO ^ONCSCHMA
IF '$DATA(ONCSCMA)!(ONCSCMA=0)
KILL X
QUIT
+4 SET ONCSCM9=ONCSCMA
DO CHKV9
+5 SET ONCEDIEN=$ORDER(^ONCO(165.9,"B",ONCSCM9,""))
IF ONCEDIEN=""
KILL X
QUIT
+6 SET ONCEDVAL=""
+7 NEW IEN
FOR IEN=0:0
SET IEN=$ORDER(^ONCO(165.9,ONCEDIEN,1,IEN))
if IEN'>0
QUIT
Begin DoDot:1
+8 SET ONCEDVAL=ONCEDVAL_"^"_$PIECE($GET(^ONCO(165.9,ONCEDIEN,1,IEN,0)),U,1)
End DoDot:1
+9 IF ONCEDVAL'[X
KILL X
QUIT
+10 SET ONCCDIEN=$ORDER(^ONCO(165.9,ONCEDIEN,1,"B",X,""))
IF ONCCDIEN=""
WRITE "??"
KILL X
QUIT
+11 WRITE " ",$PIECE($GET(^ONCO(165.9,ONCEDIEN,1,ONCCDIEN,1,1,0)),U,1)
+12 KILL ONCEDVAL
QUIT
+13 ;
RNHLP ;EOD REGIONAL NODES (#1774) FIELD HELP
+1 DO ^ONCSCHMA
IF '$DATA(ONCSCMA)!(ONCSCMA=0)
QUIT
+2 NEW ONCTMP
SET ONCSCM9=ONCSCMA
DO CHKV9
+3 SET EODIEN=$ORDER(^ONCO(165.9,"B",ONCSCM9,""))
if EODIEN'>0
QUIT
+4 SET EODSCID=$PIECE($GET(^ONCO(165.9,EODIEN,0)),"^",1)
SET EODDSPID=EODSCID
+5 SET EODSCNM=$PIECE($GET(^ONCO(165.9,EODIEN,0)),"^",2)
+6 SET ONCTMP=$PIECE($GET(^ONCO(165.5,D0,"SSD1")),U,1)
IF ONCTMP'=""
SET EODDSPID=ONCTMP
+7 DO HDR
WRITE !,"EOD Schema ID: ",EODDSPID
+8 WRITE ?23,"EOD Schema Name: ",$EXTRACT(EODSCNM,1,40),!
IF $LENGTH(EODSCNM)>40
WRITE ?40,$EXTRACT(EODSCNM,51,80),!
+9 SET EX=""
+10 NEW IEN
FOR IEN=0:0
SET IEN=$ORDER(^ONCO(165.9,EODIEN,2,IEN))
if IEN'>0!(EX=U)
QUIT
Begin DoDot:1
+11 SET ONCEODCD=$PIECE($GET(^ONCO(165.9,EODIEN,2,IEN,0)),U,1)
WRITE ONCEODCD
+12 NEW DIEN
FOR DIEN=0:0
SET DIEN=$ORDER(^ONCO(165.9,EODIEN,2,IEN,1,DIEN))
if DIEN'>0!(EX=U)
QUIT
Begin DoDot:2
+13 SET ONCEODTX=$PIECE($GET(^ONCO(165.9,EODIEN,2,IEN,1,DIEN,0)),U,1)
+14 WRITE ?8,ONCEODTX,!
DO P
if EX=U
QUIT
End DoDot:2
End DoDot:1
+15 KILL EX
QUIT
+16 ;
RNIT ;EOD REGIONAL NODES (#1774) FIELD INPUT TRANSFORM
+1 IF X=0!(X="00")
SET X="000"
+2 IF X=9!(X=99)
SET X=999
+3 DO ^ONCSCHMA
IF '$DATA(ONCSCMA)!(ONCSCMA=0)
KILL X
QUIT
+4 SET ONCSCM9=ONCSCMA
DO CHKV9
+5 SET ONCEDIEN=$ORDER(^ONCO(165.9,"B",ONCSCM9,""))
IF ONCEDIEN=""
KILL X
QUIT
+6 SET ONCEDVAL=""
+7 NEW IEN
FOR IEN=0:0
SET IEN=$ORDER(^ONCO(165.9,ONCEDIEN,2,IEN))
if IEN'>0
QUIT
Begin DoDot:1
+8 SET ONCEDVAL=ONCEDVAL_"^"_$PIECE($GET(^ONCO(165.9,ONCEDIEN,2,IEN,0)),U,1)
End DoDot:1
+9 IF ONCEDVAL'[X
KILL X
QUIT
+10 SET ONCCDIEN=$ORDER(^ONCO(165.9,ONCEDIEN,2,"B",X,""))
IF ONCCDIEN=""
WRITE "??"
KILL X
QUIT
+11 WRITE " ",$PIECE($GET(^ONCO(165.9,ONCEDIEN,2,ONCCDIEN,1,1,0)),U,1)
+12 KILL ONCEDVAL
QUIT
+13 ;
MTHLP ;EOD METS (#1776) FIELD HELP
+1 DO ^ONCSCHMA
IF '$DATA(ONCSCMA)!(ONCSCMA=0)
QUIT
+2 NEW ONCTMP
SET ONCSCM9=ONCSCMA
DO CHKV9
+3 SET EODIEN=$ORDER(^ONCO(165.9,"B",ONCSCM9,""))
if EODIEN'>0
QUIT
+4 SET EODSCID=$PIECE($GET(^ONCO(165.9,EODIEN,0)),"^",1)
SET EODDSPID=EODSCID
+5 SET EODSCNM=$PIECE($GET(^ONCO(165.9,EODIEN,0)),"^",2)
+6 SET ONCTMP=$PIECE($GET(^ONCO(165.5,D0,"SSD1")),U,1)
IF ONCTMP'=""
SET EODDSPID=ONCTMP
+7 DO HDR
WRITE !,"EOD Schema ID: ",EODDSPID
+8 WRITE ?23,"EOD Schema Name: ",$EXTRACT(EODSCNM,1,40),!
IF $LENGTH(EODSCNM)>40
WRITE ?40,$EXTRACT(EODSCNM,51,80),!
+9 SET EX=""
+10 NEW IEN
FOR IEN=0:0
SET IEN=$ORDER(^ONCO(165.9,EODIEN,3,IEN))
if IEN'>0!(EX=U)
QUIT
Begin DoDot:1
+11 SET ONCEODCD=$PIECE($GET(^ONCO(165.9,EODIEN,3,IEN,0)),U,1)
WRITE ONCEODCD
+12 NEW DIEN
FOR DIEN=0:0
SET DIEN=$ORDER(^ONCO(165.9,EODIEN,3,IEN,1,DIEN))
if DIEN'>0!(EX=U)
QUIT
Begin DoDot:2
+13 SET ONCEODTX=$PIECE($GET(^ONCO(165.9,EODIEN,3,IEN,1,DIEN,0)),U,1)
+14 WRITE ?8,ONCEODTX,!
DO P
if EX=U
QUIT
End DoDot:2
End DoDot:1
+15 KILL EX
QUIT
+16 ;
MTIT ;EOD METS (#1776) FIELD INPUT TRANSFORM
+1 IF X=0!(X="00")
SET X="00"
+2 IF X=9
SET X=99
+3 DO ^ONCSCHMA
IF '$DATA(ONCSCMA)!(ONCSCMA=0)
KILL X
QUIT
+4 SET ONCSCM9=ONCSCMA
DO CHKV9
+5 SET ONCEDIEN=$ORDER(^ONCO(165.9,"B",ONCSCM9,""))
IF ONCEDIEN=""
KILL X
QUIT
+6 SET ONCEDVAL=""
+7 NEW IEN
FOR IEN=0:0
SET IEN=$ORDER(^ONCO(165.9,ONCEDIEN,3,IEN))
if IEN'>0
QUIT
Begin DoDot:1
+8 SET ONCEDVAL=ONCEDVAL_"^"_$PIECE($GET(^ONCO(165.9,ONCEDIEN,3,IEN,0)),U,1)
End DoDot:1
+9 IF ONCEDVAL'[X
KILL X
QUIT
+10 SET ONCCDIEN=$ORDER(^ONCO(165.9,ONCEDIEN,3,"B",X,""))
IF ONCCDIEN=""
WRITE "??"
KILL X
QUIT
+11 WRITE " ",$PIECE($GET(^ONCO(165.9,ONCEDIEN,3,ONCCDIEN,1,1,0)),U,1)
+12 KILL ONCEDVAL
QUIT
+13 ;
CHKV9 ;check for v9 (09190,09210,09721,09722,09723,09724)
+1 IF ONCSCM9="09190"
SET ONCSCM9="00190"
+2 IF ONCSCM9="09210"
SET ONCSCM9="00210"
+3 IF ONCSCM9="09290"
SET ONCSCM9="00290"
+4 IF ONCSCM9="09301"
SET ONCSCM9="00301"
+5 IF ONCSCM9="09302"
SET ONCSCM9="00302"
+6 IF ONCSCM9="09310"
SET ONCSCM9="00310"
+7 IF ONCSCM9="09320"
SET ONCSCM9="00320"
+8 IF ONCSCM9="09330"
SET ONCSCM9="00330"
+9 IF ONCSCM9="09340"
SET ONCSCM9="00340"
+10 IF ONCSCM9="09500"
SET ONCSCM9="00500"
+11 IF ONCSCM9="09721"
SET ONCSCM9="00721"
+12 IF ONCSCM9="09722"
SET ONCSCM9="00722"
+13 IF ONCSCM9="09723"
SET ONCSCM9="00723"
+14 ;I ONCSCM9="09724" S ONCSCM9="00724" ;new/separate codes for 09520/Cervix
+15 ;I ONCSCM9="09724" S ONCSCM9="00724" ;new/separate codes for 09724/Medull
+16 QUIT
NEOHLP ;NEOADJUVANT THERAPY TREATMENT EFFECT (#1634) FIELD HELP
+1 DO ^ONCSCHMA
IF '$DATA(ONCSCMA)!(ONCSCMA=0)
QUIT
+2 NEW ONC1659,ONC1676,NEOIEN,NEISCID,NEOSCNM
+3 SET ONCNEOSC=$PIECE($GET(^ONCO(165.5,D0,"SSD1")),"^",1)
IF ONCNEOSC=""
QUIT
+4 SET ONC1659=$ORDER(^ONCO(165.9,"B",ONCNEOSC,""))
if ONC1659'>0
QUIT
+5 SET ONC1676=$PIECE($GET(^ONCO(165.9,ONC1659,0)),"^",3)
IF ONC1676=""
SET ONC1676=9
+6 SET NEOSCID=$PIECE($GET(^ONCO(167.6,ONC1676,0)),"^",1)
+7 SET NEOSCNM=$PIECE($GET(^ONCO(167.6,ONC1676,0)),"^",2)
+8 DO HDR
WRITE !,"Neoadjuvant Schema ID: ",NEOSCID,!,"Schemas: ",NEOSCNM,!!
+9 SET EX=""
+10 NEW IEN
FOR IEN=0:0
SET IEN=$ORDER(^ONCO(167.6,ONC1676,1,IEN))
if IEN'>0!(EX=U)
QUIT
Begin DoDot:1
+11 SET ONCNEOCD=$PIECE($GET(^ONCO(167.6,ONC1676,1,IEN,0)),U,1)
WRITE ONCNEOCD
+12 NEW DIEN
FOR DIEN=0:0
SET DIEN=$ORDER(^ONCO(167.6,ONC1676,1,IEN,1,DIEN))
if DIEN'>0!(EX=U)
QUIT
Begin DoDot:2
+13 SET ONCNEOTX=$PIECE($GET(^ONCO(167.6,ONC1676,1,IEN,1,DIEN,0)),U,1)
+14 WRITE ?4,ONCNEOTX,!
DO P
if EX=U
QUIT
End DoDot:2
End DoDot:1
+15 KILL EX,ONCNEOS
QUIT
+16 ;
NEOIT ;NEOADJUVANT THERAPY TREATMENT EFFECT (#1634) FIELD INPUT TRANSFORM
+1 DO ^ONCSCHMA
IF '$DATA(ONCSCMA)!(ONCSCMA=0)
KILL X
QUIT
+2 NEW ONC1659,ONC1676
+3 SET ONCNEOSC=$PIECE($GET(^ONCO(165.5,D0,"SSD1")),"^",1)
IF ONCNEOSC=""
QUIT
+4 SET ONC1659=$ORDER(^ONCO(165.9,"B",ONCNEOSC,""))
if ONC1659'>0
QUIT
+5 SET ONC1676=$PIECE($GET(^ONCO(165.9,ONC1659,0)),"^",3)
IF ONC1676=""
SET ONC1676=9
+6 SET ONCNEOVL=""
+7 NEW IEN
FOR IEN=0:0
SET IEN=$ORDER(^ONCO(167.6,ONC1676,1,IEN))
if IEN'>0
QUIT
Begin DoDot:1
+8 SET ONCNEOVL=ONCNEOVL_"^"_$PIECE($GET(^ONCO(167.6,ONC1676,1,IEN,0)),U,1)
End DoDot:1
+9 IF ONCNEOVL'[X
KILL X
QUIT
+10 SET ONCCDIEN=$ORDER(^ONCO(167.6,ONC1676,1,"B",X,""))
IF ONCCDIEN=""
WRITE "??"
KILL X
QUIT
+11 WRITE " ",$PIECE($GET(^ONCO(167.6,ONC1676,1,ONCCDIEN,1,1,0)),U,1)
+12 KILL ONCNEOVL
QUIT
+13 ;
NEODSP ;NEOADJUVANT THERAPY - TX EFFECT DISPLAY CALLED FROM ONCOPA2
+1 IF NEOXVAL=""
QUIT
+2 NEW ONC1659,ONC1676
+3 SET ONCNEOSC=$PIECE($GET(^ONCO(165.5,IEN,"SSD1")),"^",1)
IF ONCNEOSC=""
QUIT
+4 SET ONC1659=$ORDER(^ONCO(165.9,"B",ONCNEOSC,""))
if ONC1659'>0
QUIT
+5 SET ONC1676=$PIECE($GET(^ONCO(165.9,ONC1659,0)),"^",3)
IF ONC1676=""
SET ONC1676=9
+6 SET ONCCDIEN=$ORDER(^ONCO(167.6,ONC1676,1,"B",NEOXVAL,""))
IF ONCCDIEN=""
WRITE "??"
QUIT
+7 WRITE " ",$PIECE($GET(^ONCO(167.6,ONC1676,1,ONCCDIEN,1,1,0)),"^",1)
+8 KILL ONC1659,ONC1676,ONCNEOSC,ONCNEOVL
+9 QUIT
+10 ;
P ;Enter RETURN to continue
+1 IF $Y>(IOSL-4)
Begin DoDot:1
+2 IF $EXTRACT(IOST,1,2)="C-"
WRITE !
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Enter RETURN to see more or '^' to exit Help"
DO ^DIR
IF 'Y
SET EX=U
QUIT
+3 DO HDR
QUIT
End DoDot:1
if EX=U
QUIT
WRITE !
+4 QUIT
+5 ;
HDR ;Header
+1 WRITE @IOF
+2 QUIT
