source: WorldVistAEHR/trunk/r/ICR_IMMUNOLOGY_CASE_REGISTRY-IMR/IMRCDPR.m@ 1073

Last change on this file since 1073 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1009 bytes
RevLine 
[613]1IMRCDPR ;HCIOFO/NCA - Display Diseases For CDC Form ;7/10/95 14:33
2 ;;2.1;IMMUNOLOGY CASE REGISTRY;;Feb 09, 1998
3DISP ; 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
Note: See TracBrowser for help on using the repository browser.