1 | LRACS1 ;SLC/DCM - DAILY LAB SUMMARY REPORTS ; 2/22/87 3:06 PM ;
|
---|
2 | ;;5.2;LAB SERVICE;;Sep 27, 1994
|
---|
3 | LRMH ;from LRACS, LRACS2
|
---|
4 | S DFN=$P(^LR(LRDFN,0),U,3),LRDPF=+$P(^(0),U,2) D PT^LRX
|
---|
5 | S LRMH=0 F S LRMH=$O(^LAC(LRXLR,LRDFN,1,LRMH)) Q:LRMH<1 D MH1
|
---|
6 | Q
|
---|
7 | MH1 S LRTOM=$L(LRCLUS,U),LRMOM="" F LRIQ=1:1:LRTOM I $P(LRCLUS,U,LRIQ)=LRMH S LRMOM=$P(LRCLUS,U,LRIQ)
|
---|
8 | Q:LRMOM'=LRMH S LRMHN=$P(^LAC(LRXLR,LRDFN,1,LRMH,0),U,1),LRSH=0
|
---|
9 | D LRSH S LROSH=0
|
---|
10 | Q
|
---|
11 | LRSH S LRSH=$O(^LAC(LRXLR,LRDFN,1,LRMH,1,LRSH)) Q:LRSH<1 S X=^(LRSH,0) G:$O(^(1,0))<1 LRSH
|
---|
12 | S LRSHN=$P(X,U,1),LRTOPP=$P(X,U,2),LRSHD=$P(X,U,3),LRTOPP=$E($P(^LAB(61,LRTOPP,0),U,1),1,13),LRTOT=0,LRPL=1,LRACT=0,LRJS=0,LRTS=0,LRNP=0,LRFDT=0,LRLFDT=0,LRFFDT=0
|
---|
13 | D LRNP
|
---|
14 | LOOP G LRFDT
|
---|
15 | LRNP S LRIP=0 F S LRIP=$O(^LAB(64.5,1,1,LRMH,1,LRSH,1,LRIP)) Q:LRIP<1 S LRTOT=LRTOT+$P(^(LRIP,0),U,2) I LRTOT>(IOM-12) S LRPL=LRPL+1,LRTOT=$P(^(0),U,2)
|
---|
16 | LNS ;
|
---|
17 | S LRACT=0,LRJS=0
|
---|
18 | Q
|
---|
19 | LRFDT S LRFALT=0,LRCTR=0,J=LRJS+1,LRCL=14,LRFMT=$P(^LAC(LRXLR,LRDFN,1,LRMH,1,LRSH,0),U,4)
|
---|
20 | S LRFFDT=LRFDT,LRFDT=$O(^LAC(LRXLR,LRDFN,1,LRMH,1,LRSH,1,LRFDT)) G:LRFDT<1 LRSH S X=^(LRFDT,0),LRVDT=$P(X,U,3) I LRVDT>(LRDT_.9999)!(LRVDT<LRLDT) G LRFDT
|
---|
21 | S LRACT=LRACT+1,LRTLOC=$P(X,U,2) S:LRFDT>LRLFDT LRLFDT=LRFDT
|
---|
22 | LRTS I 'LRNAME D TOPLN^LRACS2 S LRNAME=1
|
---|
23 | K I S I=0,LRII=0 F S LRII=$O(^LAB(64.5,1,1,LRMH,1,LRSH,1,LRII)) Q:LRII<1 S I=I+1,I(I)=LRII
|
---|
24 | W:J'>LRSHD !!,LRTOPP,?LRCL F I=J:1:LRSHD S LRCW=$P(^LAB(64.5,1,1,LRMH,1,LRSH,1,I(I),0),U,2) Q:(IOM-LRCL)<LRCW S LRCL=LRCL+LRCW W $J($E($P(^(0),U,3),1,(LRCW-1)),(LRCW-3)),?LRCL
|
---|
25 | S LRJS=(I-1) S:LRACT=LRPL LRJS=LRJS+1
|
---|
26 | S LRCL=14
|
---|
27 | S LRFALT=0
|
---|
28 | GOUT D QRS I $P(^LAB(64.5,1,2,LRFULL,0),U,2) S LRHOLD=LRFDT D LRFMT,QRS:LRFDT>1 S LRFDT=LRHOLD
|
---|
29 | I LRACT'<LRPL G:$O(^LAC(LRXLR,LRDFN,1,LRMH,1,LRSH,1,LRLFDT))<1 LRSH S LRFDT=LRLFDT,LRACT=0,LRJS=0 G LRFDT
|
---|
30 | I LRACT<LRPL S LRFDT=LRFFDT G LRFDT
|
---|
31 | G LRFDT
|
---|
32 | QRS S LRCTR=LRCTR+1 F I=J:1:LRJS I $D(^LAC(LRXLR,LRDFN,1,LRMH,1,LRSH,1,LRFDT,1,I(I),0)) S:$L(^(0)) LRFALT=1
|
---|
33 | Q:'LRFALT S LRFALT=0,LRCL=14 W !,$P(^LAC(LRXLR,LRDFN,1,LRMH,1,LRSH,1,LRFDT,0),U,4)
|
---|
34 | F I=J:1:LRJS D QRS1
|
---|
35 | I $D(^LAC(LRXLR,LRDFN,1,LRMH,1,LRSH,1,LRFDT,"TX")) D TXT
|
---|
36 | I $Y>(IOSL-7) D EQUALS^LRX W @IOF D TOP^LRACS2
|
---|
37 | Q
|
---|
38 | QRS1 W ?LRCL S LRCW=$P(^LAB(64.5,1,1,LRMH,1,LRSH,1,I(I),0),U,2),LRDP=$P(^(0),U,6) Q:(IOM-LRCL)<LRCW
|
---|
39 | S LRCL=LRCL+LRCW I $D(^LAC(LRXLR,LRDFN,1,LRMH,1,LRSH,1,LRFDT,1,I(I),0)) S X=^(0) D C W:$L($P(^LAB(64.5,1,1,LRMH,1,LRSH,1,I(I),0),U,4))&($L(X)) @$P(^(0),U,4),X1 I '$L($P(^(0),U,4)) W X_X1
|
---|
40 | K X2 Q
|
---|
41 | TXT ;
|
---|
42 | S LRIT=0 F S LRIT=$O(^LAC(LRXLR,LRDFN,1,LRMH,1,LRSH,1,LRFDT,"TX",LRIT)) Q:LRIT<.1 W !?2,^(LRIT,0)
|
---|
43 | Q
|
---|
44 | C S X1=" "_$P(X,U,2),X=$P(X,U,1)
|
---|
45 | I $L($P(^LAB(64.5,1,1,LRMH,1,LRSH,1,I(I),0),U,4)) S LRCW=LRCW-3 Q
|
---|
46 | I "<>"[$E(X,1),$E(X,2,$L(X))?.N.P1N S X2=$E(X,1),X=$E(X,2,$L(X))
|
---|
47 | S LRCW(1)=LRCW-3
|
---|
48 | I X?.N.P1N!(LRDP="")!(X?.N1".".N) S X=$S(LRDP="":$J(X,LRCW(1)),1:$J(X,LRCW(1),LRDP)) I $D(X2) F X3=1:1:$L(X) I $E(X,X3)'=" " S X=$E(X,1,X3-2)_X2_$E(X,X3,$L(X)) Q
|
---|
49 | Q
|
---|
50 | LRFMT S LRFDT=$S(LRFMT["I":$O(^LAC(LRXLR,LRDFN,1,LRMH,1,LRSH,1,LRFDT)),1:LRFFDT)
|
---|
51 | I LRFDT>1 S:$P($P(^LAC(LRXLR,LRDFN,1,LRMH,1,LRSH,1,LRFDT,0),U,3),".",1)=LRDT LRFDT=-1 I LRFDT>1 D CHK S:'$D(LRMATCH) LRFDT=-1
|
---|
52 | Q
|
---|
53 | CHK K LRMATCH S I=0 F S I=$O(^LAC(LRXLR,LRDFN,1,LRMH,1,LRSH,1,LRHOLD,1,I)) Q:I<1 I $D(^LAC(LRXLR,LRDFN,1,LRMH,1,LRSH,1,LRFDT,1,I)) S LRMATCH=1 Q
|
---|
54 | Q
|
---|