source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRMIUT1.m@ 738

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

initial load of WorldVistAEHR

File size: 1.5 KB
Line 
1LRMIUT1 ;SLC/BA/MILW/JMC - INPUT TRANSFORMS FOR MICRO ;8/11/97
2 ;;5.2;LAB SERVICE;**100,121,323**;Sep 27, 1994
3RPT ;from input transform on RPT DATE APPROVED
4 I '$D(^XUSEC("LRVERIFY",DUZ)) K X W !,"You do not have the proper access to approve these results",$C(7) Q
5 S %DT="EX" D ^%DT S X=Y I Y<1 K X Q
6VT ;from LRMINEW1, LRMIVER1
7 I $D(LRLLOC),$D(PNM),$D(LRDFN),$D(LRIDT),$L(LRLLOC) S LRVTP=$P(^LAB(64.5,1,0),U,10) S Y=DT S:'$D(LRVT) LRVT="" D APP
8 Q
9APP S ^LRO(69,"AN",$E(LRLLOC,1,20),LRDFN,LRIDT)="",^LRO(69,LRCDT\1,1,"AL",$E(LRLLOC,1,15),$E(PNM,1,20),LRDFN)=""
10 S ^LRO(69,DT,1,"AN",$E(LRLLOC,1,20),LRDFN,LRIDT)=""
11 I LRVT["RE"!(LRVT["VT") S:LRVT=LRVTP ^LRO(69,Y,1,"AR",$E(LRLLOC,1,15),$E(PNM,1,20),LRDFN)="",^LRO(68,"MI",LRDFN,LRIDT,LRSB)=""
12 I LRVT["VS" I LRVT=LRVTP S ^LRO(69,Y,1,"AR",$E(LRLLOC,1,15),$E(PNM,1,20),LRDFN)="" F LRSB=1,5,8,11,16 I $D(^LR(LRDFN,"MI",LRIDT,LRSB)),$P(^LR(LRDFN,"MI",LRIDT,LRSB),U,1) S ^LRO(68,"MI",LRDFN,LRIDT,LRSB)=""
13 S Q9=+$P(^LR(LRDFN,"MI",LRIDT,0),U,7),^LRO(69,LRCDT\1,1,"AP",$S($D(^VA(200,Q9,0)):$E($P(^VA(200,Q9,0),U),1,20),1:"UNK"),$E(PNM,1,20),LRDFN)="" K Q9,^LAC("LRKILL",LRDFN,"MI",LRIDT)
14 I $D(^LRO(69,LRODT,1,LRSN,3)),'$P(^(3),U,2) S LX1=$G(X),%DT="T",X="N" D ^%DT S $P(^LRO(69,LRODT,1,LRSN,3),U,2)=Y,X=LX1
15 I $D(^LRO(69,LRODT,1,LRSN,3)) D
16 . S LX1=$G(X)
17 . I $$VER^LR7OU1<3 N II S II=0 F S II=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,II)) Q:II<1 I $P(^(II,0),"^",5) S I=II,LRACD=LRAD D V^LROR ;OE/RR 2.5
18 . N CORRECT S:$G(LRCORECT) CORRECT=1 D NEW^LR7OB1(LRODT,LRSN,"RE")
19 . S X=LX1
20 K LX1,LRVTP Q
Note: See TracBrowser for help on using the repository browser.