| [613] | 1 | LRAPQACD ;AVAMC/REG/CYM - ENTER TC/QA CODES ;2/5/97 06:37
|
|---|
| 2 | ;;5.2;LAB SERVICE;**72,85,155**;Sep 27, 1994
|
|---|
| 3 | D ^LRAP G:'$D(Y) END
|
|---|
| 4 | S DR=$S(LRSS="AU":"99",1:".99;.14;9") D ^LRAPDA Q
|
|---|
| 5 | ;
|
|---|
| 6 | EN D ^LRAP G:'$D(Y) END
|
|---|
| 7 | W !!?10,"Delete Tissue committee/QA codes from ",LRO(68),!! D B^LRU G:Y<0 END
|
|---|
| 8 | S LRSDT=LRSDT-.01,LRLDT=LRLDT+.99
|
|---|
| 9 | W !!?16,"OK to DELETE TC/QA codes",!?21,"from one date thru another " S %=2 D YN^LRU I %'=1 W !!?32,"OK, forget it !" G END
|
|---|
| 10 | D XR^LRU
|
|---|
| 11 | W ! F X=0:0 S LRSDT=$O(^LR(LRXR,LRSDT)) Q:'LRSDT!(LRSDT>LRLDT) W "." D LRDFN
|
|---|
| 12 | OUT W $C(7),!,"OK DONE !" G END
|
|---|
| 13 | LRDFN F LRDFN=0:0 S LRDFN=$O(^LR(LRXR,LRSDT,LRDFN)) Q:'LRDFN D @($S("CYEMSP"[LRSS:"I",1:"A"))
|
|---|
| 14 | Q
|
|---|
| 15 | I F LRI=0:0 S LRI=$O(^LR(LRXR,LRSDT,LRDFN,LRI)) Q:'LRI I $P($P($G(^LR(LRDFN,LRSS,LRI,0)),U,6)," ")=LRABV K ^(9) S $P(^(0),"^",14)=""
|
|---|
| 16 | Q
|
|---|
| 17 | A K:$P($P($G(^LR(LRDFN,"AU")),U,6)," ")=LRABV ^(99) Q
|
|---|
| 18 | ;
|
|---|
| 19 | END D V^LRU Q
|
|---|
