LRULB1 ;AVAMC/REG - LAB LOG-BOOK CONT. ;3/3/94 14:28 ;
;;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
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)
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 !,LR("%") Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRULB1 1709 printed Dec 13, 2024@02:21:37 Page 2
LRULB1 ;AVAMC/REG - LAB LOG-BOOK CONT. ;3/3/94 14:28 ;
+1 ;;5.2;LAB SERVICE;;Sep 27, 1994
+2 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
+3 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 if A<1
WRITE !?8,SSN,?27,LRLLOC
if $LENGTH(LRC(5))
WRITE !,LRC(5)
WRITE !!,LR("%")
QUIT
LIST SET X=$SELECT($DATA(^LAB(60,X,0)):$PIECE(^(0),"^"),1:"??")
if A=0
WRITE !?7,SSN,?27,LRLLOC
if A>0
WRITE !
WRITE ?50,$EXTRACT(X,1,30)
+1 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 WRITE !,"#= 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 WRITE !,LR("%")
QUIT
