| 1 | LRUWLF ;AVAMC/REG - FILE #68 UTILITY ;3/28/96 06:32 ;
|
|---|
| 2 | ;;5.2;LAB SERVICE;**72**;Sep 27, 1994
|
|---|
| 3 | S:'$D(LRCS) LRCS=""
|
|---|
| 4 | STF S:'$D(LRSIT) LRSIT=LRU S:'$D(LRSVC) LRSVC=""
|
|---|
| 5 | S ^LRO(68,LRAA,1,LRAD,1,LRAN,0)=LRDFN_"^"_+LRDPF_"^"_LRRC_"^^^^"_LRLLOC_"^"_LRMD(1)_"^"_LRSVC_"^"_DUZ_"^"_LRCAPLOC,^(3)=LRSD_"^^"_LRRC_"^^"_LRI_"^"_LRC(5),^(.2)=LRABV_" "_LRWHN_" "_LRAN,^(.4)=DUZ(2)
|
|---|
| 6 | K LRSD S ^LRO(68,LRAA,1,"AC",DUZ(2),LRAD,LRAN)=""
|
|---|
| 7 | S ^LRO(68,LRAA,1,LRAD,1,"E",LRRC,LRAN)=""
|
|---|
| 8 | I LRSS="CY" S ^LRO(69.2,LRAA,1,LRAN,0)=LRDFN_"^"_LRI_"^"_LRH(0) L +^LRO(69.2,LRAA,1) S X=^LRO(69.2,LRAA,1,0),^(0)=$P(X,"^",1,2)_"^"_LRAN_"^"_($P(X,"^",4)+1) L -^LRO(69.2,LRAA,1)
|
|---|
| 9 | Q
|
|---|
| 10 | EN1 ;add more tests ;used by LRUTAD
|
|---|
| 11 | S:'$D(^LRO(68,LRAA,1,LRAD,1,LRAN,4,0)) ^LRO(68,LRAA,1,LRAD,1,LRAN,4,0)="^68.04PA^^"
|
|---|
| 12 | W !
|
|---|
| 13 | TST K LRTEST
|
|---|
| 14 | S DIC=60,DIC("A")=" Add Test/Procedure: ",DIC(0)="AEMOQZ",DIC("S")="I $P(^(0),U,4)=LRAA(2),$A($P(^(0),U,3))<78" D ^DIC K DIC I Y<1 S LRSIT="" Q
|
|---|
| 15 | S (LRTEST,Y)=+Y,LRTNAM=$P(Y,U,2)
|
|---|
| 16 | S N=0 F A=0:0 S N=$O(^LAB(60,LRTEST,1,N)) Q:'N S LRTEST(1)=$S($D(^LAB(60,LRTEST,1,N,0)):+^LAB(60,LRTEST,1,N,0),1:"") Q:LRTEST(1)=LRSIT
|
|---|
| 17 | I LRSS="CH",N<1 W $C(7),!!,"CANNOT ORDER ",LRTNAM," FOR ",$P(^LAB(61,LRSIT,0),U) G TST
|
|---|
| 18 | D SUM K LRRP G TST
|
|---|
| 19 | SUM ;
|
|---|
| 20 | S N=0 F X=0:1 S N=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,N)) Q:'N S:Y=N LRRP=1
|
|---|
| 21 | Q:$D(LRRP) S ^LRO(68,LRAA,1,LRAD,1,LRAN,4,Y,0)=LRTEST_"^^" I $P(^LRO(68,LRAA,1,LRAD,1,LRAN,4,0),"^",4)<1 S ^(0)="^68.04PA^"_Y_"^"_1 Q
|
|---|
| 22 | S ^LRO(68,LRAA,1,LRAD,1,LRAN,4,0)="^68.04PA^"_Y_"^"_($P(^LRO(68,LRAA,1,LRAD,1,LRAN,4,0),"^",4)+1) Q
|
|---|
| 23 | Q
|
|---|
