| [613] | 1 | LROW2A ;SLC/FHS/JAH - CONTINUING TEST & SAMPLE VERIFICATION ;8/10/04
|
|---|
| 2 | ;;5.2;LAB SERVICE;**20,40,100,107,121,291**;Sep 27, 1994
|
|---|
| 3 | ; Modified slc/jer to include set/kill for "D" cross-reference
|
|---|
| 4 | ;from LROW2
|
|---|
| 5 | DUP L +^LRO(69,LRODT,1) S LRSN=1+$S($D(^LRO(69,LRODT,1,0)):$P(^(0),"^",3),1:0)
|
|---|
| 6 | I '$D(LR2ORD) F LRSN=LRSN:1 Q:'$D(^LRO(69,LRODT,1,LRSN,0))
|
|---|
| 7 | E S LRSAME=-1 D ADD I LRSAME=-1 L -^LRO(69,LRODT,1) Q
|
|---|
| 8 | S ^LRO(69,LRODT,1,0)="^69.01PA^"_LRSN_U_LRSN,LRSN(LRSN)=""
|
|---|
| 9 | S LRTN=$S($D(LR2ORD)&$D(^LRO(69,LRODT,1,LRSN,2,0)):$P(^(0),U,3),1:0)
|
|---|
| 10 | S LRSAMP=LRSSP S:LRSAMP=0 LRSAMP=""
|
|---|
| 11 | S ^LRO(69,LRODT,1,LRSN,0)=$P(LRSNO,U,1,2)_U_LRSAMP_U_$P(LRSNO,U,4,8),$P(^(0),U,9)=LROLLOC,^(.1)=LRORD,^LRO(69,"C",+LRORD,LRODT,LRSN)=""
|
|---|
| 12 | L -^LRO(69,LRODT,1)
|
|---|
| 13 | S ^LRO(69,LRODT,1,"AA",LRDFN,LRSN)="",^LRO(69,"D",LRDFN,LRODT,LRSN)="" S:$L(LRLLOC) ^LRO(69,LRODT,1,"AC",LRLLOC,LRSN)=""
|
|---|
| 14 | S LRI=0
|
|---|
| 15 | F S LRI=$O(LRXS(LRSSP,LRSPEC,LRI)) Q:LRI<1 D
|
|---|
| 16 | . D SET
|
|---|
| 17 | . D OR^LROW2 ;OE/RR 2.5
|
|---|
| 18 | . S ^LRO(69,LRODT,1,LRSN,2,LRTN,0)=LRTEST(LRI),^LRO(69,LRODT,1,LRSN,2,"B",+LRTEST(LRI),LRTN)="",^LRO(69,"AT",LRDFN,+LRTEST(LRI),LRSPEC,LRODT)="",^(-LRODT)=""
|
|---|
| 19 | . S $P(^LRO(69,LRODT,1,LRSN,2,LRTN,0),"^",9,10)="IP^L" D:$O(LRTCOM(+LRTEST(LRI),0)) TCOM(+LRTEST(LRI))
|
|---|
| 20 | . D:+LRDPF=2&($G(LRSS)'="BB")&('$$CHKINP^LRBEBA4(LRDFN,LRODT)) AQ2^LRBEBA3 ; CIDC
|
|---|
| 21 | S ^LRO(69,LRODT,1,LRSN,2,0)="^69.03PA^"_LRTN_U_LRTN
|
|---|
| 22 | S ^LRO(69,LRODT,1,LRSN,4,0)="^69.02PA^1^1",^(1,0)=LRSPEC
|
|---|
| 23 | I $D(LRCOM(LRSSP,LRSPEC)),LRCOM(LRSSP,LRSPEC) S X=LRCOM(LRSSP,LRSPEC),^LRO(69,LRODT,1,LRSN,6,0)="^69.04^"_X_U_X F J=1:1:X S ^LRO(69,LRODT,1,LRSN,6,J,0)=LRCOM(LRSSP,LRSPEC,J)
|
|---|
| 24 | N TSTZ S TSTZ=0 F S TSTZ=$O(LRTEST(TSTZ)) Q:TSTZ<1 S TSTZ(+LRTEST(TSTZ))=""
|
|---|
| 25 | D NEW^LR7OB1(LRODT,LRSN,"SN",$G(LRNATURE),.TSTZ)
|
|---|
| 26 | I $D(LRLWC),LRLWC="LC" S ION=$P($G(^LAB(69.9,1,3.5,+DUZ(2),0)),U,2) S:ION="" ION=$P(^LAB(69.9,1,3),U,4) I ION]"" D ^LROW2P
|
|---|
| 27 | I $D(LRLWC),LRLWC="I" S ION=$P(^LAB(69.9,1,7,DUZ(2),0),U,3) I ION]"" D ^LROW2P
|
|---|
| 28 | WCP Q:$D(LRNCWL) Q:'$D(LRORDER) S ION=LRORDER
|
|---|
| 29 | I $G(LRPIX)'=LRORD D PAUSE S LRPIX=LRORD
|
|---|
| 30 | I IO(0)=$G(IO) S IOP=LRORDER,%ZIS="Q" D ^%ZIS Q:POP I '$D(IO("Q")) U IO D ENT2^LROW2P Q
|
|---|
| 31 | I $G(IO)'=IO(0)!($D(IO("Q"))) D ^LROW2P Q
|
|---|
| 32 | Q
|
|---|
| 33 | ADD S LRSN1="" F ZZ=0:0 S LRSN1=$O(^LRO(69,LRODT,1,"AA",LRDFN,LRSN1)) Q:LRSN1="" I ^LRO(69,LRODT,1,LRSN1,.1)=LRORD S LROLLOC=$P(^LRO(69,LRODT,1,LRSN1,0),U,9),LRSAME=$S(LRSSP=$P(^(0),U,3)&(LRSPEC=^(4,1,0)):1,1:0) I LRSAME=1 S LRSN=LRSN1 Q
|
|---|
| 34 | I LRSAME=0 F LRSN=LRSN:1 Q:'$D(^LRO(69,LRODT,1,LRSN,0))
|
|---|
| 35 | Q
|
|---|
| 36 | PAUSE ;
|
|---|
| 37 | R !!,"Press RETURN to continue...",X:DTIME
|
|---|
| 38 | Q
|
|---|
| 39 | SET ;
|
|---|
| 40 | S LRTN=LRTN+1 I $D(^LRO(69,LRODT,1,LRSN,2,LRTN)) G SET
|
|---|
| 41 | Q
|
|---|
| 42 | TCOM(TEST) ;Insert test comments
|
|---|
| 43 | N J
|
|---|
| 44 | S ^LRO(69,LRODT,1,LRSN,2,LRTN,1,0)="^^"_LRTCOM(TEST)_"^"_DT_"^"
|
|---|
| 45 | S J=0 F S J=$O(LRTCOM(TEST,J)) Q:J<1 S ^LRO(69,LRODT,1,LRSN,2,LRTN,1,J,0)=LRTCOM(TEST,J)
|
|---|
| 46 | Q
|
|---|
