LR7OSUM5 ;VA/slc/dcm - Silent Patient cum cont. ;JUL 06, 2010 3:14 PM
;;5.2;LAB SERVICE;**121,187,228,241,250,251,256,356,372,1027**;NOV 01, 1997;Build 11
TS ;from LR7OSUM3
N A,B,I,J,LRII,LRCTR,LRFALT,LRCL,LRCW,LRTLOC,X,XZ,Z
I LRACT'=0 S X="",$P(X,"=",GIOM)="" D LN S ^TMP("LRC",$J,GCNT,0)=X
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
S LRFALT=0,LRCTR=0,LRACT=LRACT+1,J=LRJS+1,LRCL=20
I J'>LRSHD D LINE^LR7OSUM4,LN S ^TMP("LRC",$J,GCNT,0)="",^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(CCNT,CCNT,LRTOPP)_$$S^LR7OS(LRCL,CCNT,"")
F I=J:1:LRSHD S Z=^LAB(64.5,1,1,LRMH,1,LRSH,1,I(I),0),LRCW=$P(Z,U,2) Q:(GIOM-LRCL)<LRCW D
. S LRCL=LRCL+LRCW,A=$L($P(Z,U,3))\2,B=LRCW\2,^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(CCNT,CCNT,$J($E($P(Z,U,3),1,(LRCW-1)),(A+B)))_$$S^LR7OS(LRCL,CCNT,"")
. S:'$P($G(^TMP("LRT",$J,$P(Z,"^",3))),"^",2) $P(^TMP("LRT",$J,$P(Z,"^",3)),"^",2)=GCNT
S LRJS=(I-1)
S:LRACT=LRPL LRJS=LRJS+1
F I=J:1:LRJS Q:'$D(^LAB(64.5,"A",1,LRMH,LRSH,I(I))) S Z=^(I(I)) S:$L($P(Z,U,2))!$L($P(Z,U,11)) LRFALT=1
I LRFALT D
. D LN S ^TMP("LRC",$J,GCNT,0)="" D
. . S LRCL=20
. . S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(CCNT,CCNT,$S($L($P(^LAB(64.5,"A",1,LRMH,LRSH,I(J)),U,11)):"Therapeutic low",1:"Ref range low"))_$$S^LR7OS(LRCL,CCNT,"")
. . D TS1
. D LN S ^TMP("LRC",$J,GCNT,0)="" D
. . S LRCL=20
. . S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(CCNT,CCNT,$S($L($P(^LAB(64.5,"A",1,LRMH,LRSH,I(J)),U,11)):"Therapeutic high",1:"Ref range high"))_$$S^LR7OS(LRCL,CCNT,"")
. . D TS2
F I=J:1:LRJS Q:'$D(^LAB(64.5,"A",1,LRMH,LRSH,I(I))) S:$L($P(^(I(I)),U,7)) LRFALT=1
I LRFALT S LRCL=20 D LN S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(LRCL,CCNT,"") F I=J:1:LRJS D TS3
S LRFALT=0,XZ="",$P(XZ,"-",GIOM)=""
D LN
S ^TMP("LRC",$J,GCNT,0)=XZ
LRFDT ;
S:LRNP LRFFDT=LRFDT,LRNP=0
S LRFDT=$O(^TMP($J,LRDFN,LRMH,LRSH,LRFDT)) G:LRFDT<1 LOOP^LR7OSUM3 S LRTLOC=$P(^(LRFDT,0),U,1)
S:LRFDT>LRLFDT LRLFDT=LRFDT
GOUT ;
D QRS
I LRCTR>LRLNS&(LRACT'<LRPL) S LRFULL=1 D TXT1 G:$O(^TMP($J,LRDFN,LRMH,LRSH,LRLFDT))<1 LRSH^LR7OSUM3 D HEAD^LR7OSUM6,LRLNS^LR7OSUM3 S LRFULL=0,LRFDT=LRLFDT G TS
I LRCTR>LRLNS&(LRACT<LRPL) S LRFDT=LRFFDT G TS
G LRFDT
QRS ;
S LRCTR=LRCTR+1
F I=J:1:LRJS I $D(^TMP($J,LRDFN,LRMH,LRSH,LRFDT,I(I))) S:$L(^(I(I))) LRFALT=1
Q:'LRFALT
S LRFALT=0,LRTM=1
D UDT^LR7OSUM3
S LRCL=20,LRTM=0
D LN
S ^TMP("LRC",$J,GCNT,0)=""
S:'LRNXSW ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(2,CCNT,""),^(0)=^(0)_$$S^LR7OS(3,CCNT,"")
S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(CCNT,CCNT,LRUDT)
F I=J:1:LRJS S LRG=^LAB(64.5,1,1,LRMH,1,LRSH,1,I(I),0) S X=^(0) D QRS1
Q
QRS1 ;
S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(LRCL,CCNT,""),LRCW=$P(LRG,U,2),LRDP=$P(X,U,6)
Q:(GIOM-LRCL)<LRCW
S LRCL=LRCL+LRCW
I $D(^TMP($J,LRDFN,LRMH,LRSH,LRFDT,I(I))) S X=^(I(I)) D C(.X,.X1) S:$L($P(LRG,U,4))&($L(X)) @("X="_$P(LRG,U,4)),^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(CCNT,CCNT,X_X1) D
. I '$L($P(LRG,U,4)) S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(CCNT,CCNT,X_X1)
Q
TXT ;from LR7OSUM4
S LRVAR=0,LRIV=0
F S LRIV=$O(^TMP($J,LRDFN,LRMH,LRSH,LRFDT,"TX",LRIV)) Q:LRIV<1 S X=^(LRIV,0),LRVAR=LRVAR+1 D
. I LRVAR>1 D LN S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(3,CCNT,"")
. S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(CCNT,CCNT,X)
Q
LRLO ;from LR7OSUM4
S @("LRLO="_$S($L($P(^LAB(64.5,"A",1,LRMH,LRSH,I(I)),U,2)):$P(^(I(I)),U,2),$L($P(^LAB(64.5,"A",1,LRMH,LRSH,I(I)),U,11)):$P(^(I(I)),U,11),1:""""""))
LRHI S @("LRHI="_$S($L($P(^LAB(64.5,"A",1,LRMH,LRSH,I(I)),U,3)):$P(^(I(I)),U,3),$L($P(^LAB(64.5,"A",1,LRMH,LRSH,I(I)),U,12)):$P(^(I(I)),U,12),1:"""""")),P7=$P(^(I(I)),U,7)
S LRLOHI=$$EN^LRLRRVF(LRLO,LRHI)
Q
TXT1 ;from LR7OSUM3, LR7OSUM4
S XZ="",$P(XZ,"=",GIOM)=""
Q:'$D(LRTM(0))
N C6,I,L
S C6=0
F S C6=$O(^TMP($J,"TM",C6)) Q:C6<1 S X=^(C6) D
. D LN
. S I=$S($L($P(X,"^"))>1:2,1:3),^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(I,CCNT,$P(X,U)_". "),L(0)=0,L=0 D
. F S L=$O(^TMP($J,"TM",C6,L)) Q:L<1 S X=^(L),L(0)=L(0)+1 D
.. I L(0)>1 D LN S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(6,CCNT,"")
.. S ^(0)=^TMP("LRC",$J,GCNT,0)_X
Q
C(X,X1) ;
N X2
S X1=" "_$P(X,U,2),X=$P(X,U,1)
I $L($P(LRG,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)) D C2(.X,.X2)
Q
C1(X,X1) ;from LR7OSUM4
S LRCW=$S('$L(X1):7,1:10),X1=$S($L(X1)=1:" "_X1_" ",$L(X1)=0:X1,1:" "_X1)
I $L($P(LRG,U,4)) S LRCW=7 Q
S X=$S($L(X1):X_X1,1:X)
Q
C2(X,X2) ;
Q:'$D(X2)
Q:'$D(X)
N X3
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
TS1 ;Print low therapeutic or reference range values
F I=J:1:LRJS S LRCW=$P(^LAB(64.5,1,1,LRMH,1,LRSH,1,I(I),0),U,2),LRCL=LRCL+LRCW D
. S @("LRLO="_$S($L($P(^LAB(64.5,"A",1,LRMH,LRSH,I(I)),U,2)):$P(^(I(I)),U,2),$L($P(^LAB(64.5,"A",1,LRMH,LRSH,I(I)),U,11)):$P(^(I(I)),U,11),1:""""""))
. S A=$L(LRLO)\2,B=LRCW\2
. S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(CCNT,CCNT,$J(LRLO,(A+B))),^(0)=^(0)_$$S^LR7OS(LRCL,CCNT,"")
Q
TS2 ;Print high therapeutic or reference range values
F I=J:1:LRJS S LRCW=$P(^LAB(64.5,1,1,LRMH,1,LRSH,1,I(I),0),U,2),LRCL=LRCL+LRCW D
. S @("LRHI="_$S($L($P(^LAB(64.5,"A",1,LRMH,LRSH,I(I)),U,3)):$P(^(I(I)),U,3),$L($P(^LAB(64.5,"A",1,LRMH,LRSH,I(I)),U,12)):$P(^(I(I)),U,12),1:"""""")),P7=$P(^(I(I)),U,7)
. S A=$L(LRHI)\2,B=LRCW\2
. S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(CCNT,CCNT,$J(LRHI,(A+B))),^(0)=^(0)_$$S^LR7OS(LRCL,CCNT,"")
Q
TS3 ;Print units
S LRCW=$P(^LAB(64.5,1,1,LRMH,1,LRSH,1,I(I),0),U,2)
Q:(GIOM-LRCL)<LRCW
S LRCL=LRCL+LRCW,A=$L($P(^LAB(64.5,"A",1,LRMH,LRSH,I(I)),U,7))\2,B=LRCW\2,X=^(I(I))
S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(CCNT,CCNT,$J($P(X,U,7),(A+B)))
S ^TMP("LRC",$J,GCNT,0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(LRCL,CCNT,""),LRFALT=0
Q
LN ;
S GCNT=GCNT+1,CCNT=1
Q
LR7OSUM5 ;VA/slc/dcm - Silent Patient cum cont. ;JUL 06, 2010 3:14 PM
+1 ;;5.2;LAB SERVICE;**121,187,228,241,250,251,256,356,372,1027**;NOV 01, 1997;Build 11
TS ;from LR7OSUM3
+1 NEW A,B,I,J,LRII,LRCTR,LRFALT,LRCL,LRCW,LRTLOC,X,XZ,Z
+2 IF LRACT'=0
SET X=""
SET $PIECE(X,"=",GIOM)=""
DO LN
SET ^TMP("LRC",$JOB,GCNT,0)=X
+3 SET I=0
SET LRII=0
+4 FOR
SET LRII=$ORDER(^LAB(64.5,1,1,LRMH,1,LRSH,1,LRII))
IF LRII<1
QUIT
SET I=I+1
SET I(I)=LRII
+5 SET LRFALT=0
SET LRCTR=0
SET LRACT=LRACT+1
SET J=LRJS+1
SET LRCL=20
+6 IF J'>LRSHD
DO LINE^LR7OSUM4
DO LN
SET ^TMP("LRC",$JOB,GCNT,0)=""
SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(CCNT,CCNT,LRTOPP)_$$S^LR7OS(LRCL,CCNT,"")
+7 FOR I=J:1:LRSHD
SET Z=^LAB(64.5,1,1,LRMH,1,LRSH,1,I(I),0)
SET LRCW=$PIECE(Z,U,2)
IF (GIOM-LRCL)<LRCW
QUIT
Begin DoDot:1
+8 SET LRCL=LRCL+LRCW
SET A=$LENGTH($PIECE(Z,U,3))\2
SET B=LRCW\2
SET ^(0)=^TMP("LRC",$JOB,GCNT,0)_$$S^LR7OS(CCNT,CCNT,$JUSTIFY($EXTRACT($PIECE(Z,U,3),1,(LRCW-1)),(A+B)))_$$S^LR7OS(LRCL,CCNT,"")
+9 IF '$PIECE($GET(^TMP("LRT",$JOB,$PIECE(Z,"^",3))),"^",2)
SET $PIECE(^TMP("LRT",$JOB,$PIECE(Z,"^",3)),"^",2)=GCNT
End DoDot:1
+10 SET LRJS=(I-1)
+11 IF LRACT=LRPL
SET LRJS=LRJS+1
+12 FOR I=J:1:LRJS
IF '$DATA(^LAB(64.5,"A",1,LRMH,LRSH,I(I)))
QUIT
SET Z=^(I(I))
IF $LENGTH($PIECE(Z,U,2))!$LENGTH($PIECE(Z,U,11))
SET LRFALT=1
+13 IF LRFALT
Begin DoDot:1
+14 DO LN
SET ^TMP("LRC",$JOB,GCNT,0)=""
Begin DoDot:2
+15 SET LRCL=20
+16 SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(CCNT,CCNT,$SELECT($LENGTH($PIECE(^LAB(64.5,"A",1,LRMH,LRSH,I(J)),U,11)):"Therapeutic low",1:"Ref range low"))_$$S^LR7OS(LRCL,CCNT,"")
+17 DO TS1
End DoDot:2
+18 DO LN
SET ^TMP("LRC",$JOB,GCNT,0)=""
Begin DoDot:2
+19 SET LRCL=20
+20 SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(CCNT,CCNT,$SELECT($LENGTH($PIECE(^LAB(64.5,"A",1,LRMH,LRSH,I(J)),U,11)):"Therapeutic high",1:"Ref range high"))_$$S^LR7OS(LRCL,CCNT,"")
+21 DO TS2
End DoDot:2
End DoDot:1
+22 FOR I=J:1:LRJS
IF '$DATA(^LAB(64.5,"A",1,LRMH,LRSH,I(I)))
QUIT
IF $LENGTH($PIECE(^(I(I)),U,7))
SET LRFALT=1
+23 IF LRFALT
SET LRCL=20
DO LN
SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(LRCL,CCNT,"")
FOR I=J:1:LRJS
DO TS3
+24 SET LRFALT=0
SET XZ=""
SET $PIECE(XZ,"-",GIOM)=""
+25 DO LN
+26 SET ^TMP("LRC",$JOB,GCNT,0)=XZ
LRFDT ;
+1 IF LRNP
SET LRFFDT=LRFDT
SET LRNP=0
+2 SET LRFDT=$ORDER(^TMP($JOB,LRDFN,LRMH,LRSH,LRFDT))
IF LRFDT<1
GOTO LOOP^LR7OSUM3
SET LRTLOC=$PIECE(^(LRFDT,0),U,1)
+3 IF LRFDT>LRLFDT
SET LRLFDT=LRFDT
GOUT ;
+1 DO QRS
+2 IF LRCTR>LRLNS&(LRACT'<LRPL)
SET LRFULL=1
DO TXT1
IF $ORDER(^TMP($JOB,LRDFN,LRMH,LRSH,LRLFDT))<1
GOTO LRSH^LR7OSUM3
DO HEAD^LR7OSUM6
DO LRLNS^LR7OSUM3
SET LRFULL=0
SET LRFDT=LRLFDT
GOTO TS
+3 IF LRCTR>LRLNS&(LRACT<LRPL)
SET LRFDT=LRFFDT
GOTO TS
+4 GOTO LRFDT
QRS ;
+1 SET LRCTR=LRCTR+1
+2 FOR I=J:1:LRJS
IF $DATA(^TMP($JOB,LRDFN,LRMH,LRSH,LRFDT,I(I)))
IF $LENGTH(^(I(I)))
SET LRFALT=1
+3 IF 'LRFALT
QUIT
+4 SET LRFALT=0
SET LRTM=1
+5 DO UDT^LR7OSUM3
+6 SET LRCL=20
SET LRTM=0
+7 DO LN
+8 SET ^TMP("LRC",$JOB,GCNT,0)=""
+9 IF 'LRNXSW
SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(2,CCNT,"")
SET ^(0)=^(0)_$$S^LR7OS(3,CCNT,"")
+10 SET ^(0)=^TMP("LRC",$JOB,GCNT,0)_$$S^LR7OS(CCNT,CCNT,LRUDT)
+11 FOR I=J:1:LRJS
SET LRG=^LAB(64.5,1,1,LRMH,1,LRSH,1,I(I),0)
SET X=^(0)
DO QRS1
+12 QUIT
QRS1 ;
+1 SET ^(0)=^TMP("LRC",$JOB,GCNT,0)_$$S^LR7OS(LRCL,CCNT,"")
SET LRCW=$PIECE(LRG,U,2)
SET LRDP=$PIECE(X,U,6)
+2 IF (GIOM-LRCL)<LRCW
QUIT
+3 SET LRCL=LRCL+LRCW
+4 IF $DATA(^TMP($JOB,LRDFN,LRMH,LRSH,LRFDT,I(I)))
SET X=^(I(I))
DO C(.X,.X1)
IF $LENGTH($PIECE(LRG,U,4))&($LENGTH(X))
SET @("X="_$PIECE(LRG,U,4))
SET ^(0)=^TMP("LRC",$JOB,GCNT,0)_$$S^LR7OS(CCNT,CCNT,X_X1)
Begin DoDot:1
+5 IF '$LENGTH($PIECE(LRG,U,4))
SET ^(0)=^TMP("LRC",$JOB,GCNT,0)_$$S^LR7OS(CCNT,CCNT,X_X1)
End DoDot:1
+6 QUIT
TXT ;from LR7OSUM4
+1 SET LRVAR=0
SET LRIV=0
+2 FOR
SET LRIV=$ORDER(^TMP($JOB,LRDFN,LRMH,LRSH,LRFDT,"TX",LRIV))
IF LRIV<1
QUIT
SET X=^(LRIV,0)
SET LRVAR=LRVAR+1
Begin DoDot:1
+3 IF LRVAR>1
DO LN
SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(3,CCNT,"")
+4 SET ^(0)=^TMP("LRC",$JOB,GCNT,0)_$$S^LR7OS(CCNT,CCNT,X)
End DoDot:1
+5 QUIT
LRLO ;from LR7OSUM4
+1 SET @("LRLO="_$SELECT($LENGTH($PIECE(^LAB(64.5,"A",1,LRMH,LRSH,I(I)),U,2)):$PIECE(^(I(I)),U,2),$LENGTH($PIECE(^LAB(64.5,"A",1,LRMH,LRSH,I(I)),U,11)):$PIECE(^(I(I)),U,11),1:""""""))
LRHI SET @("LRHI="_$SELECT($LENGTH($PIECE(^LAB(64.5,"A",1,LRMH,LRSH,I(I)),U,3)):$PIECE(^(I(I)),U,3),$LENGTH($PIECE(^LAB(64.5,"A",1,LRMH,LRSH,I(I)),U,12)):$PIECE(^(I(I)),U,12),1:""""""))
SET P7=$PIECE(^(I(I)),U,7)
+1 SET LRLOHI=$$EN^LRLRRVF(LRLO,LRHI)
+2 QUIT
TXT1 ;from LR7OSUM3, LR7OSUM4
+1 SET XZ=""
SET $PIECE(XZ,"=",GIOM)=""
+2 IF '$DATA(LRTM(0))
QUIT
+3 NEW C6,I,L
+4 SET C6=0
+5 FOR
SET C6=$ORDER(^TMP($JOB,"TM",C6))
IF C6<1
QUIT
SET X=^(C6)
Begin DoDot:1
+6 DO LN
+7 SET I=$SELECT($LENGTH($PIECE(X,"^"))>1:2,1:3)
SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(I,CCNT,$PIECE(X,U)_". ")
SET L(0)=0
SET L=0
Begin DoDot:2
End DoDot:2
+8 FOR
SET L=$ORDER(^TMP($JOB,"TM",C6,L))
IF L<1
QUIT
SET X=^(L)
SET L(0)=L(0)+1
Begin DoDot:2
+9 IF L(0)>1
DO LN
SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(6,CCNT,"")
+10 SET ^(0)=^TMP("LRC",$JOB,GCNT,0)_X
End DoDot:2
End DoDot:1
+11 QUIT
C(X,X1) ;
+1 NEW X2
+2 SET X1=" "_$PIECE(X,U,2)
SET X=$PIECE(X,U,1)
+3 IF $LENGTH($PIECE(LRG,U,4))
SET LRCW=LRCW-3
QUIT
+4 IF "<>"[$EXTRACT(X,1)
IF $EXTRACT(X,2,$LENGTH(X))?.N.P1N
SET X2=$EXTRACT(X,1)
SET X=$EXTRACT(X,2,$LENGTH(X))
+5 SET LRCW(1)=LRCW-3
+6 IF X?.N.P1N!(LRDP="")!(X?.N1".".N)
SET X=$SELECT(LRDP="":$JUSTIFY(X,LRCW(1)),1:$JUSTIFY(X,LRCW(1),LRDP))
DO C2(.X,.X2)
+7 QUIT
C1(X,X1) ;from LR7OSUM4
+1 SET LRCW=$SELECT('$LENGTH(X1):7,1:10)
SET X1=$SELECT($LENGTH(X1)=1:" "_X1_" ",$LENGTH(X1)=0:X1,1:" "_X1)
+2 IF $LENGTH($PIECE(LRG,U,4))
SET LRCW=7
QUIT
+3 SET X=$SELECT($LENGTH(X1):X_X1,1:X)
+4 QUIT
C2(X,X2) ;
+1 IF '$DATA(X2)
QUIT
+2 IF '$DATA(X)
QUIT
+3 NEW X3
+4 FOR X3=1:1:$LENGTH(X)
IF $EXTRACT(X,X3)'=" "
SET X=$EXTRACT(X,1,X3-2)_X2_$EXTRACT(X,X3,$LENGTH(X))
QUIT
+5 QUIT
TS1 ;Print low therapeutic or reference range values
+1 FOR I=J:1:LRJS
SET LRCW=$PIECE(^LAB(64.5,1,1,LRMH,1,LRSH,1,I(I),0),U,2)
SET LRCL=LRCL+LRCW
Begin DoDot:1
+2 SET @("LRLO="_$SELECT($LENGTH($PIECE(^LAB(64.5,"A",1,LRMH,LRSH,I(I)),U,2)):$PIECE(^(I(I)),U,2),$LENGTH($PIECE(^LAB(64.5,"A",1,LRMH,LRSH,I(I)),U,11)):$PIECE(^(I(I)),U,11),1:""""""))
+3 SET A=$LENGTH(LRLO)\2
SET B=LRCW\2
+4 SET ^(0)=^TMP("LRC",$JOB,GCNT,0)_$$S^LR7OS(CCNT,CCNT,$JUSTIFY(LRLO,(A+B)))
SET ^(0)=^(0)_$$S^LR7OS(LRCL,CCNT,"")
End DoDot:1
+5 QUIT
TS2 ;Print high therapeutic or reference range values
+1 FOR I=J:1:LRJS
SET LRCW=$PIECE(^LAB(64.5,1,1,LRMH,1,LRSH,1,I(I),0),U,2)
SET LRCL=LRCL+LRCW
Begin DoDot:1
+2 SET @("LRHI="_$SELECT($LENGTH($PIECE(^LAB(64.5,"A",1,LRMH,LRSH,I(I)),U,3)):$PIECE(^(I(I)),U,3),$LENGTH($PIECE(^LAB(64.5,"A",1,LRMH,LRSH,I(I)),U,12)):$PIECE(^(I(I)),U,12),1:""""""))
SET P7=$PIECE(^(I(I)),U,7)
+3 SET A=$LENGTH(LRHI)\2
SET B=LRCW\2
+4 SET ^(0)=^TMP("LRC",$JOB,GCNT,0)_$$S^LR7OS(CCNT,CCNT,$JUSTIFY(LRHI,(A+B)))
SET ^(0)=^(0)_$$S^LR7OS(LRCL,CCNT,"")
End DoDot:1
+5 QUIT
TS3 ;Print units
+1 SET LRCW=$PIECE(^LAB(64.5,1,1,LRMH,1,LRSH,1,I(I),0),U,2)
+2 IF (GIOM-LRCL)<LRCW
QUIT
+3 SET LRCL=LRCL+LRCW
SET A=$LENGTH($PIECE(^LAB(64.5,"A",1,LRMH,LRSH,I(I)),U,7))\2
SET B=LRCW\2
SET X=^(I(I))
+4 SET ^(0)=^TMP("LRC",$JOB,GCNT,0)_$$S^LR7OS(CCNT,CCNT,$JUSTIFY($PIECE(X,U,7),(A+B)))
+5 SET ^TMP("LRC",$JOB,GCNT,0)=^TMP("LRC",$JOB,GCNT,0)_$$S^LR7OS(LRCL,CCNT,"")
SET LRFALT=0
+6 QUIT
LN ;
+1 SET GCNT=GCNT+1
SET CCNT=1
+2 QUIT
