21 lines
1.5 KiB
Mathematica
21 lines
1.5 KiB
Mathematica
|
LRMIUT1 ;SLC/BA/MILW/JMC - INPUT TRANSFORMS FOR MICRO ;8/11/97
|
||
|
;;5.2;LAB SERVICE;**100,121,323**;Sep 27, 1994
|
||
|
RPT ;from input transform on RPT DATE APPROVED
|
||
|
I '$D(^XUSEC("LRVERIFY",DUZ)) K X W !,"You do not have the proper access to approve these results",$C(7) Q
|
||
|
S %DT="EX" D ^%DT S X=Y I Y<1 K X Q
|
||
|
VT ;from LRMINEW1, LRMIVER1
|
||
|
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
|
||
|
Q
|
||
|
APP 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)=""
|
||
|
S ^LRO(69,DT,1,"AN",$E(LRLLOC,1,20),LRDFN,LRIDT)=""
|
||
|
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)=""
|
||
|
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)=""
|
||
|
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)
|
||
|
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
|
||
|
I $D(^LRO(69,LRODT,1,LRSN,3)) D
|
||
|
. S LX1=$G(X)
|
||
|
. 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
|
||
|
. N CORRECT S:$G(LRCORECT) CORRECT=1 D NEW^LR7OB1(LRODT,LRSN,"RE")
|
||
|
. S X=LX1
|
||
|
K LX1,LRVTP Q
|