- LRNORMAL ;SLC/RWF - TO RETURN TEST NORMALS ;2/6/91 08:54 ;
- ;;5.2;LAB SERVICE;;Sep 27, 1994
- L Q:'$D(LRTST) S U="^",LRLN=0,LRTOP=$S($D(LRTOP):LRTOP,1:LRSERUM)
- F LRLI=1:1 S LRLLT=$P(LRTST,U,LRLI) Q:LRLLT="" D LR1
- Q
- LR1 IF +LRLLT'=LRLLT S LRLLT=$O(^LAB(60,"B",LRLLT,0))
- Q:'$D(^LAB(60,LRLLT,0)) S LRLN=LRLN+1,LRLNM=$P(^(.1),U,1)
- S X=$P(^LAB(60,LRLLT,0),U,5) IF $D(LRLOC) S LRLL(LRLI)=X
- Q:X="" S X=$O(^LAB(60,"C",X,0)) Q:'$D(^LAB(60,X,1,LRTOP,0))
- IF $D(LRUTLITY) S ^TMP($J,LRLI)=LRLNM_"^"_$P(^LAB(60,X,1,LRTOP,0),U,2,99) Q
- S LRLN(LRLI)=LRLNM_"^"_$P(^LAB(60,X,1,LRTOP,0),U,2,99) Q
- LOHI S SEX=$S($D(SEX):SEX,1:"M"),LRLI=0 F S LRLI=$O(LRLN(LRLI)) Q:LRLI<1 S %=$P(LRLN(LRLI),U,2),%=$S($L(%):%,1:""""""),@("%="_%),LRLO(LRLI)=%,@("LRHI("_LRLI_")="_$S($L($P(LRLN(LRLI),U,3)):$P(LRLN(LRLI),U,3),1:""""""))
- Q
- LOC ;from LRGVG1
- F I=1:1:LRLN S X=LRLL(I),LRLL(I)="$S($D(^("_$P(X,";",2)_")):$P(^("_$P(X,";",2)_"),U,"_$P(X,";",3)_"),1:"""")"
- Q
- GET ;from LRGVG1
- D L,LOHI Q
- SERUM S LRTOP=LRSERUM D L,LOHI Q
- BLOOD S LRTOP=LRBLOOD D L,LOHI Q
- URINE S LRTOP=LRURINE D L,LOHI Q
- ;CALL WITH LRTST A LIST OF TEST NUMBERS, LRTOP SPEC TYPE
- ;LRLOC IF WANT DATA LOCATION
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRNORMAL 1180 printed Mar 13, 2025@21:22:42 Page 2
- LRNORMAL ;SLC/RWF - TO RETURN TEST NORMALS ;2/6/91 08:54 ;
- +1 ;;5.2;LAB SERVICE;;Sep 27, 1994
- L if '$DATA(LRTST)
- QUIT
- SET U="^"
- SET LRLN=0
- SET LRTOP=$SELECT($DATA(LRTOP):LRTOP,1:LRSERUM)
- +1 FOR LRLI=1:1
- SET LRLLT=$PIECE(LRTST,U,LRLI)
- if LRLLT=""
- QUIT
- DO LR1
- +2 QUIT
- LR1 IF +LRLLT'=LRLLT
- SET LRLLT=$ORDER(^LAB(60,"B",LRLLT,0))
- +1 if '$DATA(^LAB(60,LRLLT,0))
- QUIT
- SET LRLN=LRLN+1
- SET LRLNM=$PIECE(^(.1),U,1)
- +2 SET X=$PIECE(^LAB(60,LRLLT,0),U,5)
- IF $DATA(LRLOC)
- SET LRLL(LRLI)=X
- +3 if X=""
- QUIT
- SET X=$ORDER(^LAB(60,"C",X,0))
- if '$DATA(^LAB(60,X,1,LRTOP,0))
- QUIT
- +4 IF $DATA(LRUTLITY)
- SET ^TMP($JOB,LRLI)=LRLNM_"^"_$PIECE(^LAB(60,X,1,LRTOP,0),U,2,99)
- QUIT
- +5 SET LRLN(LRLI)=LRLNM_"^"_$PIECE(^LAB(60,X,1,LRTOP,0),U,2,99)
- QUIT
- LOHI SET SEX=$SELECT($DATA(SEX):SEX,1:"M")
- SET LRLI=0
- FOR
- SET LRLI=$ORDER(LRLN(LRLI))
- if LRLI<1
- QUIT
- SET %=$PIECE(LRLN(LRLI),U,2)
- SET %=$SELECT($LENGTH(%):%,1:"""""")
- SET @("%="_%)
- SET LRLO(LRLI)=%
- SET @("LRHI("_LRLI_")="_$SELECT($LENGTH($PIECE(LRLN(LRLI),U,3)):$PIECE(LRLN(LRLI),U,3),1:""""""))
- +1 QUIT
- LOC ;from LRGVG1
- +1 FOR I=1:1:LRLN
- SET X=LRLL(I)
- SET LRLL(I)="$S($D(^("_$PIECE(X,";",2)_")):$P(^("_$PIECE(X,";",2)_"),U,"_$PIECE(X,";",3)_"),1:"""")"
- +2 QUIT
- GET ;from LRGVG1
- +1 DO L
- DO LOHI
- QUIT
- SERUM SET LRTOP=LRSERUM
- DO L
- DO LOHI
- QUIT
- BLOOD SET LRTOP=LRBLOOD
- DO L
- DO LOHI
- QUIT
- URINE SET LRTOP=LRURINE
- DO L
- DO LOHI
- QUIT
- +1 ;CALL WITH LRTST A LIST OF TEST NUMBERS, LRTOP SPEC TYPE
- +2 ;LRLOC IF WANT DATA LOCATION
