source: FOIAVistA/trunk/r/ONCOLOGY-ONC/ONCP36D.m@ 785

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

initial load of FOIAVistA 6/30/08 version
File size: 4.5 KB
Line 
1ONCP36D ;HINES OIFO/GWB-POST-INSTALL ROUTINE FOR PATCH ONC*2.11*36
2 ;;2.11;ONCOLOGY;**36**;Mar 07, 1995
3 ;
4 D S:FORDS'="" $P(^ONCO(165.5,IEN,3),U,26)=FORDS
5 .S FORDS=""
6 .I +SPP<10,RFNS=0 S FORDS=1 Q
7 .I +SPP>9,+SPP<91 S FORDS=0 Q
8 .I +SPP=99,RFNS="" S FORDS=9 Q
9 ;
10 D D RTM S $P(^ONCO(165.5,IEN,27),U,7)="Y"
11 .S FORDS=""
12 .I $P($G(^ONCO(165.5,IEN,27)),U,7)="Y" Q
13 .S RAD=$$GET1^DIQ(165.5,IEN,51.2,"I")
14 .S RADAF=$$GET1^DIQ(165.5,IEN,51.4,"I")
15 .S RTM=$$GET1^DIQ(165.5,IEN,363,"I")
16 .S:RTM'="" RTM=$$GET1^DIQ(166.13,RTM,.01,"I")
17 .I (RAD=0)!(RAD=7),(RADAF<1)!(RADAF>5) S FORDS=1 Q
18 .I (RAD<1)!(RAD>5),(RADAF=0)!(RADAF=7) S FORDS=1 Q
19 .I RAD>0,RAD<6,RTM="01" S FORDS=21 Q
20 .I RAD>0,RAD<6,RTM="02" S FORDS=22 Q
21 .I RAD>0,RAD<6,RTM="03" S FORDS=23 Q
22 .I RAD>0,RAD<6,RTM="04" S FORDS=24 Q
23 .I RAD>0,RAD<6,RTM="05" S FORDS=25 Q
24 .I RAD>0,RAD<6,RTM="06" S FORDS=26 Q
25 .I RAD>0,RAD<6,RTM="07" S FORDS=27 Q
26 .I RAD>0,RAD<6,RTM="08" S FORDS=28 Q
27 .I RAD>0,RAD<6,RTM="09" S FORDS=29 Q
28 .I RAD>0,RAD<6,RTM=10 S FORDS=30 Q
29 .I RAD>0,RAD<6,RTM=11 S FORDS=20 Q
30 .I RAD>0,RAD<6,RTM=12 S FORDS=33 Q
31 .I RAD>0,RAD<6,RTM=13 S FORDS=34 Q
32 .I RAD>0,RAD<6,RTM=14 S FORDS=40 Q
33 .I RAD>0,RAD<6,RTM=15 S FORDS=41 Q
34 .I RAD>0,RAD<6,RTM=16 S FORDS=20 Q
35 .I (RAD=8)!(RAD=9),RADAF>0,RADAF<6,RTM="01" S FORDS=21 Q
36 .I (RAD=8)!(RAD=9),RADAF>0,RADAF<6,RTM="02" S FORDS=22 Q
37 .I (RAD=8)!(RAD=9),RADAF>0,RADAF<6,RTM="03" S FORDS=23 Q
38 .I (RAD=8)!(RAD=9),RADAF>0,RADAF<6,RTM="04" S FORDS=24 Q
39 .I (RAD=8)!(RAD=9),RADAF>0,RADAF<6,RTM="05" S FORDS=25 Q
40 .I (RAD=8)!(RAD=9),RADAF>0,RADAF<6,RTM="06" S FORDS=26 Q
41 .I (RAD=8)!(RAD=9),RADAF>0,RADAF<6,RTM="07" S FORDS=27 Q
42 .I (RAD=8)!(RAD=9),RADAF>0,RADAF<6,RTM="08" S FORDS=28 Q
43 .I (RAD=8)!(RAD=9),RADAF>0,RADAF<6,RTM="09" S FORDS=29 Q
44 .I (RAD=8)!(RAD=9),RADAF>0,RADAF<6,RTM=10 S FORDS=30 Q
45 .I (RAD=8)!(RAD=9),RADAF>0,RADAF<6,RTM=11 S FORDS=20 Q
46 .I (RAD=8)!(RAD=9),RADAF>0,RADAF<6,RTM=12 S FORDS=33 Q
47 .I (RAD=8)!(RAD=9),RADAF>0,RADAF<6,RTM=13 S FORDS=34 Q
48 .I (RAD=8)!(RAD=9),RADAF>0,RADAF<6,RTM=14 S FORDS=40 Q
49 .I (RAD=8)!(RAD=9),RADAF>0,RADAF<6,RTM=15 S FORDS=41 Q
50 .I (RAD=8)!(RAD=9),RADAF>0,RADAF<6,RTM=16 S FORDS=20 Q
51 .I RAD=1,(RADAF=2)!(RADAF=3)!(RADAF=4),(+RTM<1)!(+RTM>16) S FORDS=46 Q
52 .I RAD=1,RADAF=5,(+RTM<1)!(+RTM>16) S FORDS=47 Q
53 .I RAD=1,(+RTM<1)!(+RTM>16) S FORDS=20 Q
54 .I RAD=2,(RADAF=1)!(RADAF=4),(+RTM<1)!(+RTM>16) S FORDS=46 Q
55 .I RAD=2,(RADAF=3)!(RADAF=5),(+RTM<1)!(+RTM>16) S FORDS=47 Q
56 .I RAD=2,(+RTM<1)!(+RTM>16) S FORDS=37 Q
57 .I RAD=3,(RADAF=1)!(RADAF=4),(+RTM<1)!(+RTM>16) S FORDS=46 Q
58 .I RAD=3,(RADAF=2)!(RADAF=5),(+RTM<1)!(+RTM>16) S FORDS=47 Q
59 .I RAD=3,(+RTM<1)!(+RTM>16) S FORDS=43 Q
60 .I RAD=4,(+RTM<1)!(+RTM>16) S FORDS=46 Q
61 .I RAD=5,(+RTM<1)!(+RTM>16) S FORDS=47 Q
62 .I RADAF=1,(+RTM<1)!(+RTM>16) S FORDS=20 Q
63 .I RADAF=2,(+RTM<1)!(+RTM>16) S FORDS=37 Q
64 .I RADAF=3,(+RTM<1)!(+RTM>16) S FORDS=43 Q
65 .I (RADAF=4)!(RADAF=5),(+RTM<1)!(+RTM>16) S FORDS=18 Q
66 .I (RAD'="")!(RADAF'="") S FORDS=19 Q
67 .
68 D D CMX
69 .S (FORDS,FORDSAF)=""
70 .S CMX=$$GET1^DIQ(165.5,IEN,53.2,"I")
71 .S CMXAF=$$GET1^DIQ(165.5,IEN,53.3,"I")
72 .S RFNC=$$GET1^DIQ(165.5,IEN,76,"I")
73 .I CMX=0,(RFNC=0)!(RFNC="")!(RFNC=9) S FORDS="00"
74 .I CMXAF=0,(RFNC=0)!(RFNC="")!(RFNC=9) S FORDSAF="00"
75 .I CMX=1 S FORDS="01"
76 .I CMXAF=1 S FORDSAF="01"
77 .I CMX=2 S FORDS="02"
78 .I CMXAF=2 S FORDSAF="02"
79 .I CMX=3 S FORDS="03"
80 .I CMXAF=3 S FORDSAF="03"
81 .I CMX=7 S FORDS=87
82 .I CMXAF=7 S FORDSAF=87
83 .I CMX=8 S FORDS=88
84 .I CMXAF=8 S FORDSAF=88
85 .I (CMX=0)!(CMX=9),RFNC=1 S FORDS="00"
86 .I (CMXAF=0)!(CMXAF=9),RFNC=1 S FORDSAF="00"
87 .I (CMX=0)!(CMX=9),RFNC=2 S FORDS=82
88 .I (CMXAF=0)!(CMXAF=9),RFNC=2 S FORDSAF=82
89 .I (CMX=0)!(CMX=9),RFNC=6 S FORDS=86
90 .I (CMXAF=0)!(CMXAF=9),RFNC=6 S FORDSAF=86
91 .I (CMX=0)!(CMX=9),RFNC=7 S FORDS=87
92 .I (CMXAF=0)!(CMXAF=9),RFNC=7 S FORDSAF=87
93 .I (CMX=0)!(CMX=9),RFNC=8 S FORDS=88
94 .I (CMXAF=0)!(CMXAF=9),RFNC=8 S FORDSAF=88
95 .I CMX=9,RFNC=9 S FORDS=99
96 .I CMXAF=9,RFNC=9 S FORDSAF=99
97 .I CMX=9,RFNC="" S FORDS=99
98 .I CMXAF=9,RFNC="" S FORDSAF=99
99 .S SUB=0 F S SUB=$O(SUBTX(SUB)) Q:SUB'>0 D D SUBCMX
100 ..S FORDSUB=""
101 ..I $P(SUBTX(SUB),U,6)=0 S FORDSUB="00" Q
102 ..I $P(SUBTX(SUB),U,6)=1 S FORDSUB="01" Q
103 ..I $P(SUBTX(SUB),U,6)=2 S FORDSUB="02" Q
104 ..I $P(SUBTX(SUB),U,6)=3 S FORDSUB="03" Q
105 ..I $P(SUBTX(SUB),U,6)=7 S FORDSUB=87 Q
106 ..I $P(SUBTX(SUB),U,6)=8 S FORDSUB=88 Q
107 ..I $P(SUBTX(SUB),U,6)=9 S FORDSUB=99 Q
108 Q
109 ;
110RTM S:FORDS'="" $P(^ONCO(165.5,IEN,"BLA2"),U,18)=FORDS
111 Q
112 ;
113CMX S:FORDS'="" $P(^ONCO(165.5,IEN,3),U,13)=FORDS
114 S:FORDSAF'="" $P(^ONCO(165.5,IEN,3.1),U,14)=FORDSAF
115 Q
116 ;
117SUBCMX S:FORDSUB'="" $P(^ONCO(165.5,IEN,4,SUB,0),U,6)=FORDSUB
118 Q
Note: See TracBrowser for help on using the repository browser.