source: WorldVistAEHR/trunk/r/ONCOLOGY-ONC/ONCOGEN.m@ 1270

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

initial load of WorldVistAEHR
File size: 6.7 KB
Line 
1ONCOGEN ;Hines OIFO/GWB - GENERAL REPORT DRIVER FOR SELECTED FORMATS ;02/02/00
2 ;;2.11;ONCOLOGY;**6,7,11,13,16,17,18,22,24,25,26,29,44,46,47**;Mar 07, 1995;Build 19
3 ;
4SU ;IR Patient Summary [ONCO ABSTRACT-INCOMP RECORD]
5 W !
6 S DIC="^ONCO(160,",DIC(0)="AEMQZ" D ^DIC G SUEX:Y<0
7 S X=+Y
8 S D="C",DIC="^ONCO(165.5,",DIC(0)="EQ" D IX^DIC G SUEX:Y<0
9 S D0=+Y
10 S BY="NUMBER",(FR,TO)=D0,FLDS="[ONCO XABSTRACT RECORD]",L=0
11 S DIC="^ONCO(165.5,",L=0 D EN1^DIP
12 K DIR S DIR(0)="E" D ^DIR
13SUEX K DIC,D,BY,FR,TO,FLDS,L
14 Q
15 ;
16SEER ;[QA Print Abstract QA]
17 S SEER=1 G ABSEO
18SER1 S ONCODA=DA
19 S FLDS="[ONCQA1]"
20 I $P($G(^ONCO(165.5,DA,2)),U,1)=67619 S FLDS="[ONCQA]"
21 D PRT G END
22 ;
23ABSEO ;[EX Print Abstract-Extended (80c)]
24 ;[PA Print Complete Abstract (132c)]
25 S DIC="^ONCO(160,",DIC(0)="AEMQ" D ^DIC G:Y=-1 END
26 S (HI,DA,I)=0
27 I $D(^ONCO(165.5,"C",$P(Y,U,1))) W !,"Choose one:" F S DA=$O(^ONCO(165.5,"C",$P(Y,U,1),DA)) Q:DA'>0 I $$DIV^ONCFUNC(DA)=DUZ(2) S I=I+1,SI=$P(^ONCO(165.5,DA,0),U,1) W:$D(^ONCO(164.2,SI,0)) !?10,I_". "_$P(^(0),U,1) D TEXT S ^TMP($J,I)=DA S HI=I
28 I HI=0 W !,"No primaries for this patient" G EX
29ANS S ANS=$$ASKNUM^ONCOU("Enter your selection","1:"_HI,1) G EX:$D(DIRUT)
30 S DA=$P(^TMP($J,ANS),U,1),(Y,DA,NUMBER,HDA)=DA
31 S PRTPCE=0
32 I $P($G(^ONCO(165.5,DA,7)),U,15)'="" W ! K DIR S DIR(0)="YA",DIR("A")=" Print PCE data attached to this primary? ",DIR("B")="NO" D ^DIR
33 S PRTPCE=Y G EX:$D(DIRUT)
34 G SER1:$D(SEER),DS:$D(NS),X:III<49,Y
35X S OSP=$O(^ONCO(160.1,"C",DUZ(2),0))
36 I OSP="" S OSP=$O(^ONCO(160.1,0))
37 S EVADS=$P($G(^ONCO(160.1,OSP,2)),U,2)
38 D ESPD I ESPD[U K ESPD Q
39 S (ONCODA,ONCOIEN)=DA D ^ONCOPA1
40 G EX
41Y S DIOEND="S DN=1,D0=ONCODA F II=III:1:IIII K DXS D @(""^ONCOY""_II)"
42PT S ONCODA=DA,FLDS="[ONCOY49]"
43 D PRT G END
44PRT S FR=NUMBER,TO=NUMBER,BY="@NUMBER",DIC="^ONCO(165.5,",L=0
45 D EN1^DIP
46 Q
47 ;
48PRT1 S FR=NUMBER,TO=NUMBER,BY="@NUMBER",DIC="^ONCO(160,",L=0
49 D EN1^DIP
50 Q
51TEXT W:$D(^ONCO(165.5,DA,8)) " "_$P(^ONCO(165.5,DA,8),U,1) Q
52DD S Y=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_($E(Y,1,3)+1700)_$S(Y#1:" "_$E(Y_0,9,10)_":"_$E(Y_"0000",11,12),1:"")
53 Q
54 ;
55DIS ;[AS Abstract Screens Menu (80c)...]
56 G ABSEO
57DS S (D0,ONCODA)=DA
58 I $G(NF)=58 S III=50,IIII=58 D Y G END
59 S FLDS="[ONCOY49]",FR=ONCODA,TO=ONCODA,BY="@NUMBER",L=0
60 S DIC="^ONCO(165.5," D @("SCR"_NS) Q
61SCR50 S DIOEND="S DN=1,D0=ONCODA K DXS D @(""^ONCOY50"")" D EN1^DIP,RD Q
62SCR3 S DIOEND="S DN=1,D0=ONCODA K DXS D @(""^ONCOX3"")" D EN1^DIP,RD Q
63SCR51 S DIOEND="S DN=1,D0=ONCODA K DXS D @(""^ONCOY51"")" D EN1^DIP,RD Q
64SCR52 S DIOEND="S DN=1,D0=ONCODA K DXS D @(""^ONCOY52"")" D EN1^DIP,RD Q
65SCR53 S DIOEND="S DN=1,D0=ONCODA K DXS D @(""^ONCOY53"")" D EN1^DIP,RD Q
66SCR54 S DIOEND="S DN=1,D0=ONCODA F II=54,55 K DXS D @(""^ONCOY""_II)"
67 D EN1^DIP Q
68SCR56 S DIOEND="S DN=1,D0=ONCODA K DXS D @(""^ONCOY56"")" D EN1^DIP,RD Q
69SCR57 S DIOEND="S DN=1,D0=ONCODA K DXS D @(""^ONCOY57"")" D EN1^DIP,RD Q
70SCR58 S DIOEND="S DN=1,D0=ONCODA K DXS D @(""^ONCOY58"")" D EN1^DIP,RD Q
71 Q
72 ;
73RD K DIR S DIR(0)="E",DIR("A")="Hit Enter to continue" D ^DIR
74 K QDS I Y'=1 S QDS=1
75 Q
76END K ANS,BY,DA,DHCOPIES,DHD,DIC,DIOEND,DN,DXS,HDA,I,NUMBER,L,ONCODA
77 K ONCOTEMP,PG,BY,FR,TO,FLDS,HI,ANS,SI,SEER,XD0
78 D ^%ZISC S IOP=ION D ^%ZIS
79EX ;Exit
80 K %DT,X,Y,DIC,DIC,DIC1,DISH,II,D,DIJ,DIW,DIWT,DIYS,DP,FIL,ST,XXD1
81 K ONCOX1,ONCOD0,ONCON,ONCOX,%W,%ZISOS,ONTEMP,ONCOX2,ONCOR,ONCOYR
82 K %Y,F,L,O,W,%T,B,LST,O2,OG,OP,OS,OT,P,TL,TX,YY,OIO,%ZISOS,DIP
83 K ONCX,PCESEL,M,DIYS,DISH,PRTPCE,PCEABS,QDS,STGP,STGPNM
84 Q
85 ;
86PCEPRT ;PRINT PCE DATA (IF ANY) FOR A PARTICULAR PRIMARY AFTER COMPLETE
87 ;(OR EXT) ABSTR PRINT. CALLED BY ROUTINE ^ONCOPA3A (FORMERLY CALLED
88 ;BY ONCOX11 PRINT TEMPLATE). ALSO CALLED BY [ONCOY58] PRINT TEMPLATE.
89 I $P($G(^ONCO(165.5,ONCODA,7)),U,15)="" Q ;IF NO PCE DATA, QUIT
90 S STGP=$P($G(^ONCO(165.5,ONCODA,0)),U,1)
91 S STGPNM=$P($G(^ONCO(164.2,STGP,0)),U,1),SITTAB=79-$L(STGPNM)
92PRINT ;
93 D PCEVARS
94 I $P($G(^ONCO(165.5,ONCODA,7)),U,15)="BLA" D PRT^ONCBPC8 Q
95 I $P($G(^ONCO(165.5,ONCODA,7)),U,15)="THY" D PRT^ONCTPC8 Q
96 I $P($G(^ONCO(165.5,ONCODA,7)),U,15)="STS" D PRT^ONCSPC8 Q
97 I $P($G(^ONCO(165.5,ONCODA,7)),U,15)="PRO" D PRT^ONCPPC9 Q
98 I $P($G(^ONCO(165.5,ONCODA,7)),U,15)="COL" D PRT^ONCCPC9 Q
99 I $P($G(^ONCO(165.5,ONCODA,7)),U,15)="NHL" D PRT^ONCNPC8 Q
100 I $P($G(^ONCO(165.5,ONCODA,7)),U,15)="PRO2" D PRT^ONCP2P8 Q
101 I $P($G(^ONCO(165.5,ONCODA,7)),U,15)="BRE" D PRT^ONCBRP9 Q
102 I $P($G(^ONCO(165.5,ONCODA,7)),U,15)="MEL" D PRT^ONCMPC9 Q
103 I $P($G(^ONCO(165.5,ONCODA,7)),U,15)="HEP" D PRT^ONCHPC8 Q
104 I $P($G(^ONCO(165.5,ONCODA,7)),U,15)="CNS" D PRT^ONCIPC8 Q
105 I $P($G(^ONCO(165.5,ONCODA,7)),U,15)="GAS" D PRT^ONCGPC7 Q
106 I $P($G(^ONCO(165.5,ONCODA,7)),U,15)="LNG" D PRT^ONCLPC9 Q
107 Q
108PCEPRT2 ;PRINT ALL PCE'S FOR A PARTICULAR SITE.
109 S ONCQ=0
110 W !!?5,"Print PCE's for a particular site"
111 K DIR S DIR(0)="SM^1:Bladder;2:Thyroid;3:Soft Tissue Sarcoma;4:Prostate;5:Prostate (1998);6:Colorectal;7:Non-Hodgkin's Lymphoma;8:Breast;9:Melanoma;10:Hepatocellular;11:Intracranial;12:Gastric;13:Lung" D ^DIR Q:$D(DIRUT)
112 S PCESEL=$S(Y=1:"BLA",Y=2:"THY",Y=3:"STS",Y=4:"PRO",Y=5:"PRO2",Y=6:"COL",Y=7:"NHL",Y=8:"BRE",Y=9:"MEL",Y=10:"HEP",Y=11:"CNS",Y=12:"GAS",Y=13:"LNG",1:"") Q:PCESEL=""
113 W ! K DIR S DIR(0)="YA",DIR("A")="Print PCE's AND Abstracts? ",DIR("B")="Y" D ^DIR S PCEABS=Y G EX:$D(DIRUT)
114 K IOP,%ZIS S %ZIS="Q" W ! D ^%ZIS S ONCOIO=ION_";"_IOST_";"_IOM_";"_IOSL G:POP EX
115 I $D(IO("Q")) S ONCQ=1 D TASK G EX
116RTN ;
117 S ONCOQUIT=0,ONCIOST=IOST
118 I PCEABS'=1 F ONCX=0:0 S ONCX=$O(^ONCO(165.5,"APCE",PCESEL,ONCX)) Q:ONCX'>"" I $$DIV^ONCFUNC(ONCX)=DUZ(2) S ONCODA=ONCX D PRINT Q:$G(Y)=0
119 I PCEABS=1 F ONCX=0:0 S ONCX=$O(^ONCO(165.5,"APCE",PCESEL,ONCX)) Q:ONCX'>""!ONCOQUIT I $$DIV^ONCFUNC(ONCX)=DUZ(2) D
120 .S ONCODA=ONCX,PRTPCE=1
121 .S ONCOIEN=ONCX D MULT^ONCOPA1
122 .Q
123 G END
124PCEVARS ;SET VARIABLES NEEDED TO PRINT THE PCE(S).
125 K DASHES S $P(DASHES,"-",80)="-"
126 S D0=ONCODA,NODE0=^ONCO(165.5,D0,0)
127 S S=$P(NODE0,U,1),SITEGP=$P(^ONCO(164.2,S,0),U,1),DATEDX=$P(NODE0,U,16)
128 S Y=$P(NODE0,U,2),C=$P(^DD(165.5,.02,0),U,2) D Y^DIQ S PATNAM=Y
129 S SAVED0=D0 S D0=$P(NODE0,U,2) D SSN^ONCOES S SSN=X,D0=SAVED0
130 S TOP=$P($G(^ONCO(165.5,D0,2)),U,1),TOPCOD="",TOPNAM=""
131 I TOP'="" S TOPNAM=$P(^ONCO(164,TOP,0),U,1),TOPCOD=$P(^ONCO(164,TOP,0),U,2)
132 S TOPTAB=79-$L(TOPNAM_" "_TOPCOD),TTAB=79-$L(TOPCOD)
133 S STGP=$P($G(^ONCO(165.5,ONCODA,0)),U,1)
134 S STGPNM=$P($G(^ONCO(164.2,STGP,0)),U,1),SITTAB=79-$L(STGPNM)
135 S NOS=TOPTAB-$L(PATNAM),NOS=NOS-1 K SPACES S $P(SPACES," ",NOS)=" "
136 S ONCONUM=D0,ONCOPA=$P(NODE0,U,2)
137 Q
138 ;
139ESPD ;Exclude sensitive patient data
140 N DIR,X
141 W !
142 S DIR("A")=" Exclude sensitive patient data"
143 S DIR(0)="Y",DIR("B")="No" D ^DIR
144 S ESPD=Y
145 Q
146 ;
147TASK ;Queue a task
148 K IO("Q"),ZTUCI,ZTDTH,ZTIO,ZTSAVE
149 S ZTRTN="RTN^ONCOGEN"
150 S ZTREQ="@",ZTSAVE("ZTREQ")="",ZTSAVE("ONCODA")="",ZTSAVE("PCESEL")=""
151 S ZTSAVE("DATEDX")="",ZTSAVE("PCEABS")="",ZTSAVE("ONCOIO")=""
152 S ZTSAVE("ONCQ")="",ZTDESC="Print PCE Data"
153 D ^%ZTLOAD W !,"Request Queued",!
154 K V1,V2,ONCOLST,ZTSK Q
Note: See TracBrowser for help on using the repository browser.