- LRULB1 ; IHS/DIR/FJE - LAB LOG-BOOK CONT. 3/3/94 14:28 ;
- ;;5.2;LR;**1013**;JUL 15, 2002
- ;
- ;;5.2;LAB SERVICE;;Sep 27, 1994
- S LRAN=N(1)-1 D H S LR("F")=1 F B=0:0 S LRAN=$O(^LRO(68,LRAA,1,LRAD,1,LRAN)) Q:'LRAN!(LRAN>N(2))!(LR("Q")) D PRT
- W:IOST'?1"C".E @IOF D END^LRUTL,V^LRU Q
- T S X=X_"0000",Y=$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3) I $P(X,".",2) S Y=Y_" "_$E($P(X,".",2),1,2)_":"_$E($P(X,".",2),3,4)
- Q
- PRT Q:'$D(^LRO(68,LRAA,1,LRAD,1,LRAN,0)) I +^(0) S X=^(0),LRDFN=+X,LRLLOC=$E($P(X,"^",7),1,18),N(3)=^(3),LRC(5)=$P(N(3),"^",6)
- Q:'$D(^LR(LRDFN,0)) S LRI=$P(N(3),"^",5),X=^(0) D ^LRUP
- S X=$S($D(^LRO(68,LRAA,1,LRAD,1,LRAN,5,1,0)):^(0),1:""),O(1)=$S(+X:+X,1:""),C(1)=$P(X,"^",2) S X=$P(N(3),"^") D T S H(1)=Y,X=$P(N(3),"^",3) D T S H(2)=Y
- S O(1)=$S(O(1):$E($P(^LAB(61,O(1),0),"^"),1,14),1:C(1))
- D:$Y>(IOSL-8) H Q:LR("Q") W !,$J(LRAN,5) W:P("F")'=2 ?7,"#" W ?7,$E(LRP,1,15),?24,$E(O(1),1,14),?48,H(2),?65,H(1)
- I LRSS="SP" D ORG Q
- W S A=0 I $D(^LRO(68,LRAA,1,LRAD,1,LRAN,4,0))#2 S Z=0 F A=0:1 S Z=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,Z)) Q:'Z!(LR("Q")) S X=+^(Z,0) D LIST
- ;W:A<1 !?8,SSN,?27,LRLLOC W:$L(LRC(5)) !,LRC(5) W !!,LR("%") Q
- W:A<1 !?8,HRCN,?27,LRLLOC W:$L(LRC(5)) !,LRC(5) W !!,LR("%") Q ;IHS/ANMC/CLS 08/18/96
- LIST ;S X=$S($D(^LAB(60,X,0)):$P(^(0),"^"),1:"??") W:A=0 !?7,SSN,?27,LRLLOC W:A>0 ! W ?50,$E(X,1,30)
- S X=$S($D(^LAB(60,X,0)):$P(^(0),"^"),1:"??") W:A=0 !?7,HRCN,?27,LRLLOC W:A>0 ! W ?50,$E(X,1,30) ;IHS/ANMC/CLS 08/18/96
- Q
- ORG S O=0 F Q=0:1 S O=$O(^LR(LRDFN,LRSS,LRI,2,O)) Q:'O!(LR("Q")) S O(1)=+^(O,0) D LST
- Q
- LST W:Q>0 ! W ?46,$S($D(^LAB(61,O(1),0)):$E($P(^LAB(61,O(1),0),"^"),1,14),1:"") Q
- H I $D(LR("F")),IOST?1"C".E D M^LRU Q:LR("Q")
- D F^LRU W !,"LABORATORY SERVICE",?22,LRAA(1)," Log-Book for ",LRH(0)
- ;W !,"#= Not PATIENT file",?48,"|-------Date/time----|",!,"Acc no",?14,"Name",?24,"Spec/Sample",?39,"Results",?48,"Received",?65,"Taken",!?14,"SSN",?24,"Location",?58,"Tests"
- W !,"#= Not PATIENT file",?48,"|-------Date/time----|",!,"Acc no",?14,"Name",?24,"Spec/Sample",?39,"Results",?48,"Received",?65,"Taken",!?14,"HRCN",?24,"Location",?58,"Tests" ;IHS/ANMC/CLS 08/18/96
- W !,LR("%") Q
- LRULB1 ; IHS/DIR/FJE - LAB LOG-BOOK CONT. 3/3/94 14:28 ;
- +1 ;;5.2;LR;**1013**;JUL 15, 2002
- +2 ;
- +3 ;;5.2;LAB SERVICE;;Sep 27, 1994
- +4 SET LRAN=N(1)-1
- DO H
- SET LR("F")=1
- FOR B=0:0
- SET LRAN=$ORDER(^LRO(68,LRAA,1,LRAD,1,LRAN))
- IF 'LRAN!(LRAN>N(2))!(LR("Q"))
- QUIT
- DO PRT
- +5 IF IOST'?1"C".E
- WRITE @IOF
- DO END^LRUTL
- DO V^LRU
- QUIT
- T SET X=X_"0000"
- SET Y=$EXTRACT(X,4,5)_"/"_$EXTRACT(X,6,7)_"/"_$EXTRACT(X,2,3)
- IF $PIECE(X,".",2)
- SET Y=Y_" "_$EXTRACT($PIECE(X,".",2),1,2)_":"_$EXTRACT($PIECE(X,".",2),3,4)
- +1 QUIT
- PRT IF '$DATA(^LRO(68,LRAA,1,LRAD,1,LRAN,0))
- QUIT
- IF +^(0)
- SET X=^(0)
- SET LRDFN=+X
- SET LRLLOC=$EXTRACT($PIECE(X,"^",7),1,18)
- SET N(3)=^(3)
- SET LRC(5)=$PIECE(N(3),"^",6)
- +1 IF '$DATA(^LR(LRDFN,0))
- QUIT
- SET LRI=$PIECE(N(3),"^",5)
- SET X=^(0)
- DO ^LRUP
- +2 SET X=$SELECT($DATA(^LRO(68,LRAA,1,LRAD,1,LRAN,5,1,0)):^(0),1:"")
- SET O(1)=$SELECT(+X:+X,1:"")
- SET C(1)=$PIECE(X,"^",2)
- SET X=$PIECE(N(3),"^")
- DO T
- SET H(1)=Y
- SET X=$PIECE(N(3),"^",3)
- DO T
- SET H(2)=Y
- +3 SET O(1)=$SELECT(O(1):$EXTRACT($PIECE(^LAB(61,O(1),0),"^"),1,14),1:C(1))
- +4 IF $Y>(IOSL-8)
- DO H
- IF LR("Q")
- QUIT
- WRITE !,$JUSTIFY(LRAN,5)
- IF P("F")'=2
- WRITE ?7,"#"
- WRITE ?7,$EXTRACT(LRP,1,15),?24,$EXTRACT(O(1),1,14),?48,H(2),?65,H(1)
- +5 IF LRSS="SP"
- DO ORG
- QUIT
- W SET A=0
- IF $DATA(^LRO(68,LRAA,1,LRAD,1,LRAN,4,0))#2
- SET Z=0
- FOR A=0:1
- SET Z=$ORDER(^LRO(68,LRAA,1,LRAD,1,LRAN,4,Z))
- IF 'Z!(LR("Q"))
- QUIT
- SET X=+^(Z,0)
- DO LIST
- +1 ;W:A<1 !?8,SSN,?27,LRLLOC W:$L(LRC(5)) !,LRC(5) W !!,LR("%") Q
- +2 ;IHS/ANMC/CLS 08/18/96
- IF A<1
- WRITE !?8,HRCN,?27,LRLLOC
- IF $LENGTH(LRC(5))
- WRITE !,LRC(5)
- WRITE !!,LR("%")
- QUIT
- LIST ;S X=$S($D(^LAB(60,X,0)):$P(^(0),"^"),1:"??") W:A=0 !?7,SSN,?27,LRLLOC W:A>0 ! W ?50,$E(X,1,30)
- +1 ;IHS/ANMC/CLS 08/18/96
- SET X=$SELECT($DATA(^LAB(60,X,0)):$PIECE(^(0),"^"),1:"??")
- IF A=0
- WRITE !?7,HRCN,?27,LRLLOC
- IF A>0
- WRITE !
- WRITE ?50,$EXTRACT(X,1,30)
- +2 QUIT
- ORG SET O=0
- FOR Q=0:1
- SET O=$ORDER(^LR(LRDFN,LRSS,LRI,2,O))
- IF 'O!(LR("Q"))
- QUIT
- SET O(1)=+^(O,0)
- DO LST
- +1 QUIT
- LST IF Q>0
- WRITE !
- WRITE ?46,$SELECT($DATA(^LAB(61,O(1),0)):$EXTRACT($PIECE(^LAB(61,O(1),0),"^"),1,14),1:"")
- QUIT
- H IF $DATA(LR("F"))
- IF IOST?1"C".E
- DO M^LRU
- IF LR("Q")
- QUIT
- +1 DO F^LRU
- WRITE !,"LABORATORY SERVICE",?22,LRAA(1)," Log-Book for ",LRH(0)
- +2 ;W !,"#= Not PATIENT file",?48,"|-------Date/time----|",!,"Acc no",?14,"Name",?24,"Spec/Sample",?39,"Results",?48,"Received",?65,"Taken",!?14,"SSN",?24,"Location",?58,"Tests"
- +3 ;IHS/ANMC/CLS 08/18/96
- WRITE !,"#= Not PATIENT file",?48,"|-------Date/time----|",!,"Acc no",?14,"Name",?24,"Spec/Sample",?39,"Results",?48,"Received",?65,"Taken",!?14,"HRCN",?24,"Location",?58,"Tests"
- +4 WRITE !,LR("%")
- QUIT
