source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRMINEW1.m@ 1604

Last change on this file since 1604 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.5 KB
Line 
1LRMINEW1 ;SLC/CJS/BA - NEW DATA TO BE REVIEWED/VERIFIED ;5/6/04 12:04
2 ;;5.2;LAB SERVICE;**295**;Sep 27, 1994
3VER 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
14STUFF 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
21CHECK ;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
24CHECK1 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
Note: See TracBrowser for help on using the repository browser.