| 1 | LRPHITE2 ;SLC/CJS-LRPHITEM CONT ;2/23/88 10:44
|
|---|
| 2 | ;;5.2;LAB SERVICE;**221**;Sep 27, 1994
|
|---|
| 3 | OUT ;from LRPHITEM
|
|---|
| 4 | N LRX
|
|---|
| 5 | S LRSS=$P(^LRO(68,LRAA,0),"^",2)
|
|---|
| 6 | S LRX=^LRO(68,LRAA,1,LRAD,1,LRAN,0),LRIDT=$P(^LRO(68,LRAA,1,LRAD,1,LRAN,3),U,5)
|
|---|
| 7 | S LRDFN=+LRX,LRDPF=$P(LRX,U,2)
|
|---|
| 8 | I $P($G(^LR(LRDFN,LRSS,LRIDT,0)),U,3) Q
|
|---|
| 9 | D PT^LRX
|
|---|
| 10 | SKPLR S LROSN=$P(LRX,U,5),LROID=$P(LRX,U,4),LRAOD=$P(X,U,3)
|
|---|
| 11 | S LROCN=$S($D(^LRO(68,LRAA,1,LRAD,1,LRAN,.1)):$P(^(.1),U),1:""),LRACC=$S($D(^(.2)):$P(^(.2),U),1:"")
|
|---|
| 12 | S:'$D(LRLLOC) LRLLOC="" G:LRLLOC="" M
|
|---|
| 13 | M1 S LRRB="" D
|
|---|
| 14 | . N LRSN,LRODT
|
|---|
| 15 | . S LRSN=LROSN,LRODT=LROID
|
|---|
| 16 | . S LRTSTS=0 F S LRTSTS=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRTSTS)) Q:LRTSTS<1 D
|
|---|
| 17 | . . S LRTNM=$P($G(^LAB(60,+LRTSTS,0)),U)
|
|---|
| 18 | . . D SET^LRTSTOUT,M2
|
|---|
| 19 | Q
|
|---|
| 20 | M2 ;
|
|---|
| 21 | F S LRRB=$O(^LRO(69.1,"LRPH",1,LRLLOC,LRRB)) Q:LRRB="" D
|
|---|
| 22 | . I $D(^LRO(69.1,"LRPH",1,LRLLOC,LRRB,LRDFN,LROSN,LRAA,LRAN,LRTSTS)) K ^(LRTSTS)
|
|---|
| 23 | Q
|
|---|
| 24 | M F S LRLLOC=$O(^LRO(69.1,"LRPH",1,LRLLOC)) Q:LRLLOC="" D M1
|
|---|
| 25 | Q
|
|---|
