| 1 | IMRSUDLB ;HCIOFO/FT/FAI-LOCAL LISTING OF LAB UTILIZATION ;07/17/00 17:09
|
|---|
| 2 | ;;2.1;IMMUNOLOGY CASE REGISTRY;**5**;Feb 09, 1998
|
|---|
| 3 | D LRARC^IMRUTL ;check Lab archive date
|
|---|
| 4 | S IMRUT=0
|
|---|
| 5 | DQ ;
|
|---|
| 6 | U IO D GETNOW^IMRACESS
|
|---|
| 7 | K ^TMP($J) S IMRC="CANC",IMRC1="canc"
|
|---|
| 8 | F I=0:0 S I=$O(^IMR(158,I)) Q:I'>0 S X=+^(I,0),IMR1C=+$P(^(0),U,42) D XOR^IMRXOR S IMRDFN=X I $D(^DPT(IMRDFN,0)) D DQ1
|
|---|
| 9 | F IMR0C=1:1:4,"T" S IMR1C="C"_IMR0C D A1
|
|---|
| 10 | D ^IMRLLAB1
|
|---|
| 11 | KILL Q
|
|---|
| 12 | Q
|
|---|
| 13 | DQ1 ;
|
|---|
| 14 | F IMR0C=IMR1C,"T" S IMR1C="C"_IMR0C,^TMP($J,IMR1C,"PAT",IMRDFN)="" I $D(^DPT(IMRDFN,"LR")) S IMRLRFN=+^("LR") I IMRLRFN>0 D C1
|
|---|
| 15 | Q
|
|---|
| 16 | ;
|
|---|
| 17 | C1 ;
|
|---|
| 18 | S IMRI=IMRED+1
|
|---|
| 19 | F IMRI=9999999-IMRI:0 S IMRI=$O(^LR(IMRLRFN,"CH",IMRI)) Q:IMRI'>0!(IMRI>(9999999-IMRSD)) I $O(^(IMRI,0))>0 D C2
|
|---|
| 20 | Q
|
|---|
| 21 | ;
|
|---|
| 22 | C2 ;
|
|---|
| 23 | S K=0
|
|---|
| 24 | F J=0:0 S J=$O(^LR(IMRLRFN,"CH",IMRI,J)) Q:J'>0 I $D(^(J))#2 S X=$P(^(J),U) I $D(^DD(63.04,J,0)),X'[IMRC,X'[IMRC1 D C21
|
|---|
| 25 | Q
|
|---|
| 26 | C21 ;
|
|---|
| 27 | S:K=0 ^(IMRDFN)=$S($D(^TMP($J,IMR1C,"PAT",IMRDFN)):^(IMRDFN),1:0)+1,K=1 S ^(J)=$S($D(^TMP($J,IMR1C,"PAT",IMRDFN,J)):^(J),1:0)+1
|
|---|
| 28 | Q
|
|---|
| 29 | ;
|
|---|
| 30 | A1 ;
|
|---|
| 31 | S ^TMP($J,IMR1C,"LR")=0,^("LR","TST")=0 F IMRDFN=0:0 S IMRDFN=$O(^TMP($J,IMR1C,"PAT",IMRDFN)) Q:IMRDFN'>0 D:^(IMRDFN)>0 AA1 S:^TMP($J,IMR1C,"PAT",IMRDFN)>0 X=^(IMRDFN),^TMP($J,IMR1C,"MAX",(999999-X),IMRDFN)=X D A2
|
|---|
| 32 | F I=0:0 S I=$O(^TMP($J,IMR1C,"LR",I)) Q:I'>0 S X=^(I),X1=^(I,"N"),N=$P(^DD(63.04,I,0),U),^TMP($J,IMR1C,"A",(999999-X1),N)=X_U_X1 D A3 K ^TMP($J,IMR1C,"LR",I)
|
|---|
| 33 | Q
|
|---|
| 34 | ;
|
|---|
| 35 | AA1 S I=0,J=0 F K=0:0 S K=$O(^TMP($J,IMR1C,"PAT",IMRDFN,K)) Q:K'>0 S I=I+1,J=J+^(K)
|
|---|
| 36 | S ^(IMRDFN)=^TMP($J,IMR1C,"PAT",IMRDFN)_U_J_U_I
|
|---|
| 37 | Q
|
|---|
| 38 | ;
|
|---|
| 39 | A2 ;
|
|---|
| 40 | S:$O(^TMP($J,IMR1C,"PAT",IMRDFN,0))>0 ^("LR")=^TMP($J,IMR1C,"LR")+1
|
|---|
| 41 | S K=0 F J=0:0 S J=$O(^TMP($J,IMR1C,"PAT",IMRDFN,J)) Q:J'>0 S K=K+1,X=^(J),^("TST")=^TMP($J,IMR1C,"LR","TST")+X,^(J)=$S($D(^TMP($J,IMR1C,"LR",J)):^(J),1:0)+1,^("N")=$S($D(^(J,"N")):^("N"),1:0)+X,^(X)=$S($D(^(X)):^(X),1:0)+1
|
|---|
| 42 | S K=+^TMP($J,IMR1C,"PAT",IMRDFN),J=999999-K,^(J)=($S($D(^TMP($J,IMR1C,"LR","N",J)):+^(J),1:0)+1)_U_K
|
|---|
| 43 | Q
|
|---|
| 44 | ;
|
|---|
| 45 | A3 S M=0 F K=0:0 S K=$O(^TMP($J,IMR1C,"LR",I,K)) Q:K'>0 S M=K_U_^(K)
|
|---|
| 46 | S ^TMP($J,IMR1C,"A",(999999-X1),N,"MAX")=M
|
|---|
| 47 | Q
|
|---|
| 48 | ;
|
|---|
| 49 | Q
|
|---|
