278 lines
8.9 KiB
Mathematica
278 lines
8.9 KiB
Mathematica
ONCP36C ;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,4)="Y"
|
|
.I $P($G(^ONCO(165.5,IEN,27)),U,4)="Y" Q
|
|
.S (FORDS,FORDSAF)=""
|
|
.I ($D(HIST(HIST2)))!($D(HIST(HIST3))) D D SPO Q
|
|
..I ((SPP>9)&(SPP<91))!((SLN>0)&(SLN<9)) S FORDS=1
|
|
..I ((SPPAF>9)&(SPPAF<91))!((SLNAF>0)&(SLNAF<9)) S FORDSAF=1
|
|
..I SPO=0 S FORDS=0
|
|
..I SPOAF=0 S FORDSAF=0
|
|
..I SPO=1 S FORDS=1
|
|
..I SPOAF=1 S FORDSAF=1
|
|
..I SPO=9 S FORDS=9
|
|
..I SPOAF=9 S FORDSAF=9
|
|
..I (SPO=2)!(SPO=3)!(SPO=4)!(SPO=5) S FORDS=1
|
|
..I (SPOAF=2)!(SPOAF=3)!(SPOAF=4)!(SPOAF=5) S FORDSAF=1
|
|
..I SPO>0,FORDS="" S FORDS=9
|
|
..I SPOAF>0,FORDSAF="" S FORDSAF=9
|
|
..S SUB=0 F S SUB=$O(SUBTX(SUB)) Q:SUB'>0 D D SUBSPO
|
|
...S FORDSUB=""
|
|
...I (($P(SUBTX(SUB),U,1)>9)&($P(SUBTX(SUB),U,1)<91))!(($P(SUBTX(SUB),U,3)>0)&($P(SUBTX(SUB),U,3)<9)) S FORDSUB=1 Q
|
|
...I $P(SUBTX(SUB),U,5)=0 S FORDSUB=0 Q
|
|
...I $P(SUBTX(SUB),U,5)=1 S FORDSUB=1 Q
|
|
...I $P(SUBTX(SUB),U,5)=9 S FORDSUB=9 Q
|
|
...I ($P(SUBTX(SUB),U,5)=2)!($P(SUBTX(SUB),U,5)=3)!($P(SUBTX(SUB),U,5)=4)!($P(SUBTX(SUB),U,5)=5) S FORDSUB=1 Q
|
|
...I $P(SUBTX(SUB),U,5)>0,FORDSUB="" S FORDSUB=9 Q
|
|
.
|
|
.I ((TOP>67419)&(TOP<67422))!((TOP>67422)&(TOP<67425))!((TOP>67759)&(TOP<67769))!(TOP=67809) D D SPO Q
|
|
..I ((SPP>9)&(SPP<91))!((SLN>0)&(SLN<9)) S FORDS=1
|
|
..I ((SPPAF>9)&(SPPAF<91))!((SLNAF>0)&(SLNAF<9)) S FORDSAF=1
|
|
..S SUB=0 F S SUB=$O(SUBTX(SUB)) Q:SUB'>0 D D SUBSPO
|
|
...S FORDSUB=""
|
|
...I (($P(SUBTX(SUB),U,1)>9)&($P(SUBTX(SUB),U,1)<91))!(($P(SUBTX(SUB),U,3)>0)&($P(SUBTX(SUB),U,3)<9)) S FORDSUB=1 Q
|
|
.
|
|
.I ((TOP>66999)&(TOP<67070)) D D SPO Q
|
|
..I SPO=0 S FORDS=0
|
|
..I SPOAF=0 S FORDSAF=0
|
|
..I SPO=1 S FORDS=1
|
|
..I SPOAF=1 S FORDSAF=1
|
|
..I SPO=9 S FORDS=9
|
|
..I SPOAF=9 S FORDSAF=9
|
|
..I ((SPO=2)!(SPO=3)!(SPO=4)) S FORDS=2
|
|
..I ((SPOAF=2)!(SPOAF=3)!(SPOAF=4)) S FORDSAF=2
|
|
..I SPO=5 S FORDS=3
|
|
..I SPOAF=5 S FORDSAF=3
|
|
..I SPO=6 S FORDS=4
|
|
..I SPOAF=6 S FORDSAF=4
|
|
..I SPO=7 S FORDS=5
|
|
..I SPOAF=7 S FORDSAF=5
|
|
..S SUB=0 F S SUB=$O(SUBTX(SUB)) Q:SUB'>0 D D SUBSPO
|
|
...S FORDSUB=""
|
|
...I $P(SUBTX(SUB),U,5)=0 S FORDSUB=0 Q
|
|
...I $P(SUBTX(SUB),U,5)=1 S FORDSUB=1 Q
|
|
...I $P(SUBTX(SUB),U,5)=9 S FORDSUB=9 Q
|
|
...I (($P(SUBTX(SUB),U,5)=2)!($P(SUBTX(SUB),U,5)=3)!($P(SUBTX(SUB),U,5)=4)) S FORDSUB=2 Q
|
|
...I $P(SUBTX(SUB),U,5)=5 S FORDSUB=3 Q
|
|
...I $P(SUBTX(SUB),U,5)=6 S FORDSUB=4 Q
|
|
...I $P(SUBTX(SUB),U,5)=7 S FORDSUB=5 Q
|
|
.
|
|
.I TOP>67089,TOP<67139 D D SPO Q
|
|
..I SPO=0 S FORDS=0
|
|
..I SPOAF=0 S FORDSAF=0
|
|
..I SPO=1 S FORDS=1
|
|
..I SPOAF=1 S FORDSAF=1
|
|
..I SPO=9 S FORDS=9
|
|
..I SPOAF=9 S FORDSAF=9
|
|
..I SPO>1,SPO<7 S FORDS=2
|
|
..I SPOAF>1,SPOAF<7 S FORDSAF=2
|
|
..I SPO=7 S FORDS=1
|
|
..I SPOAF=7 S FORDSAF=1
|
|
..I SPO=8 S FORDS=5
|
|
..I SPOAF=8 S FORDSAF=5
|
|
..S SUB=0 F S SUB=$O(SUBTX(SUB)) Q:SUB'>0 D D SUBSPO
|
|
...S FORDSUB=""
|
|
...I $P(SUBTX(SUB),U,5)=0 S FORDSUB=0 Q
|
|
...I $P(SUBTX(SUB),U,5)=1 S FORDSUB=1 Q
|
|
...I $P(SUBTX(SUB),U,5)=9 S FORDSUB=9 Q
|
|
...I $P(SUBTX(SUB),U,5)>1,$P(SUBTX(SUB),U,5)<7 S FORDSUB=2 Q
|
|
...I $P(SUBTX(SUB),U,5)=7 S FORDSUB=1 Q
|
|
...I $P(SUBTX(SUB),U,5)=8 S FORDSUB=5 Q
|
|
.
|
|
.I TOP>67179,TOP<67210 D D SPO Q
|
|
..I SPO=0 S FORDS=0
|
|
..I SPOAF=0 S FORDSAF=0
|
|
..I SPO=1 S FORDS=1
|
|
..I SPOAF=1 S FORDSAF=1
|
|
..I SPO=9 S FORDS=9
|
|
..I SPOAF=9 S FORDSAF=9
|
|
..I SPO>1,SPO<6 S FORDS=2
|
|
..I SPOAF>1,SPOAF<6 S FORDSAF=2
|
|
..I SPO=6 S FORDS=1
|
|
..I SPOAF=6 S FORDSAF=1
|
|
..I (SPO=7)!(SPO=8) S FORDS=5
|
|
..I (SPOAF=7)!(SPOAF=8) S FORDSAF=5
|
|
..S SUB=0 F S SUB=$O(SUBTX(SUB)) Q:SUB'>0 D D SUBSPO
|
|
...S FORDSUB=""
|
|
...I $P(SUBTX(SUB),U,5)=0 S FORDSUB=0 Q
|
|
...I $P(SUBTX(SUB),U,5)=1 S FORDSUB=1 Q
|
|
...I $P(SUBTX(SUB),U,5)=9 S FORDSUB=9 Q
|
|
...I $P(SUBTX(SUB),U,5)>1,$P(SUBTX(SUB),U,5)<6 S FORDSUB=2 Q
|
|
...I $P(SUBTX(SUB),U,5)=6 S FORDSUB=1 Q
|
|
...I ($P(SUBTX(SUB),U,5)=7)!($P(SUBTX(SUB),U,5)=8) S FORDSUB=5 Q
|
|
.
|
|
.I TOP>67339,TOP<67350 D D SPO Q
|
|
..I SPO=0 S FORDS=0
|
|
..I SPOAF=0 S FORDSAF=0
|
|
..I SPO=1 S FORDS=1
|
|
..I SPOAF=1 S FORDSAF=1
|
|
..I SPO=2 S FORDS=2
|
|
..I SPOAF=2 S FORDSAF=2
|
|
..I SPO=9 S FORDS=9
|
|
..I SPOAF=9 S FORDSAF=9
|
|
..I SPO=3 S FORDS=2
|
|
..I SPOAF=3 S FORDSAF=2
|
|
..I (SPO=4)!(SPO=6) S FORDS=1
|
|
..I (SPOAF=4)!(SPOAF=6) S FORDSAF=1
|
|
..I (SPO=5)!(SPO=7) S FORDS=4
|
|
..I (SPOAF=5)!(SPOAF=7) S FORDSAF=4
|
|
..S SUB=0 F S SUB=$O(SUBTX(SUB)) Q:SUB'>0 D D SUBSPO
|
|
...S FORDSUB=""
|
|
...I $P(SUBTX(SUB),U,5)=0 S FORDSUB=0 Q
|
|
...I $P(SUBTX(SUB),U,5)=1 S FORDSUB=1 Q
|
|
...I $P(SUBTX(SUB),U,5)=2 S FORDSUB=2 Q
|
|
...I $P(SUBTX(SUB),U,5)=9 S FORDSUB=9 Q
|
|
...I $P(SUBTX(SUB),U,5)=3 S FORDSUB=2 Q
|
|
...I ($P(SUBTX(SUB),U,5)=4)!($P(SUBTX(SUB),U,5)=6) S FORDSUB=1 Q
|
|
...I ($P(SUBTX(SUB),U,5)=5)!($P(SUBTX(SUB),U,5)=7) S FORDSUB=4 Q
|
|
.
|
|
.I ((TOP>67419)&(TOP<67422))!((TOP>67422)&(TOP<67425)) D D SPO Q
|
|
..I SPO=0 S FORDS=0
|
|
..I SPOAF=0 S FORDSAF=0
|
|
..I SPO=1 S FORDS=1
|
|
..I SPOAF=1 S FORDSAF=1
|
|
..I SPO=9 S FORDS=9
|
|
..I SPOAF=9 S FORDSAF=9
|
|
..I SPO>1,SPO<6 S FORDS=1
|
|
..I SPOAF>1,SPOAF<6 S FORDSAF=1
|
|
..S SUB=0 F S SUB=$O(SUBTX(SUB)) Q:SUB'>0 D D SUBSPO
|
|
...S FORDSUB=""
|
|
...I $P(SUBTX(SUB),U,5)=0 S FORDSUB=0 Q
|
|
...I $P(SUBTX(SUB),U,5)=1 S FORDSUB=1 Q
|
|
...I $P(SUBTX(SUB),U,5)=9 S FORDSUB=9 Q
|
|
...I $P(SUBTX(SUB),U,5)>1,$P(SUBTX(SUB),U,5)<6 S FORDSUB=1 Q
|
|
.
|
|
.I (TOP=67422)!((TOP>67699)&(TOP<67730))!((TOP>67769)&(TOP<67780)) D D SPO Q
|
|
..I SPO=0 S FORDS=0
|
|
..I SPOAF=0 S FORDSAF=0
|
|
..I SPO=1 S FORDS=1
|
|
..I SPOAF=1 S FORDSAF=1
|
|
..I SPO=2 S FORDS=2
|
|
..I SPOAF=2 S FORDSAF=2
|
|
..I SPO=9 S FORDS=9
|
|
..I SPOAF=9 S FORDSAF=9
|
|
..I SPO=5 S FORDS=3
|
|
..I SPOAF=5 S FORDSAF=3
|
|
..I SPO=6 S FORDS=4
|
|
..I SPOAF=6 S FORDSAF=4
|
|
..I SPO=7 S FORDS=5
|
|
..I SPOAF=7 S FORDSAF=5
|
|
..S SUB=0 F S SUB=$O(SUBTX(SUB)) Q:SUB'>0 D D SUBSPO
|
|
...S FORDSUB=""
|
|
...I $P(SUBTX(SUB),U,5)=0 S FORDSUB=0 Q
|
|
...I $P(SUBTX(SUB),U,5)=1 S FORDSUB=1 Q
|
|
...I $P(SUBTX(SUB),U,5)=2 S FORDSUB=2 Q
|
|
...I $P(SUBTX(SUB),U,5)=9 S FORDSUB=9 Q
|
|
...I $P(SUBTX(SUB),U,5)=5 S FORDSUB=3 Q
|
|
...I $P(SUBTX(SUB),U,5)=6 S FORDSUB=4 Q
|
|
...I $P(SUBTX(SUB),U,5)=7 S FORDSUB=5 Q
|
|
.
|
|
.I TOP>67499,TOP<67510 D D SPO Q
|
|
..I SPO=0 S FORDS=0
|
|
..I SPOAF=0 S FORDSAF=0
|
|
..I SPO=1 S FORDS=1
|
|
..I SPOAF=1 S FORDSAF=1
|
|
..I SPO=2 S FORDS=2
|
|
..I SPOAF=2 S FORDSAF=2
|
|
..I SPO=3 S FORDS=3
|
|
..I SPOAF=3 S FORDSAF=3
|
|
..I SPO=4 S FORDS=4
|
|
..I SPOAF=4 S FORDSAF=4
|
|
..I SPO=9 S FORDS=9
|
|
..I SPOAF=9 S FORDSAF=9
|
|
..I SPO=5 S FORDS=4
|
|
..I SPOAF=5 S FORDSAF=4
|
|
..I SPO=6 S FORDS=5
|
|
..I SPOAF=6 S FORDSAF=5
|
|
..S SUB=0 F S SUB=$O(SUBTX(SUB)) Q:SUB'>0 D D SUBSPO
|
|
...S FORDSUB=""
|
|
...I $P(SUBTX(SUB),U,5)=0 S FORDSUB=0 Q
|
|
...I $P(SUBTX(SUB),U,5)=1 S FORDSUB=1 Q
|
|
...I $P(SUBTX(SUB),U,5)=2 S FORDSUB=2 Q
|
|
...I $P(SUBTX(SUB),U,5)=3 S FORDSUB=3 Q
|
|
...I $P(SUBTX(SUB),U,5)=4 S FORDSUB=4 Q
|
|
...I $P(SUBTX(SUB),U,5)=9 S FORDSUB=9 Q
|
|
...I $P(SUBTX(SUB),U,5)=5 S FORDSUB=4 Q
|
|
...I $P(SUBTX(SUB),U,5)=6 S FORDSUB=5 Q
|
|
.
|
|
.I TOP>67529,TOP<67540 D D SPO Q
|
|
..I SPO=0 S FORDS=0
|
|
..I SPOAF=0 S FORDSAF=0
|
|
..I SPO=1 S FORDS=1
|
|
..I SPOAF=1 S FORDSAF=1
|
|
..I SPO=2 S FORDS=2
|
|
..I SPOAF=2 S FORDSAF=2
|
|
..I SPO=3 S FORDS=3
|
|
..I SPOAF=3 S FORDSAF=3
|
|
..I SPO=9 S FORDS=9
|
|
..I SPOAF=9 S FORDSAF=9
|
|
..I SPO=4 S FORDS=3
|
|
..I SPOAF=4 S FORDSAF=3
|
|
..I SPO=5 S FORDS=4
|
|
..I SPOAF=5 S FORDSAF=4
|
|
..I (SPO=6)!(SPO=7) S FORDS=5
|
|
..I (SPOAF=6)!(SPOAF=7) S FORDSAF=5
|
|
..S SUB=0 F S SUB=$O(SUBTX(SUB)) Q:SUB'>0 D D SUBSPO
|
|
...S FORDSUB=""
|
|
...I $P(SUBTX(SUB),U,5)=0 S FORDSUB=0 Q
|
|
...I $P(SUBTX(SUB),U,5)=1 S FORDSUB=1 Q
|
|
...I $P(SUBTX(SUB),U,5)=2 S FORDSUB=2 Q
|
|
...I $P(SUBTX(SUB),U,5)=3 S FORDSUB=3 Q
|
|
...I $P(SUBTX(SUB),U,5)=9 S FORDSUB=9 Q
|
|
...I $P(SUBTX(SUB),U,5)=4 S FORDSUB=3 Q
|
|
...I $P(SUBTX(SUB),U,5)=5 S FORDSUB=4 Q
|
|
...I ($P(SUBTX(SUB),U,5)=6)!($P(SUBTX(SUB),U,5)=7) S FORDSUB=5 Q
|
|
.
|
|
.I ((TOP>67759)&(TOP<67769))!(TOP=67809) D D SPO Q
|
|
..I SPO=0 S FORDS=0
|
|
..I SPOAF=0 S FORDSAF=0
|
|
..I SPO=1 S FORDS=1
|
|
..I SPOAF=1 S FORDSAF=1
|
|
..I SPO=9 S FORDS=9
|
|
..I SPOAF=9 S FORDSAF=9
|
|
..I SPO>1,SPO<6 S FORDS=1
|
|
..I SPOAF>1,SPOAF<6 S FORDSAF=1
|
|
..S SUB=0 F S SUB=$O(SUBTX(SUB)) Q:SUB'>0 D D SUBSPO
|
|
...S FORDSUB=""
|
|
...I $P(SUBTX(SUB),U,5)=0 S FORDSUB=0 Q
|
|
...I $P(SUBTX(SUB),U,5)=1 S FORDSUB=1 Q
|
|
...I $P(SUBTX(SUB),U,5)=9 S FORDSUB=9 Q
|
|
...I $P(SUBTX(SUB),U,5)>1,$P(SUBTX(SUB),U,5)<6 S FORDSUB=1 Q
|
|
.
|
|
.D D SPO Q
|
|
..I SPO=0 S FORDS=0
|
|
..I SPOAF=0 S FORDSAF=0
|
|
..I SPO=1 S FORDS=1
|
|
..I SPOAF=1 S FORDSAF=1
|
|
..I SPO=2 S FORDS=2
|
|
..I SPOAF=2 S FORDSAF=2
|
|
..I SPO=3 S FORDS=3
|
|
..I SPOAF=3 S FORDSAF=3
|
|
..I SPO=4 S FORDS=4
|
|
..I SPOAF=4 S FORDSAF=4
|
|
..I SPO=5 S FORDS=5
|
|
..I SPOAF=5 S FORDSAF=5
|
|
..I SPO=9 S FORDS=9
|
|
..I SPOAF=9 S FORDSAF=9
|
|
..I SPO>0,FORDS="" S FORDS=9
|
|
..I SPOAF>0,FORDSAF="" S FORDSAF=9
|
|
..S SUB=0 F S SUB=$O(SUBTX(SUB)) Q:SUB'>0 D D SUBSPO
|
|
...S FORDSUB=""
|
|
...I $P(SUBTX(SUB),U,5)=0 S FORDSUB=0 Q
|
|
...I $P(SUBTX(SUB),U,5)=1 S FORDSUB=1 Q
|
|
...I $P(SUBTX(SUB),U,5)=2 S FORDSUB=2 Q
|
|
...I $P(SUBTX(SUB),U,5)=3 S FORDSUB=3 Q
|
|
...I $P(SUBTX(SUB),U,5)=4 S FORDSUB=4 Q
|
|
...I $P(SUBTX(SUB),U,5)=5 S FORDSUB=5 Q
|
|
...I $P(SUBTX(SUB),U,5)=9 S FORDSUB=9 Q
|
|
...I $P(SUBTX(SUB),U,5)>0,FORDSUB="" S FORDSUB=9 Q
|
|
Q
|
|
;
|
|
SPO S:FORDS'="" $P(^ONCO(165.5,IEN,3.1),U,33)=FORDS
|
|
S:FORDSAF'="" $P(^ONCO(165.5,IEN,3.1),U,34)=FORDSAF
|
|
Q
|
|
;
|
|
SUBSPO S:FORDSUB'="" $P(^ONCO(165.5,IEN,4,SUB,2),U,33)=FORDSUB
|
|
Q
|