LRAPBK1 ; IHS/DIR/FJE - AP LOG BOOK 12:55 ; [ 1/12/94 ]
;;5.2;LR;;NOV 01, 1997
;
;;5.2;LAB SERVICE;;Sep 27, 1994
F Z=0:0 S Z=$O(^LR(LRDFN,LRSS,LRI,2,Z)) Q:'Z S LRT=+^(Z,0) D:$Y>(IOSL-6) H1^LRAPBK Q:LR("Q") S X=$S($D(^LAB(61,LRT,0)):^(0),1:"?") W !?14,"T-",$P(X,"^",2)," ",$P(X,"^") D M
Q
M F LRM=0:0 S LRM=$O(^LR(LRDFN,LRSS,LRI,2,Z,2,LRM)) Q:'LRM!(LR("Q")) S X=+^(LRM,0),LRM(1)=$S($D(^LAB(61.1,X,0)):^(0),1:"?") D:$Y>(IOSL-6) H1^LRAPBK W !?17,"M-",$P(LRM(1),"^",2)," ",$P(LRM(1),"^") D:$D(LRB(1)) E
Q:'$D(LRB(1)) F J=0:0 S J=$O(^LR(LRDFN,LRSS,LRI,2,Z,4,J)) Q:'J!(LR("Q")) S LRX=^(J,0),LRX(1)=$P(LRX,"^",2) D:$Y>(IOSL-6) H1^LRAPBK S X=$S($D(^LAB(61.5,+LRX,0)):^(0),1:"?") W !?17,"P-",$P(X,"^",2)," ",$P(X,"^") D:LRX(1)]"" W
F LRM=0:0 S LRM=$O(^LR(LRDFN,LRSS,LRI,2,Z,1,LRM)) Q:'LRM!(LR("Q")) S X=+^(LRM,0),LRM(1)=$S($D(^LAB(61.4,X,0)):^(0),1:"?") D:$Y>(IOSL-6) H1^LRAPBK W !?17,"D-",$P(LRM(1),"^",2)," ",$P(LRM(1),"^")
F LRM=0:0 S LRM=$O(^LR(LRDFN,LRSS,LRI,2,Z,3,LRM)) Q:'LRM!(LR("Q")) S X=+^(LRM,0),LRM(1)=$S($D(^LAB(61.3,X,0)):^(0),1:"?") D:$Y>(IOSL-6) H1^LRAPBK W !?17,"F-",$P(LRM(1),"^",2)," ",$P(LRM(1),"^")
Q
W W " (",$S(LRX(1)=1:"Positive",LRX(1)=0:"Negative",1:"?"),")" Q
E F LRE=0:0 S LRE=$O(^LR(LRDFN,LRSS,LRI,2,Z,2,LRM,1,LRE)) Q:'LRE S X=+^(LRE,0),LRE(1)=$S($D(^LAB(61.2,X,0)):^(0),1:"?") W !?20,"E-",$P(LRE(1),"^",2)," ",$P(LRE(1),"^")
Q
AU F Z=0:0 S Z=$O(^LR(LRDFN,"AY",Z)) Q:'Z S LRT=+^(Z,0) D:$Y>(IOSL-6) H1^LRAPBK Q:LR("Q") S X=$S($D(^LAB(61,LRT,0)):^(0),1:"?") W !?14,"T-",$P(X,"^",2)," ",$P(X,"^") D MA
Q
MA F LRM=0:0 S LRM=$O(^LR(LRDFN,"AY",Z,2,LRM)) Q:'LRM!(LR("Q")) S X=+^(LRM,0),LRM(1)=$S($D(^LAB(61.1,X,0)):^(0),1:"?") D:$Y>(IOSL-6) H1^LRAPBK W !?17,"M-",$P(LRM(1),"^",2)," ",$P(LRM(1),"^") D:$D(LRB(1)) EA
Q:'$D(LRB(1)) F J=0:0 S J=$O(^LR(LRDFN,"AY",Z,4,J)) Q:'J!(LR("Q")) S LRX=^(J,0),LRX(1)=$P(LRX,"^") D:$Y>(IOSL-6) H1^LRAPBK S X=$S($D(^LAB(61.5,+LRX,0)):^(0),1:"?") W !?17,"P-",$P(X,"^",2)," ",$P(X,"^") D:LRX(1)]"" W
F LRM=0:0 S LRM=$O(^LR(LRDFN,"AY",Z,1,LRM)) Q:'LRM!(LR("Q")) S X=+^(LRM,0),LRM(1)=$S($D(^LAB(61.4,X,0)):^(0),1:"?") D:$Y>(IOSL-6) H1^LRAPBK W !?17,"D-",$P(LRM(1),"^",2)," ",$P(LRM(1),"^")
F LRM=0:0 S LRM=$O(^LR(LRDFN,"AY",Z,3,LRM)) Q:'LRM!(LR("Q")) S X=+^(LRM,0),LRM(1)=$S($D(^LAB(61.3,X,0)):^(0),1:"?") D:$Y>(IOSL-6) H1^LRAPBK W !?17,"F-",$P(LRM(1),"^",2)," ",$P(LRM(1),"^")
Q
EA F LRE=0:0 S LRE=$O(^LR(LRDFN,"AY",Z,2,LRM,1,LRE)) Q:'LRE S X=+^(LRE,0),LRE(1)=$S($D(^LAB(61.2,X,0)):^(0),1:"?") W !?20,"E-",$P(LRE(1),"^",2)," ",$P(LRE(1),"^")
Q
LRAPBK1 ; IHS/DIR/FJE - AP LOG BOOK 12:55 ; [ 1/12/94 ]
+1 ;;5.2;LR;;NOV 01, 1997
+2 ;
+3 ;;5.2;LAB SERVICE;;Sep 27, 1994
+4 FOR Z=0:0
SET Z=$ORDER(^LR(LRDFN,LRSS,LRI,2,Z))
IF 'Z
QUIT
SET LRT=+^(Z,0)
IF $Y>(IOSL-6)
DO H1^LRAPBK
IF LR("Q")
QUIT
SET X=$SELECT($DATA(^LAB(61,LRT,0)):^(0),1:"?")
WRITE !?14,"T-",$PIECE(X,"^",2)," ",$PIECE(X,"^")
DO M
+5 QUIT
M FOR LRM=0:0
SET LRM=$ORDER(^LR(LRDFN,LRSS,LRI,2,Z,2,LRM))
IF 'LRM!(LR("Q"))
QUIT
SET X=+^(LRM,0)
SET LRM(1)=$SELECT($DATA(^LAB(61.1,X,0)):^(0),1:"?")
IF $Y>(IOSL-6)
DO H1^LRAPBK
WRITE !?17,"M-",$PIECE(LRM(1),"^",2)," ",$PIECE(LRM(1),"^")
IF $DATA(LRB(1))
DO E
+1 IF '$DATA(LRB(1))
QUIT
FOR J=0:0
SET J=$ORDER(^LR(LRDFN,LRSS,LRI,2,Z,4,J))
IF 'J!(LR("Q"))
QUIT
SET LRX=^(J,0)
SET LRX(1)=$PIECE(LRX,"^",2)
IF $Y>(IOSL-6)
DO H1^LRAPBK
SET X=$SELECT($DATA(^LAB(61.5,+LRX,0)):^(0),1:"?")
WRITE !?17,"P-",$PIECE(X,"^",2)," ",$PIECE(X,"^")
IF LRX(1)]""
DO W
+2 FOR LRM=0:0
SET LRM=$ORDER(^LR(LRDFN,LRSS,LRI,2,Z,1,LRM))
IF 'LRM!(LR("Q"))
QUIT
SET X=+^(LRM,0)
SET LRM(1)=$SELECT($DATA(^LAB(61.4,X,0)):^(0),1:"?")
IF $Y>(IOSL-6)
DO H1^LRAPBK
WRITE !?17,"D-",$PIECE(LRM(1),"^",2)," ",$PIECE(LRM(1),"^")
+3 FOR LRM=0:0
SET LRM=$ORDER(^LR(LRDFN,LRSS,LRI,2,Z,3,LRM))
IF 'LRM!(LR("Q"))
QUIT
SET X=+^(LRM,0)
SET LRM(1)=$SELECT($DATA(^LAB(61.3,X,0)):^(0),1:"?")
IF $Y>(IOSL-6)
DO H1^LRAPBK
WRITE !?17,"F-",$PIECE(LRM(1),"^",2)," ",$PIECE(LRM(1),"^")
+4 QUIT
W WRITE " (",$SELECT(LRX(1)=1:"Positive",LRX(1)=0:"Negative",1:"?"),")"
QUIT
E FOR LRE=0:0
SET LRE=$ORDER(^LR(LRDFN,LRSS,LRI,2,Z,2,LRM,1,LRE))
IF 'LRE
QUIT
SET X=+^(LRE,0)
SET LRE(1)=$SELECT($DATA(^LAB(61.2,X,0)):^(0),1:"?")
WRITE !?20,"E-",$PIECE(LRE(1),"^",2)," ",$PIECE(LRE(1),"^")
+1 QUIT
AU FOR Z=0:0
SET Z=$ORDER(^LR(LRDFN,"AY",Z))
IF 'Z
QUIT
SET LRT=+^(Z,0)
IF $Y>(IOSL-6)
DO H1^LRAPBK
IF LR("Q")
QUIT
SET X=$SELECT($DATA(^LAB(61,LRT,0)):^(0),1:"?")
WRITE !?14,"T-",$PIECE(X,"^",2)," ",$PIECE(X,"^")
DO MA
+1 QUIT
MA FOR LRM=0:0
SET LRM=$ORDER(^LR(LRDFN,"AY",Z,2,LRM))
IF 'LRM!(LR("Q"))
QUIT
SET X=+^(LRM,0)
SET LRM(1)=$SELECT($DATA(^LAB(61.1,X,0)):^(0),1:"?")
IF $Y>(IOSL-6)
DO H1^LRAPBK
WRITE !?17,"M-",$PIECE(LRM(1),"^",2)," ",$PIECE(LRM(1),"^")
IF $DATA(LRB(1))
DO EA
+1 IF '$DATA(LRB(1))
QUIT
FOR J=0:0
SET J=$ORDER(^LR(LRDFN,"AY",Z,4,J))
IF 'J!(LR("Q"))
QUIT
SET LRX=^(J,0)
SET LRX(1)=$PIECE(LRX,"^")
IF $Y>(IOSL-6)
DO H1^LRAPBK
SET X=$SELECT($DATA(^LAB(61.5,+LRX,0)):^(0),1:"?")
WRITE !?17,"P-",$PIECE(X,"^",2)," ",$PIECE(X,"^")
IF LRX(1)]""
DO W
+2 FOR LRM=0:0
SET LRM=$ORDER(^LR(LRDFN,"AY",Z,1,LRM))
IF 'LRM!(LR("Q"))
QUIT
SET X=+^(LRM,0)
SET LRM(1)=$SELECT($DATA(^LAB(61.4,X,0)):^(0),1:"?")
IF $Y>(IOSL-6)
DO H1^LRAPBK
WRITE !?17,"D-",$PIECE(LRM(1),"^",2)," ",$PIECE(LRM(1),"^")
+3 FOR LRM=0:0
SET LRM=$ORDER(^LR(LRDFN,"AY",Z,3,LRM))
IF 'LRM!(LR("Q"))
QUIT
SET X=+^(LRM,0)
SET LRM(1)=$SELECT($DATA(^LAB(61.3,X,0)):^(0),1:"?")
IF $Y>(IOSL-6)
DO H1^LRAPBK
WRITE !?17,"F-",$PIECE(LRM(1),"^",2)," ",$PIECE(LRM(1),"^")
+4 QUIT
EA FOR LRE=0:0
SET LRE=$ORDER(^LR(LRDFN,"AY",Z,2,LRM,1,LRE))
IF 'LRE
QUIT
SET X=+^(LRE,0)
SET LRE(1)=$SELECT($DATA(^LAB(61.2,X,0)):^(0),1:"?")
WRITE !?20,"E-",$PIECE(LRE(1),"^",2)," ",$PIECE(LRE(1),"^")
+1 QUIT
