| 1 | LRMINEW1 ;SLC/CJS/BA - NEW DATA TO BE REVIEWED/VERIFIED ;5/6/04 12:04
|
|---|
| 2 | ;;5.2;LAB SERVICE;**295**;Sep 27, 1994
|
|---|
| 3 | VER W !!,"Indicate those you wish to exclude from verification."
|
|---|
| 4 | D CHECK
|
|---|
| 5 | I $O(LRAN(0))>0 W !,"Verifying all but the following:" F LRAN=0:0 S LRAN=$O(LRAN(LRAN)) Q:LRAN="" W !,LRAN
|
|---|
| 6 | F I=0:0 W !,"Want the approved reports to be printed at the requesting locations" S %=2 D YN^DICN Q:% W !,"Answer 'Y'es or 'N'o"
|
|---|
| 7 | Q:%=-1 S LRMIQUE=$S(%=1:1,1:0)
|
|---|
| 8 | F I=0:0 W !!,"Are you ready to verify" S %=2 D YN^DICN Q:% W !,"If you're not sure, it's not too late to quit."
|
|---|
| 9 | Q:%'=1
|
|---|
| 10 | S LRAN=0 F I=0:0 S LRAN=+$O(LRAN(LRAN)) Q:LRAN<1 K ^LRO(68,LRAA,1,LRAD,"AC",LRSB,LRAN)
|
|---|
| 11 | S LRAN=0 F I=0:0 S LRAN=+$O(^LRO(68,LRAA,1,LRAD,"AC",LRSB,LRAN)) Q:LRAN<1 I +^(LRAN)=LRDXZ!(LRDXZ=0) D STUFF
|
|---|
| 12 | W !,"ALL DONE"
|
|---|
| 13 | Q
|
|---|
| 14 | STUFF Q:'$D(^LRO(68,LRAA,1,LRAD,1,LRAN,0)) Q:'$D(^(3)) S Y=^(0),LRDFN=+Y,LRLLOC=$P(Y,U,7),LRODT=$S($P(Y,U,4):$P(Y,U,4),1:$P(Y,U,3)),LRSN=$P(Y,U,5),LRIDT=9999999-^(3),LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3) D PT^LRX
|
|---|
| 15 | S $P(^LR(LRDFN,"MI",LRIDT,LRSB),U)=DT,$P(^(LRSB),U,$S(LRSB=11:5,1:3))=DUZ
|
|---|
| 16 | D UPDATE^LRPXRM(LRDFN,"MI",LRIDT)
|
|---|
| 17 | S LRCDT=9999999-LRIDT,Y=DT D VT^LRMIUT1
|
|---|
| 18 | K ^LRO(68,LRAA,1,LRAD,"AC",LRSB,LRAN)
|
|---|
| 19 | D:LRMIQUE TSKM^LRMIUT
|
|---|
| 20 | Q
|
|---|
| 21 | CHECK ;from LRMINEW
|
|---|
| 22 | D LRAN^LRMIUT S LRAN=0 F I=0:0 S LRAN=+$O(LRAN(LRAN)) Q:LRAN<1 S LROK=1 D CHECK1 I 'LROK K LRAN(LRAN)
|
|---|
| 23 | Q
|
|---|
| 24 | CHECK1 I '$D(^LRO(68,LRAA,1,LRAD,"AC",LRSB,LRAN)) W !,LRAN," is not defined." S LROK=0 Q
|
|---|
| 25 | I LRDXZ'=0,+^LRO(68,LRAA,1,LRAD,"AC",LRSB,LRAN)'=LRDXZ W !,LRAN," is not your accession." S LROK=0
|
|---|
| 26 | Q
|
|---|
