- 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 Feb 18, 2025@23:31:39 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
