source: FOIAVistA/tag/r/ONCOLOGY-ONC/ONCOPOS.m@ 1416

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

initial load of FOIAVistA 6/30/08 version
File size: 4.2 KB
Line 
1ONCOPOS ;HIRMFO/GWB-POST-INSTALL ROUTINE FOR PATCH ONC*2.11*5 05/06/96
2 ;;2.11;ONCOLOGY;**5**;Mar 07, 1995
3 ;
4ITEM1 ;Re-point DEFAULT PRIMARY SITE GROUP (#164,102) pointers from TONGUE (2)
5 ;to ORAL CAVITY (9)
6 S IEN=0 F S IEN=$O(^ONCO(164,IEN)) Q:IEN'>0 I $P(^ONCO(164,IEN,0),"^",13)=2 S $P(^ONCO(164,IEN,0),"^",13)=9
7 ;
8ITEM2 ;Re-point SITE/GP (#165.5,.01) pointers from TONGUE (2) to either ORAL
9 ;CAVITY (9) or PHARYNX (13)
10 S IEN=0 F S IEN=$O(^ONCO(165.5,IEN)) Q:IEN'>0 I $P(^ONCO(165.5,IEN,0),"^",1)=2 D
11 .S DIE="^ONCO(165.5,",DA=IEN
12 .I $D(^ONCO(165.5,IEN,2)),$P(^ONCO(165.5,IEN,2),"^",1)=67019 S DR=".01///13" D ^DIE Q
13 .S DR=".01///9" D ^DIE
14ITEM3 ;Delete TONGUE (2) from SITE-GROUP FOR ONCOLOGY (#164.2) file
15 S DIK="^ONCO(164.2,",DA=2 D ^DIK
16ITEM4 ;Set ONCOLOGY PRINT and SORT templates' READ ACCESS to null and WRITE
17 ;ACCESS to @
18 D ^ONCOPOS1
19 D ^ONCOPOS2
20ITEM5 ;Reindex new "D" uppercase cross-reference on the DEFINITION (#1) field
21 ;of the TYPE OF RECURRENCE (#160.12) file
22 S DIK="^ONCO(160.12,",DIK(1)="1^D" D ENALL^DIK
23 K DIK
24ITEM6 ;If treatments are "None" (0) set treatment dates to 00/00/00
25 ;If treatments are "Unknown" (8 or 9) set treatment dates to 99/99/99
26 S IEN=0,CNT=0 F S IEN=$O(^ONCO(165.5,IEN)) Q:IEN'>0 I $D(^ONCO(165.5,IEN,3)) D
27 .S DATEDX=$P(^ONCO(165.5,IEN,0),U,16),NODE3=^ONCO(165.5,IEN,3),CNT=CNT+1
28 .
29 .S NCDS=$P(NODE3,U,27),NCDSDT=$P(NODE3,U,31)
30 .S CDS=$P(NODE3,U,38),CDSDT=$P(NODE3,U,1)
31 .I DATEDX<2960101 D
32 ..I (+NCDS>0)&(CDS="00"),CDSDT>2000000 D
33 ...I (NCDSDT="")!(NCDSDT=2000000) S DIE="^ONCO(165.5,",DA=IEN,DR="58.3////"_CDSDT D ^DIE
34 ..I (NCDS=0)&(+CDS>0) D
35 ...S $P(^ONCO(165.5,IEN,3),U,27)="",NCDS=""
36 ...S DIE="^ONCO(165.5,",DA=IEN,DR="58.3////@" D ^DIE
37 ..I $E(CDS,1)=0,$E(CDS,2)'=0 S $P(^ONCO(165.5,IEN,3),U,27)=CDS,CDS="00",$P(^ONCO(165.5,IEN,3),U,38)="00"
38 .
39 .I (NCDS=0)!(NCDS="00") S DIE="^ONCO(165.5,",DA=IEN,DR="58.3////2000000" D ^DIE
40 .I (NCDS=9)!(NCDS="09") S DIE="^ONCO(165.5,",DA=IEN,DR="58.3////2999999" D ^DIE
41 .
42 .I CDS="00" S DIE="^ONCO(165.5,",DA=IEN,DR="50////2000000" D ^DIE
43 .
44 .S RAD=$P(NODE3,U,6)
45 .I RAD=0 S DIE="^ONCO(165.5,",DA=IEN,DR="51////2000000" D ^DIE
46 .I (RAD=8)!(RAD=9) S DIE="^ONCO(165.5,",DA=IEN,DR="51////2999999" D ^DIE
47 .
48 .S RADCNS=$P(NODE3,U,10)
49 .I RADCNS=0 S DIE="^ONCO(165.5,",DA=IEN,DR="52////2000000" D ^DIE
50 .I RADCNS=9 S DIE="^ONCO(165.5,",DA=IEN,DR="52////2999999" D ^DIE
51 .
52 .S CHE=$P(NODE3,U,13)
53 .I CHE=0 S DIE="^ONCO(165.5,",DA=IEN,DR="53////2000000" D ^DIE
54 .I (CHE=8)!(CHE=9) S DIE="^ONCO(165.5,",DA=IEN,DR="53////2999999" D ^DIE
55 .
56 .S HOR=$P(NODE3,U,16)
57 .I HOR=0 S DIE="^ONCO(165.5,",DA=IEN,DR="54////2000000" D ^DIE
58 .I (HOR=8)!(HOR=9) S DIE="^ONCO(165.5,",DA=IEN,DR="54////2999999" D ^DIE
59 .
60 .S IMM=$P(NODE3,U,19)
61 .I IMM=6 S DIE="^ONCO(165.5,",DA=IEN,DR="55////2000000" D ^DIE
62 .I (IMM=8)!(IMM=9) S DIE="^ONCO(165.5,",DA=IEN,DR="55////2999999" D ^DIE
63 .
64 .S OTH=$P(NODE3,U,25)
65 .I OTH=0 S DIE="^ONCO(165.5,",DA=IEN,DR="57////2000000" D ^DIE
66 .I (OTH=8)!(OTH=9) S DIE="^ONCO(165.5,",DA=IEN,DR="57////2999999" D ^DIE
67 .W:CNT#100=0 "."
68 .
69 .I $D(^ONCO(165.5,IEN,4)) S SCT=0 F S SCT=$O(^ONCO(165.5,IEN,4,SCT)) Q:SCT'>0 D
70 ..S NODE40=^ONCO(165.5,IEN,4,SCT,0)
71 ..S NODE43="" I $D(^ONCO(165.5,IEN,4,SCT,3)) S NODE43=^ONCO(165.5,IEN,4,SCT,3)
72 ..
73 ..S CDS=$P(NODE40,U,4)
74 ..I CDS="00" S $P(^ONCO(165.5,IEN,4,SCT,0),U,11)=2000000
75 ..
76 ..S RAD=$P(NODE40,U,5)
77 ..I RAD=0 S $P(^ONCO(165.5,IEN,4,SCT,0),U,12)=2000000
78 ..I RAD=9 S $P(^ONCO(165.5,IEN,4,SCT,0),U,12)=2999999
79 ..
80 ..S CHE=$P(NODE40,U,6)
81 ..I CHE=0 S $P(^ONCO(165.5,IEN,4,SCT,0),U,13)=2000000
82 ..I CHE=9 S $P(^ONCO(165.5,IEN,4,SCT,0),U,13)=2999999
83 ..
84 ..S HOR=$P(NODE40,U,7)
85 ..I HOR=0 S $P(^ONCO(165.5,IEN,4,SCT,0),U,14)=2000000
86 ..I HOR=9 S $P(^ONCO(165.5,IEN,4,SCT,0),U,14)=2999999
87 ..
88 ..S IMM=$P(NODE43,U,19)
89 ..I IMM=6 S $P(^ONCO(165.5,IEN,4,SCT,0),U,15)=2000000
90 ..I (IMM=8)!(IMM=9) S $P(^ONCO(165.5,IEN,4,SCT,0),U,15)=2999999
91 ..
92 ..S OTH=$P(NODE40,U,9)
93 ..I OTH=0 S $P(^ONCO(165.5,IEN,4,SCT,0),U,16)=2000000
94 ..I (OTH=8)!(OTH=9) S $P(^ONCO(165.5,IEN,4,SCT,0),U,16)=2999999
95 ..
96 ..S RADCNS=$P(NODE40,U,10)
97 ..I RADCNS=0 S $P(^ONCO(165.5,IEN,4,SCT,0),U,17)=2000000
98 ..I RADCNS=9 S $P(^ONCO(165.5,IEN,4,SCT,0),U,17)=2999999
99 K IEN,NODE3,NCDS,CDS,RAD,RADCNS,CHE,HOR,IMM,OTH,DIE,DA,DR
100 K SCT,NODE40,NODE43,DATEDX
Note: See TracBrowser for help on using the repository browser.