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 Oct 16, 2024@17:42:54 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
