LR7OSUM5 ;DALOI/STAFFC - Silent Patient cum cont. ;02/20/13 16:48
;;5.2;LAB SERVICE;**121,187,228,241,250,251,256,356,372,350,427**;Sep 27, 1994;Build 33
;
TS ; from LR7OSUM3
N A,B,I,J,LRII,LRCCNT,LRCTR,LRFALT,LRCL,LRCW,LRJ,LRLEN,LRPNAME,LRTLOC,LRWRAP,LRX,LRY,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=25
;
I J'>LRSHD D
. D LINE^LR7OSUM4,LN
. S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(CCNT,CCNT,LRTOPP)_$$S^LR7OS(LRCL,CCNT,"")
;
; GIOM=right margin LRCL=column position LRCW=column width
F I=J:1:LRSHD S Z=^LAB(64.5,1,1,LRMH,1,LRSH,1,I(I),0),LRCW=$P(Z,U,2) S:LRCW<1 LRCW=15 Q:(GIOM-LRCL)<LRCW D
. S LRCL=LRCL+LRCW,LRPNAME=$P(Z,U,3),LRLEN=$L(LRPNAME),LRWRAP=0
. I LRLEN>($S(LRCW>1:LRCW-1,1:1)) S LRCCNT=CCNT,LRWRAP=1
. S LRX=$E(LRPNAME,1,$S(LRCW>1:LRCW-1,1:1)),LRX=$$TRIM^XLFSTR(LRX,"RL"," "),LRX=$$CJ^XLFSTR(LRX,$S(LRCW>1:LRCW-1,1:1))
. S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(CCNT,CCNT,LRX)_$$S^LR7OS(LRCL,CCNT,"")
. S:'$P($G(^TMP("LRT",$J,LRPNAME)),"^",2) $P(^TMP("LRT",$J,LRPNAME),"^",2)=GCNT
. I LRWRAP D
. . S LRJ=0
. . F D Q:LRPNAME=""
. . . S LRPNAME=$E(LRPNAME,$S(LRCW>1:LRCW,1:LRCW+1),LRLEN) S:$E(LRPNAME,1)=" " LRPNAME=$$TRIM^XLFSTR(LRPNAME,"L"," ") Q:LRPNAME=""
. . . S LRX=$E(LRPNAME,1,$S(LRCW>1:LRCW-1,1:1)),LRX=$$TRIM^XLFSTR(LRX,"RL"," "),LRX=$$CJ^XLFSTR(LRX,$S(LRCW>1:LRCW-1,1:1)),LRJ=LRJ+1
. . . S LRY=$G(^TMP("LRC",$J,GCNT+LRJ,0))
. . . S ^TMP("LRC",$J,GCNT+LRJ,0)=$$LJ^XLFSTR(LRY,LRCCNT-1)_LRX
S GCNT=$O(^TMP("LRC",$J,""),-1)
;
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 LRCL=25
. S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(CCNT,CCNT,$S($P(^LAB(64.5,"A",1,LRMH,LRSH,I(J)),U,11)'="":"Therapeutic low",1:"Ref range low"))_$$S^LR7OS(LRCL,CCNT,"")
. D TS1,LN
. S LRCL=25
. S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(CCNT,CCNT,$S($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:$P(^(I(I)),U,7)'="" LRFALT=1
I LRFALT S LRCL=25 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:^(I(I))'="" LRFALT=1
Q:'LRFALT
S LRFALT=0,LRTM=1
D UDT^LR7OSUM3
S LRCL=25,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)
I LRCW<1 S LRCW=15
Q:(GIOM-LRCL)<LRCW
S LRCL=LRCL+LRCW
I $D(^TMP($J,LRDFN,LRMH,LRSH,LRFDT,I(I))) D
. S X=^TMP($J,LRDFN,LRMH,LRSH,LRFDT,I(I))
. D C(.X,.X1)
. I $P(LRG,U,4)'=""&($L(X)) S @("X="_$P(LRG,U,4)),^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(CCNT,CCNT,X_X1)
. I $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 D
. S X=^TMP($J,LRDFN,LRMH,LRSH,LRFDT,"TX",LRIV,0),LRVAR=LRVAR+1
. I LRVAR>1 D LN S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(5,CCNT,"")
. S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(5,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 $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
N X2
S LRCW=$S(X1="":7,1:10),X1=$S($L(X1)=1:" "_X1_" ",$L(X1)=0:X1,1:" "_X1)
I $P(LRG,U,4)'="" S LRCW=7 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)
S X=$S(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) S:LRCW<1 LRCW=15 S 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 ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(CCNT,CCNT,$J(LRLO,(A+B))),^(0)=^(0)_$$S^LR7OS(LRCL,CCNT,"")
. S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(CCNT,CCNT,$$CJ^XLFSTR(LRLO,LRCW)),^(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) S:LRCW<1 LRCW=15 S 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 ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(CCNT,CCNT,$J(LRHI,(A+B))),^(0)=^(0)_$$S^LR7OS(LRCL,CCNT,"")
. S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(CCNT,CCNT,$$CJ^XLFSTR(LRHI,LRCW)),^(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)
I LRCW<1 S LRCW=15
Q:(GIOM-LRCL)<LRCW
S LRCL=LRCL+LRCW,X=^LAB(64.5,"A",1,LRMH,LRSH,I(I))
;S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(CCNT,CCNT,$J($P(X,U,7),(A+B)))
S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(CCNT,CCNT,$$CJ^XLFSTR($P(X,U,7),LRCW))
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLR7OSUM5 7238 printed Oct 16, 2024@18:06:31 Page 2
LR7OSUM5 ;DALOI/STAFFC - Silent Patient cum cont. ;02/20/13 16:48
+1 ;;5.2;LAB SERVICE;**121,187,228,241,250,251,256,356,372,350,427**;Sep 27, 1994;Build 33
+2 ;
TS ; from LR7OSUM3
+1 NEW A,B,I,J,LRII,LRCCNT,LRCTR,LRFALT,LRCL,LRCW,LRJ,LRLEN,LRPNAME,LRTLOC,LRWRAP,LRX,LRY,X,XZ,Z
+2 ;
+3 IF LRACT'=0
SET X=""
SET $PIECE(X,"=",GIOM)=""
DO LN
SET ^TMP("LRC",$JOB,GCNT,0)=X
+4 ;
+5 SET I=0
SET LRII=0
+6 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
+7 SET LRFALT=0
SET LRCTR=0
SET LRACT=LRACT+1
SET J=LRJS+1
SET LRCL=25
+8 ;
+9 IF J'>LRSHD
Begin DoDot:1
+10 DO LINE^LR7OSUM4
DO LN
+11 SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(CCNT,CCNT,LRTOPP)_$$S^LR7OS(LRCL,CCNT,"")
End DoDot:1
+12 ;
+13 ; GIOM=right margin LRCL=column position LRCW=column width
+14 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 LRCW<1
SET LRCW=15
if (GIOM-LRCL)<LRCW
QUIT
Begin DoDot:1
+15 SET LRCL=LRCL+LRCW
SET LRPNAME=$PIECE(Z,U,3)
SET LRLEN=$LENGTH(LRPNAME)
SET LRWRAP=0
+16 IF LRLEN>($SELECT(LRCW>1:LRCW-1,1:1))
SET LRCCNT=CCNT
SET LRWRAP=1
+17 SET LRX=$EXTRACT(LRPNAME,1,$SELECT(LRCW>1:LRCW-1,1:1))
SET LRX=$$TRIM^XLFSTR(LRX,"RL"," ")
SET LRX=$$CJ^XLFSTR(LRX,$SELECT(LRCW>1:LRCW-1,1:1))
+18 SET ^(0)=^TMP("LRC",$JOB,GCNT,0)_$$S^LR7OS(CCNT,CCNT,LRX)_$$S^LR7OS(LRCL,CCNT,"")
+19 if '$PIECE($GET(^TMP("LRT",$JOB,LRPNAME)),"^",2)
SET $PIECE(^TMP("LRT",$JOB,LRPNAME),"^",2)=GCNT
+20 IF LRWRAP
Begin DoDot:2
+21 SET LRJ=0
+22 FOR
Begin DoDot:3
+23 SET LRPNAME=$EXTRACT(LRPNAME,$SELECT(LRCW>1:LRCW,1:LRCW+1),LRLEN)
if $EXTRACT(LRPNAME,1)=" "
SET LRPNAME=$$TRIM^XLFSTR(LRPNAME,"L"," ")
if LRPNAME=""
QUIT
+24 SET LRX=$EXTRACT(LRPNAME,1,$SELECT(LRCW>1:LRCW-1,1:1))
SET LRX=$$TRIM^XLFSTR(LRX,"RL"," ")
SET LRX=$$CJ^XLFSTR(LRX,$SELECT(LRCW>1:LRCW-1,1:1))
SET LRJ=LRJ+1
+25 SET LRY=$GET(^TMP("LRC",$JOB,GCNT+LRJ,0))
+26 SET ^TMP("LRC",$JOB,GCNT+LRJ,0)=$$LJ^XLFSTR(LRY,LRCCNT-1)_LRX
End DoDot:3
if LRPNAME=""
QUIT
End DoDot:2
End DoDot:1
+27 SET GCNT=$ORDER(^TMP("LRC",$JOB,""),-1)
+28 ;
+29 SET LRJS=(I-1)
+30 if LRACT=LRPL
SET LRJS=LRJS+1
+31 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
+32 IF LRFALT
Begin DoDot:1
+33 DO LN
+34 SET LRCL=25
+35 SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(CCNT,CCNT,$SELECT($PIECE(^LAB(64.5,"A",1,LRMH,LRSH,I(J)),U,11)'="":"Therapeutic low",1:"Ref range low"))_$$S^LR7OS(LRCL,CCNT,"")
+36 DO TS1
DO LN
+37 SET LRCL=25
+38 SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(CCNT,CCNT,$SELECT($PIECE(^LAB(64.5,"A",1,LRMH,LRSH,I(J)),U,11)'="":"Therapeutic high",1:"Ref range high"))_$$S^LR7OS(LRCL,CCNT,"")
+39 DO TS2
End DoDot:1
+40 ;
+41 FOR I=J:1:LRJS
if '$DATA(^LAB(64.5,"A",1,LRMH,LRSH,I(I)))
QUIT
if $PIECE(^(I(I)),U,7)'=""
SET LRFALT=1
+42 IF LRFALT
SET LRCL=25
DO LN
SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(LRCL,CCNT,"")
FOR I=J:1:LRJS
DO TS3
+43 SET LRFALT=0
SET XZ=""
SET $PIECE(XZ,"-",GIOM)=""
+44 DO LN
+45 SET ^TMP("LRC",$JOB,GCNT,0)=XZ
+46 ;
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
+4 ;
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
+5 ;
+6 ;
QRS ;
+1 SET LRCTR=LRCTR+1
+2 FOR I=J:1:LRJS
IF $DATA(^TMP($JOB,LRDFN,LRMH,LRSH,LRFDT,I(I)))
if ^(I(I))'=""
SET LRFALT=1
+3 if 'LRFALT
QUIT
+4 SET LRFALT=0
SET LRTM=1
+5 DO UDT^LR7OSUM3
+6 SET LRCL=25
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
+13 ;
+14 ;
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 LRCW<1
SET LRCW=15
+3 if (GIOM-LRCL)<LRCW
QUIT
+4 SET LRCL=LRCL+LRCW
+5 IF $DATA(^TMP($JOB,LRDFN,LRMH,LRSH,LRFDT,I(I)))
Begin DoDot:1
+6 SET X=^TMP($JOB,LRDFN,LRMH,LRSH,LRFDT,I(I))
+7 DO C(.X,.X1)
+8 IF $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)
+9 IF $PIECE(LRG,U,4)=""
SET ^(0)=^TMP("LRC",$JOB,GCNT,0)_$$S^LR7OS(CCNT,CCNT,X_X1)
End DoDot:1
+10 QUIT
+11 ;
+12 ;
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
Begin DoDot:1
+3 SET X=^TMP($JOB,LRDFN,LRMH,LRSH,LRFDT,"TX",LRIV,0)
SET LRVAR=LRVAR+1
+4 IF LRVAR>1
DO LN
SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(5,CCNT,"")
+5 SET ^(0)=^TMP("LRC",$JOB,GCNT,0)_$$S^LR7OS(5,CCNT,X)
End DoDot:1
+6 QUIT
+7 ;
+8 ;
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:""""""))
+2 ;
LRHI ;
+1 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)
+2 SET LRLOHI=$$EN^LRLRRVF(LRLO,LRHI)
+3 QUIT
+4 ;
+5 ;
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
+12 ;
+13 ;
C(X,X1) ;
+1 NEW X2
+2 SET X1=" "_$PIECE(X,U,2)
SET X=$PIECE(X,U,1)
+3 IF $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
+8 ;
+9 ;
C1(X,X1) ; from LR7OSUM4
+1 NEW X2
+2 SET LRCW=$SELECT(X1="":7,1:10)
SET X1=$SELECT($LENGTH(X1)=1:" "_X1_" ",$LENGTH(X1)=0:X1,1:" "_X1)
+3 IF $PIECE(LRG,U,4)'=""
SET LRCW=7
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 SET X=$SELECT(X1'="":X_X1,1:X)
+8 QUIT
+9 ;
+10 ;
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
+6 ;
+7 ;
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)
if LRCW<1
SET LRCW=15
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 ;S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(CCNT,CCNT,$J(LRLO,(A+B))),^(0)=^(0)_$$S^LR7OS(LRCL,CCNT,"")
+4 SET ^(0)=^TMP("LRC",$JOB,GCNT,0)_$$S^LR7OS(CCNT,CCNT,$$CJ^XLFSTR(LRLO,LRCW))
SET ^(0)=^(0)_$$S^LR7OS(LRCL,CCNT,"")
End DoDot:1
+5 QUIT
+6 ;
+7 ;
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)
if LRCW<1
SET LRCW=15
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 ;S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(CCNT,CCNT,$J(LRHI,(A+B))),^(0)=^(0)_$$S^LR7OS(LRCL,CCNT,"")
+4 SET ^(0)=^TMP("LRC",$JOB,GCNT,0)_$$S^LR7OS(CCNT,CCNT,$$CJ^XLFSTR(LRHI,LRCW))
SET ^(0)=^(0)_$$S^LR7OS(LRCL,CCNT,"")
End DoDot:1
+5 QUIT
+6 ;
+7 ;
TS3 ; Print units
+1 SET LRCW=$PIECE(^LAB(64.5,1,1,LRMH,1,LRSH,1,I(I),0),U,2)
+2 IF LRCW<1
SET LRCW=15
+3 if (GIOM-LRCL)<LRCW
QUIT
+4 SET LRCL=LRCL+LRCW
SET X=^LAB(64.5,"A",1,LRMH,LRSH,I(I))
+5 ;S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(CCNT,CCNT,$J($P(X,U,7),(A+B)))
+6 SET ^(0)=^TMP("LRC",$JOB,GCNT,0)_$$S^LR7OS(CCNT,CCNT,$$CJ^XLFSTR($PIECE(X,U,7),LRCW))
+7 SET ^TMP("LRC",$JOB,GCNT,0)=^TMP("LRC",$JOB,GCNT,0)_$$S^LR7OS(LRCL,CCNT,"")
SET LRFALT=0
+8 QUIT
+9 ;
+10 ;
LN ;
+1 SET GCNT=GCNT+1
SET CCNT=1
+2 QUIT
