- 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
