source: WorldVistAEHR/trunk/r/ICR_IMMUNOLOGY_CASE_REGISTRY-IMR/IMRSUDLB.m@ 1639

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

initial load of WorldVistAEHR

File size: 2.0 KB
Line 
1IMRSUDLB ;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
5DQ ;
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
11KILL Q
12 Q
13DQ1 ;
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 ;
17C1 ;
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 ;
22C2 ;
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
26C21 ;
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 ;
30A1 ;
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 ;
35AA1 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 ;
39A2 ;
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 ;
45A3 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
Note: See TracBrowser for help on using the repository browser.