238 lines
8.5 KiB
Mathematica
238 lines
8.5 KiB
Mathematica
ONCP36A ;HINES OIFO/GWB-POST-INSTALL ROUTINE FOR PATCH ONC*2.11*36
|
|
;;2.11;ONCOLOGY;**36**;Mar 07, 1995
|
|
;
|
|
D Q
|
|
.S DATEDX=$P($G(^ONCO(165.5,IEN,0)),U,16)
|
|
.S TOP=$P($G(^ONCO(165.5,IEN,2)),U,1)
|
|
.S HIST2=$E($$GET1^DIQ(165.5,IEN,22,"I"),1,4) I HIST2="" S HIST2=2222
|
|
.S HIST3=$E($$GET1^DIQ(165.5,IEN,22.1,"I"),1,4) I HIST3="" S HIST3=3333
|
|
.S HIST(9720)=""
|
|
.S HIST(9750)=""
|
|
.F H=9760:1:9764 S HIST(H)=""
|
|
.F H=9800:1:9820 S HIST(H)=""
|
|
.S HIST(9826)=""
|
|
.F H=9831:1:9897 S HIST(H)=""
|
|
.F H=9910:1:9920 S HIST(H)=""
|
|
.F H=9931:1:9964 S HIST(H)=""
|
|
.F H=9980:1:9989 S HIST(H)=""
|
|
.S SPP=$$RXPRI^ONCACDU2(IEN,58.2,"SPS")
|
|
.S SPPAF=$$RXPRI^ONCACDU2(IEN,50.2,"SPS")
|
|
.S SPPPNT=$P($G(^ONCO(165.5,IEN,3)),U,38)
|
|
.S SPPAFPNT=$P($G(^ONCO(165.5,IEN,3.1)),U,7)
|
|
.
|
|
.K SUBTX
|
|
.S SUB=0 F I=1:1 S SUB=$O(^ONCO(165.5,IEN,4,SUB)) Q:SUB'>0 D
|
|
..S SUBTX(SUB)=$$SUB^ONCACDU2(IEN,SUB+1,.04)
|
|
..S SUBRR=$$SUB^ONCACDU2(IEN,SUB+1,33)
|
|
..S $P(SUBTX(SUB),U,2)=SUBRR
|
|
..S $P(SUBTX(SUB),U,3)="X"
|
|
..S SUBSLN=$$SUB^ONCACDU2(IEN,SUB+1,35)
|
|
..S:SUBSLN'="" $P(SUBTX(SUB),U,3)=SUBSLN
|
|
..S SUBNNE=$$SUB^ONCACDU2(IEN,SUB+1,37)
|
|
..S $P(SUBTX(SUB),U,4)=SUBNNE
|
|
..S SUBSPO=$$SUB^ONCACDU2(IEN,SUB+1,36)
|
|
..S $P(SUBTX(SUB),U,5)=SUBSPO
|
|
..S SUBCT=$P(^ONCO(165.5,IEN,4,SUB,0),U,6)
|
|
..S $P(SUBTX(SUB),U,6)=SUBCT
|
|
..S SUBHT=$P(^ONCO(165.5,IEN,4,SUB,0),U,7)
|
|
..S $P(SUBTX(SUB),U,7)=SUBHT
|
|
..S SUBIT=$P(^ONCO(165.5,IEN,4,SUB,0),U,8)
|
|
..S $P(SUBTX(SUB),U,8)=SUBIT
|
|
.
|
|
.S SLN=$$RXPRI^ONCACDU2(IEN,138,"SC5")
|
|
.S SLNAF=$$RXPRI^ONCACDU2(IEN,138.1,"SC5")
|
|
.S NNE=$$GET1^DIQ(165.5,IEN,140,"I")
|
|
.S NNEAF=$$GET1^DIQ(165.5,IEN,140.1,"I")
|
|
.S RR=$$RXPRI^ONCACDU2(IEN,23,"RR5")
|
|
.S SM=$$RXPRI^ONCACDU2(IEN,59,"SM5")
|
|
.S SCP=$$RXPRI^ONCACDU2(IEN,138,"SC5")
|
|
.S SCPAF=$$RXPRI^ONCACDU2(IEN,138.1,"SC5")
|
|
.S SPO=$$RXPRI^ONCACDU2(IEN,139,"SO5")
|
|
.S SPOAF=$$RXPRI^ONCACDU2(IEN,139.1,"SO5")
|
|
.S RFNS=$$GET1^DIQ(165.5,IEN,58,"I")
|
|
.S (FORDS,FORDSAF)=""
|
|
.I DATEDX<2980000 D SPP Q
|
|
.D
|
|
..I ($D(HIST(HIST2)))!($D(HIST(HIST3))) D D SPP Q
|
|
...I SPP'="" S FORDS=1
|
|
...I SPPAF'="" S FORDSAF=1
|
|
...S SUB=0 F S SUB=$O(SUBTX(SUB)) Q:SUB'>0 D D SUBTX
|
|
....I $P(SUBTX(SUB),U,1)'="" S FORDSUB=1
|
|
..
|
|
..I TOP>67078,TOP<67090 D D SPP Q
|
|
...I SPP>49,SPP<53,RR>0,RR<4 S FORDS=33
|
|
...I SPPAF>49,SPPAF<53,RR>0,RR<4 S FORDSAF=33
|
|
...S SUB=0 F S SUB=$O(SUBTX(SUB)) Q:SUB'>0 D D SUBTX
|
|
....S FORDSUB=""
|
|
....I $P(SUBTX(SUB),U,1)>49,$P(SUBTX(SUB),U,1)<53,$P(SUBTX(SUB),U,2)>0,$P(SUBTX(SUB),U,2)<4 S FORDSUB=33
|
|
..
|
|
..I TOP>67149,TOP<67160 D D SPP Q
|
|
...I (SPP=60)!(SPP=70) S FORDS=17
|
|
...I (SPPAF=60)!(SPPAF=70) S FORDSAF=17
|
|
...I SPP=61 S FORDS=18
|
|
...I SPPAF=61 S FORDSAF=18
|
|
...I SPP=62 S FORDS=19
|
|
...I SPPAF=62 S FORDSAF=19
|
|
...I SPP=63 S FORDS=20
|
|
...I SPPAF=63 S FORDSAF=20
|
|
...I SPP=64 S FORDS=21
|
|
...I SPPAF=64 S FORDSAF=21
|
|
...I SPP=65 S FORDS=22
|
|
...I SPPAF=65 S FORDSAF=22
|
|
...S SUB=0 F S SUB=$O(SUBTX(SUB)) Q:SUB'>0 D D SUBTX
|
|
....S FORDSUB=""
|
|
....I $P(SUBTX(SUB),U,1)=60 S FORDSUB=17 Q
|
|
....I $P(SUBTX(SUB),U,1)=70 S FORDSUB=17 Q
|
|
....I $P(SUBTX(SUB),U,1)=61 S FORDSUB=18 Q
|
|
....I $P(SUBTX(SUB),U,1)=62 S FORDSUB=19 Q
|
|
....I $P(SUBTX(SUB),U,1)=63 S FORDSUB=20 Q
|
|
....I $P(SUBTX(SUB),U,1)=64 S FORDSUB=21 Q
|
|
....I $P(SUBTX(SUB),U,1)=65 S FORDSUB=22 Q
|
|
..
|
|
..I TOP>67179,TOP<67190 D D SPP Q
|
|
...I SPP=31 S FORDS=15
|
|
...I SPPAF=31 S FORDSAF=15
|
|
...S SUB=0 F S SUB=$O(SUBTX(SUB)) Q:SUB'>0 D D SUBTX
|
|
....S FORDSUB=""
|
|
....I $P(SUBTX(SUB),U,1)=31 S FORDSUB=15
|
|
..
|
|
..I TOP=67199 D D SPP Q
|
|
...I SPP=51,RR>1,RR<6 S FORDS=25
|
|
...I SPPAF=51,RR>1,RR<6 S FORDSAF=25
|
|
...I SPP=60,RR>1,RR<6 S FORDS=28
|
|
...I SPPAF=60,RR>1,RR<6 S FORDSAF=28
|
|
...S SUB=0 F S SUB=$O(SUBTX(SUB)) Q:SUB'>0 D D SUBTX
|
|
....S FORDSUB=""
|
|
....I $P(SUBTX(SUB),U,1)=51,$P(SUBTX(SUB),U,2)>1,$P(SUBTX(SUB),U,2)<6 S FORDSUB=25 Q
|
|
....I $P(SUBTX(SUB),U,1)=60,$P(SUBTX(SUB),U,2)>1,$P(SUBTX(SUB),U,2)<6 S FORDSUB=28 Q
|
|
..
|
|
..I TOP>67209,TOP<67219 D D SPP Q
|
|
...I $P($G(^ONCO(165.5,IEN,27)),U,3)="Y" Q
|
|
...I SPP=60,SLN>3,SLN<6 S FORDS=20
|
|
...I SPPAF=60,SLNAF>3,SLNAF<6 S FORDSAF=20
|
|
...I SPP=60,SLN=6 S FORDS=21
|
|
...I SPPAF=60,SLNAF=6 S FORDSAF=21
|
|
...S SUB=0 F S SUB=$O(SUBTX(SUB)) Q:SUB'>0 D D SUBTX
|
|
....S FORDSUB=""
|
|
....I $P(SUBTX(SUB),U,1)=60,$P(SUBTX(SUB),U,3)>3,$P(SUBTX(SUB),U,3)<6 S FORDSUB=20 Q
|
|
....I $P(SUBTX(SUB),U,1)=60,$P(SUBTX(SUB),U,3)=6 S FORDSUB=21 Q
|
|
..
|
|
..I TOP>67219,TOP<67222 D D SPP Q
|
|
...I SPP=31 S FORDS=11
|
|
...I SPPAF=31 S FORDSAF=11
|
|
...I SPP=32 S FORDS=28
|
|
...I SPPAF=32 S FORDSAF=28
|
|
...I SPP=70 S FORDS=33
|
|
...I SPPAF=70 S FORDSAF=33
|
|
...I SPP=80 S FORDS=32
|
|
...I SPPAF=80 S FORDSAF=32
|
|
...I SPP=40 S FORDS=34
|
|
...I SPPAF=40 S FORDSAF=34
|
|
...S SUB=0 F S SUB=$O(SUBTX(SUB)) Q:SUB'>0 D D SUBTX
|
|
....S FORDSUB=""
|
|
....I $P(SUBTX(SUB),U,1)=31 S FORDSUB=11 Q
|
|
....I $P(SUBTX(SUB),U,1)=32 S FORDSUB=28 Q
|
|
....I $P(SUBTX(SUB),U,1)=70 S FORDSUB=33 Q
|
|
....I $P(SUBTX(SUB),U,1)=80 S FORDSUB=32 Q
|
|
....I $P(SUBTX(SUB),U,1)=40 S FORDSUB=34 Q
|
|
..
|
|
..I TOP>67249,TOP<67260 D D SPP Q
|
|
...I SPP=10 S FORDS=13
|
|
...I SPPAF=10 S FORDSAF=13
|
|
...I SPP=20 S FORDS=14
|
|
...I SPPAF=20 S FORDSAF=14
|
|
...I SPP=50 S FORDS=15
|
|
...I SPPAF=50 S FORDSAF=15
|
|
...I SPP=51 S FORDS=16
|
|
...I SPPAF=51 S FORDSAF=16
|
|
...I SPP=52 S FORDS=17
|
|
...I SPPAF=52 S FORDSAF=17
|
|
...S SUB=0 F S SUB=$O(SUBTX(SUB)) Q:SUB'>0 D D SUBTX
|
|
....S FORDSUB=""
|
|
....I $P(SUBTX(SUB),U,1)=10 S FORDSUB=13 Q
|
|
....I $P(SUBTX(SUB),U,1)=20 S FORDSUB=14 Q
|
|
....I $P(SUBTX(SUB),U,1)=50 S FORDSUB=15 Q
|
|
....I $P(SUBTX(SUB),U,1)=51 S FORDSUB=16 Q
|
|
....I $P(SUBTX(SUB),U,1)=52 S FORDSUB=17 Q
|
|
..
|
|
..I TOP>67339,TOP<67350 D D SPP Q
|
|
...I SPP>9,SPP<15 S FORDS=24
|
|
...I SPPAF>9,SPPAF<15 S FORDSAF=24
|
|
...I SPP>30,SPP<33 S FORDS=10
|
|
...I SPPAF>30,SPPAF<33 S FORDSAF=10
|
|
...I SPP=40 S FORDS=34
|
|
...I SPPAF=40 S FORDSAF=34
|
|
...I SPP>49,SPP<54 S FORDS=30
|
|
...I SPPAF>49,SPPAF<54 S FORDSAF=30
|
|
...I SPP=54 S FORDS=34
|
|
...I SPPAF=54 S FORDSAF=34
|
|
...I SPP=60 S FORDS=35
|
|
...I SPPAF=60 S FORDSAF=35
|
|
...S SUB=0 F S SUB=$O(SUBTX(SUB)) Q:SUB'>0 D D SUBTX
|
|
....S FORDSUB=""
|
|
....I $P(SUBTX(SUB),U,1)>9,$P(SUBTX(SUB),U,1)<15 S FORDSUB=24 Q
|
|
....I $P(SUBTX(SUB),U,1)>30,$P(SUBTX(SUB),U,1)<33 S FORDSUB=10 Q
|
|
....I $P(SUBTX(SUB),U,1)=40 S FORDSUB=34 Q
|
|
....I $P(SUBTX(SUB),U,1)>49,$P(SUBTX(SUB),U,1)<54 S FORDSUB=30 Q
|
|
....I $P(SUBTX(SUB),U,1)=54 S FORDSUB=34 Q
|
|
....I $P(SUBTX(SUB),U,1)=60 S FORDSUB=35 Q
|
|
..
|
|
..I TOP>67419,TOP<67422 D D SPP Q
|
|
...I SPP'="" S FORDS=1
|
|
...I SPPAF'="" S FORDSAF=1
|
|
...S SUB=0 F S SUB=$O(SUBTX(SUB)) Q:SUB'>0 D D SUBTX
|
|
....I $P(SUBTX(SUB),U,1)'="" S FORDSUB=1
|
|
..
|
|
..I TOP>67422,TOP<67425 D D SPP Q
|
|
...I SPP'="" S FORDS=1
|
|
...I SPPAF'="" S FORDSAF=1
|
|
...S SUB=0 F S SUB=$O(SUBTX(SUB)) Q:SUB'>0 D D SUBTX
|
|
....I $P(SUBTX(SUB),U,1)'="" S FORDSUB=1
|
|
..
|
|
..I ((TOP>67399)&(TOP<67420))!((TOP>67469)&(TOP<67480))!((TOP>67489)&(TOP<67500)) D D SPP Q
|
|
...I SPP=20 S FORDS=12
|
|
...I SPPAF=20 S FORDSAF=12
|
|
...I SPP=10 S FORDS=14
|
|
...I SPPAF=10 S FORDSAF=14
|
|
...S SUB=0 F S SUB=$O(SUBTX(SUB)) Q:SUB'>0 D D SUBTX
|
|
....S FORDSUB=""
|
|
....I $P(SUBTX(SUB),U,1)=20 S FORDSUB=12 Q
|
|
....I $P(SUBTX(SUB),U,1)=10 S FORDSUB=14 Q
|
|
..
|
|
..I TOP=67422 D D SPP Q
|
|
...I SPP=10 S FORDS=20
|
|
...I SPPAF=10 S FORDSAF=20
|
|
...I (SPP=20)!(SPP=40)!(SPP=41)!(SPP=42)!(SPP=60)!(SPP=61)!(SPP=62) S FORDS=21
|
|
...I (SPPAF=20)!(SPPAF=40)!(SPPAF=41)!(SPPAF=42)!(SPPAF=60)!(SPPAF=61)!(SPPAF=62) S FORDSAF=21
|
|
...I (SPP=30)!(SPP=31)!(SPP=32) S FORDS=18
|
|
...I (SPPAF=30)!(SPPAF=31)!(SPPAF=32) S FORDSAF=18
|
|
...I (SPP=50)!(SPP=51)!(SPP=52) S FORDS=19
|
|
...I (SPPAF=50)!(SPPAF=51)!(SPPAF=52) S FORDSAF=19
|
|
...S SUB=0 F S SUB=$O(SUBTX(SUB)) Q:SUB'>0 D D SUBTX
|
|
....S FORDSUB=""
|
|
....I $P(SUBTX(SUB),U,1)=10 S FORDSUB=20 Q
|
|
....I ($P(SUBTX(SUB),U,1)=20)!($P(SUBTX(SUB),U,1)=40)!($P(SUBTX(SUB),U,1)=41)!($P(SUBTX(SUB),U,1)=42)!($P(SUBTX(SUB),U,1)=60)!($P(SUBTX(SUB),U,1)=61)!($P(SUBTX(SUB),U,1)=62) S FORDSUB=21 Q
|
|
....I ($P(SUBTX(SUB),U,1)=30)!($P(SUBTX(SUB),U,1)=31)!($P(SUBTX(SUB),U,1)=32) S FORDSUB=18 Q
|
|
....I ($P(SUBTX(SUB),U,1)=50)!($P(SUBTX(SUB),U,1)=51)!($P(SUBTX(SUB),U,1)=52) S FORDSUB=19 Q
|
|
..
|
|
..I TOP>67439,TOP<67450 D D SPP Q
|
|
...I ((SPP=40)!(SPP=50)),SM=0 S FORDS=27
|
|
...I ((SPPAF=40)!(SPPAF=50)),SM=0 S FORDSAF=27
|
|
...I ((SPP=40)!(SPP=50)),SM'=0 S FORDS=7
|
|
...I ((SPPAF=40)!(SPPAF=50)),SM'=0 S FORDSAF=7
|
|
...S SUB=0 F S SUB=$O(SUBTX(SUB)) Q:SUB'>0 D D SUBTX
|
|
....S FORDSUB=""
|
|
....I ($P(SUBTX(SUB),U,1)=40)!($P(SUBTX(SUB),U,1)=50),SM=0 S FORDSUB=27 Q
|
|
....I ($P(SUBTX(SUB),U,1)=40)!($P(SUBTX(SUB),U,1)=50),SM'=0 S FORDSUB=7 Q
|
|
..
|
|
..D ^ONCP36A1 Q
|
|
;
|
|
SPP I FORDS'="" S $P(^ONCO(165.5,IEN,3.1),U,29)=FORDS
|
|
E S $P(^ONCO(165.5,IEN,3.1),U,29)=SPPPNT
|
|
I FORDSAF'="" S $P(^ONCO(165.5,IEN,3.1),U,30)=FORDSAF
|
|
E S $P(^ONCO(165.5,IEN,3.1),U,30)=SPPAFPNT
|
|
Q
|
|
;
|
|
SUBTX S:FORDSUB'="" $P(^ONCO(165.5,IEN,4,SUB,0),U,4)=FORDSUB
|
|
Q
|