VistA-WorldVistAEHR/r/ONCOLOGY-ONC/ONCP36B.m

175 lines
6.9 KiB
Mathematica
Raw Permalink Normal View History

2009-11-29 13:37:14 -05:00
ONCP36B ;HINES OIFO/GWB-POST-INSTALL ROUTINE FOR PATCH ONC*2.11*36
;;2.11;ONCOLOGY;**36**;Mar 07, 1995
;
D S $P(^ONCO(165.5,IEN,27),U,2)="Y"
.I $P($G(^ONCO(165.5,IEN,27)),U,2)="Y" Q
.S FORDS="" D
..I ($D(HIST(HIST2)))!($D(HIST(HIST3))) D D SM Q
...I SM'="" S FORDS=9
..I TOP>67419,TOP<67422 D D SM Q
...I SM'="" S FORDS=9
..I TOP>67422,TOP<67425 D D SM Q
...I SM'="" S FORDS=9
..I TOP>67759,TOP<67769 D D SM Q
...I SM'="" S FORDS=9
..I TOP=67809 D D SM Q
...I SM'="" S FORDS=9
..I TOP>67769,TOP<67780,((HIST3>9589)&(HIST3<9597))!((HIST3>9649)&(HIST3<9720))!((HIST3>9726)&(HIST3<9730)) D D SM Q
...I SM'="" S FORDS=9
..I TOP>67769,TOP<67780,((HIST2>9589)&(HIST2<9597))!((HIST2>9649)&(HIST2<9720))!((HIST2>9726)&(HIST2<9730)) D D SM Q
...I SM'="" S FORDS=9
..I SPP'="",+SPP=0 D D SM Q
...I SM'="" S FORDS=8
..I ((TOP>67499)&(TOP<67510))!(TOP=67619) D D SM Q
...I SM=0 S FORDS=0
...I SM=1 S FORDS=1
...I SM=2 S FORDS=2
...I SM=7 S FORDS=7
...I SM=8 S FORDS=8
...I SM=9 S FORDS=9
...I (SM=3)!(SM=4) S FORDS=2
...I SM=5 S FORDS=3
..I TOP=67569 D D SM Q
...I SM=0 S FORDS=9
...I (SM=1)!(SM=2)!(SM=3)!(SM=4) S FORDS=3
...I SM=8 S FORDS=8
...I SM=9 S FORDS=9
..I SM=0 S FORDS=0 D SM Q
..I SM=1 S FORDS=1 D SM Q
..I SM=2 S FORDS=2 D SM Q
..I SM=5 S FORDS=3 D SM Q
..I SM=7 S FORDS=7 D SM Q
..I SM=8 S FORDS=8 D SM Q
..I SM=9 S FORDS=9 D SM Q
..S FORDS=9 D SM Q
..
D S $P(^ONCO(165.5,IEN,27),U,3)="Y"
.I $P($G(^ONCO(165.5,IEN,27)),U,3)="Y" Q
.S (FORDS,FORDSAF)="" D
..I ($D(HIST(HIST2)))!($D(HIST(HIST3))) D D SLN Q
...I SLN'="" S FORDS=9
...I SLNAF'="" S FORDSAF=9
...S SUB=0 F S SUB=$O(SUBTX(SUB)) Q:SUB'>0 D D SUBSLN
....S FORDSUB=""
....I $P(SUBTX(SUB),U,3)'="" S FORDSUB=9
..
..I ((TOP>66999)&(TOP<67139))!((TOP>67319)&(TOP<67330))!(TOP=67739) D D SLN Q
...I SLN=0 S FORDS=0
...I SLNAF=0 S FORDSAF=0
...I SLN=1 S FORDS=1
...I SLNAF=1 S FORDSAF=1
...I SLN=9 S FORDS=9
...I SLNAF=9 S FORDSAF=9
...I ((SLN=2)!(SLN=4)!(SLN=5)),NNE>95,NNE<99 S FORDS=3
...I ((SLNAF=2)!(SLNAF=4)!(SLNAF=5)),NNEAF>95,NNEAF<99 S FORDSAF=3
...I ((SLN=2)!(SLN=4)!(SLN=5)),((NNE=99)!(NNE="")) S FORDS=9
...I ((SLNAF=2)!(SLNAF=4)!(SLNAF=5)),((NNEAF=99)!(NNEAF="")) S FORDSAF=9
...I SLN=3,((NNE>95)!(NNE="")) S FORDS=3
...I SLNAF=3,((NNEAF>95)!(NNEAF="")) S FORDSAF=3
...I ((SLN>1)&(SLN<6)),+NNE>0,+NNE<4 S FORDS=4
...I ((SLNAF>1)&(SLNAF<6)),+NNEAF>0,+NNEAF<4 S FORDSAF=4
...I ((SLN>1)&(SLN<6)),+NNE>3,+NNE<91 S FORDS=5
...I ((SLNAF>1)&(SLNAF<6)),+NNEAF>3,+NNEAF<91 S FORDSAF=5
...I ((SLN>1)&(SLN<6)),NNE=95 S FORDS=1
...I ((SLNAF>1)&(SLNAF<6)),NNEAF=95 S FORDSAF=1
...I SLN>0,FORDS="" S FORDS=9
...I SLNAF>0,FORDSAF="" S FORDSAF=9
...S SUB=0 F S SUB=$O(SUBTX(SUB)) Q:SUB'>0 D D SUBSLN
....S FORDSUB=""
....I $P(SUBTX(SUB),U,3)=0 S FORDSUB=0 Q
....I $P(SUBTX(SUB),U,3)=1 S FORDSUB=1 Q
....I $P(SUBTX(SUB),U,3)=9 S FORDSUB=9 Q
....I (($P(SUBTX(SUB),U,3)=2)!($P(SUBTX(SUB),U,3)=4)!($P(SUBTX(SUB),U,3)=5)),+$P(SUBTX(SUB),U,4)>95,+$P(SUBTX(SUB),U,4)<99 S FORDSUB=3 Q
....I (($P(SUBTX(SUB),U,3)=2)!($P(SUBTX(SUB),U,3)=4)!($P(SUBTX(SUB),U,3)=5)),((+$P(SUBTX(SUB),U,4)=99)!($P(SUBTX(SUB),U,4)="")) S FORDSUB=9 Q
....I $P(SUBTX(SUB),U,3)=3,((+$P(SUBTX(SUB),U,4)>95)!($P(SUBTX(SUB),U,4)="")) S FORDSUB=3 Q
....I (($P(SUBTX(SUB),U,3)>1)&($P(SUBTX(SUB),U,3)<6)),+$P(SUBTX(SUB),U,4)>0,+$P(SUBTX(SUB),U,4)<4 S FORDSUB=4 Q
....I (($P(SUBTX(SUB),U,3)>1)&($P(SUBTX(SUB),U,3)<6)),+$P(SUBTX(SUB),U,4)>3,+$P(SUBTX(SUB),U,4)<91 S FORDSUB=5 Q
....I (($P(SUBTX(SUB),U,3)>1)&($P(SUBTX(SUB),U,3)<6)),+$P(SUBTX(SUB),U,4)=95 S FORDSUB=1 Q
....I $P(SUBTX(SUB),U,3)>0,FORDSUB="" S FORDSUB=9 Q
..
..I TOP>67419,TOP<67422 D D SLN Q
...I SLN'="" S FORDS=9
...I SLNAF'="" S FORDSAF=9
...S SUB=0 F S SUB=$O(SUBTX(SUB)) Q:SUB'>0 D D SUBSLN
....S FORDSUB=""
....I $P(SUBTX(SUB),U,3)'="" S FORDSUB=9 Q
..
..I TOP>67422,TOP<67425 D D SLN Q
...I SLN'="" S FORDS=9
...I SLNAF'="" S FORDSAF=9
...S SUB=0 F S SUB=$O(SUBTX(SUB)) Q:SUB'>0 D D SUBSLN
....S FORDSUB=""
....I $P(SUBTX(SUB),U,3)'="" S FORDSUB=9 Q
..
..I TOP>67439,TOP<67450 D D SLN Q
...I SLN=0 S FORDS=0
...I SLNAF=0 S FORDSAF=0
...I SLN=9 S FORDS=9
...I SLNAF=9 S FORDSAF=9
...I SLN=1 S FORDS=2
...I SLNAF=1 S FORDSAF=2
...I SLN=2,+NNE>0,+NNE<4 S FORDS=4
...I SLNAF=2,+NNEAF>0,+NNEAF<4 S FORDSAF=4
...I SLN=2,+NNE>3,+NNE<91 S FORDS=5
...I SLNAF=2,+NNEAF>3,+NNEAF<91 S FORDSAF=5
...I SLN=2,NNE=95 S FORDS=1
...I SLNAF=2,NNEAF=95 S FORDSAF=1
...I SLN=2,((NNE>95)!(NNE="")) S FORDS=3
...I SLNAF=2,((NNEAF>95)!(NNEAF="")) S FORDSAF=3
...I SLN>0,FORDS="" S FORDS=9
...I SLNAF>0,FORDSAF="" S FORDSAF=9
...S SUB=0 F S SUB=$O(SUBTX(SUB)) Q:SUB'>0 D D SUBSLN
....S FORDSUB=""
....I $P(SUBTX(SUB),U,3)=0 S FORDSUB=0 Q
....I $P(SUBTX(SUB),U,3)=9 S FORDSUB=9 Q
....I $P(SUBTX(SUB),U,3)=1 S FORDSUB=2 Q
....I $P(SUBTX(SUB),U,3)=2,+$P(SUBTX(SUB),U,4)>0,+$P(SUBTX(SUB),U,4)<4 S FORDSUB=4 Q
....I $P(SUBTX(SUB),U,3)=2,+$P(SUBTX(SUB),U,4)>3,+$P(SUBTX(SUB),U,4)<91 S FORDSUB=5 Q
....I $P(SUBTX(SUB),U,3)=2,+$P(SUBTX(SUB),U,4)=95 S FORDSUB=1 Q
....I $P(SUBTX(SUB),U,3)=2,((+$P(SUBTX(SUB),U,4)>95)!($P(SUBTX(SUB),U,4)="")) S FORDSUB=3 Q
....I $P(SUBTX(SUB),U,3)>0,FORDSUB="" S FORDSUB=9 Q
..
..I TOP>67499,TOP<67510 D D SLN Q
...I SLN=0 S FORDS=0
...I SLNAF=0 S FORDSAF=0
...I SLN=9 S FORDS=9
...I SLNAF=9 S FORDSAF=9
...I SLN=1 S FORDS=2
...I SLNAF=1 S FORDSAF=2
...I ((SLN=2)!(SLN=4)!(SLN=5)),+NNE>0,+NNE<4 S FORDS=4
...I ((SLNAF=2)!(SLNAF=4)!(SLNAF=5)),+NNEAF>0,+NNEAF<4 S FORDSAF=4
...I ((SLN=2)!(SLN=4)!(SLN=5)),+NNE>3,+NNE<89 S FORDS=5
...I ((SLNAF=2)!(SLNAF=4)!(SLNAF=5)),+NNEAF>3,+NNEAF<89 S FORDSAF=5
...I ((SLN=2)!(SLN=4)!(SLN=5)),NNE=95 S FORDS=1
...I ((SLNAF=2)!(SLNAF=4)!(SLNAF=5)),NNEAF=95 S FORDSAF=1
...I ((SLN=2)!(SLN=4)!(SLN=5)),((NNE>95)!(NNE="")) S FORDS=3
...I ((SLNAF=2)!(SLNAF=4)!(SLNAF=5)),((NNEAF>95)!(NNEAF="")) S FORDSAF=3
...I SLN=3 S FORDS=6
...I SLNAF=3 S FORDSAF=6
...I SLN>0,FORDS="" S FORDS=9
...I SLNAF>0,FORDSAF="" S FORDSAF=9
...S SUB=0 F S SUB=$O(SUBTX(SUB)) Q:SUB'>0 D D SUBSLN
....S FORDSUB=""
....I $P(SUBTX(SUB),U,3)=0 S FORDSUB=0 Q
....I $P(SUBTX(SUB),U,3)=9 S FORDSUB=9 Q
....I $P(SUBTX(SUB),U,3)=1 S FORDSUB=2 Q
....I (($P(SUBTX(SUB),U,3)=2)!($P(SUBTX(SUB),U,3)=4)!($P(SUBTX(SUB),U,3)=5)),+$P(SUBTX(SUB),U,4)>0,+$P(SUBTX(SUB),U,4)<4 S FORDSUB=4 Q
....I (($P(SUBTX(SUB),U,3)=2)!($P(SUBTX(SUB),U,3)=4)!($P(SUBTX(SUB),U,3)=5)),+$P(SUBTX(SUB),U,4)>3,+$P(SUBTX(SUB),U,4)<91 S FORDSUB=5 Q
....I (($P(SUBTX(SUB),U,3)=2)!($P(SUBTX(SUB),U,3)=4)!($P(SUBTX(SUB),U,3)=5)),+$P(SUBTX(SUB),U,4)=95 S FORDSUB=1 Q
....I (($P(SUBTX(SUB),U,3)=2)!($P(SUBTX(SUB),U,3)=4)!($P(SUBTX(SUB),U,3)=5)),((+$P(SUBTX(SUB),U,4)>95)!($P(SUBTX(SUB),U,4)="")) S FORDSUB=3 Q
....I $P(SUBTX(SUB),U,3)=3 S FORDSUB=6 Q
....I $P(SUBTX(SUB),U,3)>0,FORDSUB="" S FORDSUB=9 Q
..
..D ^ONCP36B1 Q
Q
;
SM S:FORDS'="" $P(^ONCO(165.5,IEN,3),U,28)=FORDS
Q
;
SLN S:FORDS'="" $P(^ONCO(165.5,IEN,3.1),U,31)=FORDS
S:FORDSAF'="" $P(^ONCO(165.5,IEN,3.1),U,32)=FORDSAF
Q
;
SUBSLN S:FORDSUB'="" $P(^ONCO(165.5,IEN,4,SUB,2),U,32)=FORDSUB
Q