source: WorldVistAEHR/trunk/r/ONCOLOGY-ONC/ONCP2P2.m@ 1800

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

initial load of WorldVistAEHR
File size: 8.5 KB
Line 
1ONCP2P2 ;HINES CIOFO/GWB - 1998 Prostate Cancer Study - Table II ;6/1/98
2 ;;2.11;ONCOLOGY;**18**;Mar 07, 1995
3 K TABLE,HTABLE
4 S TABLE("10. CLASS OF CASE")="COC"
5 S TABLE("11. SYMPTOMS PRESENT AT INITIAL DIAGNOSIS")="SPAID"
6 S TABLE("12. INITIAL METHODS OF DIAGNOSIS")="IMOD"
7 S TABLE("13. DIAGNOSTIC EVALUATION")="DE"
8 S TABLE("14. RESULTS OF MOST RECENT PRE-TREATMENT PSA TEST")="ROPP"
9 S TABLE("15. DATE OF INITIAL DIAGNOSIS")="DOID"
10 S TABLE("16. PRIMARY SITE (ICD-O-2)")="PS"
11 S TABLE("17. HISTOLOGY (ICD-O-2)")="HIST"
12 S TABLE("18. BEHAVIOR CODE(ICD-O-2)")="BC"
13 S TABLE("19. GRADE")="GRADE"
14 S TABLE("20. BIOPSY PROCEDURE")="BP"
15 S TABLE("21. GUIDANCE OF BIOPSY TO PRIMARY")="GOBTP"
16 S TABLE("22. BIOPSY APPROACH FOR PRIMARY")="BAFP"
17 S TABLE("23. BIOPSY OF OTHER THAN PRIMARY")="BOOTP"
18 S TABLE("24. DIAGNOSTIC CONFIRMATION")="DC"
19 S TABLE("25. GLEASON'S SCORE FOR BIOPSY, LOCAL RESECTION, OR SIMPLE PROSTATECTOMY")="GSFSP"
20 S TABLE("26. GLEASON'S SCORE FOR RADICAL PROSTATECTOMY")="GSFRP"
21 S HTABLE(1)="10. CLASS OF CASE"
22 S HTABLE(2)="11. SYMPTOMS PRESENT AT INITIAL DIAGNOSIS"
23 S HTABLE(3)="12. INITIAL METHODS OF DIAGNOSIS"
24 S HTABLE(4)="13. DIAGNOSTIC EVALUATION"
25 S HTABLE(5)="14. RESULTS OF MOST RECENT PRE-TREATMENT PSA TEST"
26 S HTABLE(6)="15. DATE OF INITIAL DIAGNOSIS"
27 S HTABLE(7)="16. PRIMARY SITE (ICD-O-2)"
28 S HTABLE(8)="17. HISTOLOGY (ICD-O-2)"
29 S HTABLE(9)="18. BEHAVIOR CODE (ICD-O-2)"
30 S HTABLE(10)="19. GRADE"
31 S HTABLE(11)="20. BIOPSY PROCEDURE"
32 S HTABLE(12)="21. GUIDANCE OF BIOPSY TO PRIMARY"
33 S HTABLE(13)="22. BIOPSY APPROACH FOR PRIMARY"
34 S HTABLE(14)="23. BIOPSY OF OTHER THAN PRIMARY"
35 S HTABLE(15)="24. DIAGNOSTIC CONFIRMATION"
36 S HTABLE(16)="25. GLEASON'S SCORE FOR BIOPSY, LOCAL RESECTION, OR SIMPLE PROSTATECTOMY"
37 S HTABLE(17)="26. GLEASON'S SCORE FOR RADICAL PROSTATECTOMY"
38 S CHOICES=17
39 K DIQ S DIC="^ONCO(165.5,",DR=".04;22;58.1;58.2",DA=ONCONUM,DIQ="ONC",DIQ(0)="IE"
40 D EN^DIQ1
41 S NCDS=$E(ONC(165.5,ONCONUM,58.1,"E"),1,2)
42 S CDS=$E(ONC(165.5,ONCONUM,58.2,"E"),1,2)
43 F SUB="02","03","04","05","06","07" S NCDS(SUB)=""
44 F SUB=10,11,12,13,14,15,16,17,30,40 S CDS(SUB)=""
45 S DIE="^ONCO(165.5,",DA=ONCONUM
46 W @IOF D HEAD^ONCP2P0
47 W !," TABLE II - INITIAL DIAGNOSIS"
48 W !," ----------------------------"
49COC W !," 10. CLASS OF CASE................: ",ONC(165.5,ONCONUM,.04,"E")
50SPAID W !!," 11. SYMPTOMS PRESENT AT INITIAL DIAGNOSIS:",!
51 S DR="658 HEMATURIA...................." D ^DIE G:$D(Y) JUMP
52 S DR="659 LOWER BACK PAIN.............." D ^DIE G:$D(Y) JUMP
53 S DR="660 TROUBLE URINATING............" D ^DIE G:$D(Y) JUMP
54IMOD W !!," 12. INITIAL METHOD OF DIAGNOSIS:",!
55 S DR="661 CLINICAL DX WITH BONE LESION." D ^DIE G:$D(Y) JUMP
56 S DR="662 CLINICAL DX BY RECTAL EXAM..." D ^DIE G:$D(Y) JUMP
57 S DR="663 CYTOLOGY....................." D ^DIE G:$D(Y) JUMP
58 S DR="664 DIGITAL TRANSRECTAL BIOPSY..." D ^DIE G:$D(Y) JUMP
59 S DR="665 INCIDENTAL FINDING IN TURP FOR BENIGN DISEASE..........." D ^DIE G:$D(Y) JUMP
60 S DR="666 NEEDLE BIOPSY, NOS..........." D ^DIE G:$D(Y) JUMP
61 S DR="667 PERINEAL BIOPSY.............." D ^DIE G:$D(Y) JUMP
62 S DR="668 PSA.........................." D ^DIE G:$D(Y) JUMP
63 S DR="669 TRUS GUIDED BIOPSY..........." D ^DIE G:$D(Y) JUMP
64 S DR="670 TURP, NOS...................." D ^DIE G:$D(Y) JUMP
65DE W !!," 13. DIAGNOSTIC EVALUATION:",!
66 S DR="671 BONE MARROW ASPIRATION......." D ^DIE G:$D(Y) JUMP
67 S DR="672 BONE SCAN...................." D ^DIE G:$D(Y) JUMP
68 S DR="673 BONE X-RAY..................." D ^DIE G:$D(Y) JUMP
69 S DR="674 CHEST X-RAY.................." D ^DIE G:$D(Y) JUMP
70 S DR="675 CT SCAN OF ABDOMEN..........." D ^DIE G:$D(Y) JUMP
71 S DR="676 CT SCAN OF PELVIS............" D ^DIE G:$D(Y) JUMP
72 S DR="677 IVP.........................." D ^DIE G:$D(Y) JUMP
73 S DR="678 MRI.........................." D ^DIE G:$D(Y) JUMP
74 S DR="679 PELVIC LYMPH NODE DISSECTION." D ^DIE G:$D(Y) JUMP
75 S DR="680 PCR.........................." D ^DIE G:$D(Y) JUMP
76 S DR="681 PAP.........................." D ^DIE G:$D(Y) JUMP
77 S DR="682 PSA.........................." D ^DIE G:$D(Y) JUMP
78 S DR="683 ULTRASOUND OF ABDOMEN........" D ^DIE G:$D(Y) JUMP
79 W !
80ROPP S DR="684 14. RESULTS OF MOST RECENT PRE- TREATMENT PSA TEST..........." D ^DIE G:$D(Y) JUMP
81DOID S DOID=$E(DATEDX,4,5)_"/"_$E(DATEDX,6,7)_"/"_(1700+$E(DATEDX,1,3))
82 W !," 15. DATE OF INITIAL DIAGNOSIS....: ",DOID
83PS W !," 16. PRIMARY SITE (ICD-O-2).......: C61.9"
84HIST W !," 17. HISTOLOGY (ICD-O-2)..........: ",$E(ONC(165.5,ONCONUM,22,"I"),1,4)
85BC W !," 18. BEHAVIOR CODE (ICD-O-2)......: ",$E(ONC(165.5,ONCONUM,22,"I"),5)
86GRADE S DR="24 19. GRADE........................" D ^DIE G:$D(Y) JUMP
87BP S DR="141 20. BIOSPY PROCEDURE............." D ^DIE G:$D(Y) JUMP
88 I $G(X)=1 D G BOOTP
89 .S $P(^ONCO(165.5,ONCONUM,2.1),U,15)=1
90 .S $P(^ONCO(165.5,ONCONUM,2.1),U,18)=0
91 .W !," 21. GUIDANCE OF BIOPSY TO PRIMARY: Not guided, no biopsy"
92 .W !," 22. BIOPSY APPROACH FOR PRIMARY..: No biopsy"
93 I $G(X)=6 D G BOOTP
94 .S $P(^ONCO(165.5,ONCONUM,2.1),U,15)=5
95 .S $P(^ONCO(165.5,ONCONUM,2.1),U,18)=9
96 .W !," 21. GUIDANCE OF BIOPSY TO PRIMARY: Unknown/death cert only"
97 .W !," 22. BIOPSY APPROACH FOR PRIMARY..: Unknown/death cert only"
98GOBTP S DR="142 21. GUIDANCE OF BIOSPY TO PRIMARY" D ^DIE G:$D(Y) JUMP
99BAFP S DR="145 22. BIOSPY APPROACH FOR PRIMARY.." D ^DIE G:$D(Y) JUMP
100BOOTP S DR="146 23. BIOSPY OF OTHER THAN PRIMARY." D ^DIE G:$D(Y) JUMP
101DC S DR="26 24. DIAGNOSTIC CONFIRMATION......" D ^DIE G:$D(Y) JUMP
102GSFSP W !," 25. GLEASON'S SCORE FOR BIOPSY, LOCAL RESECTION, OR SIMPLE PROSTATECTOMY:",!
103 I NCDS'="",$D(NCDS(NCDS)) G PP25
104 I CDS'="",$D(CDS(CDS)) G PP25
105 E D G GSFRP
106 .W !," Surgery codes not 02 through 40",!
107 .K DR S DR=""
108 .S DR(1,165.5,1)="623.1///9"
109 .S DR(1,165.5,2)="623.2///9"
110 .S DR(1,165.5,3)="623///99"
111 .D ^DIE
112 .W !," PREDOMINENT (PRIMARY) PATTERN: 9"
113 .W !," LESSER (SECONDARY) PATTERN...: 9"
114 .W !," GLEASON SCORE................: 99 Unknown, not reported, or NA"
115PP25 S DR="623.1 PREDOMINENT (PRIMARY) PATTERN" D ^DIE G:$D(Y) JUMP
116 I $P($G(^ONCO(165.5,ONCONUM,"PRO2")),U,43)=0 D G GS25
117 .S DR="623.2///0" D ^DIE
118 .W !," LESSER (SECONDARY) PATTERN...: 0"
119 I $P($G(^ONCO(165.5,ONCONUM,"PRO2")),U,43)=9 D G GSFRP
120 .S DR="623///99;623.2///9" D ^DIE
121 .W !," LESSER (SECONDARY) PATTERN...: 9"
122 .W !," GLEASON SCORE................: 99 Unknown, not reported, or NA"
123LP25 S DR="623.2 LESSER (SECONDARY) PATTERN..." D ^DIE G:$D(Y) JUMP
124 S PP=$P($G(^ONCO(165.5,D0,"PRO2")),U,43)
125 S LP=$P($G(^ONCO(165.5,D0,"PRO2")),U,44)
126 I PP>0,PP<6,(X=0)!(X=9) W *7,"??" G LP25
127 I ((PP>0)&(PP<6))&((LP>0)&(LP<6)) S GS=PP+LP S:$L(GS)=1 GS="0"_GS D G GSFRP
128 .S DR="623///"_GS D ^DIE
129 .W !," GLEASON SCORE................: ",GS
130GS25 S DR="623 GLEASON SCORE................" D ^DIE G:$D(Y) JUMP
131GSFRP W !!," 26. GLEASON'S SCORE FOR RADICAL PROSTATECTOMY:",!
132 I (CDS=50)!(CDS=70) G PP26
133 E D G PRTC
134 .W !," Surgery codes not 50 through 70",!
135 .K DR S DR=""
136 .S DR(1,165.5,1)="623.4///9"
137 .S DR(1,165.5,2)="623.5///9"
138 .S DR(1,165.5,3)="623.3///99"
139 .D ^DIE
140 .W !," PREDOMINENT (PRIMARY) PATTERN: 9"
141 .W !," LESSER (SECONDARY) PATTERN...: 9"
142 .W !," GLEASON SCORE................: 99 Unknown, not reported, or NA"
143PP26 S DR="623.4 PREDOMINENT (PRIMARY) PATTERN" D ^DIE G:$D(Y) JUMP
144 I $P($G(^ONCO(165.5,ONCONUM,"PRO2")),U,46)=0 D G GS26
145 .S DR="623.5///0" D ^DIE
146 .W !," LESSER (SECONDARY) PATTERN...: 0"
147 I $P($G(^ONCO(165.5,ONCONUM,"PRO2")),U,46)=9 D G PRTC
148 .S DR="623.3///99;623.5///9" D ^DIE
149 .W !," LESSER (SECONDARY) PATTERN...: 9"
150 .W !," GLEASON SCORE................: 99 Unknown, not reported, or NA"
151LP26 S DR="623.5 LESSER (SECONDARY) PATTERN..." D ^DIE G:$D(Y) JUMP
152 S PP=$P($G(^ONCO(165.5,D0,"PRO2")),U,46)
153 S LP=$P($G(^ONCO(165.5,D0,"PRO2")),U,47)
154 I PP>0,PP<6,(X=0)!(X=9) W *7,"??" G LP26
155 I ((PP>0)&(PP<6))&((LP>0)&(LP<6)) S GS=PP+LP S:$L(GS)=1 GS="0"_GS D G PRTC
156 .S DR="623.3///"_GS D ^DIE
157 .W !," GLEASON SCORE................: ",GS
158GS26 S DR="623.3 GLEASON SCORE................" D ^DIE G:$D(Y) JUMP
159PRTC W ! K DIR S DIR(0)="E" D ^DIR S:$D(DIRUT) OUT="Y"
160 G EXIT
161JUMP ;Jump to prompts
162 S XX="" R !!," GO TO ITEM NUMBER: ",X:DTIME I (X="")!(X[U) S OUT="Y" G EXIT
163 I X["?" D G JUMP
164 .W !," CHOOSE FROM:" F I=1:1:CHOICES W !,?5,HTABLE(I)
165 I '$D(TABLE(X)) S:X?1.2N X=X_"." S XX=X,X=$O(TABLE(X)) I ($P(X,XX,1)'="")!(X="") W *7,"??" D G JUMP
166 .W !," CHOOSE FROM:" F I=1:1:CHOICES W !,?5,HTABLE(I)
167 S X=TABLE(X)
168 G @X
169EXIT K CHOICES,HTABLE,TABLE
170 K DOID,NCDS,CDS,PP,LP,GS,PIECE
171 K DA,DIE,DIR,DIROUT,DIRUT,DR,DTOUT,DUOUT,X,XX,Y
172 Q
Note: See TracBrowser for help on using the repository browser.