source: WorldVistAEHR/trunk/r/ONCOLOGY-ONC/ONCP36B1.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: 5.7 KB
Line 
1ONCP36B1 ;HINES OIFO/GWB-POST-INSTALL ROUTINE FOR PATCH ONC*2.11*36
2 ;;2.11;ONCOLOGY;**36**;Mar 07, 1995
3 ;
4 D Q
5 .D Q
6 ..I ((TOP>67209)&(TOP<67219))!((TOP>67339)&(TOP<67350))!((TOP>67619)&(TOP<67630))!((TOP>67648)&(TOP<67680)) D D SLN Q
7 ...I SLN=0 S FORDS=0
8 ...I SLNAF=0 S FORDSAF=0
9 ...I SLN=9 S FORDS=9
10 ...I SLNAF=9 S FORDSAF=9
11 ...I ((SLN>0)&(SLN<7)),+NNE>0,+NNE<4 S FORDS=4
12 ...I ((SLNAF>0)&(SLNAF<7)),+NNEAF>0,+NNEAF<4 S FORDSAF=4
13 ...I ((SLN>0)&(SLN<7)),+NNE>3,+NNE<91 S FORDS=5
14 ...I ((SLNAF>0)&(SLNAF<7)),+NNEAF>3,+NNEAF<91 S FORDSAF=5
15 ...I ((SLN>0)&(SLN<7)),NNE=95 S FORDS=1
16 ...I ((SLNAF>0)&(SLNAF<7)),NNEAF=95 S FORDSAF=1
17 ...I ((SLN>0)&(SLN<7)),((NNE>95)!(NNE="")) S FORDS=3
18 ...I ((SLN>0)&(SLN<7)),((NNEAF>95)!(NNEAF="")) S FORDSAF=3
19 ...I SLN>0,FORDS="" S FORDS=9
20 ...I SLNAF>0,FORDSAF="" S FORDSAF=9
21 ...S SUB=0 F S SUB=$O(SUBTX(SUB)) Q:SUB'>0 D D SUBSLN
22 ....S FORDSUB=""
23 ....I $P(SUBTX(SUB),U,3)=0 S FORDSUB=0 Q
24 ....I $P(SUBTX(SUB),U,3)=9 S FORDSUB=9 Q
25 ....I (($P(SUBTX(SUB),U,3)>0)&($P(SUBTX(SUB),U,3)<7)),+$P(SUBTX(SUB),U,4)>0,+$P(SUBTX(SUB),U,4)<4 S FORDSUB=4 Q
26 ....I (($P(SUBTX(SUB),U,3)>0)&($P(SUBTX(SUB),U,3)<7)),+$P(SUBTX(SUB),U,4)>3,+$P(SUBTX(SUB),U,4)<91 S FORDSUB=5 Q
27 ....I (($P(SUBTX(SUB),U,3)>0)&($P(SUBTX(SUB),U,3)<7)),+$P(SUBTX(SUB),U,4)=95 S FORDSUB=1 Q
28 ....I (($P(SUBTX(SUB),U,3)>0)&($P(SUBTX(SUB),U,3)<7)),((+$P(SUBTX(SUB),U,4)>95)!($P(SUBTX(SUB),U,4)="")) S FORDSUB=3 Q
29 ....I $P(SUBTX(SUB),U,3)>0,FORDSUB="" S FORDSUB=9 Q
30 ..
31 ..I TOP>67699,TOP<67720 D D SLN Q
32 ...I SLN'="" S FORDS=9
33 ...I SLNAF'="" S FORDSAF=9
34 ...S SUB=0 F S SUB=$O(SUBTX(SUB)) Q:SUB'>0 D D SUBSLN
35 ....S FORDSUB=""
36 ....I $P(SUBTX(SUB),U,3)'="" S FORDSUB=9 Q
37 ..
38 ..I ((TOP>67249)&(TOP<67260))!((TOP>67539)&(TOP<67560)) D D SLN Q
39 ...I SLN=0 S FORDS=0
40 ...I SLNAF=0 S FORDSAF=0
41 ...I SLN=9 S FORDS=9
42 ...I SLNAF=9 S FORDSAF=9
43 ...I ((SLN>0)&(SLN<3)),+NNE>0,+NNE<4 S FORDS=4
44 ...I ((SLNAF>0)&(SLNAF<3)),+NNEAF>0,+NNEAF<4 S FORDSAF=4
45 ...I ((SLN>0)&(SLN<3)),+NNE>3,+NNE<91 S FORDS=5
46 ...I ((SLNAF>0)&(SLNAF<3)),+NNEAF>3,+NNEAF<91 S FORDSAF=5
47 ...I ((SLN>0)&(SLN<3)),NNE=95 S FORDS=1
48 ...I ((SLNAF>0)&(SLNAF<3)),NNEAF=95 S FORDSAF=1
49 ...I ((SLN>0)&(SLN<3)),((NNE>95)!(NNE="")) S FORDS=3
50 ...I ((SLN>0)&(SLN<3)),((NNEAF>95)!(NNEAF="")) S FORDSAF=3
51 ...I SLN>0,FORDS="" S FORDS=9
52 ...I SLNAF>0,FORDSAF="" S FORDSAF=9
53 ...S SUB=0 F S SUB=$O(SUBTX(SUB)) Q:SUB'>0 D D SUBSLN
54 ....S FORDSUB=""
55 ....I $P(SUBTX(SUB),U,3)=0 S FORDSUB=0 Q
56 ....I $P(SUBTX(SUB),U,3)=9 S FORDSUB=9 Q
57 ....I (($P(SUBTX(SUB),U,3)>0)&($P(SUBTX(SUB),U,3)<3)),+$P(SUBTX(SUB),U,4)>0,+$P(SUBTX(SUB),U,4)<4 S FORDSUB=4 Q
58 ....I (($P(SUBTX(SUB),U,3)>0)&($P(SUBTX(SUB),U,3)<3)),+$P(SUBTX(SUB),U,4)>3,+$P(SUBTX(SUB),U,4)<91 S FORDSUB=5 Q
59 ....I (($P(SUBTX(SUB),U,3)>0)&($P(SUBTX(SUB),U,3)<3)),+$P(SUBTX(SUB),U,4)=95 S FORDSUB=1 Q
60 ....I (($P(SUBTX(SUB),U,3)>0)&($P(SUBTX(SUB),U,3)<3)),((+$P(SUBTX(SUB),U,4)>95)!($P(SUBTX(SUB),U,4)="")) S FORDSUB=3 Q
61 ....I $P(SUBTX(SUB),U,3)>0,FORDSUB="" S FORDSUB=9 Q
62 ..
63 ..I ((TOP>67769)&(TOP<67780)) D D SLN Q
64 ...I ((HIST3>9589)&(HIST3<9597)),SLN'="" S FORDS=9
65 ...I ((HIST3>9589)&(HIST3<9597)),SLNAF'="" S FORDSAF=9
66 ...I ((HIST3>9649)&(HIST3<9718)),SLN'="" S FORDS=9
67 ...I ((HIST3>9649)&(HIST3<9718)),SLNAF'="" S FORDSAF=9
68 ...I ((HIST3>9726)&(HIST3<9730)),SLN'="" S FORDS=9
69 ...I ((HIST3>9726)&(HIST3<9730)),SLNAF'="" S FORDSAF=9
70 ...S SUB=0 F S SUB=$O(SUBTX(SUB)) Q:SUB'>0 D D SUBSLN
71 ....S FORDSUB=""
72 ....I ((HIST3>9589)&(HIST3<9597)),$P(SUBTX(SUB),U,3)'="" S FORDSUB=9 Q
73 ....I ((HIST3>9649)&(HIST3<9718)),$P(SUBTX(SUB),U,3)'="" S FORDSUB=9 Q
74 ....I ((HIST3>9726)&(HIST3<9730)),$P(SUBTX(SUB),U,3)'="" S FORDSUB=9 Q
75 ..
76 ..I ((TOP>67769)&(TOP<67780)) D D SLN Q
77 ...I ((HIST2>9589)&(HIST2<9597)),SLN'="" S FORDS=9
78 ...I ((HIST2>9589)&(HIST2<9597)),SLNAF'="" S FORDSAF=9
79 ...I ((HIST2>9649)&(HIST2<9718)),SLN'="" S FORDS=9
80 ...I ((HIST2>9649)&(HIST2<9718)),SLNAF'="" S FORDSAF=9
81 ...I ((HIST2>9726)&(HIST2<9730)),SLN'="" S FORDS=9
82 ...I ((HIST2>9726)&(HIST2<9730)),SLNAF'="" S FORDSAF=9
83 ...S SUB=0 F S SUB=$O(SUBTX(SUB)) Q:SUB'>0 D D SUBSLN
84 ....S FORDSUB=""
85 ....I ((HIST2>9589)&(HIST2<9597)),$P(SUBTX(SUB),U,3)'="" S FORDSUB=9 Q
86 ....I ((HIST2>9649)&(HIST2<9718)),$P(SUBTX(SUB),U,3)'="" S FORDSUB=9 Q
87 ....I ((HIST2>9726)&(HIST2<9730)),$P(SUBTX(SUB),U,3)'="" S FORDSUB=9 Q
88 ..
89 ..I ((TOP>67759)&(TOP<67766))!((TOP>67766)&(TOP<67769))!(TOP=67809) D D SLN Q
90 ...I SLN'="" S FORDS=9
91 ...I SLNAF'="" S FORDSAF=9
92 ...S SUB=0 F S SUB=$O(SUBTX(SUB)) Q:SUB'>0 D D SUBSLN
93 ....S FORDSUB=""
94 ....I $P(SUBTX(SUB),U,3)'="" S FORDSUB=9 Q
95 ..
96 ..D D SLN Q
97 ...I SLN=0 S FORDS=0
98 ...I SLNAF=0 S FORDSAF=0
99 ...I SLN=9 S FORDS=9
100 ...I SLNAF=9 S FORDSAF=9
101 ...I SLN=1,+NNE>0,+NNE<4 S FORDS=4
102 ...I SLNAF=1,+NNEAF>0,+NNEAF<4 S FORDSAF=4
103 ...I SLN=1,+NNE>3,+NNE<91 S FORDS=5
104 ...I SLNAF=1,+NNEAF>3,+NNEAF<91 S FORDSAF=5
105 ...I SLN=1,NNE=95 S FORDS=1
106 ...I SLNAF=1,NNEAF=95 S FORDSAF=1
107 ...I SLN=1,((NNE>95)!(NNE="")) S FORDS=3
108 ...I SLN=1,((NNEAF>95)!(NNEAF="")) S FORDSAF=3
109 ...I SLN>0,FORDS="" S FORDS=9
110 ...I SLNAF>0,FORDSAF="" S FORDSAF=9
111 ...S SUB=0 F S SUB=$O(SUBTX(SUB)) Q:SUB'>0 D D SUBSLN
112 ....S FORDSUB=""
113 ....I $P(SUBTX(SUB),U,3)=0 S FORDSUB=0 Q
114 ....I $P(SUBTX(SUB),U,3)=9 S FORDSUB=9 Q
115 ....I $P(SUBTX(SUB),U,3)=1,+$P(SUBTX(SUB),U,4)>0,+$P(SUBTX(SUB),U,4)<4 S FORDSUB=4 Q
116 ....I $P(SUBTX(SUB),U,3)=1,+$P(SUBTX(SUB),U,4)>3,+$P(SUBTX(SUB),U,4)<91 S FORDSUB=5 Q
117 ....I $P(SUBTX(SUB),U,3)=1,+$P(SUBTX(SUB),U,4)=95 S FORDSUB=1 Q
118 ....I $P(SUBTX(SUB),U,3)=1,((+$P(SUBTX(SUB),U,4)>95)!($P(SUBTX(SUB),U,4)="")) S FORDSUB=3 Q
119 ....I $P(SUBTX(SUB),U,3)>0,FORDSUB="" S FORDSUB=9 Q
120 Q
121 ;
122SLN S:FORDS'="" $P(^ONCO(165.5,IEN,3.1),U,31)=FORDS
123 S:FORDSAF'="" $P(^ONCO(165.5,IEN,3.1),U,32)=FORDSAF
124 Q
125 ;
126SUBSLN S:FORDSUB'="" $P(^ONCO(165.5,IEN,4,SUB,2),U,32)=FORDSUB
127 Q
Note: See TracBrowser for help on using the repository browser.