LRPHITE2 ;SLC/CJS-LRPHITEM CONT ;2/23/88 10:44
;;5.2;LAB SERVICE;**221**;Sep 27, 1994
OUT ;from LRPHITEM
N LRX
S LRSS=$P(^LRO(68,LRAA,0),"^",2)
S LRX=^LRO(68,LRAA,1,LRAD,1,LRAN,0),LRIDT=$P(^LRO(68,LRAA,1,LRAD,1,LRAN,3),U,5)
S LRDFN=+LRX,LRDPF=$P(LRX,U,2)
I $P($G(^LR(LRDFN,LRSS,LRIDT,0)),U,3) Q
D PT^LRX
SKPLR S LROSN=$P(LRX,U,5),LROID=$P(LRX,U,4),LRAOD=$P(X,U,3)
S LROCN=$S($D(^LRO(68,LRAA,1,LRAD,1,LRAN,.1)):$P(^(.1),U),1:""),LRACC=$S($D(^(.2)):$P(^(.2),U),1:"")
S:'$D(LRLLOC) LRLLOC="" G:LRLLOC="" M
M1 S LRRB="" D
. N LRSN,LRODT
. S LRSN=LROSN,LRODT=LROID
. S LRTSTS=0 F S LRTSTS=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRTSTS)) Q:LRTSTS<1 D
. . S LRTNM=$P($G(^LAB(60,+LRTSTS,0)),U)
. . D SET^LRTSTOUT,M2
Q
M2 ;
F S LRRB=$O(^LRO(69.1,"LRPH",1,LRLLOC,LRRB)) Q:LRRB="" D
. I $D(^LRO(69.1,"LRPH",1,LRLLOC,LRRB,LRDFN,LROSN,LRAA,LRAN,LRTSTS)) K ^(LRTSTS)
Q
M F S LRLLOC=$O(^LRO(69.1,"LRPH",1,LRLLOC)) Q:LRLLOC="" D M1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRPHITE2 963 printed Oct 16, 2024@18:20:04 Page 2
LRPHITE2 ;SLC/CJS-LRPHITEM CONT ;2/23/88 10:44
+1 ;;5.2;LAB SERVICE;**221**;Sep 27, 1994
OUT ;from LRPHITEM
+1 NEW LRX
+2 SET LRSS=$PIECE(^LRO(68,LRAA,0),"^",2)
+3 SET LRX=^LRO(68,LRAA,1,LRAD,1,LRAN,0)
SET LRIDT=$PIECE(^LRO(68,LRAA,1,LRAD,1,LRAN,3),U,5)
+4 SET LRDFN=+LRX
SET LRDPF=$PIECE(LRX,U,2)
+5 IF $PIECE($GET(^LR(LRDFN,LRSS,LRIDT,0)),U,3)
QUIT
+6 DO PT^LRX
SKPLR SET LROSN=$PIECE(LRX,U,5)
SET LROID=$PIECE(LRX,U,4)
SET LRAOD=$PIECE(X,U,3)
+1 SET LROCN=$SELECT($DATA(^LRO(68,LRAA,1,LRAD,1,LRAN,.1)):$PIECE(^(.1),U),1:"")
SET LRACC=$SELECT($DATA(^(.2)):$PIECE(^(.2),U),1:"")
+2 if '$DATA(LRLLOC)
SET LRLLOC=""
if LRLLOC=""
GOTO M
M1 SET LRRB=""
Begin DoDot:1
+1 NEW LRSN,LRODT
+2 SET LRSN=LROSN
SET LRODT=LROID
+3 SET LRTSTS=0
FOR
SET LRTSTS=$ORDER(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRTSTS))
if LRTSTS<1
QUIT
Begin DoDot:2
+4 SET LRTNM=$PIECE($GET(^LAB(60,+LRTSTS,0)),U)
+5 DO SET^LRTSTOUT
DO M2
End DoDot:2
End DoDot:1
+6 QUIT
M2 ;
+1 FOR
SET LRRB=$ORDER(^LRO(69.1,"LRPH",1,LRLLOC,LRRB))
if LRRB=""
QUIT
Begin DoDot:1
+2 IF $DATA(^LRO(69.1,"LRPH",1,LRLLOC,LRRB,LRDFN,LROSN,LRAA,LRAN,LRTSTS))
KILL ^(LRTSTS)
End DoDot:1
+3 QUIT
M FOR
SET LRLLOC=$ORDER(^LRO(69.1,"LRPH",1,LRLLOC))
if LRLLOC=""
QUIT
DO M1
+1 QUIT
