source: WorldVistAEHR/trunk/r/ONCOLOGY-ONC/ONCP36A1.m@ 1015

ONCP36A1 ;HINES OIFO/GWB-POST-INSTALL ROUTINE FOR PATCH ONC*2.11*36
 ;;2.11;ONCOLOGY;**36**;Mar 07, 1995
 ;
 D  Q
 .D  Q
 ..I TOP>67499,TOP<67510 D  D SPP Q
 ...I SPP=10 S FORDS=26
 ...I SPPAF=10 S FORDSAF=26
 ...I SPP=11 S FORDS=27
 ...I SPPAF=11 S FORDSAF=27
 ...I SPP=12 S FORDS=28
 ...I SPPAF=12 S FORDSAF=28
 ...I SPP=13 S FORDS=29
 ...I SPPAF=13 S FORDSAF=29
 ...I SPP>13,SPP<18 S FORDS=30
 ...I SPPAF>13,SPP<18 S FORDSAF=30
 ...I SPP=41,RR>5,RR<9 S FORDS=51
 ...I SPPAF=41,RR>5,RR<9 S FORDSAF=51
 ...I SPP=41,RR=2 S FORDS=50
 ...I SPPAF=41,RR=2 S FORDSAF=50
 ...I SPP=41,RR>2,RR<6 S FORDS=49
 ...I SPPAF=41,RR>2,RR<6 S FORDSAF=49
 ...I SPP=41,RR=1 S FORDS=48
 ...I SPPAF=41,RR=1 S FORDSAF=48
 ...I SPP=42,RR>5,RR<9 S FORDS=55
 ...I SPPAF=42,RR>5,RR<9 S FORDSAF=55
 ...I SPP=42,RR=2 S FORDS=54
 ...I SPPAF=42,RR=2 S FORDSAF=54
 ...I SPP=42,RR>2,RR<6 S FORDS=53
 ...I SPPAF=42,RR>2,RR<6 S FORDSAF=53
 ...I SPP=42,RR=1 S FORDS=52
 ...I SPPAF=42,RR=1 S FORDSAF=52
 ...I SPP=51,RR>5,RR<9 S FORDS=34
 ...I SPPAF=51,RR>5,RR<9 S FORDSAF=34
 ...I SPP=51,RR=2 S FORDS=33
 ...I SPPAF=51,RR=2 S FORDSAF=33
 ...I SPP=51,RR>2,RR<6 S FORDS=32
 ...I SPPAF=51,RR>2,RR<6 S FORDSAF=32
 ...I SPP=51,RR=1 S FORDS=31
 ...I SPPAF=51,RR=1 S FORDSAF=31
 ...I SPP=52,RR>5,RR<9 S FORDS=38
 ...I SPPAF=52,RR>5,RR<9 S FORDSAF=38
 ...I SPP=52,RR=2 S FORDS=37
 ...I SPPAF=52,RR=2 S FORDSAF=37
 ...I SPP=52,RR>2,RR<6 S FORDS=36
 ...I SPPAF=52,RR>2,RR<6 S FORDSAF=36
 ...I SPP=52,RR=1 S FORDS=35
 ...I SPPAF=52,RR=1 S FORDSAF=35
 ...I SPP=61,RR>5,RR<9 S FORDS=42
 ...I SPPAF=61,RR>5,RR<9 S FORDSAF=42
 ...I SPP=61,RR=2 S FORDS=41
 ...I SPPAF=61,RR=2 S FORDSAF=41
 ...I SPP=61,RR>2,RR<6 S FORDS=40
 ...I SPPAF=61,RR>2,RR<6 S FORDSAF=40
 ...I SPP=61,RR=1 S FORDS=39
 ...I SPPAF=61,RR=1 S FORDSAF=39
 ...I SPP=62,RR>5,RR<9 S FORDS=46
 ...I SPPAF=62,RR>5,RR<9 S FORDSAF=46
 ...I SPP=62,RR=2 S FORDS=45
 ...I SPPAF=62,RR=2 S FORDSAF=45
 ...I SPP=62,RR>2,RR<6 S FORDS=44
 ...I SPPAF=62,RR>2,RR<6 S FORDSAF=44
 ...I SPP=62,RR=1 S FORDS=43
 ...I SPPAF=62,RR=1 S FORDSAF=43
 ...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=26 Q
 ....I $P(SUBTX(SUB),U,1)=11 S FORDSUB=27 Q
 ....I $P(SUBTX(SUB),U,1)=12 S FORDSUB=28 Q
 ....I $P(SUBTX(SUB),U,1)=13 S FORDSUB=29 Q
 ....I $P(SUBTX(SUB),U,1)>13,$P(SUBTX(SUB),U,1)<18 S FORDSUB=30 Q
 ....I $P(SUBTX(SUB),U,1)=51,$P(SUBTX(SUB),U,2)>5,$P(SUBTX(SUB),U,2)<9 S FORDSUB=34 Q
 ....I $P(SUBTX(SUB),U,1)=51,$P(SUBTX(SUB),U,2)=2 S FORDSUB=33 Q
 ....I $P(SUBTX(SUB),U,1)=51,$P(SUBTX(SUB),U,2)>2,$P(SUBTX(SUB),U,2)<6 S FORDSUB=32 Q
 ....I $P(SUBTX(SUB),U,1)=51,$P(SUBTX(SUB),U,2)=1 S FORDSUB=31 Q
 ....I $P(SUBTX(SUB),U,1)=52,$P(SUBTX(SUB),U,2)>5,$P(SUBTX(SUB),U,2)<9 S FORDSUB=38 Q
 ....I $P(SUBTX(SUB),U,1)=52,$P(SUBTX(SUB),U,2)=2 S FORDSUB=37 Q
 ....I $P(SUBTX(SUB),U,1)=52,$P(SUBTX(SUB),U,2)>2,$P(SUBTX(SUB),U,2)<6 S FORDSUB=36 Q
 ....I $P(SUBTX(SUB),U,1)=52,$P(SUBTX(SUB),U,2)=1 S FORDSUB=35 Q
 ....I $P(SUBTX(SUB),U,1)=61,$P(SUBTX(SUB),U,2)>5,$P(SUBTX(SUB),U,2)<9 S FORDSUB=42 Q
 ....I $P(SUBTX(SUB),U,1)=61,$P(SUBTX(SUB),U,2)=2 S FORDSUB=41 Q
 ....I $P(SUBTX(SUB),U,1)=61,$P(SUBTX(SUB),U,2)>2,$P(SUBTX(SUB),U,2)<6 S FORDSUB=40 Q
 ....I $P(SUBTX(SUB),U,1)=61,$P(SUBTX(SUB),U,2)=1 S FORDSUB=39 Q
 ....I $P(SUBTX(SUB),U,1)=62,$P(SUBTX(SUB),U,2)>5,$P(SUBTX(SUB),U,2)<9 S FORDSUB=46 Q
 ....I $P(SUBTX(SUB),U,1)=62,$P(SUBTX(SUB),U,2)=2 S FORDSUB=45 Q
 ....I $P(SUBTX(SUB),U,1)=62,$P(SUBTX(SUB),U,2)>2,$P(SUBTX(SUB),U,2)<6 S FORDSUB=44 Q
 ....I $P(SUBTX(SUB),U,1)=62,$P(SUBTX(SUB),U,2)=1 S FORDSUB=43 Q
 ..
 ..I TOP>67539,TOP<67560 D  D SPP Q
 ...I SPP=70 S FORDS=37
 ...I SPPAF=70 S FORDSAF=37
 ...I SPP=71 S FORDS=38
 ...I SPPAF=71 S FORDSAF=38
 ...I SPP=72 S FORDS=39
 ...I SPPAF=72 S FORDSAF=39
 ...I SPP=80 S FORDS=40
 ...I SPPAF=80 S FORDSAF=40
 ...I SPP=81 S FORDS=41
 ...I SPPAF=81 S FORDSAF=41
 ...I SPP=82 S FORDS=42
 ...I SPPAF=82 S FORDSAF=42
 ...I SPP=83 S FORDS=43
 ...I SPPAF=83 S FORDSAF=43
 ...I SPP=84 S FORDS=44
 ...I SPPAF=84 S FORDSAF=44
 ...S SUB=0 F  S SUB=$O(SUBTX(SUB)) Q:SUB'>0  D  D SUBTX
 ....S FORDSUB=""
 ....I $P(SUBTX(SUB),U,1)=70 S FORDSUB=37 Q
 ....I $P(SUBTX(SUB),U,1)=71 S FORDSUB=38 Q
 ....I $P(SUBTX(SUB),U,1)=72 S FORDSUB=39 Q
 ....I $P(SUBTX(SUB),U,1)=80 S FORDSUB=40 Q
 ....I $P(SUBTX(SUB),U,1)=81 S FORDSUB=41 Q
 ....I $P(SUBTX(SUB),U,1)=82 S FORDSUB=42 Q
 ....I $P(SUBTX(SUB),U,1)=83 S FORDSUB=43 Q
 ....I $P(SUBTX(SUB),U,1)=84 S FORDSUB=44 Q
 ..
 ..I TOP=67569 D  D SPP Q
 ...I SPP=10 S FORDS=28
 ...I SPPAF=10 S FORDSAF=28
 ...I SPP=11 S FORDS=29
 ...I SPPAF=11 S FORDSAF=29
 ...I SPP=12 S FORDS=30
 ...I SPPAF=12 S FORDSAF=30
 ...I SPP=13 S FORDS=31
 ...I SPPAF=13 S FORDSAF=31
 ...I SPP=14 S FORDS=32
 ...I SPPAF=14 S FORDSAF=32
 ...I SPP=15 S FORDS=33
 ...I SPPAF=15 S FORDSAF=33
 ...I SPP=16 S FORDS=34
 ...I SPPAF=16 S FORDSAF=34
 ...I SPP=20 S FORDS=35
 ...I SPPAF=20 S FORDSAF=35
 ...I SPP=21 S FORDS=36
 ...I SPPAF=21 S FORDSAF=36
 ...I SPP=22 S FORDS=37
 ...I SPPAF=22 S FORDSAF=37
 ...I SPP=30 S FORDS=38
 ...I SPPAF=30 S FORDSAF=38
 ...I SPP=31 S FORDS=39
 ...I SPPAF=31 S FORDSAF=39
 ...I SPP=32 S FORDS=40
 ...I SPPAF=32 S FORDSAF=40
 ...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=28 Q
 ....I $P(SUBTX(SUB),U,1)=11 S FORDSUB=29 Q
 ....I $P(SUBTX(SUB),U,1)=12 S FORDSUB=30 Q
 ....I $P(SUBTX(SUB),U,1)=13 S FORDSUB=31 Q
 ....I $P(SUBTX(SUB),U,1)=14 S FORDSUB=32 Q
 ....I $P(SUBTX(SUB),U,1)=15 S FORDSUB=33 Q
 ....I $P(SUBTX(SUB),U,1)=16 S FORDSUB=34 Q
 ....I $P(SUBTX(SUB),U,1)=20 S FORDSUB=35 Q
 ....I $P(SUBTX(SUB),U,1)=21 S FORDSUB=36 Q
 ....I $P(SUBTX(SUB),U,1)=22 S FORDSUB=37 Q
 ....I $P(SUBTX(SUB),U,1)=30 S FORDSUB=38 Q
 ....I $P(SUBTX(SUB),U,1)=31 S FORDSUB=39 Q
 ....I $P(SUBTX(SUB),U,1)=32 S FORDSUB=40 Q
 ..
 ..D ^ONCP36A2 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