| 1 | TIULAB ; SLC/JER - Lab objects ;7/7/95  15:22
 | 
|---|
| 2 |  ;;1.0;TEXT INTEGRATION UTILITIES;;Jun 20, 1997
 | 
|---|
| 3 | MAIN(DFN,EARLY,LATE,DISPLAY,NORM,TARGET,LINE) ; Control branching
 | 
|---|
| 4 |  N GMTS1,GMTS2,GMTSAGE,GMTSDOB,GMTSPNM,GMTSRB,GMTSSN,GMTSWARD,SEX
 | 
|---|
| 5 |  N LRDFN,MAX,I,J,SMPL,TIUY,VADPT,VAIN
 | 
|---|
| 6 |  K ^TMP("LRC",$J)
 | 
|---|
| 7 |  I $G(NORM)']"" S NORM="ALL"
 | 
|---|
| 8 |  I '$D(^DPT(DFN,"LR")) D NOLABS G LABX
 | 
|---|
| 9 |  S LRDFN=+^DPT(DFN,"LR") I '$D(^LR(LRDFN)) D NOLABS G LABX
 | 
|---|
| 10 |  S MAX=999,GMTS1=9999999-LATE,GMTS2=9999999-EARLY
 | 
|---|
| 11 |  I +$G(DISPLAY) W !,"Gathering Laboratory Data."
 | 
|---|
| 12 |  D ^GMTSLRCE
 | 
|---|
| 13 |  I '$D(^TMP("LRC",$J)) D NOLABS G LABX
 | 
|---|
| 14 |  D SORT($G(NORM))
 | 
|---|
| 15 |  S (TIUY,SMPL)="" F  S SMPL=$O(^TMP("LRC",$J,NORM,SMPL)) Q:SMPL=""  D
 | 
|---|
| 16 |  . S I=GMTS1 F  S I=$O(^TMP("LRC",$J,NORM,SMPL,I)) Q:+I'>0!(I>GMTS2)  D
 | 
|---|
| 17 |  . . S J=0 F  S J=$O(^TMP("LRC",$J,NORM,SMPL,I,J)) Q:+J'>0  D LINE
 | 
|---|
| 18 |  K ^TMP("LRC",$J)
 | 
|---|
| 19 | LABX Q "~@"_$NA(@TARGET)
 | 
|---|
| 20 | NOLABS ; Handles Case Where no Labs are found to satisfy criteria
 | 
|---|
| 21 |  S LINE=$S(+$G(LINE):+$G(LINE),1:1),@TARGET@(LINE,0)="No data available"
 | 
|---|
| 22 |  S LINE=+$G(LINE)+1,@TARGET@(LINE,0)=" "
 | 
|---|
| 23 |  S @TARGET@(0)="^^"_LINE_"^"_LINE_"^"_DT_"^^"
 | 
|---|
| 24 |  Q
 | 
|---|
| 25 | SORT(NFLAG) ; Sort ^TMP("LRC",$J, by reference flag
 | 
|---|
| 26 |  N I,J,K,L I $G(NFLAG)']"" S NFLAG="ALL"
 | 
|---|
| 27 |  S I=GMTS1 F  S I=$O(^TMP("LRC",$J,I)) Q:+I'>0!(I>GMTS2)  D
 | 
|---|
| 28 |  . S J=0 F  S J=$O(^TMP("LRC",$J,I,J)) Q:+J'>0  D
 | 
|---|
| 29 |  . . I NFLAG="ALL" S K="ALL"
 | 
|---|
| 30 |  . . E  I $P(^TMP("LRC",$J,I,J),U,5)']"" S K="NORM"
 | 
|---|
| 31 |  . . E  S K="ABNORM"
 | 
|---|
| 32 |  . . S L=$P(^TMP("LRC",$J,I,J),U,2)
 | 
|---|
| 33 |  . . I NFLAG="ALL"!(K=NFLAG) S ^TMP("LRC",$J,K,L,I,J)=^TMP("LRC",$J,I,J)
 | 
|---|
| 34 |  . . K ^TMP("LRC",$J,I,J)
 | 
|---|
| 35 |  Q
 | 
|---|
| 36 | LINE ; Line-wrap with comma-dimited data
 | 
|---|
| 37 |  N X,Y,TIUX
 | 
|---|
| 38 |  S TIUX=$P($G(^TMP("LRC",$J,NORM,SMPL,I,J)),U,3,4)
 | 
|---|
| 39 |  I $S($$HASNUM^TIULS($P(TIUX,U)):0,$L($P(TIUX,U))>5:1,$L($P(TIUX,U)," ")>1:1,1:0) D
 | 
|---|
| 40 |  . S $P(TIUX,U)=$$MIXED^TIULS($P(TIUX,U))
 | 
|---|
| 41 |  S $P(TIUX,U,2)=$TR($P(TIUX,U,2)," ",""),TIUX=$TR(TIUX,U," ")
 | 
|---|
| 42 |  S TIUY=$$FILL^TIULS(TIUX,TIUY,79)
 | 
|---|
| 43 |  I TIUY=TIUX S LINE=+$G(LINE)+1
 | 
|---|
| 44 |  S @TARGET@(LINE,0)=TIUY
 | 
|---|
| 45 |  S @TARGET@(0)="^^"_LINE_"^"_LINE_"^"_DT_"^^"
 | 
|---|
| 46 |  I +$G(DISPLAY) W "."
 | 
|---|
| 47 |  Q
 | 
|---|