source: FOIAVistA/tag/r/ONCOLOGY-ONC/ONCOPA1.m@ 628

Last change on this file since 628 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version
File size: 7.7 KB
Line 
1ONCOPA1 ;Hines OIFO/GWB - [PA Print Complete Abstract (132c)]; 08/25/97
2 ;;2.11;ONCOLOGY;**13,15,16,18,28,33,34,36,40,41,42,43,44,45,46,47**;Mar 07, 1995;Build 19
3 ;Replaces print templates ONCOX1-X11.
4 ;
5 K IOP,%ZIS S %ZIS="MQ" W ! D ^%ZIS K %ZIS,IOP G:POP EXIT
6 I $D(IO("Q")) S ONCOLST="ONCOIEN^PTIEN^STARS^LENGTH^TITLE^PRTPCE^ONCODA^EVADS^ESPD" D TASK G EXIT
7 U IO D PRINT D ^%ZISC K %ZIS,IOP G EXIT
8 ;
9PRINT ;Print
10 Q:$G(ONCOIEN)=""
11 W @IOF
12 S (IEN,D0)=ONCOIEN,PTIEN=$P($G(^ONCO(165.5,IEN,0)),U,2)
13 S PG=0,EX="",LINE=$S(IOST?1"C".E:IOSL-2,1:IOSL-6)
14 S STARS="******************************************************************************"
15 S DATEDX=$P($G(^ONCO(165.5,IEN,0)),U,16)
16 D NOW^%DTC S Y=% D DD^%DT S PRTDATE=Y
17 K DIQ S DIC="^ONCO(160,",DIQ(0)="C"
18 S DR=".111:.131;2;7:10;13;18.9:21;22.9:29;38:44;48;50;51;52;61;55;56"
19 S DA=PTIEN,DIQ="ONCAB" D EN^DIQ1
20 K DIQ S DIC="^ONCO(165.5,",DIQ(0)="C"
21 S DR=".01:.07;1.2;2:2.4;3;3.5:19;20.1;22:35.1;37:40.2;41;49:59;62:67;70:71.3;74:79;83;85:92;95;100;101;108;117:130;132;133;137:146;200;346;363;363.1;442;443;560;787;50.2;361;623;684;1010;153;153.1;435;149;151;154:157;170;171:192;711:713;809"
22 S DA=ONCOIEN,DIQ="ONCAB" D EN^DIQ1
23 K DIQ S DIC="^ONCO(165.5,",DIQ(0)="IE"
24 S DR="29.2;30.2;29.1;31.1;32.1;32;33;34.3;34.4;44.1;44.2;44.3;44.4;44.5;44.6;160;161;162;163;164;165;166;167;168;148:148.4;15;21;25;44;46;47;96;102;159;193;194;195;196;2.2"
25 S DA=ONCOIEN,DIQ="ONCAB" D EN^DIQ1
26 K DIQ S DIC="^ONCO(165.5,",DIQ(0)="C"
27 S DR="72",DA=ONCOIEN,DR(165.572)=".01;.02;.03;.031;.032",DIQ="ONCAB"
28 F SR=0:0 S SR=$O(^ONCO(165.5,IEN,23,SR)) Q:SR'>0 D
29 .S DA(165.572)=SR D EN^DIQ1 Q
30 K DIQ S DIC="^ONCO(165.5,",DIQ(0)="C"
31 S DR="60",DA=ONCOIEN,DR(165.51)=".01:2;33:37",DIQ="ONCAB"
32 F SCT=0:0 S SCT=$O(^ONCO(165.5,IEN,4,SCT)) Q:SCT'>0 D
33 .S DA(165.51)=SCT D EN^DIQ1 Q
34 K DIQ S DIC="^ONCO(160,",DIQ(0)="C"
35 S DR="44",DA=PTIEN,DR(160.044)=".01:1",DIQ="ONCAB"
36 F CHST=0:0 S CHST=$O(^ONCO(160,PTIEN,9,CHST)) Q:CHST'>0 D
37 .S DA(160.044)=CHST D EN^DIQ1 Q
38 I $G(ESPD)=1 D
39 .S ONCAB(165.5,IEN,.02)="XXXXX,XXXXX"
40 .S ONCAB(160,PTIEN,2)="XXX-XX-XXXX"
41 .S ONCAB(160,PTIEN,.119)="XXXXXXXXXX"
42 .S $P(ONCAB(160,PTIEN,.116),",",1)="XXXXX"
43 .S ONCAB(160,PTIEN,.131)="XXX-XXX-XXXX"
44 .S ONCAB(165.5,IEN,8)="XXXXXXXXXX"
45 .S ONCAB(165.5,IEN,8.2)="XXXXXXXXXX"
46 .S ONCAB(165.5,IEN,8.1)="XXXXX"
47 S PATNAME=$G(ONCAB(165.5,IEN,.02)),SSAN=$G(ONCAB(160,PTIEN,2))
48 S NAME="CANCER REGISTRY ABSTRACT" D FORMAT
49 S CRA=TITLE W !!,TITLE
50 W !!?21,$E(ONCAB(165.5,IEN,.03),1,26)
51 W " ACOS #: ",ONCAB(165.5,IEN,67)
52 W ?76,"Print Date: ",PRTDATE D P Q:EX=U
53 W !," Patient Name: ",ONCAB(165.5,IEN,.02),?76,"SSN: ",ONCAB(160,PTIEN,2) D P Q:EX=U
54 S DOB="",VRBLPTR=$P($G(^ONCO(160,PTIEN,0)),U,1) I VRBLPTR'="" D
55 .S FILE=U_$P(VRBLPTR,";",2)_$P(VRBLPTR,";",1)_",0)"
56 .S Y=$S($D(@FILE):$P(@FILE,U,3),1:"") I Y'="" D DD^%DT S DOB=Y Q
57 W !," Home Address: ",ONCAB(160,PTIEN,.119) D P Q:EX=U
58 W !," ",ONCAB(160,PTIEN,.116) D P Q:EX=U
59 W !," County: ",ONCAB(160,PTIEN,.12) D P Q:EX=U
60 W !," Sex: ",$E(ONCAB(160,PTIEN,10),1,14),?44,"Race: ",$E(ONCAB(160,PTIEN,8),1,21),?76,"Ethnicity: ",ONCAB(160,PTIEN,9) D P Q:EX=U
61 W !," Date of Birth: ",DOB
62 W ?38," Age at DX: ",ONCAB(165.5,IEN,4) D P Q:EX=U
63 ;
64CI ;Cancer Identification
65 S NAME="CANCER IDENTIFICATION" D FORMAT
66 W !!,TITLE
67 S NODE2=$G(^ONCO(165.5,IEN,2))
68 S COC=$P($G(^ONCO(165.5,IEN,0)),U,4)
69 W !!," Accession Number: ",ONCAB(165.5,IEN,.05),?38,"Accession Year: ",ONCAB(165.5,IEN,.07),?76,"Sequence Number: ",ONCAB(165.5,IEN,.06) D P Q:EX=U
70 W !," Date Dx: ",ONCAB(165.5,IEN,3) D P Q:EX=U
71 I DATEDX>3061231 D
72 .W !," Ambiguous Terminology Dx: ",ONCAB(165.5,IEN,159,"E") D P Q:EX=U
73 .W !," Date of Conclusive Dx: ",ONCAB(165.5,IEN,193,"E") D P Q:EX=U
74 W !," Dx Facility: ",ONCAB(165.5,IEN,5) D P Q:EX=U
75 W !," Date of First Contact: ",ONCAB(165.5,IEN,155) D P Q:EX=U
76 W !," Class of Case: ",ONCAB(165.5,IEN,.04) D P Q:EX=U
77 I COC=1,$G(EVADS)'="N" D
78 .W !," Date of First Symptoms: ",ONCAB(165.5,IEN,171) D P Q:EX=U
79 .W !," Date Start Workup Ordered: ",ONCAB(165.5,IEN,172) D P Q:EX=U
80 .W !," Date Workup Started: ",ONCAB(165.5,IEN,173) D P Q:EX=U
81 W !," Type of Reporting Source: ",ONCAB(165.5,IEN,1.2) D P Q:EX=U
82 W !," Site/Gp: ",ONCAB(165.5,IEN,.01) D P Q:EX=U
83 W !," Primary Site Code: ",ONCAB(165.5,IEN,20.1)," "
84 S TOP=$P(NODE2,U,1) I TOP'="" W $P(^ONCO(164,TOP,0),U,1) D P Q:EX=U
85 W !," Text-Primary Site Title: ",ONCAB(165.5,IEN,100) D P Q:EX=U
86 I DATEDX>3061231 D
87 .W !," Mult Tum Rpt as One Prim: ",ONCAB(165.5,IEN,194,"E") D P Q:EX=U
88 .W !," Date of Multiple Tumorsm: ",ONCAB(165.5,IEN,195,"E") D P Q:EX=U
89 .W !," Multiplicity Counter: ",ONCAB(165.5,IEN,196,"E") D P Q:EX=U
90 W !," Laterality: ",ONCAB(165.5,IEN,28) D P Q:EX=U
91 S HIST=$$HIST^ONCFUNC(IEN)
92 W !," Histology: ",ONCAB(165.5,IEN,HSTFLD) D P Q:EX=U
93 W !," Text-Histology Title: ",ONCAB(165.5,IEN,101) D P Q:EX=U
94 W:TOP=67619 !," Gleason's Score: ",ONCAB(165.5,IEN,623)
95 W:TOP=67619 !," PSA: ",ONCAB(165.5,IEN,684)
96 W:TOP=67619 !," PSA Date: ",ONCAB(165.5,IEN,96,"E")
97 W:TOP=67619 !," DRE +/-: ",ONCAB(165.5,IEN,102,"E")
98 W:TOP=67619 !," DRE Date: ",ONCAB(165.5,IEN,156)
99 W !," Grade/Diff/Cell Type: ",ONCAB(165.5,IEN,24)," "
100 S GR=$P(NODE2,U,5) I GR'="" W $P(^ONCO(164.43,GR,0),U,2) D P Q:EX=U
101 W !," AFIP Submission: ",ONCAB(165.5,IEN,83) D P Q:EX=U
102 W !," Diagnostic Confirmation: ",ONCAB(165.5,IEN,26) D P Q:EX=U
103 W:TOP=67220 !," Hepatitis C: ",ONCAB(165.5,IEN,1010)
104 S TM1=$$PRINT^ONCOTM(IEN,1)
105 I TM1["UMOR" S $E(TM1,2,5)="umor" I TM1["ARKER" S $E(TM1,8,12)="arker"
106 S TM2=$$PRINT^ONCOTM(IEN,2)
107 I TM2["UMOR" S $E(TM2,2,5)="umor" I TM2["ARKER" S $E(TM2,8,12)="arker"
108 S TM3=$$PRINT^ONCOTM(IEN,3)
109 I TM3["UMOR" S $E(TM3,2,5)="umor" I TM3["ARKER" S $E(TM3,8,12)="arker"
110 S LEN=$L(TM1) W !?(27-LEN),TM1,": ",ONCAB(165.5,IEN,25.1) D P Q:EX=U
111 S LEN=$L(TM2) W !?(27-LEN),TM2,": ",ONCAB(165.5,IEN,25.2) D P Q:EX=U
112 S LEN=$L(TM3) W !?(27-LEN),TM3,": ",ONCAB(165.5,IEN,25.3) D P Q:EX=U
113 W !," Referring Facility: ",ONCAB(165.5,IEN,6) D P Q:EX=U
114 W !," Transfer Facility: ",ONCAB(165.5,IEN,7) D P Q:EX=U
115 W !,"Presentation at Cancer Conf: ",ONCAB(165.5,IEN,120) D P Q:EX=U
116 W !," Date of Cancer Conference: ",ONCAB(165.5,IEN,121) D P Q:EX=U
117 W !," Casefinding Source: ",ONCAB(165.5,IEN,21,"E") ;D P Q:EX=U
118 ;
119 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 PA1A
120 D P Q:EX=U
121PA1A D ^ONCOPA1A
122 ;
123EXIT K CHF,CHST,CRA,DOB,DXDT,EX,FHDT,FHIEN,FHZN,FILE,FLG,FM,FOLH,FR,GR
124 K HIST,IEN,J,LEN,LENGTH,LINE,NAME,NF,NODE2,NOK,NUM,ONCAB,ONCOIEN,OTHPRI
125 K PATNAME,PG,PRTDATE,PRZN,PTIEN,QS,RCDT,SCT,SITE,SR,SSAN,ST,STARS
126 K TITLE,TM1,TM2,TM3,TOP,TSTAT,TX,VRBLPTR,VS,XDX,XD1
127 Q
128P ;
129 I $Y>(IOSL-10) D Q:EX=U W !
130 .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
131 .D HDR Q
132 Q
133FORMAT ;
134 S LENGTH=$L(NAME),NUM=(((132-LENGTH)/2)\1)-10
135 S TITLE=" "_$E(STARS,1,NUM)_" "_NAME_" "_$E(STARS,1,NUM)
136 Q
137TASK ;If report is queued
138 K IO("Q"),ZTUCI,ZTDTH,ZTIO,ZTSAVE
139 S ZTRTN="PRINT^ONCOPA1",ZTREQ="@",ZTSAVE("ZTREQ")=""
140 S ZTDESC="Print Complete Abstract"
141 F RK=1:1 S RK1=$P(ONCOLST,U,RK) Q:RK1="" S ZTSAVE(RK1)=""
142 D ^%ZTLOAD D ^%ZISC U IO W !,"Report Queued",!
143 K RK,RK1,ONCOLST,ZTSK Q
144HDR ;Header
145 W @IOF S PG=PG+1
146 W CRA,!
147 W ?5," Patient Name: ",PATNAME,?84,"SSN: ",SSAN,!
148 Q
149MULT ;Entry point for option ABS...MA...3).
150 ;Also called from PCEPRT2^ONCOGEN.
151 I $D(IO("Q")) S ONCOLST="ONCOIEN^PTIEN^STARS^LENGTH^TITLE^PRTPCE^ONCODA^EVADS^ESPD" D TASK G EXIT
152 U IO D PRINT K %ZIS,IOP G EXIT
153 Q
Note: See TracBrowser for help on using the repository browser.