source: WorldVistAEHR/trunk/r/ONCOLOGY-ONC/ONCLPC1.m@ 846

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

initial load of WorldVistAEHR
File size: 4.0 KB
RevLine 
[613]1ONCLPC1 ;Hines OIFO/GWB - 2001 Lung (NSCLC) Cancers PCE Study ;05/04/01
2 ;;2.11;ONCOLOGY;**29**;Mar 07, 1995
3 ;Patient Information
4 S DIE="^ONCO(165.5,",DA=ONCONUM,DR=""
5 W @IOF D HEAD^ONCLPC0
6 W !," PATIENT INFORMATION"
7 W !," -------------------"
8 S DR(1,165.5,1)="1400.6 1. CO-MORBID CONDITIONS (YES/NO)."
9 S DR(1,165.5,2)="I $G(X)=0 D CC1^ONCLPC1,CC2^ONCLPC1,CC3^ONCLPC1,CC4^ONCLPC1,CC5^ONCLPC1,CC6^ONCLPC1 S Y=1401"
10 S DR(1,165.5,3)="1400 CO-MORBID CONDITION #1......."
11 S DR(1,165.5,4)="I ($G(X)="""")&($P($G(^ONCO(165.5,DA,""LUN1"")),U,76)=1) D ITEM1ED^ONCLPC1 S Y=1400"
12 S DR(1,165.5,5)="1400.1 CO-MORBID CONDITION #2......."
13 S DR(1,165.5,6)="I $G(X)="""" D CC3^ONCLPC1,CC4^ONCLPC1,CC5^ONCLPC1,CC6^ONCLPC1 S Y=1401"
14 S DR(1,165.5,7)="1400.2 CO-MORBID CONDITION #3......."
15 S DR(1,165.5,8)="I $G(X)="""" D CC4^ONCLPC1,CC5^ONCLPC1,CC6^ONCLPC1 S Y=1401"
16 S DR(1,165.5,9)="1400.3 CO-MORBID CONDITION #4......."
17 S DR(1,165.5,10)="I $G(X)="""" D CC5^ONCLPC1,CC6^ONCLPC1 S Y=1401"
18 S DR(1,165.5,11)="1400.4 CO-MORBID CONDITION #5......."
19 S DR(1,165.5,12)="I $G(X)="""" D CC6^ONCLPC1 S Y=1401"
20 S DR(1,165.5,13)="1400.5 CO-MORBID CONDITION #6......."
21 S DR(1,165.5,14)="W !"
22 S DR(1,165.5,15)="1401 2. DURATION OF TOBACCO USE......."
23 S DR(1,165.5,16)="W !"
24 S DR(1,165.5,17)="S DEF="""" D ITEM3^ONCLPC1 K DEF"
25 S DR(1,165.5,18)="1403 3. PERSONAL HISTORY OF OTHER INVASIVE MALIGNANCIES PRIOR TO THIS CANCER DIAGNOSIS....//^S X=PHDEF"
26 D ^DIE
27 W !
28 K DIR S DIR(0)="E" D ^DIR S:$D(DIRUT) OUT="Y"
29EXIT K DIC,DR,DA,DIQ,DIE,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
30 Q
31ITEM1ED ;ITEM 1 EDIT
32 W !
33 W !," CO-MORBID CONDITIONS (YES/NO) equals ""Yes"""
34 W !," CO-MORBID CONDITION #1 may not be blank"
35 W !
36 Q
37CC1 S $P(^ONCO(165.5,D0,"LUN1"),U,1)=""
38 W !," CO-MORBID CONDITION #1.......: 000.00 No co-morbidities"
39 Q
40CC2 S $P(^ONCO(165.5,D0,"LUN1"),U,2)=""
41 W !," CO-MORBID CONDITION #2.......:"
42 Q
43CC3 S $P(^ONCO(165.5,D0,"LUN1"),U,3)=""
44 W !," CO-MORBID CONDITION #3.......:"
45 Q
46CC4 S $P(^ONCO(165.5,D0,"LUN1"),U,4)=""
47 W !," CO-MORBID CONDITION #4.......:"
48 Q
49CC5 S $P(^ONCO(165.5,D0,"LUN1"),U,5)=""
50 W !," CO-MORBID CONDITION #5.......:"
51 Q
52CC6 S $P(^ONCO(165.5,D0,"LUN1"),U,6)=""
53 W !," CO-MORBID CONDITION #6.......:"
54 W !
55 Q
56ITEM3 ;PERSONAL HISTORY OF OTHER INVASIVE MALIGNANCIES PRIOR TO THIS CANCER
57 ;DIAGNOSIS and Item 8 of the 2001 Gastric Cancers PCE Study
58 ;(165.5,1403) and (165.5,1573)
59 ;XECUTABLE 'HELP'
60 N PHOM,PATIEN,PRIMIEN,PHOMDTXI,PHOMDTXE,PHOMTOP,PNUM,PHDTDX,PHLAST
61 S PATIEN=$P(^ONCO(165.5,D0,0),U,2),PRIMIEN=""
62 F S PRIMIEN=$O(^ONCO(165.5,"C",PATIEN,PRIMIEN)) Q:PRIMIEN'>0 I $P($G(^ONCO(165.5,PRIMIEN,"DIV")),U,1)=DUZ(2) D
63 .Q:PRIMIEN=D0
64 .S PHODTXI=$$GET1^DIQ(165.5,PRIMIEN,3,"I")
65 .S PHODTXE=$$GET1^DIQ(165.5,PRIMIEN,3,"E")
66 .S PHOMTOP=$$GET1^DIQ(165.5,PRIMIEN,20.1)
67 .Q:(PHODTXI="")!(PHOMTOP="")
68 .S PHOM(PHODTXI)=PHODTXE_U_PHOMTOP
69 I $D(DEF) D Q
70 .I '$D(PHOM) S PHDEF="C88.8" Q
71 .S PHDTDX="",PHLAST=$O(PHOM(PHDTDX),-1),PHDEF=$P(PHOM(PHLAST),U,2) Q
72 W !?3,"This item describes the patient's prior history of other invasive"
73 W !?3,"malignancies. If the patient has a history of other malignancies"
74 W !?3,"report the ICD-O-3 site code for the most recently diagnosed disease."
75 W !?3,"If the patient has no personal history of other cancer, code C88.8. If"
76 W !?3,"the patient's personal history of other invasive malignancies is not"
77 W !?3,"documented, code C99.9."
78 W !
79 W !?3,"Allowable Codes: C00.0 thru C80.9 - valid ICD-0-3 site (topography) codes"
80 W !?3," C88.8 - no personal history of other cancer"
81 W !?3," C99.9 - personal history of other cancer not documented"
82 W !
83 I '$D(PHOM) W !?3,"This patient has no other primaries." G ITEM3EX
84 W !?3,"Other primaries for this patient:",!
85 W !?3,"Date DX"
86 W !?3,"-----------------"
87 S PNUM="" F S PNUM=$O(PHOM(PNUM)) Q:PNUM'>0 D
88 .W !?3,$P(PHOM(PNUM),U,1),?15,$P(PHOM(PNUM),U,2)
89ITEM3EX W ! K DIR S DIR(0)="E" D ^DIR S:$D(DIRUT) OUT="Y"
90 Q
Note: See TracBrowser for help on using the repository browser.