source: WorldVistAEHR/trunk/r/ONCOLOGY-ONC/ONCOPA3.m@ 1361

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

initial load of WorldVistAEHR
File size: 6.0 KB
RevLine 
[613]1ONCOPA3 ;Hines OIFO/GWB-[PA Print Complete Abstract (132c)]..continued ;05/30/00
2 ;;2.11;ONCOLOGY;**13,15,18,25,26,33,34,36,37,44,45,46,47**;Mar 07, 1995;Build 19
3 ;
4 S NAME="PERSONAL DATA" D FORMAT^ONCOPA1
5 W !!,TITLE
6 W !!?10," Address at Dx: ",ONCAB(165.5,IEN,8)
7 W !?10," Address at Dx - Supp: ",ONCAB(165.5,IEN,8.2)
8 W !?10," City/Town at Dx: ",ONCAB(165.5,IEN,8.1),?70," Place of Birth: ",ONCAB(160,PTIEN,7) D P Q:EX=U
9 W !?10," State at Dx: ",ONCAB(165.5,IEN,16),?70," Religion: ",$E(ONCAB(160,PTIEN,13),1,14) D P Q:EX=U
10 W !?10," Postal Code at Dx: ",ONCAB(165.5,IEN,9),?69,"Marital Status at Dx: ",ONCAB(165.5,IEN,11) D P Q:EX=U
11 W !?10," County at Dx: ",ONCAB(165.5,IEN,10),?70,"Primary Payer at Dx: ",ONCAB(165.5,IEN,18) D P Q:EX=U
12 W !?10," Telephone: ",ONCAB(160,PTIEN,.131)
13 S NOK=""
14 I $D(^ONCO(160,PTIEN,0)) S RCDT=$G(^ONCO(160,PTIEN,0)) I $P(RCDT,";",2)["DPT",$D(^DPT($P(RCDT,";",1),.21)) S NOK=$P(^(.21),U)_" ("_$P(^(.21),U,2)_")"
15 I ESPD=1 S NOK="XXXXX,XXXXX"
16 W ?70," Next of Kin: ",NOK D P Q:EX=U
17 W !?10," Abstract Status: ",ONCAB(165.5,IEN,91) D P Q:EX=U
18 W !?10," Date of First Contact: ",ONCAB(165.5,IEN,155) D P Q:EX=U
19 W !?10," Date Case Completed: ",ONCAB(165.5,IEN,90) D P Q:EX=U
20 W !?10,"Elapsed Days to Completion: ",ONCAB(165.5,IEN,157) D P Q:EX=U
21 W !?10," Abstracted by: ",ONCAB(165.5,IEN,92) D P Q:EX=U
22 W !
23 W !?1," Previous History of Cancer: ",ONCAB(165.5,IEN,148,"E") D P Q:EX=U
24 W !?1," Cancer #1: ",ONCAB(165.5,IEN,148.1,"E") D P Q:EX=U
25 W !?1," Cancer #2: ",ONCAB(165.5,IEN,148.2,"E") D P Q:EX=U
26 W !?1," Cancer #3: ",ONCAB(165.5,IEN,148.3,"E") D P Q:EX=U
27 W !?1," Cancer #4: ",ONCAB(165.5,IEN,148.4,"E") D P Q:EX=U
28 W !!?7,"Agent Orange Exposure: ",ONCAB(160,PTIEN,48) D P Q:EX=U
29 W !?1,"Ionizing Radiation Exposure: ",ONCAB(160,PTIEN,50) D P Q:EX=U
30 W !?1," Chemical Exposure: ",ONCAB(160,PTIEN,52) D P Q:EX=U
31 W !?1," Asbestos Exposure: ",ONCAB(160,PTIEN,61) D P Q:EX=U
32 W !?1," Persian Gulf Service: ",ONCAB(160,PTIEN,51) D P Q:EX=U
33 W !?1," Middle East Service: ",ONCAB(160,PTIEN,55) D P Q:EX=U
34 W !?1," Somalia Service: ",ONCAB(160,PTIEN,56) D P Q:EX=U
35 W !!?1,"Comorbidity/Complication 1: ",ONCAB(160,PTIEN,25) D P Q:EX=U
36 W !?1,"Comorbidity/Complication 2: ",ONCAB(160,PTIEN,25.1) D P Q:EX=U
37 W !?1,"Comorbidity/Complication 3: ",ONCAB(160,PTIEN,25.2) D P Q:EX=U
38 W !?1,"Comorbidity/Complication 4: ",ONCAB(160,PTIEN,25.3) D P Q:EX=U
39 W !?1,"Comorbidity/Complication 5: ",ONCAB(160,PTIEN,25.4) D P Q:EX=U
40 W !?1,"Comorbidity/Complication 6: ",ONCAB(160,PTIEN,25.5) D P Q:EX=U
41 W !?1,"Comorbidity/Complication 7: ",ONCAB(160,PTIEN,25.6) D P Q:EX=U
42 W !?1,"Comorbidity/Complication 8: ",ONCAB(160,PTIEN,25.7) D P Q:EX=U
43 W !?1,"Comorbidity/Complication 9: ",ONCAB(160,PTIEN,25.8) D P Q:EX=U
44 W !?1,"Comorbidity/Complication 10: ",ONCAB(160,PTIEN,25.9) D P Q:EX=U
45 S NAME="EMPLOYMENT HISTORY" D FORMAT^ONCOPA1
46 W !!,TITLE,!
47 I $D(^ONCO(160,PTIEN,7,0)) F OC=0:0 S OC=$O(^ONCO(160,PTIEN,7,OC)) Q:OC'>0 D
48 .S OCCP=$P($G(^ONCO(160,PTIEN,7,OC,0)),U,1) I OCCP="" Q
49 .W !," Occupation: ",$E($P($G(^LAB(61.6,OCCP,0)),U,1),1,24) D P Q:EX=U
50 .W !,"Usual Industry: ",$E($P($G(^ONCO(160,PTIEN,7,OC,0)),U,4),1,22) D P Q:EX=U
51 .W ! D P Q:EX=U
52 S NAME="TOBACCO AND ALCOHOL USAGE" D FORMAT^ONCOPA1
53 W !,TITLE
54 W !!?15," TOBACCO HISTORY: ",ONCAB(160,PTIEN,38) D P Q:EX=U
55 F TBHS=0:0 S TBHS=$O(^ONCO(160,PTIEN,5,TBHS)) Q:TBHS'>0 D
56 .S TBZN=$G(^ONCO(160,PTIEN,5,TBHS,0)) S TBTP=$P(TBZN,U,1) I TBTP="" Q
57 .W !?3,"Type of Tobacco User: ",$S(TBTP=1:"CIGARETTE",TBTP=2:"CIGARS",TBTP=3:"PIPE",TBTP=4:"CHEWING TOBACCO",TBTP=5:"SNUFF",TBTP=6:"MARIJUANA",TBTP=7:"MORE THAN 1 TYPE",TBTP=8:"UNKNOWN",1:"")
58 .W ?55,"Pack-Years: ",$S($P(TBZN,U,2)="U":"UNK",1:$P(TBZN,U,2))
59 .W ?77,"Year Quit Tobacco Use: " S Y=$P(TBZN,U,3) W:Y="U" "UNK" I +Y D DD^%DT W Y
60 .Q
61 W !!?15," ALCOHOL HISTORY: ",ONCAB(160,PTIEN,39) D P Q:EX=U
62 F ALHS=0:0 S ALHS=$O(^ONCO(160,PTIEN,6,ALHS)) Q:ALHS'>0 D
63 .S ALZN=$G(^ONCO(160,PTIEN,6,ALHS,0)) S ALTP=$P(ALZN,U,1) I ALTP="" Q
64 .W !?3,"Type of Alcohol User: ",$S(ALTP="B":"BEER",ALTP="W":"WINE",ALTP="H":"HARD LIQUOR",ALTP="M":"MODERATE/SOCIAL",ALTP="S":"SERIOUS/HEAVY",ALTP="U":"UNKNOWN",1:"")
65 .W ?45,"Years of Alcohol Use: ",$S($P(ALZN,U,2)="U":"UNK",1:$P(ALZN,U,2))
66 .W ?77,"Drinks Per Day: ",$S($P(ALZN,U,3)="U":"UNK",1:$P(ALZN,U,3))
67 .W ?100,"Year Quit Drinking: " S Y=$P(ALZN,U,4) W:Y="U" "UNK" I +Y D DD^%DT W Y
68 .Q
69 S CFH=ONCAB(160,PTIEN,43),NAME="CANCER FAMILY HISTORY: "_CFH
70 D FORMAT^ONCOPA1 W !!,TITLE,!
71 F CHST=0:0 S CHST=$O(ONCAB(160.044,CHST)) Q:CHST'>0 D
72 .W !," Family member with cancer: ",ONCAB(160.044,CHST,.01)
73 .W ?50," Cancer: ",ONCAB(160.044,CHST,1) D P Q:EX=U
74 .Q
75 S NAME="PHYSICIAN CONTACTS " D FORMAT^ONCOPA1
76 W !!,TITLE
77 I DATEDX>3061231 D
78 .W !," Managing Physician: ",ONCAB(165.5,IEN,2.2,"E") D P Q:EX=U
79 W !," Following Physician: ",ONCAB(165.5,IEN,2.1) D P Q:EX=U
80 W !," Primary Surgeon: ",ONCAB(165.5,IEN,2) D P Q:EX=U
81 W !," Physician #3: ",ONCAB(165.5,IEN,2.3) D P Q:EX=U
82 W !," Physician #4: ",ONCAB(165.5,IEN,2.4) D P Q:EX=U
83 W !!," QA Selected: ",ONCAB(165.5,IEN,62) D P Q:EX=U
84 W ?25," QA Reviewer: ",ONCAB(165.5,IEN,64.1) D P Q:EX=U
85 W ?75," QA Date: ",ONCAB(165.5,IEN,64) D P Q:EX=U
86 W ?100," QA Review: ",ONCAB(165.5,IEN,63) D P Q:EX=U
87 W !," QA Findings: " F TX=0:0 S TX=$O(^ONCO(165.5,IEN,28,TX)) Q:TX'>0 W !?6,^ONCO(165.5,IEN,28,TX,0) D P Q:EX=U
88 ;
89 I IOST?1"C".E W ! K DIR S DIR(0)="E",DIR("A")="Enter RETURN to continue with this abstract" D ^DIR Q:'Y D HDR G PA3A
90 D P Q:EX=U
91PA3A D ^ONCOPA3A
92 Q
93P ;
94 I ($Y'<(LINE-1)) D Q:EX=U W !
95 .I IOST?1"C".E W ! K DIR S DIR(0)="E",DIR("A")="Enter RETURN to continue with this abstract" D ^DIR I 'Y S EX=U Q
96 .D HDR Q
97 Q
98HDR ; Header
99 W @IOF S PG=PG+1
100 W CRA,!
101 W ?5," Patient Name: ",PATNAME,?84,"SSN: ",SSAN,!
102 Q
Note: See TracBrowser for help on using the repository browser.