source: WorldVistAEHR/trunk/r/ONCOLOGY-ONC/ONCODEL.m@ 1093

Last change on this file since 1093 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 3.2 KB
RevLine 
[613]1ONCODEL ;Hines OIFO/GWB - EXTENSION and LYMPH NODES ;8/12/94
2 ;;2.11;ONCOLOGY;**7,15,19,22,27,28,30,36,47**;Mar 07, 1995;Build 19
3 ;
4IN ;EXTENSION (165.5,30) and LYMPH NODES (165.5,31) INPUT TRANSFORM
5 S ONCOT=$P($G(^ONCO(165.5,D0,2)),U,1)
6 N OP S OP=$$GETLIST(D0,ONCOX,ONCOT)
7 I OP D
8 .I X?.N D Q
9 ..I (X>99)!(X<0)!(X?.E1"."1N.N)!(X'?1.2N) K X W " Invalid code" Q
10 ..S:($L(X)=2)&($E(X,1)="0") X=$E(X,2)
11 ..S Y=$G(^ONCO(164.5,OP,1,(X+1),0))
12 ..I Y="" K X W " Invalid Code" Q
13 ..W ?(17-$L(X))," "_Y
14 .I X?.AP D UCASE^ONCOU D Q
15 ..S XX=X
16 ..I $D(^ONCO(164.5,OP,1,"C",X)) D Q
17 ...S X=$O(^ONCO(164.5,OP,1,"C",X,0)),X=X-1
18 ...W ?(17-$L(X)),$P(Y,XX,2)
19 ..S Y=$O(^ONCO(164.5,OP,1,"C",X))
20 ..I ($P(Y,XX,1)'="")!(Y="") K X W " Invalid code" Q
21 ..S X=$O(^ONCO(164.5,OP,1,"C",Y,0)),X=X-1
22 ..W ?(17-$L(X)),$P(Y,XX,2)
23 .K X W " Invalid code"
24 E W:OP'="" !,OP,*7,! K X
25 D EX Q
26 ;
27OT ;EXTENSION (165.5,30) and LYMPH NODES (165.5,31) OUTPUT TRANSFORM
28 Q:Y=""
29 N YY,OP
30 S ONCOT=$P($G(^ONCO(165.5,D0,2)),U,1)
31 S OP=$$GETLIST(D0,ONCOX,ONCOT)
32 I ONCOX="E",$L(Y)=1 S Y="0"_Y
33 I OP S YY=$G(^ONCO(164.5,OP,1,(Y+1),0)),Y=$S(YY="":"Invalid code",1:Y_" "_YY)
34 E S Y=OP
35 D EX
36 Q
37 ;
38HP ;EXTENSION (165.5,30) and LYMPH NODES (165.5,31) HELP
39 S ONCOT=$P($G(^ONCO(165.5,D0,2)),U,1)
40 N OP S OP=$$GETLIST(D0,ONCOX,ONCOT)
41 I OP D
42 .W !?2,$P(^ONCO(164.5,OP,0),U)," (",SEERED," edition)",!
43 .N X,Y S X=0
44 .F S X=$O(^ONCO(164.5,OP,1,X)) Q:X'>0 D
45 ..S Y=X-1 S:($L(Y)=1)&(ONCOX="E") Y="0"_Y W !?2,Y_" "_^(X,0)
46 E W:OP'="" !,OP,*7,! K X
47 W !
48 D EX Q
49 ;
50EX ;Exit
51 K ONCOX,SEERED,ONCFLD
52 Q
53 ;
54GETLIST(ONCOIX,CODTYP,ONCOT,OUTFLAG) ;CODTYP (E=extension, L=lymph node)
55 N OP
56 N ED S ED=$$EDITION^ONCOU55(ONCOIX)
57 S SEERED=$S(ED=3:"3rd",ED=2:"2nd",ED=1:"1st",1:ED)
58 N ONCOER
59 N SCOD S SCOD=$P(^ONCO(165.5,ONCOIX,0),U)
60 I ONCOT="" S ONCOER="No PRIMARY SITE."
61 I $G(ONCOER)="" N HST S HST=$$HIST^ONCFUNC(D0) I HST="" S ONCOER="No HISTOLOGY."
62 I $G(ONCOER)="" D
63 .N MELANOMA S MELANOMA=$$MELANOMA^ONCOU55(ONCOIX)
64 .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
65 .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)
66 .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
67 .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
68 .E D
69 ..S OP=$P($G(^ONCO(ICDFILE,HST,CODTYP)),U,ED) ;Histology
70 ..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)
71 ..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
72 ..I '$G(OP),ONCOT=67619,$G(ONCFLD)=30,ED=3 S OP=$P($G(^ONCO(164,ONCOT,CODTYP)),U,ED) ;Prostate Gland--Clincal Extension
73 ..I '$G(OP),ONCOT=67619,$G(ONCFLD)=30.1,ED=3 S OP=250 ;Prostate Gland--Pathologic Extension
74 ..I '$G(OP) S OP=$P($G(^ONCO(164,ONCOT,CODTYP)),U,ED) ;Topography
75 ..I '$G(OP) S OP=$P($G(^ONCO(164.2,SCOD,CODTYP)),U,ED) ;Other site-groups
76 I $D(ONCOER) Q ONCOER
77 E Q $S($G(OUTFLAG)'="OUT":OP,1:OP_" "_$P(^ONCO(164.5,OP,0),U,5)_" "_ED_" "_$P(^(0),U))
Note: See TracBrowser for help on using the repository browser.