source: WorldVistAEHR/trunk/r/ONCOLOGY-ONC/ONCOPST.m@ 1800

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

initial load of WorldVistAEHR
File size: 6.2 KB
Line 
1ONCOPST ;HIRMFO/GWB-POST INIT FOR PATCH ONC*2.11*2 01/04/96
2 ;;2.11;ONCOLOGY;**1,4**;Feb 01, 1996
3 ;
4 ;Replace REPORTING HOSPITAL (165.5,.03) pointer value with INSTITUTION
5 ;ID NUMBER (160.1,27) value
6 ;
7 ;Prefix existing ACCESSION YEAR (165.5,.07) value with "19"
8 ;
9 ;Convert IMMUNOTHERAPY (165.5,55.2 and 165.51,.08) set-of-codes values
10 ;of "0" to pointer values of "6"
11 ;
12 ;Convert TYPE of FIRST RECURRENCE (165.5,71) and TYPE of SUBSEQUENT
13 ;RECURRENCE (165.572,.02) set-of-codes values of "0" to pointer values
14 ;of "5"
15 ;
16 ;If the NON CANCER-DIRECTED SURGERY (165.5.58.1) code is 1-digit, set
17 ;the CANCER-DIRECTED SUGERY (165.5,58.2) code to "00"
18 ;If the NON CANCER-DIRECTED SURGERY (165.5.58.1) code is 2-digits, move
19 ;it to the CANCER-DIRECTED SUGERY (165.5,58.2) field and set the NON
20 ;CANCER-DIRECTED SURGERY code to "0"
21 ;
22 ;Convert STATE AT DIAGNOSIS (165.5,16) pointer values from pointers to
23 ;the STATE (5) file to pointers to the new ACOS STATE AT DIAGNOSIS
24 ;(160.19) file
25 ;
26 ;Convert POSTAL CODE AT DIAGNOSIS (165.5,9) pointer values to the
27 ;actual postal code value
28 ;
29 ;Convert AJCC SUMMARY STAGE (165.5,38) values of 9 and O to 99 and 0C
30 ;Convert AJCC SUMMARY STAGE (165.5,38) and STAGE GROUPING-AJCC
31 ;(165.5,38.5) values of OCCULT to 0C and 0
32 ;
33 S OSPIEN=$O(^ONCO(160.1,0)),IIN=""
34 I OSPIEN'="",$D(^ONCO(160.1,OSPIEN,1)) S IIN=$P(^ONCO(160.1,OSPIEN,1),"^",4)
35 ;W !!," Converting the following fields in the Oncology Primary file:",!
36 ;W !," REPORTING HOSPITAL .03"
37 ;W !," POSTAL CODE AT DIAGNOSIS 9"
38 ;W !," STATE AT DIAGNOSIS 16"
39 ;W !," IMMUNOTHERAPY 55.2"
40 ;W !," NON CANCER-DIRECTED SURGERY 58.1"
41 ;W !," CANCER-DIRECTED SURGERY 58.2"
42 ;W !," TYPE OF FIRST RECURRENCE 71"
43 ;W !," TYPE OF SUBSEQUENT RECURRENCE 165.572,.02"
44 ;W !," IMMUNOTHERAPY 165.51,.08"
45 S OPIEN=0 F CNT=1:1 S OPIEN=$O(^ONCO(165.5,OPIEN)) Q:OPIEN'>0 D W:CNT#100=0 "."
46 .S:IIN'="" $P(^ONCO(165.5,OPIEN,0),"^",3)=IIN
47 .S AY=$P(^ONCO(165.5,OPIEN,0),"^",7)
48 .S:$L(AY)=2 $P(^ONCO(165.5,OPIEN,0),"^",7)="19"_AY
49 .I $D(^ONCO(165.5,OPIEN,2)) D
50 ..I $P(^ONCO(165.5,OPIEN,2),"^",20)=9 S $P(^ONCO(165.5,OPIEN,2),"^",20)=99
51 ..I $P(^ONCO(165.5,OPIEN,2),"^",20)="O" S $P(^ONCO(165.5,OPIEN,2),"^",20)="0C"
52 ..I $P(^ONCO(165.5,OPIEN,2),"^",20)="OCCULT" S $P(^ONCO(165.5,OPIEN,2),"^",20)="0C"
53 ..I $P(^ONCO(165.5,OPIEN,2),"^",28)="OCCULT" S $P(^ONCO(165.5,OPIEN,2),"^",28)=0
54 ..S S=$P(^ONCO(165.5,OPIEN,0),"^",1),N2=$G(^(2)),TOP=$P(N2,"^",1),HIST=$P(N2,"^",3)
55 ..I (S=35)!($$LEUKEMIA^ONCOAIP2(OPIEN))!((S>65)&(S<71)) D
56 ...S M=$E(HIST,1,4),N=$S(M=9731:"999^10^9",1:"999^80^9")
57 ...S N=N_"^99^99^9^0^0^7"
58 ...S $P(^ONCO(165.5,OPIEN,2),"^",9,17)=N
59 ...S $P(^ONCO(165.5,OPIEN,2),"^",20)=88
60 ...S $P(^ONCO(165.5,OPIEN,2),"^",25)=88
61 ...S $P(^ONCO(165.5,OPIEN,2),"^",26)=88
62 ...S $P(^ONCO(165.5,OPIEN,2),"^",27)=88
63 ..I (HIST=91402)!(HIST=91403) D
64 ...S $P(^ONCO(165.5,OPIEN,2),"^",20)=88
65 ...S $P(^ONCO(165.5,OPIEN,2),"^",25)=88
66 ...S $P(^ONCO(165.5,OPIEN,2),"^",26)=88
67 ...S $P(^ONCO(165.5,OPIEN,2),"^",27)=88
68 ..I (S=65)!(TOP=67690)!(TOP=67695)!(TOP=67696)!(TOP=67698) S $P(^ONCO(165.5,OPIEN,2),"^",20)=88
69 ..I TOP=67441 D
70 ...Q:(HIST=87203)!(HIST=87443)!(HIST=87303)!(HIST=87223)!(HIST=87453)
71 ...Q:(HIST=87713)!(HIST=87703)!(HIST=87202)!(HIST=87700)!(HIST=87423)
72 ...Q:(HIST=87613)!(HIST=87403)!(HIST=87413)!(HIST=87233)!(HIST=87213)
73 ...Q:(HIST=87723)!(HIST=87433)!(HIST=87412)!(HIST=87422)!(HIST=93630)
74 ...Q:(HIST=95410)
75 ...S $P(^ONCO(165.5,OPIEN,2),"^",20)=88
76 .I $D(^ONCO(165.5,OPIEN,3)),$P(^ONCO(165.5,OPIEN,3),"^",19)=0 S $P(^ONCO(165.5,OPIEN,3),"^",19)=6
77 .I $D(^ONCO(165.5,OPIEN,4)) S SCTIEN=0 F S SCTIEN=$O(^ONCO(165.5,OPIEN,4,SCTIEN)) Q:SCTIEN'>0 I $D(^ONCO(165.5,OPIEN,4,SCTIEN,3)),$P(^ONCO(165.5,OPIEN,4,SCTIEN,3),"^",19)=0 S $P(^ONCO(165.5,OPIEN,4,SCTIEN,3),"^",19)=6
78 .I $D(^ONCO(165.5,OPIEN,5)) D
79 ..I $P(^ONCO(165.5,OPIEN,5),"^",1)="000000" S $P(^ONCO(165.5,OPIEN,5),"^",1)=2000000
80 ..I $P(^ONCO(165.5,OPIEN,5),"^",2)=0 S $P(^ONCO(165.5,OPIEN,5),"^",2)=5
81 .I $D(^ONCO(165.5,OPIEN,23)) S SRIEN=0 F S SRIEN=$O(^ONCO(165.5,OPIEN,23,SRIEN)) Q:SRIEN'>0 I $P(^ONCO(165.5,OPIEN,23,SRIEN,0),"^",2)=0 S $P(^ONCO(165.5,OPIEN,23,SRIEN,0),"^",2)=5
82 .I $D(^ONCO(165.5,OPIEN,3)) D
83 ..I ($L($P(^ONCO(165.5,OPIEN,3),"^",27))=1)&($P(^ONCO(165.5,OPIEN,3),"^",38)="") S $P(^ONCO(165.5,OPIEN,3),"^",38)="00"
84 ..I $L($P(^ONCO(165.5,OPIEN,3),"^",27))=2 S $P(^ONCO(165.5,OPIEN,3),"^",38)=$P(^ONCO(165.5,OPIEN,3),"^",27),$P(^ONCO(165.5,OPIEN,3),"^",27)=0
85 .I $G(^ONCO(165.5,OPIEN,25))'="Y",$D(^ONCO(165.5,OPIEN,1)) S STP=$P(^ONCO(165.5,OPIEN,1),"^",4) I STP'="" S STN=$P(^DIC(5,STP,0),"^",1),STC=$P(^DIC(5,STP,0),"^",2) D S $P(^ONCO(165.5,OPIEN,1),"^",4)=ASPT,$P(^ONCO(165.5,OPIEN,25),"^",1)="Y"
86 ..I STC'="",$D(^ONCO(160.15,"B",STC)) S ASPT=$O(^ONCO(160.15,"B",STC,0)) Q
87 ..I STN'="",$D(^ONCO(160.15,"D",STN)) S ASPT=$O(^ONCO(160.15,"D",STN,0)) Q
88 ..S ASPT=68
89 .I $G(^ONCO(165.5,OPIEN,26))'="Y",$D(^ONCO(165.5,OPIEN,1)) S PCADPT=$P(^ONCO(165.5,OPIEN,1),"^",2) I PCADPT'="",$D(^VIC(5.11,PCADPT)) D
90 ..S PCAD=$P(^VIC(5.11,PCADPT,0),"^",1),CTAD=$P(^VIC(5.11,PCADPT,0),"^",2),$P(^ONCO(165.5,OPIEN,1),"^",2)=PCAD,$P(^ONCO(165.5,OPIEN,1),"^",12)=CTAD,$P(^ONCO(165.5,OPIEN,26),"^",1)="Y"
91 K OSPIEN,IIN,OPIEN,AY,TOFR,STP,STN,STC,ASPT,PCADPT,PCAD,SRIEN,SCTIEN
92 ;
93 ;Kill the ACCESSION YEAR (165.5,.07) "AY", "AAY" and ""ACAY"
94 ;cross-references and reindex them
95 ;
96 ;W !!," Re-indexing the AY, AAY, and ACAY cross-references on the"
97 ;W !," ACCESSION YEAR (165.5,.07) field"
98 K ^ONCO(165.5,"AY"),^ONCO(165.5,"AAY"),^ONCO(165.5,"ACAY")
99 S DIK="^ONCO(165.5,",DIK(1)=.07 D ENALL^DIK
100 K DIK
101 ;
102 ;Edit the N2 N-CLASS ENCODING (.01) entry in N-CLASS ENCODING (164.0651)
103 ;multiple of the PROSTATE record in the ICDO TOPOGRAPHY (164) file
104 S PIEN=$O(^ONCO(164,"B","PROSTATE",0))
105 I PIEN'="" S DIE="^ONCO(164,PIEN,""N"",",DA(1)=PIEN,DA=4,DR=".01///"_"SINGLE LN>2cm-5cm/ MULT Nn<5cm" D ^DIE
106 K PIEN,DIE,DA,DR
107 ;Delete the first 10 entries in the CODE/DESCRIPTION (164.54) multiple
108 ;of the SG9 ORAL CAVITY record in the SEER CODE SET file
109 F NCDS=1:1:10 S DIE="^ONCO(164.5,179,1,",DA(1)=179,DA=NCDS,DR=".01///"_"@" D ^DIE
110 K NCDS,DIE,DA,DR
111 ;
112 ;Call ONCOPST1 ACOS NUMBER file pointer conversion routine
113 D ^ONCOPST1
Note: See TracBrowser for help on using the repository browser.