source: WorldVistAEHR/trunk/r/ONCOLOGY-ONC/ONCLPC9.m@ 814

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

initial load of WorldVistAEHR
File size: 4.2 KB
RevLine 
[613]1ONCLPC9 ;Hines OIFO/GWB - 2001 Lung (NSCLC) PCE Study ;05/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" 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 CMC=$$GET1^DIQ(165.5,IE,1400.6) ;LNG CO-MORBID CONDITIONS Y/N
9 S TC=$$GET1^DIQ(165.5,IE,1426.5) ;LNG TREATMENT COMPLICATIONS Y/N
10 K LINE S $P(LINE,"-",40)="-"
11I S TABLE="PATIENT INFORMATION"
12 D HEAD^ONCLPC0
13 K LINE S $P(LINE,"-",19)="-"
14 W !?4,TABLE,!?4,LINE
15ITEM1 W !," 1. CO-MORBID CONDITIONS:"
16 D P Q:EX=U
17 I CMC="No" D G CMC2
18 .W !," CO-MORBID CONDITION #1.......: 000.00 No co-morbidities"
19 W !," CO-MORBID CONDITION #1.......: ",$P($$GET1^DIQ(165.5,IE,1400)," ",1),?44,$P($$GET1^DIQ(165.5,IE,1400)," ",2,99)
20CMC2 D P Q:EX=U
21 W !," CO-MORBID CONDITION #2.......: ",$P($$GET1^DIQ(165.5,IE,1400.1)," ",1),?44,$P($$GET1^DIQ(165.5,IE,1400.1)," ",2,99)
22 D P Q:EX=U
23 W !," CO-MORBID CONDITION #3.......: ",$P($$GET1^DIQ(165.5,IE,1400.2)," ",1),?44,$P($$GET1^DIQ(165.5,IE,1400.2)," ",2,99)
24 D P Q:EX=U
25 W !," CO-MORBID CONDITION #4.......: ",$P($$GET1^DIQ(165.5,IE,1400.3)," ",1),?44,$P($$GET1^DIQ(165.5,IE,1400.3)," ",2,99)
26 D P Q:EX=U
27 W !," CO-MORBID CONDITION #5.......: ",$P($$GET1^DIQ(165.5,IE,1400.4)," ",1),?44,$P($$GET1^DIQ(165.5,IE,1400.4)," ",2,99)
28 D P Q:EX=U
29 W !," CO-MORBID CONDITION #6.......: ",$P($$GET1^DIQ(165.5,IE,1400.5)," ",1),?44,$P($$GET1^DIQ(165.5,IE,1400.5)," ",2,99)
30 D P Q:EX=U
31 W !
32 D P Q:EX=U
33ITEM2 W !," 2. DURATION OF TOBACCO USE.......: ",$$GET1^DIQ(165.5,IE,1401)
34 D P Q:EX=U
35 W !
36 D P Q:EX=U
37ITEM3 W !," 3. PERSONAL HISTORY OF OTHER"
38 D P Q:EX=U
39 W !," INVASIVE MALIGNANCIES PRIOR"
40 D P Q:EX=U
41 W !," TO THIS CANCER DIAGNOSIS....: ",$$GET1^DIQ(165.5,IE,1403)
42 I IOST?1"C".E W ! K DIR S DIR(0)="E" D ^DIR Q:'Y D HEAD^ONCLPC0 G II
43 D P Q:EX=U
44II S TABLE="TUMOR IDENTIFICATION AND DIAGNOSIS"
45 I IOST'?1"C".E W ! I ($Y'<(LIN-4)) D HEAD^ONCLPC0
46 K LINE S $P(LINE,"-",34)="-"
47 W !?4,TABLE,!?4,LINE
48 D P Q:EX=U
49ITEM4 W !," 4. SYMPTOMS PRESENT AT INITIAL DIAGNOSIS:"
50 D P Q:EX=U
51 W !," COUGH........................: ",$$GET1^DIQ(165.5,IE,1404)
52 D P Q:EX=U
53 W !," SHORTNESS OF BREATH..........: ",$$GET1^DIQ(165.5,IE,1404.1)
54 D P Q:EX=U
55 W !," WEIGHT LOSS..................: ",$$GET1^DIQ(165.5,IE,1404.2)
56 D P Q:EX=U
57 W !," HEMOPTYSIS...................: ",$$GET1^DIQ(165.5,IE,1404.3)
58 D P Q:EX=U
59 W !," PALPABLE LYMPH NODES.........: ",$$GET1^DIQ(165.5,IE,1404.4)
60 D P Q:EX=U
61 W !
62 D P Q:EX=U
63ITEM5 W !," 5. SCREENING FOR HIGH RISK/ASYMPTOMATIC PRESENTATION:"
64 D P Q:EX=U
65 W !," CHEST X-RAY..................: ",$$GET1^DIQ(165.5,IE,1405)
66 D P Q:EX=U
67 W !," CT SCAN......................: ",$$GET1^DIQ(165.5,IE,1405.1)
68 D P Q:EX=U
69 W !," BRONCHOSCOPY.................: ",$$GET1^DIQ(165.5,IE,1405.2)
70 D P Q:EX=U
71 I IOST?1"C".E W ! K DIR S DIR(0)="E" D ^DIR Q:'Y D HEAD^ONCLPC0 G ITEM6
72 W !
73 D P Q:EX=U
74ITEM6 W !," 6. INITIAL DIAGNOSTIC STUDIES (PRE-THERAPY):"
75 D P Q:EX=U
76 W !," HISTORY AND PHYSICAL.........: ",$$GET1^DIQ(165.5,IE,1406)
77 D P Q:EX=U
78 W !," BRONCHOSCOPY.................: ",$$GET1^DIQ(165.5,IE,1406.1)
79 D P Q:EX=U
80 W !," FNAB.........................: ",$$GET1^DIQ(165.5,IE,1406.2)
81 D P Q:EX=U
82 W !," MEDIASTINOSCOPY..............: ",$$GET1^DIQ(165.5,IE,1406.3)
83 D P Q:EX=U
84 W !," THOROCOTOMY/OPEN BIOSPY......: ",$$GET1^DIQ(165.5,IE,1406.4)
85 D P Q:EX=U
86 W !," VATS.........................: ",$$GET1^DIQ(165.5,IE,1406.5)
87 D P Q:EX=U
88 I IOST?1"C".E W ! K DIR S DIR(0)="E" D ^DIR Q:'Y
89 I IOST?1"C".E D HEAD^ONCLPC0
90 D ^ONCLPC9A
91KILL ;
92 K CS,CSDAT,CSI,CSPNT,DESC,DESC1,DESC2,DLC,DOFCT
93 K EX,IE,LIN,LINE,LOS,NOP,ONCOLST,TABLE
94 K %,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
95 Q
96P ;Print
97 I ($Y'<(LIN-1)) D Q:EX=U
98 .I IOST?1"C".E W ! K DIR S DIR(0)="E" D ^DIR I 'Y S EX=U Q
99 .D HEAD^ONCLPC0 Q
100 Q
101TASK ;Queue a task
102 K IO("Q"),ZTUCI,ZTDTH,ZTIO,ZTSAVE
103 S ZTRTN="PRT^ONCLPC9",ZTREQ="@",ZTSAVE("ZTREQ")=""
104 S ZTDESC="Print Lung (NSCLC) PCE"
105 F V2=1:1 S V1=$P(ONCOLST,"^",V2) Q:V1="" S ZTSAVE(V1)=""
106 D ^%ZTLOAD D ^%ZISC U IO W !,"Request Queued",!
107 K V1,V2,ONCOLST,ZTSK Q
Note: See TracBrowser for help on using the repository browser.