| 1 | LRPHSET1 ;SLC/CJS-COLLECTION LIST TO ACCESSIONS ;8/11/97
|
|---|
| 2 | ;;5.2;LAB SERVICE;**121,191,221,240**;Sep 27, 1994
|
|---|
| 3 | Q
|
|---|
| 4 | EN ;from LRPHSET
|
|---|
| 5 | K ^LRO(69,DT,1,"AD") S $P(^LAB(69.9,1,5),"^",10,12)=1_"^"_$H_"^"_$S($D(DUZ):DUZ,1:"")
|
|---|
| 6 | S LRDFN=0 F S LRDFN=$O(^LRO(69,DT,1,"AA",LRDFN)) Q:LRDFN<1 K T D S6
|
|---|
| 7 | S LRLOC="",LRCOUNT=0,LRDUZ(2)=$S($D(DUZ(2)):DUZ(2),1:"") F LRPH=0:0 S LRLOC=$O(^LRO(69,DT,1,"AD",LRLOC)) Q:LRLOC="" D S4
|
|---|
| 8 | S $P(^LAB(69.9,1,5),"^",10)=0
|
|---|
| 9 | G END
|
|---|
| 10 | S4 K DIC S D="C",X=LRLOC,DIC(0)="Z",DIC=44 D IX^DIC S LRDUZ(2)=$S(Y<1:LRDUZ(2),1:$S($P(Y(0),U,4):$P(Y(0),U,4),1:DUZ(2)))
|
|---|
| 11 | S LRDFN=0 F S LRDFN=$O(^LRO(69,DT,1,"AD",LRLOC,LRDFN)) Q:LRDFN<1 D S4A
|
|---|
| 12 | Q
|
|---|
| 13 | S4A S LRSN=0 F S LRSN=$O(^LRO(69,DT,1,"AD",LRLOC,LRDFN,LRSN)) Q:LRSN<1 D:$D(^LRO(69,DT,1,LRSN,1)) S4C D:'($D(^LRO(69,DT,1,LRSN,1))#2)&($D(^(0))) S4B
|
|---|
| 14 | Q
|
|---|
| 15 | S4B S X=^LRO(69,DT,1,LRSN,0) I $P(X,U,4)="LC",LRDFN=+X,$P(X,U,8)'>LRDTI S:$$GOT(DT,LRSN) LRCOUNT=LRCOUNT+1 D S5
|
|---|
| 16 | Q
|
|---|
| 17 | S4C I $P(^LRO(69,DT,1,LRSN,1),U)'>LRDTI S X=^(0) I $P(X,U,4)="LC",LRDFN=+X,$P(X,U,8)'>LRDTI D S5
|
|---|
| 18 | Q
|
|---|
| 19 | S5 S ^LRO(69,DT,1,"AC",LRLOC,LRSN)=1,LRSCR=$S($D(^LRO(69,DT,1,LRSN,1)):$P(^(1),U,3,99),1:""),^(1)=LRDTI_"^1^"_LRSCR,LRTJ=$P(^(0),U,3,4)_"^"_DT,LRSAMP=$P(LRTJ,U,1)
|
|---|
| 20 | S LRSPEC=$P(^LAB(62,LRSAMP,0),U,2),I=$O(^LRO(69,DT,1,LRSN,6,0)) K LRSPCDSC S:I LRSPCDSC=^(I,0)
|
|---|
| 21 | I $D(^LRO(69,DT,1,LRSN,1)),'$L($P(^(1),U,4)),$D(^(3)) S LRLLOC=$P(^LRO(69,DT,1,LRSN,0),U,7),LROLLOC=$P(^(0),U,9) D REUP^LRPHSET2
|
|---|
| 22 | D OLD^LRORDST K LRTJ Q
|
|---|
| 23 | S6 S T="",LRSN=0 F S LRSN=$O(^LRO(69,DT,1,"AA",LRDFN,LRSN)) Q:LRSN<1 D S6A
|
|---|
| 24 | S LRSAMP=0 F S LRSAMP=$O(T(LRSAMP)) Q:LRSAMP<1 S LRSTEP=0 D S7^LRPHSET2 S LRSTEP=1 D S7^LRPHSET2
|
|---|
| 25 | Q
|
|---|
| 26 | S6A I '$S($D(^LRO(69,DT,1,LRSN,0)):$L($P(^(0),U,2)),1:0) Q
|
|---|
| 27 | Q:$P(^LRO(69,DT,1,LRSN,0),U,4)'="LC" Q:$P(^(0),U,8)>LRDTI I $D(^(1)),$L($P(^(1),U,4)) Q
|
|---|
| 28 | Q:'$D(^LRO(69,DT,1,LRSN,2,0)) Q:'$$GOT(DT,LRSN)
|
|---|
| 29 | S LRSAMP=$P(^LRO(69,DT,1,LRSN,0),U,3),LRLLOC=$E($P(^(0),U,7),1,30),LROLLOC=$P(^(0),U,9)
|
|---|
| 30 | S X=^LR(LRDFN,0),LRDPF=$P(X,U,2) I LRDPF=2,$D(^DPT(+$P(X,U,3),.1)) S LRLLOC=^(.1) D DPT^LRWU S $P(^LRO(69,DT,1,LRSN,0),U,7)=$S($L(LRLLOC):LRLLOC,1:"UNKNOWN")
|
|---|
| 31 | S:'$L(LRLLOC) LRLLOC="UNKNOWN" Q:LRSAMP<1 S ^LRO(69,DT,1,"AD",LRLLOC,LRDFN,LRSN)=""
|
|---|
| 32 | S I=0 F S I=$O(^LRO(69,DT,1,LRSN,2,I)) Q:I<1 S X=^(I,0) I '$P(X,"^",6),'$P(X,"^",11) S T(LRSAMP,+X,LRSN)=I_U_$P(X,U,2)
|
|---|
| 33 | Q
|
|---|
| 34 | END Q ;BACK TO LRPHSET
|
|---|
| 35 | GOT(ODT,SN) ;See if all tests have been canceled
|
|---|
| 36 | N I S GOT=0
|
|---|
| 37 | I $D(^LRO(69,ODT,1,SN)) S I=0 F S I=$O(^LRO(69,ODT,1,SN,2,I)) Q:I<1 I $D(^(I,0)),'$P(^(0),"^",11) S GOT=1 Q
|
|---|
| 38 | Q GOT
|
|---|
