- LRUTA ; IHS/DIR/FJE - DISPLAY LAB TEST INFO FOR LAB 2/14/89 17:18 ;
- ;;5.2;LR;**1013**;JUL 15, 2002
- ;
- ;;5.2;LAB SERVICE;;Sep 27, 1994
- N N,LRCSREC
- S IOP="HOME" D ^%ZIS W @IOF
- ASK S DIC="^LAB(60,",DIC(0)="AEMOQZ",DIC("S")="I $E($P(^(0),U,3),1)'[""N""" D ^DIC K DIC Q:X=""!(X[U) S LRIFN=+Y
- HDR W @IOF,"Lab test",?32,"Stat ok ?",?44,"Cost",?58,"Lab Test Synonym",!
- W $E($P(Y(0),U),1,30),?35,$S($P(Y(0),U,16)=1:"YES",1:"NO"),?42,$P(Y(0),U,11),?51,$E($P(Y(0),U,2),1,30)
- I $D(^LAB(60,LRIFN,2)) D PANEL R !!,"< Press ANY key to continue >",X:DTIME
- I $D(^LAB(60,LRIFN,1,0)),$P(^LAB(60,LRIFN,1,0),U,4)>0 D NORM
- I $D(^LAB(60,LRIFN,3,0)),$P(^LAB(60,LRIFN,3,0),U,4)>0 D LIST
- W !! G ASK
- LIST S N=0
- F A=1:1 S N=$O(^LAB(60,LRIFN,3,N)) Q:'N D
- . ;W:A=1 !!,"Collection Sample",?21,"VA Lab Slip",?37,"Container"
- . W:A=1 !!,"Collection Sample",?21,"Lab Slip",?37,"Container" ;IHS/ANMC/CLS 08/18/96
- . W ?68,"Vol Req(ml)"
- . S LRND=^LAB(60,LRIFN,3,N,0)
- . D SHOW
- Q
- SHOW S LRCSREC=$G(^LAB(62,+LRND,0))
- W !,$S($L($P(LRCSREC,U)):$E($P(LRCSREC,U),1,20),1:"??")
- W ?21,$E($P(LRND,U,2),1,15),?37,$E($P(LRCSREC,U,3),1,30)
- W ?68,$E($P(LRND,U,4),1,12)
- WRD S M=0 F B=1:1 S M=$O(^LAB(60,LRIFN,3,N,1,M)) Q:'M W:B=1 !!,"Ward Instructions:" W !,^LAB(60,LRIFN,3,N,1,M,0)
- LAB S M=0 F C=1:1 S M=$O(^LAB(60,LRIFN,3,N,2,M)) Q:'M W:C=1 !!,"Lab Processing Instructions:" W !,^LAB(60,LRIFN,3,N,2,M,0)
- Q
- NORM S N=0 F A=1:1 S N=$O(^LAB(60,LRIFN,1,N)) Q:'N W:A=1 !!,"Reference Values",?22,"Ref Low",?30,"Ref High",?41,"Critical Low",?54,"Critical High",!,?22,"<---",?37,$P(^LAB(60,LRIFN,1,N,0),U,7),?63,"--->",! D LST
- Q
- LST W !,$E($P(^LAB(61,N,0),U),1,19),?25,$P(^LAB(60,LRIFN,1,N,0),U,2),?32,$P(^(0),U,3),?48,$P(^(0),U,4),?60,$P(^(0),U,5)
- F X=0:0 S X=$O(^LAB(60,LRIFN,1,N,1,X)) Q:'X W !,^(X,0)
- Q
- PANEL W !,"Tests in panel:" S X=0 F A=1:1 S X=$O(^LAB(60,LRIFN,2,X)) Q:'X S Y=+^(X,0) W:A#2 ! W:A#2=0 ?40 W $P(^LAB(60,Y,0),U,1)
- Q
- LRUTA ; IHS/DIR/FJE - DISPLAY LAB TEST INFO FOR LAB 2/14/89 17:18 ;
- +1 ;;5.2;LR;**1013**;JUL 15, 2002
- +2 ;
- +3 ;;5.2;LAB SERVICE;;Sep 27, 1994
- +4 NEW N,LRCSREC
- +5 SET IOP="HOME"
- DO ^%ZIS
- WRITE @IOF
- ASK SET DIC="^LAB(60,"
- SET DIC(0)="AEMOQZ"
- SET DIC("S")="I $E($P(^(0),U,3),1)'[""N"""
- DO ^DIC
- KILL DIC
- IF X=""!(X[U)
- QUIT
- SET LRIFN=+Y
- HDR WRITE @IOF,"Lab test",?32,"Stat ok ?",?44,"Cost",?58,"Lab Test Synonym",!
- +1 WRITE $EXTRACT($PIECE(Y(0),U),1,30),?35,$SELECT($PIECE(Y(0),U,16)=1:"YES",1:"NO"),?42,$PIECE(Y(0),U,11),?51,$EXTRACT($PIECE(Y(0),U,2),1,30)
- +2 IF $DATA(^LAB(60,LRIFN,2))
- DO PANEL
- READ !!,"< Press ANY key to continue >",X:DTIME
- +3 IF $DATA(^LAB(60,LRIFN,1,0))
- IF $PIECE(^LAB(60,LRIFN,1,0),U,4)>0
- DO NORM
- +4 IF $DATA(^LAB(60,LRIFN,3,0))
- IF $PIECE(^LAB(60,LRIFN,3,0),U,4)>0
- DO LIST
- +5 WRITE !!
- GOTO ASK
- LIST SET N=0
- +1 FOR A=1:1
- SET N=$ORDER(^LAB(60,LRIFN,3,N))
- IF 'N
- QUIT
- Begin DoDot:1
- +2 ;W:A=1 !!,"Collection Sample",?21,"VA Lab Slip",?37,"Container"
- +3 ;IHS/ANMC/CLS 08/18/96
- IF A=1
- WRITE !!,"Collection Sample",?21,"Lab Slip",?37,"Container"
- +4 WRITE ?68,"Vol Req(ml)"
- +5 SET LRND=^LAB(60,LRIFN,3,N,0)
- +6 DO SHOW
- End DoDot:1
- +7 QUIT
- SHOW SET LRCSREC=$GET(^LAB(62,+LRND,0))
- +1 WRITE !,$SELECT($LENGTH($PIECE(LRCSREC,U)):$EXTRACT($PIECE(LRCSREC,U),1,20),1:"??")
- +2 WRITE ?21,$EXTRACT($PIECE(LRND,U,2),1,15),?37,$EXTRACT($PIECE(LRCSREC,U,3),1,30)
- +3 WRITE ?68,$EXTRACT($PIECE(LRND,U,4),1,12)
- WRD SET M=0
- FOR B=1:1
- SET M=$ORDER(^LAB(60,LRIFN,3,N,1,M))
- IF 'M
- QUIT
- IF B=1
- WRITE !!,"Ward Instructions:"
- WRITE !,^LAB(60,LRIFN,3,N,1,M,0)
- LAB SET M=0
- FOR C=1:1
- SET M=$ORDER(^LAB(60,LRIFN,3,N,2,M))
- IF 'M
- QUIT
- IF C=1
- WRITE !!,"Lab Processing Instructions:"
- WRITE !,^LAB(60,LRIFN,3,N,2,M,0)
- +1 QUIT
- NORM SET N=0
- FOR A=1:1
- SET N=$ORDER(^LAB(60,LRIFN,1,N))
- IF 'N
- QUIT
- IF A=1
- WRITE !!,"Reference Values",?22,"Ref Low",?30,"Ref High",?41,"Critical Low",?54,"Critical High",!,?22,"<---",?37,$PIECE(^LAB(60,LRIFN,1,N,0),U,7),?63,"--->",!
- DO LST
- +1 QUIT
- LST WRITE !,$EXTRACT($PIECE(^LAB(61,N,0),U),1,19),?25,$PIECE(^LAB(60,LRIFN,1,N,0),U,2),?32,$PIECE(^(0),U,3),?48,$PIECE(^(0),U,4),?60,$PIECE(^(0),U,5)
- +1 FOR X=0:0
- SET X=$ORDER(^LAB(60,LRIFN,1,N,1,X))
- IF 'X
- QUIT
- WRITE !,^(X,0)
- +2 QUIT
- PANEL WRITE !,"Tests in panel:"
- SET X=0
- FOR A=1:1
- SET X=$ORDER(^LAB(60,LRIFN,2,X))
- IF 'X
- QUIT
- SET Y=+^(X,0)
- IF A#2
- WRITE !
- IF A#2=0
- WRITE ?40
- WRITE $PIECE(^LAB(60,Y,0),U,1)
- +1 QUIT