55 lines
3.2 KiB
Mathematica
55 lines
3.2 KiB
Mathematica
LRACS1 ;SLC/DCM - DAILY LAB SUMMARY REPORTS ; 2/22/87 3:06 PM ;
|
|
;;5.2;LAB SERVICE;;Sep 27, 1994
|
|
LRMH ;from LRACS, LRACS2
|
|
S DFN=$P(^LR(LRDFN,0),U,3),LRDPF=+$P(^(0),U,2) D PT^LRX
|
|
S LRMH=0 F S LRMH=$O(^LAC(LRXLR,LRDFN,1,LRMH)) Q:LRMH<1 D MH1
|
|
Q
|
|
MH1 S LRTOM=$L(LRCLUS,U),LRMOM="" F LRIQ=1:1:LRTOM I $P(LRCLUS,U,LRIQ)=LRMH S LRMOM=$P(LRCLUS,U,LRIQ)
|
|
Q:LRMOM'=LRMH S LRMHN=$P(^LAC(LRXLR,LRDFN,1,LRMH,0),U,1),LRSH=0
|
|
D LRSH S LROSH=0
|
|
Q
|
|
LRSH S LRSH=$O(^LAC(LRXLR,LRDFN,1,LRMH,1,LRSH)) Q:LRSH<1 S X=^(LRSH,0) G:$O(^(1,0))<1 LRSH
|
|
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
|
|
D LRNP
|
|
LOOP G LRFDT
|
|
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)
|
|
LNS ;
|
|
S LRACT=0,LRJS=0
|
|
Q
|
|
LRFDT S LRFALT=0,LRCTR=0,J=LRJS+1,LRCL=14,LRFMT=$P(^LAC(LRXLR,LRDFN,1,LRMH,1,LRSH,0),U,4)
|
|
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
|
|
S LRACT=LRACT+1,LRTLOC=$P(X,U,2) S:LRFDT>LRLFDT LRLFDT=LRFDT
|
|
LRTS I 'LRNAME D TOPLN^LRACS2 S LRNAME=1
|
|
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
|
|
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
|
|
S LRJS=(I-1) S:LRACT=LRPL LRJS=LRJS+1
|
|
S LRCL=14
|
|
S LRFALT=0
|
|
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
|
|
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
|
|
I LRACT<LRPL S LRFDT=LRFFDT G LRFDT
|
|
G LRFDT
|
|
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
|
|
Q:'LRFALT S LRFALT=0,LRCL=14 W !,$P(^LAC(LRXLR,LRDFN,1,LRMH,1,LRSH,1,LRFDT,0),U,4)
|
|
F I=J:1:LRJS D QRS1
|
|
I $D(^LAC(LRXLR,LRDFN,1,LRMH,1,LRSH,1,LRFDT,"TX")) D TXT
|
|
I $Y>(IOSL-7) D EQUALS^LRX W @IOF D TOP^LRACS2
|
|
Q
|
|
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
|
|
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
|
|
K X2 Q
|
|
TXT ;
|
|
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)
|
|
Q
|
|
C S X1=" "_$P(X,U,2),X=$P(X,U,1)
|
|
I $L($P(^LAB(64.5,1,1,LRMH,1,LRSH,1,I(I),0),U,4)) S LRCW=LRCW-3 Q
|
|
I "<>"[$E(X,1),$E(X,2,$L(X))?.N.P1N S X2=$E(X,1),X=$E(X,2,$L(X))
|
|
S LRCW(1)=LRCW-3
|
|
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
|
|
Q
|
|
LRFMT S LRFDT=$S(LRFMT["I":$O(^LAC(LRXLR,LRDFN,1,LRMH,1,LRSH,1,LRFDT)),1:LRFFDT)
|
|
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
|
|
Q
|
|
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
|
|
Q
|