LRMIUT1.m

LRMIUT1 ;SLC/BA/MILW/JMC - INPUT TRANSFORMS FOR MICRO ;JUL 06, 2010 3:14 PM

 ;;5.2;LAB SERVICE;**100,121,323,1027**;NOV 01, 1997

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

LRMIUT1   ;SLC/BA/MILW/JMC - INPUT TRANSFORMS FOR MICRO ;JUL 06, 2010 3:14 PM

 +1       ;;5.2;LAB SERVICE;**100,121,323,1027**;NOV 01, 1997

RPT       ;from input transform on RPT DATE APPROVED

 +1        IF '$DATA(^XUSEC("LRVERIFY",DUZ))

               KILL X

               WRITE !,"You do not have the proper access to approve these results",$CHAR(7)

               QUIT 

 +2        SET %DT="EX"

           DO ^%DT

           SET X=Y

           IF Y<1

               KILL X

               QUIT 

VT        ;from LRMINEW1, LRMIVER1

 +1        IF $DATA(LRLLOC)

               IF $DATA(PNM)

                   IF $DATA(LRDFN)

                       IF $DATA(LRIDT)

                           IF $LENGTH(LRLLOC)

                               SET LRVTP=$PIECE(^LAB(64.5,1,0),U,10)

                               SET Y=DT

                               IF '$DATA(LRVT)

                                   SET LRVT=""

                               DO APP

 +2        QUIT 

APP        SET ^LRO(69,"AN",$EXTRACT(LRLLOC,1,20),LRDFN,LRIDT)=""

           SET ^LRO(69,LRCDT\1,1,"AL",$EXTRACT(LRLLOC,1,15),$EXTRACT(PNM,1,20),LRDFN)=""

 +1        SET ^LRO(69,DT,1,"AN",$EXTRACT(LRLLOC,1,20),LRDFN,LRIDT)=""

 +2        IF LRVT["RE"!(LRVT["VT")

               IF LRVT=LRVTP

                   SET ^LRO(69,Y,1,"AR",$EXTRACT(LRLLOC,1,15),$EXTRACT(PNM,1,20),LRDFN)=""

                   SET ^LRO(68,"MI",LRDFN,LRIDT,LRSB)=""

 +3        IF LRVT["VS"

               IF LRVT=LRVTP

                   SET ^LRO(69,Y,1,"AR",$EXTRACT(LRLLOC,1,15),$EXTRACT(PNM,1,20),LRDFN)=""

                   FOR LRSB=1,5,8,11,16

                       IF $DATA(^LR(LRDFN,"MI",LRIDT,LRSB))

                           IF $PIECE(^LR(LRDFN,"MI",LRIDT,LRSB),U,1)

                               SET ^LRO(68,"MI",LRDFN,LRIDT,LRSB)=""

 +4        SET Q9=+$PIECE(^LR(LRDFN,"MI",LRIDT,0),U,7)

           SET ^LRO(69,LRCDT\1,1,"AP",$SELECT($DATA(^VA(200,Q9,0)):$EXTRACT($PIECE(^VA(200,Q9,0),U),1,20),1:"UNK"),$EXTRACT(PNM,1,20),LRDFN)=""

           KILL Q9,^LAC("LRKILL",LRDFN,"MI",LRIDT)

 +5        IF $DATA(^LRO(69,LRODT,1,LRSN,3))

               IF '$PIECE(^(3),U,2)

                   SET LX1=$GET(X)

                   SET %DT="T"

                   SET X="N"

                   DO ^%DT

                   SET $PIECE(^LRO(69,LRODT,1,LRSN,3),U,2)=Y

                   SET X=LX1

 +6        IF $DATA(^LRO(69,LRODT,1,LRSN,3))

               Begin DoDot:1

 +7                SET LX1=$GET(X)

 +8       ;OE/RR 2.5

                   IF $$VER^LR7OU1<3

                       NEW II

                       SET II=0

                       FOR 

                           SET II=$ORDER(^LRO(68,LRAA,1,LRAD,1,LRAN,4,II))

                           IF II<1

                               QUIT 

                           IF $PIECE(^(II,0),"^",5)

                               SET I=II

                               SET LRACD=LRAD

                               DO V^LROR

 +9                NEW CORRECT

                   IF $GET(LRCORECT)

                       SET CORRECT=1

                   DO NEW^LR7OB1(LRODT,LRSN,"RE")

 +10               SET X=LX1

               End DoDot:1

 +11       KILL LX1,LRVTP

           QUIT