source: WorldVistAEHR/trunk/r/ONCOLOGY-ONC/ONCPREMR.m@ 846

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

initial load of WorldVistAEHR
File size: 4.1 KB
RevLine 
[613]1ONCPREMR ;HIRMFO/RTK-PRE-INSTALL ROUTINE CONTINUED ONC*2.11*13 09/10/97
2 ;;2.11;ONCOLOGY;**13**;Mar 07, 1995
3 ;
4 ; Loop thru ICDO MORPHOLOGY (#164.1) file and find any duplicate entries
5 ; of 9710/2 & 9710/3. Convert any pointers that point to these entries
6 ; and then delete the duplicates entries.
7 ;
8 W !!,"Checking for any duplicates in ICDO MORHOLOGY (#164.1) file..."
9 S MRBAD=""
10 F MR=0:0 S MR=$O(^ONCO(164.1,"B","MARGINAL ZONE LYMPHOMA, NOS IN",MR)) Q:MR'>0 I MR'=97102 S MRBAD=MRBAD_MR_"^"
11 F MR=0:0 S MR=$O(^ONCO(164.1,"B","MARGINAL ZONE LYMPHOMA, NOS",MR)) Q:MR'>0 I MR'=97103 S MRBAD=MRBAD_MR_"^"
12 I MRBAD="" G CHANGE ;if theres no duplicates, skip the conversion stuff
13 ;
14 ; Convert field #22 of file #165.5
15 ;
16 S CT=0
17 W !?4,"Converting file #165.5 pointers..."
18 F PRIEN=0:0 S PRIEN=$O(^ONCO(165.5,PRIEN)) Q:PRIEN'>0 D
19 .S CT=CT+1 I CT#100=0 W "."
20 .I '$D(^ONCO(165.5,PRIEN,2)) Q
21 .S HIST=$P($G(^ONCO(165.5,PRIEN,2)),"^",3) I HIST="" Q
22 .I MRBAD[HIST D
23 ..I $P($G(^ONCO(164.1,HIST,0)),"^",2)="9710/2" S $P(^ONCO(165.5,PRIEN,2),"^",3)=97102 Q
24 ..I $P($G(^ONCO(164.1,HIST,0)),"^",2)="9710/3" S $P(^ONCO(165.5,PRIEN,2),"^",3)=97103 Q
25 ..W !,"CANNOT CONVERT POINTER IN ENTRY NUMBER: ",PRIEN Q
26 .Q
27 ;
28 ; Convert field #64 of file #160
29 ;
30 S CT=0
31 W !?4,"Converting file #160 pointers..."
32 F PTIEN=0:0 S PTIEN=$O(^ONCO(160,PTIEN)) Q:PTIEN'>0 D
33 .S CT=CT+1 I CT#100=0 W "."
34 .I '$D(^ONCO(160,PTIEN,2)) Q
35 .S MORPH=$P($G(^ONCO(160,PTIEN,2)),"^",10) I MORPH="" Q
36 .I MRBAD[MORPH D
37 ..I $P($G(^ONCO(164.1,MORPH,0)),"^",2)="9710/2" S $P(^ONCO(160,PTIEN,2),"^",10)=97102 Q
38 ..I $P($G(^ONCO(164.1,MORPH,0)),"^",2)="9710/3" S $P(^ONCO(160,PTIEN,2),"^",10)=97103 Q
39 ..W !,"CANNOT CONVERT POINTER IN ENTRY NUMBER: ",PTIEN Q
40 .Q
41 ;
42 ; Convert field #70 of file #169.1
43 ;
44 S CT=0
45 W !?4,"Converting file #169.1 pointers..."
46 F ICDIEN=0:0 S ICDIEN=$O(^ONCO(169.1,ICDIEN)) Q:ICDIEN'>0 D
47 .S CT=CT+1 I CT#100=0 W "."
48 .I '$D(^ONCO(169.1,ICDIEN,0)) Q
49 .S MRPH1=$P($G(^ONCO(169.1,ICDIEN,0)),"^",5) I MRPH1="" Q
50 .I MRBAD[MRPH1 D
51 ..I $P($G(^ONCO(164.1,MRPH1,0)),"^",2)="9710/2" S $P(^ONCO(169.1,ICDIEN,0),"^",5)=97102 Q
52 ..I $P($G(^ONCO(164.1,MRPH1,0)),"^",2)="9710/3" S $P(^ONCO(169.1,ICDIEN,0),"^",5)=97103 Q
53 ..W !,"CANNOT CONVERT POINTER IN ENTRY NUMBER: ",ICDIEN Q
54 .Q
55 ;
56 ; Convert field #30 of file #164.1 (points to itself)
57 ;
58 S CT=0
59 W !?4,"Converting file #164.1 pointers..."
60 F MRIEN=0:0 S MRIEN=$O(^ONCO(164.1,MRIEN)) Q:MRIEN'>0 D
61 .S CT=CT+1 I CT#100=0 W "."
62 .I '$D(^ONCO(164.1,MRIEN,0)) Q
63 .S TNCODE=$P($G(^ONCO(164.1,MRIEN,0)),"^",4) I TNCODE="" Q
64 .I MRBAD[TNCODE D
65 ..I $P($G(^ONCO(164.1,TNCODE,0)),"^",2)="9710/2" S $P(^ONCO(164.1,MRIEN,0),"^",4)=97102 Q
66 ..I $P($G(^ONCO(164.1,TNCODE,0)),"^",2)="9710/3" S $P(^ONCO(164.1,MRIEN,0),"^",4)=97103 Q
67 ..W !,"CANNOT CONVERT POINTER IN ENTRY NUMBER: ",MRIEN Q
68 .Q
69 ;
70 ; Convert sub-field #.01 of field #20 (multiple) of file #164.2
71 ;
72 S CT=0
73 W !?4,"Converting file #164.2 pointers..."
74 F STIEN=0:0 S STIEN=$O(^ONCO(164.2,STIEN)) Q:STIEN'>0 D
75 .S CT=CT+1 I CT#100=0 W "."
76 .I '$D(^ONCO(164.2,STIEN,"M",0)) Q
77 .F STMULT=0:0 S STMULT=$O(^ONCO(164.2,STIEN,"M",STMULT)) Q:STMULT'>0 D
78 ..S STMORP=$P($G(^ONCO(164.2,STIEN,"M",STMULT,0)),"^",1) I STMORP="" Q
79 ..I MRBAD[STMORP D
80 ...I $P($G(^ONCO(164.1,STMORP,0)),"^",2)="9710/2" S $P(^ONCO(164.2,STIEN,"M",STMULT,0),"^",1)=97102 Q
81 ...I $P($G(^ONCO(164.1,STMORP,0)),"^",2)="9710/3" S $P(^ONCO(164.2,STIEN,"M",STMULT,0),"^",1)=97103 Q
82 ...W !,"CANNOT CONVERT POINTER IN ENTRY NUMBER: ",STIEN," SUBFIELD ",STMULT Q
83 ..Q
84 .Q
85 ;
86 ; Delete the duplicates of MARGINAL ZONE LYMPHOMA, NOS & NOS IN SITU
87 ;
88 S NUM=0 F S NUM=NUM+1,MRDA=$P(MRBAD,"^",NUM) Q:MRDA="" D
89 .S DIK="^ONCO(164.1,",DA=MRDA D ^DIK
90 .Q
91 ;
92CHANGE ; Correct NAME (#.01) field of entries #97102,#97103 in 164.1 file
93 ; and correct CODE (#1) field of entry #86221 in 164.1 file
94 ;
95 S DR=".01///MARGINAL ZONE LYMPHOMA, NOS IN SITU",DIE="^ONCO(164.1,",DA=97102 D ^DIE
96 S DR=".01///MARGINAL ZONE LYMPHOMA, NOS",DIE="^ONCO(164.1,",DA=97103 D ^DIE
97 S DR="1////8622/1",DIE="^ONCO(164.1,",DA=86221 D ^DIE
98 ;
99 K CT,HIST,ICDIEN,MORPH,MR,MRBAD,MRDA,MRIEN,MRPH1,NUM,PRIEN,PTIEN
100 K STIEN,STMORP,STMULT,TNCODE
101 Q
Note: See TracBrowser for help on using the repository browser.