- 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
