source: WorldVistAEHR/trunk/r/ONCOLOGY-ONC/ONCGPC7.m@ 1489

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

initial load of WorldVistAEHR
File size: 5.1 KB
Line 
1ONCGPC7 ;Hines OIFO/GWB - 2001 Gastric Cancers PCE Study ;04/16/01
2 ;;2.11;ONCOLOGY;**29**;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^ADENOCA^HIST1234^LYMPHOMA" 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 S HIST=$$HIST^ONCFUNC(ONCONUM)
9 S HIST1234=$E(HIST,1,4),BEH=$E(HIST,5)
10 S ADENOCA=0,LYMPHOMA=0
11 I (HIST1234>8139)&(HIST1234<8577) S ADENOCA=1 ;Adenocarcinomas
12 I HIST1234=8941 S ADENOCA=1 ;Adenocarcinoma
13 I (HIST1234>9589)&(HIST1234<9730) S LYMPHOMA=1 ;Lymphomas
14 S CMC=$$GET1^DIQ(165.5,IE,1400.6) ;GAS CO-MORBID CONDITIONS Y/N
15 S TC=$$GET1^DIQ(165.5,IE,1426.5) ;LNG COMPLICATIONS Y/N
16 K LINE S $P(LINE,"-",40)="-"
17I S TABLE="PATIENT INFORMATION"
18 D HEAD^ONCGPC0
19 K LINE S $P(LINE,"-",19)="-"
20 W !?4,TABLE,!?4,LINE
21ITEM1 W !," 1. CO-MORBID CONDITIONS:"
22 D P Q:EX=U
23 I CMC="No" D G CMC2
24 .W !," CO-MORBID CONDITION #1.......: 000.00 No co-morbidities"
25 W !," CO-MORBID CONDITION #1.......: ",$P($$GET1^DIQ(165.5,IE,1571)," ",1),?43,$P($$GET1^DIQ(165.5,IE,1571)," ",2,99)
26CMC2 D P Q:EX=U
27 W !," CO-MORBID CONDITION #2.......: ",$P($$GET1^DIQ(165.5,IE,1571.1)," ",1),?43,$P($$GET1^DIQ(165.5,IE,1571.1)," ",2,99)
28 D P Q:EX=U
29 W !," CO-MORBID CONDITION #3.......: ",$P($$GET1^DIQ(165.5,IE,1571.2)," ",1),?43,$P($$GET1^DIQ(165.5,IE,1571.2)," ",2,99)
30 D P Q:EX=U
31 W !," CO-MORBID CONDITION #4.......: ",$P($$GET1^DIQ(165.5,IE,1571.3)," ",1),?43,$P($$GET1^DIQ(165.5,IE,1571.3)," ",2,99)
32 D P Q:EX=U
33 W !," CO-MORBID CONDITION #5.......: ",$P($$GET1^DIQ(165.5,IE,1571.4)," ",1),?43,$P($$GET1^DIQ(165.5,IE,1571.4)," ",2,99)
34 D P Q:EX=U
35 W !," CO-MORBID CONDITION #6.......: ",$P($$GET1^DIQ(165.5,IE,1571.5)," ",1),?43,$P($$GET1^DIQ(165.5,IE,1571.5)," ",2,99)
36 D P Q:EX=U
37 W !
38 D P Q:EX=U
39ITEM2 W !," 2. PRIOR EXPOSURE TO RADIATION...: ",$$GET1^DIQ(165.5,IE,1500)
40 W !
41 D P Q:EX=U
42ITEM3 W !," 3. ALCOHOL CONSUMPTION...........: ",$$GET1^DIQ(165.5,IE,1501)
43 D P Q:EX=U
44 W !
45 D P Q:EX=U
46ITEM4 W !," 4. DURATION OF TOBACCO USE.......: ",$$GET1^DIQ(165.5,IE,1572)
47 D P Q:EX=U
48 W !
49 D P Q:EX=U
50ITEM5 W !," 5. MENOPAUSAL STATUS AND HORMONE"
51 D P Q:EX=U
52 W !," REPLACEMENT THERAPY..........: ",$$GET1^DIQ(165.5,IE,1502)
53 D P Q:EX=U
54 W !
55 D P Q:EX=U
56ITEM6 W !," 6. H2/BLOCKER PROTON PUMP"
57 D P Q:EX=U
58 W !," INHIBITOR....................: ",$$GET1^DIQ(165.5,IE,1503)
59 D P Q:EX=U
60 W !
61 D P Q:EX=U
62ITEM7 W !," 7. FAMILY HISTORY OF GASTRIC"
63 D P Q:EX=U
64 W !," CANCER.......................: ",$$GET1^DIQ(165.5,IE,1504)
65 W !
66 D P Q:EX=U
67ITEM8 W !," 8. PERSONAL HISTORY OF OTHER"
68 D P Q:EX=U
69 W !," INVASIVE MALIGNANCIES PRIOR"
70 D P Q:EX=U
71 W !," TO THIS CANCER DIAGNOSIS....: ",$$GET1^DIQ(165.5,IE,1573)
72 I IOST?1"C".E W ! K DIR S DIR(0)="E" D ^DIR Q:'Y D HEAD^ONCGPC0 G ITEM9
73 W !
74 D P Q:EX=U
75ITEM9 W !," 9. ASSOCIATED BENIGN CONDITIONS:"
76 D P Q:EX=U
77 W !," H-PYLORI INECTION............: ",$$GET1^DIQ(165.5,IE,1505)
78 D P Q:EX=U
79 W !," DUODENAL ULCER...............: ",$$GET1^DIQ(165.5,IE,1506)
80 D P Q:EX=U
81 W !," GASTRIC ULCER................: ",$$GET1^DIQ(165.5,IE,1507)
82 D P Q:EX=U
83 W !," HEARTBURN....................: ",$$GET1^DIQ(165.5,IE,1508)
84 D P Q:EX=U
85 W !," PERNICIOUS ANEMIA............: ",$$GET1^DIQ(165.5,IE,1509)
86 D P Q:EX=U
87 W !," POLYPS OF STOMACH............: ",$$GET1^DIQ(165.5,IE,1510)
88 D P Q:EX=U
89 W !," POLYPOSIS OF SMALL OR LARGE"
90 D P Q:EX=U
91 W !," BOWEL.......................: ",$$GET1^DIQ(165.5,IE,1511)
92 D P Q:EX=U
93 W !," BARRETT'S ESOPHAGUS..........: ",$$GET1^DIQ(165.5,IE,1512)
94 D P Q:EX=U
95 W !," ATROPHIC GASTRITIS...........: ",$$GET1^DIQ(165.5,IE,1513)
96 D P Q:EX=U
97 W !," GASTRIC METAPLASIA...........: ",$$GET1^DIQ(165.5,IE,1514)
98 I IOST?1"C".E W ! K DIR S DIR(0)="E" D ^DIR Q:'Y D HEAD^ONCGPC0 G ITEM10
99 W !
100 D P Q:EX=U
101ITEM10 W !,"10. H-PYLORI DRUGS GIVEN:"
102 D P Q:EX=U
103 W !," ANTIBIOTICS..................: ",$$GET1^DIQ(165.5,IE,1515)
104 D P Q:EX=U
105 W !," PROTON PUMP INHIBITORS.......: ",$$GET1^DIQ(165.5,IE,1516)
106 D P Q:EX=U
107 W !," H2 BLOCKERS..................: ",$$GET1^DIQ(165.5,IE,1517)
108 D P Q:EX=U
109 W !," BISMUTH COMPOUNDS............: ",$$GET1^DIQ(165.5,IE,1518)
110 D P Q:EX=U
111 W !
112 D P Q:EX=U
113ITEM11 W !,"11. PRIOR INTRA-ABDOMINAL SURGERY.: ",$$GET1^DIQ(165.5,IE,1519)
114 D P Q:EX=U
115 W !
116 D P Q:EX=U
117ITEM12 W !,"12. YEAR OF PRIOR GASTRIC"
118 D P Q:EX=U
119 W !," RESECTION....................: ",$$GET1^DIQ(165.5,IE,1520)
120 D P Q:EX=U
121 I IOST?1"C".E W ! K DIR S DIR(0)="E" D ^DIR Q:'Y
122 I IOST?1"C".E D HEAD^ONCGPC0
123 D ^ONCGPC7A
124KILL ;
125 K CS,CSDAT,CSI,CSPNT,DESC,DESC1,DESC2,DLC,DOFCT
126 K EX,IE,LIN,LINE,LOS,NOP,ONCOLST,TABLE
127 K %,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
128 Q
129P ;Print
130 I ($Y'<(LIN-1)) D Q:EX=U
131 .I IOST?1"C".E W ! K DIR S DIR(0)="E" D ^DIR I 'Y S EX=U Q
132 .D HEAD^ONCGPC0 Q
133 Q
134TASK ;Queue a task
135 K IO("Q"),ZTUCI,ZTDTH,ZTIO,ZTSAVE
136 S ZTRTN="PRT^ONCGPC7",ZTREQ="@",ZTSAVE("ZTREQ")=""
137 S ZTDESC="Print Gastric Cancers PCE"
138 F V2=1:1 S V1=$P(ONCOLST,"^",V2) Q:V1="" S ZTSAVE(V1)=""
139 D ^%ZTLOAD D ^%ZISC U IO W !,"Request Queued",!
140 K V1,V2,ONCOLST,ZTSK Q
Note: See TracBrowser for help on using the repository browser.