source: WorldVistAEHR/trunk/r/ONCOLOGY-ONC/ONCHPC8.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: 7.7 KB
RevLine 
[613]1ONCHPC8 ;Hines OIFO/GWB - 2000 Hepatocellular Cancers PCE Study ;01/12/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 S TABLE="PATIENT INFORMATION"
12 D HEAD^ONCHPC0
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 DIAGNOIS.....: ",$$GET1^DIQ(165.5,IE,9)
23 D P Q:EX=U
24 W !," 5. PLACE OF BIRTH..............: ",$$GET1^DIQ(160,ONCOPA,7)
25 D P Q:EX=U
26 W !," 6. DATE OF BIRTH...............: ",DOB
27 D P Q:EX=U
28 W !," 7. RACE........................: ",$$GET1^DIQ(165.5,IE,.12)
29 D P Q:EX=U
30 W !," 8. SPANISH ORIGIN..............: ",$$GET1^DIQ(160,ONCOPA,9)
31 D P Q:EX=U
32 W !," 9. SEX.........................: ",$$GET1^DIQ(160,ONCOPA,10)
33 D P Q:EX=U
34 W !,"10. PRIMARY PAYER AT DIAGNOSIS..: ",$$GET1^DIQ(165.5,IE,18)
35 D P Q:EX=U
36 I IOST?1"C".E W ! K DIR S DIR(0)="E" D ^DIR Q:'Y D HEAD^ONCHPC0 G II
37 D P Q:EX=U
38II S TABLE="TUMOR IDENTIFICATION"
39 I IOST'?1"C".E W ! I ($Y'<(LIN-4)) D HEAD^ONCHPC0
40 K LINE S $P(LINE,"-",20)="-"
41 W !?4,TABLE,!?4,LINE
42 D P Q:EX=U
43 W !,"11. CLASS OF CASE...............: ",$$GET1^DIQ(165.5,IE,.04)
44 D P Q:EX=U
45 W !
46 D P Q:EX=U
47 W !,"12. HORMONES:"
48 D P Q:EX=U
49 W !," ORAL CONTRACEPTIVES........: ",$$GET1^DIQ(165.5,IE,1000)
50 D P Q:EX=U
51 W !," ESTROGEN REPLACEMENT.......: ",$$GET1^DIQ(165.5,IE,1001)
52 D P Q:EX=U
53 W !," TAMOXIFEN..................: ",$$GET1^DIQ(165.5,IE,1002)
54 D P Q:EX=U
55 W !," OTHER......................: ",$$GET1^DIQ(165.5,IE,1003)
56 D P Q:EX=U
57 W !
58 D P Q:EX=U
59 W !,"13. CONDITIONS PRESENT AT INITIAL DIAGNOSIS:"
60 D P Q:EX=U
61 W !," ASCITES....................: ",$$GET1^DIQ(165.5,IE,1004)
62 D P Q:EX=U
63 W !," CIRRHOSIS..................: ",$$GET1^DIQ(165.5,IE,1005)
64 D P Q:EX=U
65 W !," CHILD'S CLASS A............: ",$$GET1^DIQ(165.5,IE,1006)
66 D P Q:EX=U
67 W !," CHILD'S CLASS B............: ",$$GET1^DIQ(165.5,IE,1007)
68 D P Q:EX=U
69 W !," CHILD'S CLASS C............: ",$$GET1^DIQ(165.5,IE,1008)
70 D P Q:EX=U
71 W !," HEPATITIS B................: ",$$GET1^DIQ(165.5,IE,1009)
72 D P Q:EX=U
73 W !," HEPATITIS C................: ",$$GET1^DIQ(165.5,IE,1010)
74 D P Q:EX=U
75 W !," HEMOCHROMATOSIS............: ",$$GET1^DIQ(165.5,IE,1011)
76 D P Q:EX=U
77 W !
78 D P Q:EX=U
79 W !,"14. ALCOHOL CONSUMPTION.........: ",$$GET1^DIQ(165.5,IE,1012)
80 D P Q:EX=U
81 W !
82 D P Q:EX=U
83 W !,"15. TUMOR MARKERS:"
84 D P Q:EX=U
85 W !," AFP (IU/ml)................: ",$$GET1^DIQ(165.5,IE,1013)
86 D P Q:EX=U
87 W !," CEA (mg/ml)................: ",$$GET1^DIQ(165.5,IE,1014)
88 D P Q:EX=U
89 W !," CA 19.9 (U/ml).............: ",$$GET1^DIQ(165.5,IE,1015)
90 D P Q:EX=U
91 W !
92 D P Q:EX=U
93 W !,"16. TESTS RELATED TO LIVER FUNCTION:"
94 D P Q:EX=U
95 W !," PROTIME (sec)..............: ",$$GET1^DIQ(165.5,IE,1016)
96 D P Q:EX=U
97 W !," BILIRUBIN (mg/ml)..........: ",$$GET1^DIQ(165.5,IE,1017)
98 D P Q:EX=U
99 W !," ALBUMIN (g/dl).............: ",$$GET1^DIQ(165.5,IE,1018)
100 D P Q:EX=U
101 W !," LDH (U/l)..................: ",$$GET1^DIQ(165.5,IE,1019)
102 D P Q:EX=U
103 W !
104 D P Q:EX=U
105 W !,"17. RADIOLOGICAL EVALUATION"
106 D P Q:EX=U
107 W !
108 D P Q:EX=U
109 W !," CT ARTERIAL PORTOGRAPHY:"
110 D P Q:EX=U
111 W !," PERFORMED..................: ",$$GET1^DIQ(165.5,IE,1020)
112 D P Q:EX=U
113 W !," CIRRHOSIS..................: ",$$GET1^DIQ(165.5,IE,1021)
114 D P Q:EX=U
115 W !," VASCULAR INVASTION.........: ",$$GET1^DIQ(165.5,IE,1022)
116 D P Q:EX=U
117 W !," BILOBAR DISEASE............: ",$$GET1^DIQ(165.5,IE,1023)
118 D P Q:EX=U
119 W !," LYMPH NODES................: ",$$GET1^DIQ(165.5,IE,1024)
120 D P Q:EX=U
121 W !," SIZE OF DOMINANT TUMOR (MM): ",$$GET1^DIQ(165.5,IE,1025)
122 D P Q:EX=U
123 W !," NUMBER OF TUMORS...........: ",$$GET1^DIQ(165.5,IE,1026)
124 D P Q:EX=U
125 W !
126 D P Q:EX=U
127 W !," SPIRAL CT:"
128 D P Q:EX=U
129 W !," PERFORMED..................: ",$$GET1^DIQ(165.5,IE,1027)
130 D P Q:EX=U
131 W !," CIRRHOSIS..................: ",$$GET1^DIQ(165.5,IE,1028)
132 D P Q:EX=U
133 W !," VASCULAR INVASTION.........: ",$$GET1^DIQ(165.5,IE,1029)
134 D P Q:EX=U
135 W !," BILOBAR DISEASE............: ",$$GET1^DIQ(165.5,IE,1030)
136 D P Q:EX=U
137 W !," LYMPH NODES................: ",$$GET1^DIQ(165.5,IE,1031)
138 D P Q:EX=U
139 W !," SIZE OF DOMINANT TUMOR (MM): ",$$GET1^DIQ(165.5,IE,1032)
140 D P Q:EX=U
141 W !," NUMBER OF TUMORS...........: ",$$GET1^DIQ(165.5,IE,1033)
142 D P Q:EX=U
143 W !
144 D P Q:EX=U
145 W !," INCREMENTAL CT:"
146 D P Q:EX=U
147 W !," PERFORMED..................: ",$$GET1^DIQ(165.5,IE,1034)
148 D P Q:EX=U
149 W !," CIRRHOSIS..................: ",$$GET1^DIQ(165.5,IE,1035)
150 D P Q:EX=U
151 W !," VASCULAR INVASTION.........: ",$$GET1^DIQ(165.5,IE,1036)
152 D P Q:EX=U
153 W !," BILOBAR DISEASE............: ",$$GET1^DIQ(165.5,IE,1037)
154 D P Q:EX=U
155 W !," LYMPH NODES................: ",$$GET1^DIQ(165.5,IE,1038)
156 D P Q:EX=U
157 W !," SIZE OF DOMINANT TUMOR (MM): ",$$GET1^DIQ(165.5,IE,1039)
158 D P Q:EX=U
159 W !," NUMBER OF TUMORS...........: ",$$GET1^DIQ(165.5,IE,1040)
160 D P Q:EX=U
161 W !
162 D P Q:EX=U
163 W !," ULTRASOUND:"
164 D P Q:EX=U
165 W !," PERFORMED..................: ",$$GET1^DIQ(165.5,IE,1041)
166 D P Q:EX=U
167 W !," CIRRHOSIS..................: ",$$GET1^DIQ(165.5,IE,1042)
168 D P Q:EX=U
169 W !," VASCULAR INVASTION.........: ",$$GET1^DIQ(165.5,IE,1043)
170 D P Q:EX=U
171 W !," BILOBAR DISEASE............: ",$$GET1^DIQ(165.5,IE,1044)
172 D P Q:EX=U
173 W !," LYMPH NODES................: ",$$GET1^DIQ(165.5,IE,1045)
174 D P Q:EX=U
175 W !," SIZE OF DOMINANT TUMOR (MM): ",$$GET1^DIQ(165.5,IE,1046)
176 D P Q:EX=U
177 W !," NUMBER OF TUMORS...........: ",$$GET1^DIQ(165.5,IE,1047)
178 D P Q:EX=U
179 W !
180 D P Q:EX=U
181 W !," MRI:"
182 D P Q:EX=U
183 W !," PERFORMED..................: ",$$GET1^DIQ(165.5,IE,1048)
184 D P Q:EX=U
185 W !," CIRRHOSIS..................: ",$$GET1^DIQ(165.5,IE,1049)
186 D P Q:EX=U
187 W !," VASCULAR INVASTION.........: ",$$GET1^DIQ(165.5,IE,1050)
188 D P Q:EX=U
189 W !," BILOBAR DISEASE............: ",$$GET1^DIQ(165.5,IE,1051)
190 D P Q:EX=U
191 W !," LYMPH NODES................: ",$$GET1^DIQ(165.5,IE,1052)
192 D P Q:EX=U
193 W !," SIZE OF DOMINANT TUMOR (MM): ",$$GET1^DIQ(165.5,IE,1053)
194 D P Q:EX=U
195 W !," NUMBER OF TUMORS...........: ",$$GET1^DIQ(165.5,IE,1054)
196 D P Q:EX=U
197 W !
198 D P Q:EX=U
199 W !,"18. DEFINITIVE DIAGNOSIS........: ",$$GET1^DIQ(165.5,IE,1055)
200 D P Q:EX=U
201 W !,"19. DATE OF INITIAL DIAGNOSIS...: ",$$GET1^DIQ(165.5,IE,3)
202 D P Q:EX=U
203 W !,"20. HISTOLOGY (ICD-O-2).........: ",$E(HIST,1,4)
204 D P Q:EX=U
205 W !,"21. GRADE.......................: ",$$GET1^DIQ(165.5,IE,24)
206 D P Q:EX=U
207 W !,"22. DIAGNOSTIC CONFIRMATION.....: ",$$GET1^DIQ(165.5,IE,26)
208 I IOST?1"C".E W ! K DIR S DIR(0)="E" D ^DIR G:'Y KILL
209III D HEAD^ONCHPC0,^ONCHPC8A
210KILL ;
211 K CS,CSDAT,CSI,CSPNT,DESC,DESC1,DESC2,DLC,DOB,DOFCT
212 K EX,HIST,IE,LIN,LINE,LOS,NOP,ONDATE,ONCOLST,TABLE
213 K %,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
214 Q
215P ;Print
216 I ($Y'<(LIN-1)) D Q:EX=U W !?4,TABLE_" (continued)",!?4,LINE_"------------"
217 .I IOST?1"C".E W ! K DIR S DIR(0)="E" D ^DIR I 'Y S EX=U Q
218 .D HEAD^ONCHPC0 Q
219 Q
220TASK ;Queue a task
221 K IO("Q"),ZTUCI,ZTDTH,ZTIO,ZTSAVE
222 S ZTRTN="PRT^ONCHPC8",ZTREQ="@",ZTSAVE("ZTREQ")=""
223 S ZTDESC="Print Hepatocellular Cancer PCE"
224 F V2=1:1 S V1=$P(ONCOLST,"^",V2) Q:V1="" S ZTSAVE(V1)=""
225 D ^%ZTLOAD D ^%ZISC U IO W !,"Request Queued",!
226 K V1,V2,ONCOLST,ZTSK Q
Note: See TracBrowser for help on using the repository browser.