LACRIT.m

LACRIT ; IHS/DIR/FJE - PRINT OUT CRITICAL VALUES AT DATA GATHER TIME 7/20/90 07:56 ;

 ;;5.2;LA;;NOV 01, 1997

 ;;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

LACRIT    ; IHS/DIR/FJE - PRINT OUT CRITICAL VALUES AT DATA GATHER TIME 7/20/90 07:56 ;

 +1       ;;5.2;LA;;NOV 01, 1997

 +2       ;;5.2;AUTOMATED LAB INSTRUMENTS;;Sep 27, 1994

 +3        SET Y=$SELECT(DPF=62.3:"Q"_LRDFN,1:"P")

 +4        FOR I=1:1:TC

               IF '$DATA(^TMP($JOB,I))

                   QUIT 

               SET X=^(I)

               DO CK

 +5        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