ONCODEL ;Hines OIFO/GWB - EXTENSION and LYMPH NODES ;8/12/94
;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
;
IN ;EXTENSION (165.5,30) and LYMPH NODES (165.5,31) INPUT TRANSFORM
S ONCOT=$P($G(^ONCO(165.5,D0,2)),U,1)
N OP S OP=$$GETLIST(D0,ONCOX,ONCOT)
I OP D
.I X?.N D Q
..I (X>99)!(X<0)!(X?.E1"."1N.N)!(X'?1.2N) K X W " Invalid code" Q
..S:($L(X)=2)&($E(X,1)="0") X=$E(X,2)
..S Y=$G(^ONCO(164.5,OP,1,(X+1),0))
..I Y="" K X W " Invalid Code" Q
..W ?(17-$L(X))," "_Y
.I X?.AP D UCASE^ONCOU D Q
..S XX=X
..I $D(^ONCO(164.5,OP,1,"C",X)) D Q
...S X=$O(^ONCO(164.5,OP,1,"C",X,0)),X=X-1
...W ?(17-$L(X)),$P(Y,XX,2)
..S Y=$O(^ONCO(164.5,OP,1,"C",X))
..I ($P(Y,XX,1)'="")!(Y="") K X W " Invalid code" Q
..S X=$O(^ONCO(164.5,OP,1,"C",Y,0)),X=X-1
..W ?(17-$L(X)),$P(Y,XX,2)
.K X W " Invalid code"
E W:OP'="" !,OP,*7,! K X
D EX Q
;
OT ;EXTENSION (165.5,30) and LYMPH NODES (165.5,31) OUTPUT TRANSFORM
Q:Y=""
N YY,OP
S ONCOT=$P($G(^ONCO(165.5,D0,2)),U,1)
S OP=$$GETLIST(D0,ONCOX,ONCOT)
I ONCOX="E",$L(Y)=1 S Y="0"_Y
I OP S YY=$G(^ONCO(164.5,OP,1,(Y+1),0)),Y=$S(YY="":"Invalid code",1:Y_" "_YY)
E S Y=OP
D EX
Q
;
HP ;EXTENSION (165.5,30) and LYMPH NODES (165.5,31) HELP
S ONCOT=$P($G(^ONCO(165.5,D0,2)),U,1)
N OP S OP=$$GETLIST(D0,ONCOX,ONCOT)
I OP D
.W !?2,$P(^ONCO(164.5,OP,0),U)," (",SEERED," edition)",!
.N X,Y S X=0
.F S X=$O(^ONCO(164.5,OP,1,X)) Q:X'>0 D
..S Y=X-1 S:($L(Y)=1)&(ONCOX="E") Y="0"_Y W !?2,Y_" "_^(X,0)
E W:OP'="" !,OP,*7,! K X
W !
D EX Q
;
EX ;KILL variables
K HISTNAM,HSTFLD,ICDFILE,ONCOX,SEERED,ONCFLD,XX
Q
;
GETLIST(ONCOIX,CODTYP,ONCOT,OUTFLAG) ;CODTYP (E=extension, L=lymph node)
N OP
N ED S ED=$$EDITION^ONCOU55(ONCOIX)
S SEERED=$S(ED=3:"3rd",ED=2:"2nd",ED=1:"1st",1:ED)
N ONCOER
N SCOD S SCOD=$P(^ONCO(165.5,ONCOIX,0),U)
I ONCOT="" S ONCOER="No PRIMARY SITE."
I $G(ONCOER)="" N HST S HST=$$HIST^ONCFUNC(D0,.HSTFLD,.HISTNAM,.ICDFILE) I HST="" S ONCOER="No HISTOLOGY."
I $G(ONCOER)="" D
.N MELANOMA S MELANOMA=$$MELANOMA^ONCOU55(ONCOIX)
.I MELANOMA,$P($G(^ONCO(164,ONCOT,0)),U,15) S OP=$S(CODTYP="E":145,CODTYP="L":146,1:0) ;Malignant melanoma of the skin
.E I MELANOMA,ED=2,ONCOT=67690 S OP=$S(CODTYP="E":167,CODTYP="L":172,1:0) ;Malignant melanoma of the conjunctiva (uses Conjunctiva list)
.E I MELANOMA,ED=2,ONCOT>67690,ONCOT<67700 S OP=$S(CODTYP="E":169,CODTYP="L":170,1:0) ;Malignant Melanoma of Uvea - 2nd edition
.E I MELANOMA,ED=3,ONCOT>67690,ONCOT<67700 S OP=$S(CODTYP="E":241,CODTYP="L":170,1:0) ;Malignant Melanoma of Uvea - 3rd edition
.E D
..S OP=$P($G(^ONCO(ICDFILE,HST,CODTYP)),U,ED) ;Histology
..I '$G(OP),ONCOT=67422,(($E(HST,1,3)<959)!($E(HST,1,3)>971)),'$$LEUKEMIA^ONCOAIP2(ONCOIX),HST'=91403 S OP=$S(CODTYP="E":132,1:133)
..I '$G(OP),((ONCOT=67770)&((SCOD=62)!(SCOD=63)))!(SCOD=35)!(SCOD=39)!(SCOD=40) S OP=$P($G(^ONCO(164.2,SCOD,CODTYP)),U,ED) ;Special site-groups
..I '$G(OP),ONCOT=67619,$G(ONCFLD)=30,ED=3 S OP=$P($G(^ONCO(164,ONCOT,CODTYP)),U,ED) ;Prostate Gland--Clincal Extension
..I '$G(OP),ONCOT=67619,$G(ONCFLD)=30.1,ED=3 S OP=250 ;Prostate Gland--Pathologic Extension
..I '$G(OP) S OP=$P($G(^ONCO(164,ONCOT,CODTYP)),U,ED) ;Topography
..I '$G(OP) S OP=$P($G(^ONCO(164.2,SCOD,CODTYP)),U,ED) ;Other site-groups
..I '$G(OP),SCOD=77,HST=97613 S OP=$S(CODTYP="E":84,CODTYP="L":85,1:0) ;Waldenstrom macroglobulinemia
I $D(ONCOER) Q ONCOER
E Q $S($G(OUTFLAG)'="OUT":OP,1:OP_" "_$P(^ONCO(164.5,OP,0),U,5)_" "_ED_" "_$P(^(0),U))
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HONCODEL 3524 printed Apr 09, 2024@21:25:28 Page 2
ONCODEL ;Hines OIFO/GWB - EXTENSION and LYMPH NODES ;8/12/94
+1 ;;2.2;ONCOLOGY;**1**;Jul 31, 2013;Build 8
+2 ;
IN ;EXTENSION (165.5,30) and LYMPH NODES (165.5,31) INPUT TRANSFORM
+1 SET ONCOT=$PIECE($GET(^ONCO(165.5,D0,2)),U,1)
+2 NEW OP
SET OP=$$GETLIST(D0,ONCOX,ONCOT)
+3 IF OP
Begin DoDot:1
+4 IF X?.N
Begin DoDot:2
+5 IF (X>99)!(X<0)!(X?.E1"."1N.N)!(X'?1.2N)
KILL X
WRITE " Invalid code"
QUIT
+6 if ($LENGTH(X)=2)&($EXTRACT(X,1)="0")
SET X=$EXTRACT(X,2)
+7 SET Y=$GET(^ONCO(164.5,OP,1,(X+1),0))
+8 IF Y=""
KILL X
WRITE " Invalid Code"
QUIT
+9 WRITE ?(17-$LENGTH(X))," "_Y
End DoDot:2
QUIT
+10 IF X?.AP
DO UCASE^ONCOU
Begin DoDot:2
+11 SET XX=X
+12 IF $DATA(^ONCO(164.5,OP,1,"C",X))
Begin DoDot:3
+13 SET X=$ORDER(^ONCO(164.5,OP,1,"C",X,0))
SET X=X-1
+14 WRITE ?(17-$LENGTH(X)),$PIECE(Y,XX,2)
End DoDot:3
QUIT
+15 SET Y=$ORDER(^ONCO(164.5,OP,1,"C",X))
+16 IF ($PIECE(Y,XX,1)'="")!(Y="")
KILL X
WRITE " Invalid code"
QUIT
+17 SET X=$ORDER(^ONCO(164.5,OP,1,"C",Y,0))
SET X=X-1
+18 WRITE ?(17-$LENGTH(X)),$PIECE(Y,XX,2)
End DoDot:2
QUIT
+19 KILL X
WRITE " Invalid code"
End DoDot:1
+20 IF '$TEST
if OP'=""
WRITE !,OP,*7,!
KILL X
+21 DO EX
QUIT
+22 ;
OT ;EXTENSION (165.5,30) and LYMPH NODES (165.5,31) OUTPUT TRANSFORM
+1 if Y=""
QUIT
+2 NEW YY,OP
+3 SET ONCOT=$PIECE($GET(^ONCO(165.5,D0,2)),U,1)
+4 SET OP=$$GETLIST(D0,ONCOX,ONCOT)
+5 IF ONCOX="E"
IF $LENGTH(Y)=1
SET Y="0"_Y
+6 IF OP
SET YY=$GET(^ONCO(164.5,OP,1,(Y+1),0))
SET Y=$SELECT(YY="":"Invalid code",1:Y_" "_YY)
+7 IF '$TEST
SET Y=OP
+8 DO EX
+9 QUIT
+10 ;
HP ;EXTENSION (165.5,30) and LYMPH NODES (165.5,31) HELP
+1 SET ONCOT=$PIECE($GET(^ONCO(165.5,D0,2)),U,1)
+2 NEW OP
SET OP=$$GETLIST(D0,ONCOX,ONCOT)
+3 IF OP
Begin DoDot:1
+4 WRITE !?2,$PIECE(^ONCO(164.5,OP,0),U)," (",SEERED," edition)",!
+5 NEW X,Y
SET X=0
+6 FOR
SET X=$ORDER(^ONCO(164.5,OP,1,X))
if X'>0
QUIT
Begin DoDot:2
+7 SET Y=X-1
if ($LENGTH(Y)=1)&(ONCOX="E")
SET Y="0"_Y
WRITE !?2,Y_" "_^(X,0)
End DoDot:2
End DoDot:1
+8 IF '$TEST
if OP'=""
WRITE !,OP,*7,!
KILL X
+9 WRITE !
+10 DO EX
QUIT
+11 ;
EX ;KILL variables
+1 KILL HISTNAM,HSTFLD,ICDFILE,ONCOX,SEERED,ONCFLD,XX
+2 QUIT
+3 ;
GETLIST(ONCOIX,CODTYP,ONCOT,OUTFLAG) ;CODTYP (E=extension, L=lymph node)
+1 NEW OP
+2 NEW ED
SET ED=$$EDITION^ONCOU55(ONCOIX)
+3 SET SEERED=$SELECT(ED=3:"3rd",ED=2:"2nd",ED=1:"1st",1:ED)
+4 NEW ONCOER
+5 NEW SCOD
SET SCOD=$PIECE(^ONCO(165.5,ONCOIX,0),U)
+6 IF ONCOT=""
SET ONCOER="No PRIMARY SITE."
+7 IF $GET(ONCOER)=""
NEW HST
SET HST=$$HIST^ONCFUNC(D0,.HSTFLD,.HISTNAM,.ICDFILE)
IF HST=""
SET ONCOER="No HISTOLOGY."
+8 IF $GET(ONCOER)=""
Begin DoDot:1
+9 NEW MELANOMA
SET MELANOMA=$$MELANOMA^ONCOU55(ONCOIX)
+10 ;Malignant melanoma of the skin
IF MELANOMA
IF $PIECE($GET(^ONCO(164,ONCOT,0)),U,15)
SET OP=$SELECT(CODTYP="E":145,CODTYP="L":146,1:0)
+11 ;Malignant melanoma of the conjunctiva (uses Conjunctiva list)
IF '$TEST
IF MELANOMA
IF ED=2
IF ONCOT=67690
SET OP=$SELECT(CODTYP="E":167,CODTYP="L":172,1:0)
+12 ;Malignant Melanoma of Uvea - 2nd edition
IF '$TEST
IF MELANOMA
IF ED=2
IF ONCOT>67690
IF ONCOT<67700
SET OP=$SELECT(CODTYP="E":169,CODTYP="L":170,1:0)
+13 ;Malignant Melanoma of Uvea - 3rd edition
IF '$TEST
IF MELANOMA
IF ED=3
IF ONCOT>67690
IF ONCOT<67700
SET OP=$SELECT(CODTYP="E":241,CODTYP="L":170,1:0)
+14 IF '$TEST
Begin DoDot:2
+15 ;Histology
SET OP=$PIECE($GET(^ONCO(ICDFILE,HST,CODTYP)),U,ED)
+16 IF '$GET(OP)
IF ONCOT=67422
IF (($EXTRACT(HST,1,3)<959)!($EXTRACT(HST,1,3)>971))
IF '$$LEUKEMIA^ONCOAIP2(ONCOIX)
IF HST'=91403
SET OP=$SELECT(CODTYP="E":132,1:133)
+17 ;Special site-groups
IF '$GET(OP)
IF ((ONCOT=67770)&((SCOD=62)!(SCOD=63)))!(SCOD=35)!(SCOD=39)!(SCOD=40)
SET OP=$PIECE($GET(^ONCO(164.2,SCOD,CODTYP)),U,ED)
+18 ;Prostate Gland--Clincal Extension
IF '$GET(OP)
IF ONCOT=67619
IF $GET(ONCFLD)=30
IF ED=3
SET OP=$PIECE($GET(^ONCO(164,ONCOT,CODTYP)),U,ED)
+19 ;Prostate Gland--Pathologic Extension
IF '$GET(OP)
IF ONCOT=67619
IF $GET(ONCFLD)=30.1
IF ED=3
SET OP=250
+20 ;Topography
IF '$GET(OP)
SET OP=$PIECE($GET(^ONCO(164,ONCOT,CODTYP)),U,ED)
+21 ;Other site-groups
IF '$GET(OP)
SET OP=$PIECE($GET(^ONCO(164.2,SCOD,CODTYP)),U,ED)
+22 ;Waldenstrom macroglobulinemia
IF '$GET(OP)
IF SCOD=77
IF HST=97613
SET OP=$SELECT(CODTYP="E":84,CODTYP="L":85,1:0)
End DoDot:2
End DoDot:1
+23 IF $DATA(ONCOER)
QUIT ONCOER
+24 IF '$TEST
QUIT $SELECT($GET(OUTFLAG)'="OUT":OP,1:OP_" "_$PIECE(^ONCO(164.5,OP,0),U,5)_" "_ED_" "_$PIECE(^(0),U))
