source: WorldVistAEHR/trunk/r/ONCOLOGY-ONC/ONCIPC8.m@ 700

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

initial load of WorldVistAEHR
File size: 6.6 KB
RevLine 
[613]1ONCIPC8 ;Hines OIFO/GWB - Primary Intracranial/CNS Tumors PCE Study ;05/01/00
2 ;;2.11;ONCOLOGY;**26**;Mar 07, 1995
3 ;Print
4 K IOP,%ZIS S %ZIS="MQ" W ! D ^%ZIS K %ZIS,IOP G:POP KILL
5 I $D(IO("Q")) S ONCOLST="ONCONUM^ONCOPA^PATNAM^SPACES^TOPNAM^SSN^TOPTAB^TOPCOD^DASHES^SITTAB^SITEGP" D TASK G KILL
6 U IO D PRT D ^%ZISC K %ZIS,IOP G KILL
7PRT S EX="",LIN=$S(IOST?1"C".E:IOSL-2,1:IOSL-4),IE=ONCONUM
8 D NOW^%DTC S ONDATE=%,Y=ONDATE X ^DD("DD") S ONDATE=$P(Y,":",1,2)
9 S HIST=$P($G(^ONCO(165.5,ONCONUM,2)),U,3)
10 K LINE S $P(LINE,"-",40)="-"
11I D HEAD^ONCIPC0
12 S TABLE="PATIENT INFORMATION"
13 K LINE S $P(LINE,"-",19)="-"
14 W !?4,TABLE,!?4,LINE
15 S D0=ONCOPA D DOB1^ONCOES S Y=X D DATEOT^ONCOPCE S DOB=Y
16 W !," 1. FACILITY ID NUMBER (FIN)......: ",$$IIN^ONCFUNC
17 D P Q:EX=U
18 W !," 2. ACCESSION NUMBER..............: ",$$GET1^DIQ(165.5,IE,.05)
19 D P Q:EX=U
20 W !," 3. SEQUENCE NUMBER...............: ",$$GET1^DIQ(165.5,IE,.06)
21 D P Q:EX=U
22 W !," 4. POSTAL CODE AT DIAGNOSIS......: ",$$GET1^DIQ(165.5,IE,9)
23 D P Q:EX=U
24 W !," 5. DATE OF BIRTH.................: ",DOB
25 D P Q:EX=U
26 W !," 6. RACE..........................: ",$$GET1^DIQ(165.5,IE,.12)
27 D P Q:EX=U
28 W !," 7. SPANISH ORIGIN................: ",$$GET1^DIQ(160,ONCOPA,9)
29 D P Q:EX=U
30 W !," 8. SEX...........................: ",$$GET1^DIQ(160,ONCOPA,10)
31 D P Q:EX=U
32 W !," 9. HANDEDNESS....................: ",$$GET1^DIQ(165.5,IE,1200)
33 D P Q:EX=U
34 W !,"10. PRIOR EXPOSURE TO RADIATION...: ",$$GET1^DIQ(165.5,IE,403)
35 D P Q:EX=U
36 W !,"11. PRIMARY PAYER AT DIAGNOSIS....: ",$$GET1^DIQ(165.5,IE,18)
37 D P Q:EX=U
38 W !
39 D P Q:EX=U
40 W !,"12. PRIOR MEDICAL CONDITIONS:"
41 D P Q:EX=U
42 W !," HYPERTENSION.................: ",$$GET1^DIQ(165.5,IE,1201)
43 D P Q:EX=U
44 W !," MULTIPLE SCLEROSIS (MS)......: ",$$GET1^DIQ(165.5,IE,1202)
45 D P Q:EX=U
46 W !," DIABETES.....................: ",$$GET1^DIQ(165.5,IE,1203)
47 D P Q:EX=U
48 W !," MYOCARDIAL INFARCTION (MI)...: ",$$GET1^DIQ(165.5,IE,354)
49 D P Q:EX=U
50 W !," CEREBROVASCULAR DISEASE......: ",$$GET1^DIQ(165.5,IE,1204)
51 D P Q:EX=U
52 W !
53 D P Q:EX=U
54 W !,"13. PERSONAL HISTORY OF OTHER CANCER:"
55 D P Q:EX=U
56 W !," BRAIN........................: ",$$GET1^DIQ(165.5,IE,1205)
57 D P Q:EX=U
58 W !," BREAST.......................: ",$$GET1^DIQ(165.5,IE,1206)
59 D P Q:EX=U
60 W !," PROSTATE.....................: ",$$GET1^DIQ(165.5,IE,1207)
61 D P Q:EX=U
62 W !," MALIGNANT MELANOMA...........: ",$$GET1^DIQ(165.5,IE,1208)
63 D P Q:EX=U
64 W !," OTHER SKIN CANCER............: ",$$GET1^DIQ(165.5,IE,1209)
65 D P Q:EX=U
66 W !," LEUKEMIA.....................: ",$$GET1^DIQ(165.5,IE,1210)
67 D P Q:EX=U
68 W !," COLON OR OTHER GI CANCERS....: ",$$GET1^DIQ(165.5,IE,1211)
69 D P Q:EX=U
70 W !," OTHER........................: ",$$GET1^DIQ(165.5,IE,1212)
71 D P Q:EX=U
72 I IOST?1"C".E W ! K DIR S DIR(0)="E" D ^DIR Q:'Y D HEAD^ONCIPC0 G GP
73 W !
74 D P Q:EX=U
75GP W !,"14. GENETIC PREDISPOSITION:"
76 D P Q:EX=U
77 W !," NEUROFIBROMATOSIS............: ",$$GET1^DIQ(165.5,IE,1213)
78 D P Q:EX=U
79 W !," VON HIPPEL-LINDAU DISEASE....: ",$$GET1^DIQ(165.5,IE,1214)
80 D P Q:EX=U
81 W !," TUBEROUS SCLEROSIS...........: ",$$GET1^DIQ(165.5,IE,1215)
82 D P Q:EX=U
83 W !," TURCOT SYNDROME..............: ",$$GET1^DIQ(165.5,IE,1216)
84 D P Q:EX=U
85 W !," LI-FRAUMENI SYNDROME.........: ",$$GET1^DIQ(165.5,IE,1217)
86 D P Q:EX=U
87 W !," KOWDEN DISEASE...............: ",$$GET1^DIQ(165.5,IE,1218)
88 D P Q:EX=U
89 W !," NEVOID BASAL CELL CARCINOMA"
90 D P Q:EX=U
91 W !," SYNDROME....................: ",$$GET1^DIQ(165.5,IE,1219)
92 D P Q:EX=U
93 W !
94 D P Q:EX=U
95 W !," 15. USUAL OCCUPATION.............: ",$$OCCUP^ONCACDU1(ONCOPA)
96 D P Q:EX=U
97 W !," 16. USUAL INDUSTRY...............: ",$$OCCUP^ONCACDU1(ONCOPA)
98 I IOST?1"C".E W ! K DIR S DIR(0)="E" D ^DIR G:'Y KILL D HEAD^ONCIPC0 G II
99 D P Q:EX=U
100II S TABLE="TUMOR IDENTIFICATION"
101 I IOST'?1"C".E W ! I ($Y'<(LIN-4)) D HEAD^ONCIPC0
102 K LINE S $P(LINE,"-",20)="-"
103 W !?4,TABLE,!?4,LINE
104 D P Q:EX=U
105 W !,"17. CLASS OF CASE.................: ",$$GET1^DIQ(165.5,IE,.04)
106 D P Q:EX=U
107 W !
108 D P Q:EX=U
109 W !,"18. SYMPTOMS:"
110 D P Q:EX=U
111 W !," HEADACHE.....................: ",$$GET1^DIQ(165.5,IE,1220)
112 D P Q:EX=U
113 W !," NAUSEA/VOMITING..............: ",$$GET1^DIQ(165.5,IE,1221)
114 D P Q:EX=U
115 W !," CHANGE IN SENSE OF SMELL AND/"
116 D P Q:EX=U
117 W !," OR TASTE....................: ",$$GET1^DIQ(165.5,IE,1222)
118 D P Q:EX=U
119 W !," ALTERED ALERTNESS............: ",$$GET1^DIQ(165.5,IE,1223)
120 D P Q:EX=U
121 W !," FATIGUE......................: ",$$GET1^DIQ(165.5,IE,1224)
122 D P Q:EX=U
123 W !," SPEECH DISTURBANCE...........: ",$$GET1^DIQ(165.5,IE,1225)
124 D P Q:EX=U
125 W !," PERSONALITY CHANGES..........: ",$$GET1^DIQ(165.5,IE,1226)
126 D P Q:EX=U
127 W !," DEPRESSION...................: ",$$GET1^DIQ(165.5,IE,1227)
128 D P Q:EX=U
129 W !," MEMORY LOSS..................: ",$$GET1^DIQ(165.5,IE,1228)
130 D P Q:EX=U
131 W !," LACK OF CONCENTRATION........: ",$$GET1^DIQ(165.5,IE,1229)
132 D P Q:EX=U
133 W !," DOUBLE VISION................: ",$$GET1^DIQ(165.5,IE,1230)
134 D P Q:EX=U
135 W !," OTHER VISUAL DISTURBANCE.....: ",$$GET1^DIQ(165.5,IE,1231)
136 D P Q:EX=U
137 W !," DECREASED HEARING............: ",$$GET1^DIQ(165.5,IE,1232)
138 D P Q:EX=U
139 W !," VERTIGO......................: ",$$GET1^DIQ(165.5,IE,1233)
140 D P Q:EX=U
141 W !," TINNITUS.....................: ",$$GET1^DIQ(165.5,IE,1234)
142 D P Q:EX=U
143 W !," NUMBNESS/TINGLING............: ",$$GET1^DIQ(165.5,IE,1235)
144 D P Q:EX=U
145 W !," WEAKNESS OR PARALYSIS........: ",$$GET1^DIQ(165.5,IE,1236)
146 D P Q:EX=U
147 W !," DIFFICULTY IN COORDINATION/"
148 D P Q:EX=U
149 W !," BALANCE.....................: ",$$GET1^DIQ(165.5,IE,1237)
150 D P Q:EX=U
151 W !," GENERALIZED SEIZURE..........: ",$$GET1^DIQ(165.5,IE,1238)
152 D P Q:EX=U
153 W !," FOCAL SEIZURE................: ",$$GET1^DIQ(165.5,IE,1239)
154 D P Q:EX=U
155 W !," BLADDER INCONTINENCE.........: ",$$GET1^DIQ(165.5,IE,1240)
156 D P Q:EX=U
157 W !," BOWEL INCONTINENCE...........: ",$$GET1^DIQ(165.5,IE,1241)
158 D P Q:EX=U
159 W !," PAIN (OTHER THAN HEADACHE)...: ",$$GET1^DIQ(165.5,IE,1242)
160 D P Q:EX=U
161 W !," WEIGHT CHANGE................: ",$$GET1^DIQ(165.5,IE,1243)
162 D P Q:EX=U
163 W !," OTHER........................: ",$$GET1^DIQ(165.5,IE,1244)
164 D P Q:EX=U
165 W !
166 D P Q:EX=U
167 D:IOST?1"C".E HEAD^ONCIPC0 D ^ONCIPC8A
168KILL ;Kill variables
169 K EX,IE,LIN,ONDATE,X,Y
170 Q
171P ;Print
172 I ($Y'<(LIN-1)) D Q:EX=U
173 .I IOST?1"C".E W ! K DIR S DIR(0)="E" D ^DIR I 'Y S EX=U Q
174 .D HEAD^ONCIPC0 Q
175 Q
176TASK ;Queue a task
177 K IO("Q"),ZTUCI,ZTDTH,ZTIO,ZTSAVE
178 S ZTRTN="PRT^ONCIPC8",ZTREQ="@",ZTSAVE("ZTREQ")=""
179 S ZTDESC="Print Intracranial & CNS PCE"
180 F V2=1:1 S V1=$P(ONCOLST,"^",V2) Q:V1="" S ZTSAVE(V1)=""
181 D ^%ZTLOAD D ^%ZISC U IO W !,"Request Queued",!
182 K V1,V2,ONCOLST,ZTSK Q
Note: See TracBrowser for help on using the repository browser.