| 1 | IMRCDPR ;HCIOFO/NCA - Display Diseases For CDC Form ;7/10/95 14:33
|
---|
| 2 | ;;2.1;IMMUNOLOGY CASE REGISTRY;;Feb 09, 1998
|
---|
| 3 | DISP ; Display Diseases Currently Selected
|
---|
| 4 | ; called from IMRCDCED routine
|
---|
| 5 | S K=0 F I=1:1:26 D
|
---|
| 6 | . S X1=$P(^DD(158,+$P(IMRIX,",",I),0),U,4),IMRXN=$P(^(0),U),X2=$P(X1,";"),J=+$P(X1,";",2) I $D(^IMR(158,DA,X2)) S X1=$P(^(X2),U,J)
|
---|
| 7 | . I X1="D"!(X1="P")!(X1=1)!(X1=2) D
|
---|
| 8 | . . S IMRX1=$S(X1="D"!(X1=1):"Definitive",1:"Presumptive")
|
---|
| 9 | . . S IMRXD=108+(I+1/200),IMRXD=$S(I#2:IMRXD,1:IMRXD+.13)
|
---|
| 10 | . . S J=IMRXD-108*100 S IMRD=$P($G(^IMR(158,DA,108)),U,J)
|
---|
| 11 | . . S IMRSP="",$P(IMRSP," ",34)="",IMRXY=IMRXN_$E(IMRSP,1,($L(IMRSP)-$L(IMRXN)))
|
---|
| 12 | . . S IMRDATA=$S(IMRD:$E(IMRD,4,5)_"/"_$E(IMRD,6,7)_"/"_$E(IMRD,2,3),1:" ")_" "_IMRXY_" - "_IMRX1_$S(IMRD:"",1:" ** NO DATE **") S K=K+1
|
---|
| 13 | . . S ^TMP($J,"IMRDIS",$S(IMRD:IMRD,1:9999999)_"~"_IMRXN)=IMRDATA
|
---|
| 14 | . . Q
|
---|
| 15 | . Q
|
---|
| 16 | W !!,"Diseases Currently Selected:",!
|
---|
| 17 | S X1="" F S X1=$O(^TMP($J,"IMRDIS",X1)) Q:X1="" S IMRX=$G(^(X1)) W !,IMRX
|
---|
| 18 | W !
|
---|
| 19 | K ^TMP($J,"IMRDIS")
|
---|
| 20 | Q
|
---|