- LACRIT ;SLC/RWF - PRINT OUT CRITICAL VALUES AT DATA GATHER TIME ;7/20/90 07:56 ;
- ;;5.2;AUTOMATED LAB INSTRUMENTS;;Sep 27, 1994
- S Y=$S(DPF=62.3:"Q"_LRDFN,1:"P")
- F I=1:1:TC Q:'$D(^TMP($J,I)) S X=^(I) D CK
- Q
- CK S V=@TC(I,1) IF V]"",$L($P(X,U,4,5))>1,(V<$P(X,U,4))!(V>$P(X,U,5)) D TELL
- IF V]"" S X=$S($D(^TMP($J,Y,I)):^(I),1:""),^(I)=(X+V)_U_($P(X,U,2)+1)
- Q
- TELL O IO::1 Q:'$T U IO
- W !,$C(7),"*********************************************************"
- W !,$C(7)," CRITICAL VALUE ",V," ON TEST ",$P(X,U,1)," FOR ID: ",ID," (",ID,")"
- W !,$C(7),"*********************************************************"
- C IO Q
- SET Q
- Q
- MEAN O IO::1 Q:'$T U IO
- S J="P" W !!!," AVERAGE PATIENT VALUES" D WR
- S J="Q" F LX=0:0 S J=$O(^TMP($J,J)) Q:J']"Q" W !!!," AVERAGE ",$S($D(^LAB(62.3,+$P(J,"Q",2),0)):^(0),1:"UNKNOWN")," VALUES" D WR
- Q
- WR W !,"TEST",?20,"# VALUES",?30,"AVERAGE"
- F I=1:1:TC W !,$P(^TMP($J,I),U,1),?20 IF $D(^TMP($J,J,I)) S X=^(I),Y=$P(X,U,2) IF Y W Y,?30,$J(X/Y,7,2)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLACRIT 1007 printed Mar 13, 2025@20:46:43 Page 2
- LACRIT ;SLC/RWF - PRINT OUT CRITICAL VALUES AT DATA GATHER TIME ;7/20/90 07:56 ;
- +1 ;;5.2;AUTOMATED LAB INSTRUMENTS;;Sep 27, 1994
- +2 SET Y=$SELECT(DPF=62.3:"Q"_LRDFN,1:"P")
- +3 FOR I=1:1:TC
- if '$DATA(^TMP($JOB,I))
- QUIT
- SET X=^(I)
- DO CK
- +4 QUIT
- CK SET V=@TC(I,1)
- IF V]""
- IF $LENGTH($PIECE(X,U,4,5))>1
- IF (V<$PIECE(X,U,4))!(V>$PIECE(X,U,5))
- DO TELL
- +1 IF V]""
- SET X=$SELECT($DATA(^TMP($JOB,Y,I)):^(I),1:"")
- SET ^(I)=(X+V)_U_($PIECE(X,U,2)+1)
- +2 QUIT
- TELL OPEN IO::1
- if '$TEST
- QUIT
- USE IO
- +1 WRITE !,$CHAR(7),"*********************************************************"
- +2 WRITE !,$CHAR(7)," CRITICAL VALUE ",V," ON TEST ",$PIECE(X,U,1)," FOR ID: ",ID," (",ID,")"
- +3 WRITE !,$CHAR(7),"*********************************************************"
- +4 CLOSE IO
- QUIT
- SET QUIT
- +1 QUIT
- MEAN OPEN IO::1
- if '$TEST
- QUIT
- USE IO
- +1 SET J="P"
- WRITE !!!," AVERAGE PATIENT VALUES"
- DO WR
- +2 SET J="Q"
- FOR LX=0:0
- SET J=$ORDER(^TMP($JOB,J))
- if J']"Q"
- QUIT
- WRITE !!!," AVERAGE ",$SELECT($DATA(^LAB(62.3,+$PIECE(J,"Q",2),0)):^(0),1:"UNKNOWN")," VALUES"
- DO WR
- +3 QUIT
- WR WRITE !,"TEST",?20,"# VALUES",?30,"AVERAGE"
- +1 FOR I=1:1:TC
- WRITE !,$PIECE(^TMP($JOB,I),U,1),?20
- IF $DATA(^TMP($JOB,J,I))
- SET X=^(I)
- SET Y=$PIECE(X,U,2)
- IF Y
- WRITE Y,?30,$JUSTIFY(X/Y,7,2)
- +2 QUIT
