source: FOIAVistA/trunk/r/ONCOLOGY-ONC/ONCOCOF.m@ 847

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

initial load of FOIAVistA 6/30/08 version
File size: 4.5 KB
Line 
1ONCOCOF ;Hines OIFO/GWB - COMPUTED FIELDS FOR FOLLOW-UP ;12/13/99
2 ;;2.11;ONCOLOGY;**13,25,28,39,41,45**;Mar 07, 1995
3NM ;HOSPITAL NAME (160.1,.01)
4 S XD0=$O(^ONCO(160.1,"C",DUZ(2),0))
5 I XD0="" S XD0=$O(^ONCO(160.1,0))
6 I XD0'="" S X=$P(^ONCO(160.1,XD0,0),U,1)
7 G EX
8 ;
9ADD ;STREET ADDRESS (160.1,.02)
10 S XD0=$O(^ONCO(160.1,"C",DUZ(2),0))
11 I XD0="" S XD0=$O(^ONCO(160.1,0))
12 I XD0'="" S X=$P(^ONCO(160.1,XD0,0),U,2)
13 G EX
14 ;
15ZIP ;ZIPCODE (160.1,.03) Compute city and state.
16 S XD0=$O(^ONCO(160.1,"C",DUZ(2),0))
17 I XD0="" S XD0=$O(^ONCO(160.1,0))
18 I XD0'="" S X=$P(^ONCO(160.1,XD0,0),U,3)
19 S X=$G(^VIC(5.11,+X,0)) G EX:X=""
20 S CTP=$P(X,U,3),STP=$P(^VIC(5.1,+CTP,0),U,2) G EX:STP=""
21 S ST=$P(^DIC(5,+STP,0),U,2) G EX:ST=""
22 S X=$P(X,U,2)_","_ST_" "_$P(X,U)
23 G EX
24 ;
25FR ;[RS Registry Summary Reports - Follow Up]
26 N SITECODE,SITENAME,AA,AB,AC,AD,AE,AF,CC,AS,PP,VV,SS,SFC,PSFC
27 F SITENAME="CERVIX","SKIN" D
28 .S DIC=164.2,DIC(0)="O",X=SITENAME
29 .D ^DIC K DIC,X
30 .S SITECODE(SITENAME)=+Y
31 K ^TMP($J)
32 S (T,AB,AC,AS,AF,AN,AA,CC)=0
33 D TOTCASE
34 S T=AA+AN
35 S X0=0 F S X0=$O(^TMP($J,X0)) Q:X0'>0 D
36 .S ST=$P($G(^ONCO(165.5,X0,0)),U)
37 .S MO=$$HIST^ONCFUNC(X0)
38 .S SUMSTG=$P($G(^ONCO(165.5,X0,2)),U,17)
39 .S BEH=$E(MO,5)
40 .D SUB
41 S AA=AA-AB-AC-AS-CC
42 S FR=T_U_AB_U_AC_U_AS
43 S (AB,AC,AD,AE,AF)=0
44 S X0=0 F S X0=$O(^TMP($J,X0)) Q:X0'>0 S PP=$P(^ONCO(165.5,X0,0),U,2),VV=$G(^ONCO(160,PP,1)),ONCODF=$P(VV,U,2),AS=$P(VV,U,7),VV=$P(VV,U) D F
45 S AC=AA-AB
46 I AA S PB=$J(AB/AA,0,2)*100,PC=$J(AC/AA,0,2)*100,PD=$J(AD/AA,0,2)*100,PE=$J(AE/AA,0,2)*100
47 E S (PB,PC,PD,PE)="N/A" ;avoid division by zero
48 I AC S PA=$J(AD/AC,0,2)*100,PL=$J(AE/AC,0,2)*100
49 E S (PA,PL)="N/A" ;avoid division by zero
50 S SFC=AA-AE
51 S PSFC=$J(SFC/AA,0,2)*100
52 S FR=FR_U_AF_U_AN_U_AA_U_AB_U_AC_U_PC_U_PB_U_AD_U_PD_U_AE_U_PE_U_PA_U_PL_U_SFC_U_PSFC_U_CC
53 S AS=$O(^ONCO(160.1,"C",DUZ(2),0))
54 I AS="" S AS=$O(^ONCO(160.1,0))
55 S ^ONCO(160.1,AS,"FR")=FR
56 ;
57TT ;RUN FOLLOWUP RATE FORM
58 I ONCOS("F")=1 S DIC=160.2,DIC(0)="",X="FOLLOWUP RATE REPORT 1" D ^DIC K DIC,X
59 I ONCOS("F")=2 S DIC=160.2,DIC(0)="",X="FOLLOWUP RATE REPORT" D ^DIC K DIC,X
60 S IOP=ION
61 S DIWF="^ONCO(160.2,"_(+Y)_",1,",DIWF(1)="160.1"
62 S BY="NUMBER"
63 S (FR,TO)=$O(^ONCO(160.1,"C",DUZ(2),0))
64 I FR="" S (FR,TO)=$O(^ONCO(160.1,0))
65 W !!
66 D EN2^DIWF K DIWF,BY,FR,TO S IOP=ION D ^%ZIS
67 Q
68 ;
69TOTCASE ;Total cases
70 N VASITE,ONCOPARS,REFDATE,XD0,EOF,XD1
71 S VASITE=$O(^ONCO(160.1,"C",DUZ(2),0))
72 I VASITE="" S VASITE=$O(^ONCO(160.1,0))
73 S ONCOPARS=$G(^ONCO(160.1,VASITE,0))
74 S REFDATE=$P(ONCOPARS,U,4)
75 S XD0=REFDATE,EOF=0
76 S MINUS5=DT-50000
77 I ONCOS("F")=2,MINUS5>REFDATE S XD0=MINUS5
78 F D Q:EOF
79 .S XD1=""
80 .F S XD1=$O(^ONCO(165.5,"ADX",XD0,XD1)) Q:'XD1 I $$DIV^ONCFUNC(XD1)=DUZ(2) D
81 ..S DATEDX=$P($G(^ONCO(165.5,XD1,0)),U,16)
82 ..S COC=$P($G(^ONCO(165.5,XD1,0)),U,4)
83 ..I COC>2 S AN=AN+1
84 ..;I (COC>2)!((COC=0)&(DATEDX>3051231)) S AN=AN+1
85 ..E S AA=AA+1,^TMP($J,XD1)=""
86 .S XD0=$O(^ONCO(165.5,"ADX",XD0))
87 .I 'XD0 S EOF=1
88 Q
89 ;
90SUB ;Subtract non-reportables
91 I ST="" S AA=AA-1 D KIL Q ;No SITE/GP
92 I BEH=0!(BEH=1) S AB=AB+1 D KIL Q ;Less benign/borderline
93 I ST=SITECODE("CERVIX"),BEH=2 S AC=AC+1 D KIL Q ;Less carcinoma in situof CERVIX
94 I ST=SITECODE("SKIN"),MO>80699,MO<80944,(BEH=0)!(BEH=1)!(BEH=2)!(BEH=3),(SUMSTG=0)!(SUMSTG=1) S AS=AS+1 D KIL Q ;Less in situ/localized basal and squamous cell carcinoma of skin
95 S DATEDX=$P($G(^ONCO(165.5,X0,0)),U,16)
96 S COC=$P($G(^ONCO(165.5,X0,0)),U,4)
97 I (COC=0)&(DATEDX>3051231) S CC=CC+1 D KIL ;Less 2006+ CLASS OF CASE 0 cases
98 Q
99 ;
100F ;Foreign residents and LTF
101 I VV&'AS S X1=$O(^ONCO(160,PP,"F","AA",0)) I X1'="" S LC=$O(^(X1,0)),FS=$P(^ONCO(160,PP,"F",LC,0),U,6) I FS=8 S AF=AF+1,AA=AA-1 D KIL Q
102 I 'VV S AB=AB+1 D KIL Q
103 S X2=ONCODF,X1=DT D ^%DTC I X<91.25 S AD=AD+1 Q
104 S AE=AE+1
105 Q
106 ;
107KIL ;Remove entry
108 K ^TMP($J,X0)
109 Q
110 ;
111SS ;Suspense Status display
112 S XD0=D0 D DLC^ONCOCRF,DATEOT^ONCOES S LC=X
113 W:X'="" ?25,"Date Last Contact: ",LC
114 D SDD^ONCOCOM
115 Q
116 ;
117MTS ;Multiple Tumor Status at Death (last followup)
118 N D1
119 G EX:$P($G(^ONCO(160,D0,1)),U) ;quit if alive
120 S D1=$O(^ONCO(160,D0,"F","AA",0)) I D1'="" S D1=$O(^(D1,0)) D TS:D1'="" Q
121 ;
122TS ;Display SITE/GP (165.5,.01): LAST TUMOR STATUS (165.5,95)
123 N ONCOJ,ONCOK,XY
124 I '$D(^ONCO(165.5,"C",D0)) W ?30,"No primaries defined",! Q
125 S PD0=0,ONCOJ=0
126 F S PD0=$O(^ONCO(165.5,"C",D0,PD0)) Q:PD0'>0 I $$DIV^ONCFUNC(PD0)=DUZ(2) S ONCOJ=ONCOJ+1,XY(ONCOJ)=PD0
127 W !
128 F ONCOK=1:1:ONCOJ D
129 .N PD0,ST,TS
130 .S PD0=XY(ONCOK)
131 .S ST=$P(^ONCO(164.2,$P(^ONCO(165.5,PD0,0),U),0),U)
132 .S TS=+$P($G(^ONCO(165.5,PD0,7)),U,6)
133 .S TS=$P($G(^ONCO(164.42,TS,0)),U)
134 .W !,ST_": "_TS
135 .W:ONCOK=ONCOJ !
136 Q
137 ;
138EX ;EXIT
139 K PA,PB,PC,PD,PE,PL,X0
140 Q
Note: See TracBrowser for help on using the repository browser.