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

128 lines
5.7 KiB
Mathematica

ONCP36B1 ;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>67209)&(TOP<67219))!((TOP>67339)&(TOP<67350))!((TOP>67619)&(TOP<67630))!((TOP>67648)&(TOP<67680)) 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>0)&(SLN<7)),+NNE>0,+NNE<4 S FORDS=4
...I ((SLNAF>0)&(SLNAF<7)),+NNEAF>0,+NNEAF<4 S FORDSAF=4
...I ((SLN>0)&(SLN<7)),+NNE>3,+NNE<91 S FORDS=5
...I ((SLNAF>0)&(SLNAF<7)),+NNEAF>3,+NNEAF<91 S FORDSAF=5
...I ((SLN>0)&(SLN<7)),NNE=95 S FORDS=1
...I ((SLNAF>0)&(SLNAF<7)),NNEAF=95 S FORDSAF=1
...I ((SLN>0)&(SLN<7)),((NNE>95)!(NNE="")) S FORDS=3
...I ((SLN>0)&(SLN<7)),((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)>0)&($P(SUBTX(SUB),U,3)<7)),+$P(SUBTX(SUB),U,4)>0,+$P(SUBTX(SUB),U,4)<4 S FORDSUB=4 Q
....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
....I (($P(SUBTX(SUB),U,3)>0)&($P(SUBTX(SUB),U,3)<7)),+$P(SUBTX(SUB),U,4)=95 S FORDSUB=1 Q
....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
....I $P(SUBTX(SUB),U,3)>0,FORDSUB="" S FORDSUB=9 Q
..
..I TOP>67699,TOP<67720 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>67249)&(TOP<67260))!((TOP>67539)&(TOP<67560)) 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>0)&(SLN<3)),+NNE>0,+NNE<4 S FORDS=4
...I ((SLNAF>0)&(SLNAF<3)),+NNEAF>0,+NNEAF<4 S FORDSAF=4
...I ((SLN>0)&(SLN<3)),+NNE>3,+NNE<91 S FORDS=5
...I ((SLNAF>0)&(SLNAF<3)),+NNEAF>3,+NNEAF<91 S FORDSAF=5
...I ((SLN>0)&(SLN<3)),NNE=95 S FORDS=1
...I ((SLNAF>0)&(SLNAF<3)),NNEAF=95 S FORDSAF=1
...I ((SLN>0)&(SLN<3)),((NNE>95)!(NNE="")) S FORDS=3
...I ((SLN>0)&(SLN<3)),((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)>0)&($P(SUBTX(SUB),U,3)<3)),+$P(SUBTX(SUB),U,4)>0,+$P(SUBTX(SUB),U,4)<4 S FORDSUB=4 Q
....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
....I (($P(SUBTX(SUB),U,3)>0)&($P(SUBTX(SUB),U,3)<3)),+$P(SUBTX(SUB),U,4)=95 S FORDSUB=1 Q
....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
....I $P(SUBTX(SUB),U,3)>0,FORDSUB="" S FORDSUB=9 Q
..
..I ((TOP>67769)&(TOP<67780)) D D SLN Q
...I ((HIST3>9589)&(HIST3<9597)),SLN'="" S FORDS=9
...I ((HIST3>9589)&(HIST3<9597)),SLNAF'="" S FORDSAF=9
...I ((HIST3>9649)&(HIST3<9718)),SLN'="" S FORDS=9
...I ((HIST3>9649)&(HIST3<9718)),SLNAF'="" S FORDSAF=9
...I ((HIST3>9726)&(HIST3<9730)),SLN'="" S FORDS=9
...I ((HIST3>9726)&(HIST3<9730)),SLNAF'="" S FORDSAF=9
...S SUB=0 F S SUB=$O(SUBTX(SUB)) Q:SUB'>0 D D SUBSLN
....S FORDSUB=""
....I ((HIST3>9589)&(HIST3<9597)),$P(SUBTX(SUB),U,3)'="" S FORDSUB=9 Q
....I ((HIST3>9649)&(HIST3<9718)),$P(SUBTX(SUB),U,3)'="" S FORDSUB=9 Q
....I ((HIST3>9726)&(HIST3<9730)),$P(SUBTX(SUB),U,3)'="" S FORDSUB=9 Q
..
..I ((TOP>67769)&(TOP<67780)) D D SLN Q
...I ((HIST2>9589)&(HIST2<9597)),SLN'="" S FORDS=9
...I ((HIST2>9589)&(HIST2<9597)),SLNAF'="" S FORDSAF=9
...I ((HIST2>9649)&(HIST2<9718)),SLN'="" S FORDS=9
...I ((HIST2>9649)&(HIST2<9718)),SLNAF'="" S FORDSAF=9
...I ((HIST2>9726)&(HIST2<9730)),SLN'="" S FORDS=9
...I ((HIST2>9726)&(HIST2<9730)),SLNAF'="" S FORDSAF=9
...S SUB=0 F S SUB=$O(SUBTX(SUB)) Q:SUB'>0 D D SUBSLN
....S FORDSUB=""
....I ((HIST2>9589)&(HIST2<9597)),$P(SUBTX(SUB),U,3)'="" S FORDSUB=9 Q
....I ((HIST2>9649)&(HIST2<9718)),$P(SUBTX(SUB),U,3)'="" S FORDSUB=9 Q
....I ((HIST2>9726)&(HIST2<9730)),$P(SUBTX(SUB),U,3)'="" S FORDSUB=9 Q
..
..I ((TOP>67759)&(TOP<67766))!((TOP>67766)&(TOP<67769))!(TOP=67809) 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
..
..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,+NNE>0,+NNE<4 S FORDS=4
...I SLNAF=1,+NNEAF>0,+NNEAF<4 S FORDSAF=4
...I SLN=1,+NNE>3,+NNE<91 S FORDS=5
...I SLNAF=1,+NNEAF>3,+NNEAF<91 S FORDSAF=5
...I SLN=1,NNE=95 S FORDS=1
...I SLNAF=1,NNEAF=95 S FORDSAF=1
...I SLN=1,((NNE>95)!(NNE="")) S FORDS=3
...I SLN=1,((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,+$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,4)>3,+$P(SUBTX(SUB),U,4)<91 S FORDSUB=5 Q
....I $P(SUBTX(SUB),U,3)=1,+$P(SUBTX(SUB),U,4)=95 S FORDSUB=1 Q
....I $P(SUBTX(SUB),U,3)=1,((+$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
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