| 1 | IMRCDC ;ISC-SF/JLI-CDC DATA ;6/13/95 10:22
|
|---|
| 2 | ;;2.1;IMMUNOLOGY CASE REGISTRY;;Feb 09, 1998
|
|---|
| 3 | ENT ; Is ENT code ever used?
|
|---|
| 4 | S IMRPT=0 F IMRI=0:0 S IMRPT=$O(^IMR(158,"AC",4,IMRPT)) Q:IMRPT="" I $D(^IMR(158,IMRPT,0)),$P(^(0),U,23)'="",$P(^(0),U,39)="" D S1 S $P(^IMR(158,IMRPT,0),U,39)="C" S:$P(^(0),U,41)="" $P(^(0),U,41)=IMRIP D ST
|
|---|
| 5 | END ; called from IMRCDCPR
|
|---|
| 6 | K IMRBDT,IMRCDT,IMRCK,IMRCNT,IMRDT,IMRI,IMRIP,IMRJ,IMRLAB,IMRP0,IMRP1,IMRP2,IMRP3,IMRP4,IMRP5,IMRP6,IMRP7
|
|---|
| 7 | Q
|
|---|
| 8 | ST ; called from ENT. Is this code used?
|
|---|
| 9 | S:'$D(^IMR(159,1,7,0)) ^(0)="^159.06P^^"
|
|---|
| 10 | I '$D(^IMR(159,1,7,"B",IMRPT)) S IMRCNT=$P(^IMR(159,1,7,0),U,3),IMRCNT=IMRCNT+1,$P(^(0),U,3)=IMRCNT,$P(^(0),U,4)=$P(^(0),U,4)+1,^IMR(159,1,7,IMRCNT,0)=IMRPT_"^"_IMRCDT,^IMR(159,1,7,"B",IMRPT,IMRCNT)="",$P(^IMR(159,1,0),U,3)=IMRPT Q
|
|---|
| 11 | I $D(^IMR(159,1,7,"B",IMRPT)) S IMRCNT=$O(^IMR(159,1,7,"B",IMRPT)) Q:IMRCNT="" I $D(^IMR(159,1,7,IMRCNT,0)) S $P(^(0),U,2)=IMRCDT
|
|---|
| 12 | Q
|
|---|
| 13 | S1 ; called from IMRCDCPR
|
|---|
| 14 | S (IMRIP,IMRP0,IMRP1,IMRP2,IMRP3,IMRP4,IMRP5,IMRP6,IMRP7)="" S (IMRBDT,IMRCK)=0 Q:IMRPT=""!('$D(^IMR(158,IMRPT,0))) S IMRP0=^(0) S:'$D(^IMR(158,IMRPT,1)) ^(1)="^" S IMRP1=^(1) S IMRCDT=$P(IMRP1,U,6) S:IMRCDT="" IMRCDT=DT
|
|---|
| 15 | S $P(^IMR(158,IMRPT,1),U,6)=IMRCDT Q:$P(IMRP1,U,5)="Y" S:'$D(^IMR(158,IMRPT,2)) ^(2)="^" S IMRP2=^(2) S IMRP4=$S($D(^IMR(158,IMRPT,4)):^(4),1:""),IMRP5=$S($D(^IMR(158,IMRPT,5)):^(5),1:"")
|
|---|
| 16 | S IMRX1=$S($P(IMRP0,U,35):$P(IMRP0,U,35),1:$P(IMRP0,U,23)) ;calculate Age at AIDS Diagnosis. Used Cat 3 date first if it exists.
|
|---|
| 17 | S IMRX2=$P(VADM(3),U) ;date of birth
|
|---|
| 18 | S IMRAAAD=$$AGE^IMRUTL(IMRX1,IMRX2) ;calculate age at aids dx
|
|---|
| 19 | S:IMRAAAD>0 $P(^IMR(158,IMRPT,2),U,16)=IMRAAAD ;store age if >0
|
|---|
| 20 | K IMRAAAD,IMRX1,IMRX2
|
|---|
| 21 | S:$P(IMRP1,U,34)="" $P(^IMR(158,IMRPT,1),U,34)=$S($P(IMRP5,U,19)'="":$P(^(1),U,34)=2,1:1) S:$P(IMRP2,U,21)="" $P(^IMR(158,IMRPT,2),U,21)=9
|
|---|
| 22 | S:$P(IMRP2,U,23)="" $P(^IMR(158,IMRPT,2),U,23)=9 S:$P(IMRP2,U,53)="" $P(^IMR(158,IMRPT,2),U,53)=9 S:$P(IMRP1,U,26)="" $P(^IMR(158,IMRPT,1),U,26)=9 S:$P(IMRP1,U,28)="" $P(^IMR(158,IMRPT,1),U,28)=9
|
|---|
| 23 | S IMRLAB=$P(VADM(5),U)="M" S:IMRLAB $P(^IMR(158,IMRPT,1),U,29)="" I 'IMRLAB S:$P(IMRP1,U,29)="" $P(^IMR(158,IMRPT,1),U,29)=9
|
|---|
| 24 | S:$P(IMRP1,U,30)="" $P(^IMR(158,IMRPT,1),U,30)=9 S:$P(IMRP1,U,31)="" $P(^IMR(158,IMRPT,1),U,31)=9 S:$P(IMRP1,U,32)="" $P(^IMR(158,IMRPT,1),U,32)=9
|
|---|
| 25 | S:$P(IMRP1,U,33)="" $P(^IMR(158,IMRPT,1),U,33)=9 S:$P(IMRP1,U,21)="" $P(^IMR(158,IMRPT,1),U,21)=9 S:$P(IMRP1,U,24)="" $P(^IMR(158,IMRPT,1),U,24)=9
|
|---|
| 26 | S IMRCK=$P(IMRP2,U,4) S:IMRCK>0 $P(^IMR(158,IMRPT,2),U,24)="D" D:IMRCK>0 CK S IMRCK=$P(IMRP4,U,17) S:IMRCK>0 $P(^(2),U,25)="P" D:IMRCK>0 CK S IMRCK=$P(IMRP4,U,24) S:IMRCK>0 $P(^(2),U,26)="D" D:IMRCK>0 CK
|
|---|
| 27 | S IMRCK=$P(IMRP4,U,23) S:IMRCK>0 $P(^IMR(158,IMRPT,2),U,27)="D" D:IMRCK>0 CK S IMRCK=$P(IMRP4,U,19) S:IMRCK>0 $P(^(2),U,28)="P" D:IMRCK>0 CK S IMRCK=$P(IMRP5,U,6) S:IMRCK>0 $P(^(2),U,29)="D" D:IMRCK>0 CK
|
|---|
| 28 | S IMRCK=$P(IMRP2,U,8) S:IMRCK>0 $P(^IMR(158,IMRPT,2),U,30)="D" D:IMRCK>0 CK S IMRCK=$P(IMRP5,U,3) S:IMRCK>0 $P(^(2),U,31)="D" D:IMRCK>0 CK
|
|---|
| 29 | S IMRCK=$S($P(IMRP4,U,1)'="":$P(IMRP4,U,1),$P(IMRP4,U,2)'="":$P(IMRP4,U,2),$P(IMRP4,U,3)'="":$P(IMRP4,U,3),1:"") S:IMRCK>0 $P(^IMR(158,IMRPT,2),U,32)="D" D:IMRCK>0 CK
|
|---|
| 30 | S IMRCK=$P(IMRP4,U,25) S:IMRCK>0 $P(^IMR(158,IMRPT,2),U,33)="D" D:IMRCK>0 CK S IMRCK=$P(IMRP2,U,9) S:IMRCK>0 $P(^(2),U,34)="D" D:IMRCK>0 CK S IMRCK=$P(IMRP4,U,30) S:IMRCK>0 $P(^(2),U,35)="D" D:IMRCK>0 CK
|
|---|
| 31 | S IMRCK=$P(IMRP2,U,6) S:IMRCK>0 $P(^IMR(158,IMRPT,2),U,36)="D" D:IMRCK>0 CK S IMRCK=$P(IMRP2,U,7) S:IMRCK>0 $P(^(2),U,37)="D" D:IMRCK>0 CK S IMRCK=$P(IMRP5,U,2) S:IMRCK>0 $P(^(2),U,38)="D" D:IMRCK>0 CK
|
|---|
| 32 | S IMRCK=$S($P(IMRP4,U,28)'="":$P(IMRP4,U,28),$P(IMRP4,U,29)'="":$P(IMRP4,U,29),1:"") S:IMRCK>0 $P(^IMR(158,IMRPT,2),U,39)="D" D:IMRCK>0 CK S IMRCK=$P(IMRP4,U,27) S:IMRCK>0 $P(^(2),U,40)="D" D:IMRCK>0 CK
|
|---|
| 33 | S IMRCK=$P(IMRP2,U,5) S:IMRCK>0 $P(^IMR(158,IMRPT,2),U,41)="D" D:IMRCK>0 CK S IMRCK=$P(IMRP4,U,22) S:IMRCK>0 $P(^(2),U,42)="D" D:IMRCK>0 CK S IMRCK=$P(IMRP5,U,5) S:IMRCK>0 $P(^(2),U,43)="D" D:IMRCK>0 CK
|
|---|
| 34 | S IMRCK=$P(IMRP5,U,8) S:IMRCK>0 $P(^IMR(158,IMRPT,2),U,44)="D" D:IMRCK>0 CK S IMRCK=$P(IMRP4,U,21) S:IMRCK>0 $P(^(2),U,45)="D" D:IMRCK>0 CK S IMRCK=$P(IMRP5,U,7) S:IMRCK>0 $P(^(2),U,46)="D" D:IMRCK>0 CK S:IMRCK>0 $P(^(2),U,47)=IMRBDT
|
|---|
| 35 | S $P(^IMR(158,IMRPT,2),U,51)=$S($P(IMRP5,U,17)'=""!($P(IMRP5,U,18)'="")!($P(IMRP5,U,20)'=""):"Y",1:"U")
|
|---|
| 36 | S2 S IMRDT=0 S (IMRLAB(1),IMRLAB(2),IMRLAB(3))=""
|
|---|
| 37 | Q
|
|---|
| 38 | CK S:IMRBDT=0&(IMRCK>0) IMRBDT=IMRCK S:IMRCK<IMRBDT IMRBDT=IMRCK S IMRCK=0 Q
|
|---|
