Routine: LRVER3

LRVER3 ;DALOI/CJS/JAH - DATA VERIFICATION ; 03-Oct-2016 10:28 ; MKK

 ;;5.2;LAB SERVICE;**42,100,121,140,171,1010,153,1018,286,1027,291,1031,406,1033,1038,1039**;NOV 1, 1997;Build 38

 ; NOTE: LR*5.2*1031 restores LR*5.2*1027 modifications

EP ; EP - LR*5.2*1031

 D V1

 I $D(LRLOCKER)#2 L -@(LRLOCKER) K LRLOCKER

V1 I $D(LRLOCKER)#2 L -@(LRLOCKER)

 S LRLOCKER="^LR("_LRDFN_","""_LRSS_""","_LRIDT_")"

 L +@(LRLOCKER):1

 I '$T W !," This entry is being edited by someone else." Q

 I $D(LRGVP) S X="1-"_LRNTN D RANGE^LRWU2 G L10

 S LRALL="",LRALERT=LROUTINE,LRLCT=6

 ; List any not performed tests.

 S I=0

 F  S I=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,I)) Q:I<1  D

 . S LRX=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,4,I,0))

 . I $P(LRX,"^",6)'="*Not Performed" Q

 . W !,?3,$P(^LAB(60,I,0),"^"),?25," ",$P(LRX,"^",6)

 . S LRLCT=LRLCT+1 D:LRLCT>22 WT^LRVER4

 ; No tests to edit

 I LRNTN=0 D COM^LRVR4 G EXIT

 F I=1:1:LRNTN I $D(LRNAME(I)) D

 . S LRALL=LRALL_","_I W !,I,"  ",LRNAME(I)

 . I $D(^LRO(68,LRAA,1,LRAD,1,LRAN,4,$O(LRNAME(I,0)),0))#2 D

 . . S LRX=^LRO(68,LRAA,1,LRAD,1,LRAN,4,$O(LRNAME(I,0)),0)

 . . S LRAL=$P(LRX,U,2)#50

 . . I $P(LRX,U,5) W ?25,$S($P(LRX,U,6)'="":$P(LRX,U,6),1:" verified")

 . . I LRAL S LRALERT=$S(LRAL<LRALERT:LRAL,1:LRALERT)

 . S LRLCT=LRLCT+1 D:LRLCT>22 WT^LRVER4

 I $D(LRALERT),LRALERT<($P(LRPARAM,U,20)+1) D

 . W !?15 W:IOST["C-" @LRVIDO

 . W "Test ordered "_$P($G(^LAB(62.05,+LRALERT,0)),U)

 . W:IOST["C-" @LRVIDOF W !,$C(7)

 S X9="" I LRNTN=1 S T1=1 G L10

V9 S LRALL=$P(LRALL,",",2,99)

 R !!,"TEST #(s) (or ""ALL""): ",X:DTIME S:'$T X=U S:X["A" X=LRALL

 I X["?" W !,"Enter for example 1,2,5-9." G V9

 Q:X[U!(X="")  D RANGE^LRWU2 G EXIT:X9="" X (X9_"S:'$D(LRNAME(T1)) X=0") G EXIT:X=0

L10 ;

 N LRCORECT S LRCORECT=0

 S LRNX=0 X (X9_"D EX1^LRVER1")

 D V7^LRVER2

 S LRCMTDSP=$$CHKCDSP^LRVERA

 K LRSA,LRSB,LRORU3

 F LRSB=1:0 S LRSB=$O(^LR(LRDFN,LRSS,LRIDT,LRSB)) Q:LRSB<1  D

 . Q:LRSB=9009027                      ; IHS/OIT/MKK LR*5.2*1027 - Skip E-SIG ENTRY

 . Q:$G(^(LRSB))=""                    ; IHS/MSC/MKK - LR*5.2*1033 - Skip "empty" node

 . S LRSB(LRSB)=^(LRSB),LRSB(LRSB,"P")=$P(LRSB(LRSB),U,3)

 . I $D(LRNOVER) S LRNOVER(LRSB)=""

 S LREDIT=1

 D ^LRVER4

 ; If group data review then quit before updating results

 I $D(LRGVP) G EXIT

 I '$O(LRORD(0)) G EXIT

 ; I '$G(LRCHG),'LRVF F LRSB=1:0 S LRSB=$O(LRSB(LRSB)) Q:LRSB<1  S:LRSB(LRSB)'="" ^LR(LRDFN,LRSS,LRIDT,LRSB)=LRSB(LRSB)

 ; ----- BEGIN IHS/MSC/MKK - LR*5.2*1039 - Add in LEDI IV update to put Result Date into File 63

 I '$G(LRCHG),'LRVF D

 . N LRNOW S LRNOW=$$NOW^XLFDT

 . F LRSB=1:0 S LRSB=$O(LRSB(LRSB)) Q:LRSB<1  I $P(LRSB(LRSB),"^")'="" D

 . . S $P(LRSB(LRSB),U,6)=LRNOW

 . . S ^LR(LRDFN,LRSS,LRIDT,LRSB)=LRSB(LRSB)

 ; ----- END IHS/MSC/MKK - LR*5.2*1039 - Add in LEDI IV update

 I $G(LRCHG) D CHG K LRCHG,LRUP I $G(LREND) S LREND=0 G EXIT

 I $D(LRSA),$D(LRF) K LRF S X=$P(^LR(LRDFN,LRSS,LRIDT,0),U,9) S:$L(X)&($E(X)'["-") $P(^(0),U,9)="-"_X G V11

 G EXIT:$D(LRGVP),V11:LRVF&$D(LRSA),V1:LRVF&(LRNTN>1),EXIT:LRVF

NOVER I $O(LRNOVER(0)) D  G EXIT

 . F I=0:0 S I=+$O(LRNOVER(I)) Q:I<2  W !,"Test Not Reviewed: ",$P(^DD(63.04,I,0),U) W:$D(LRSB(I))#2 " = "_$P(LRSB(I),U)_" "_$P(LRSB(I),U,2)

 . W !,$$CJ^XLFSTR("The above test(s) have results already entered,",80)

 . W !,$$CJ^XLFSTR("but you did not select them for review.",80)

 . W !,$$CJ^XLFSTR(" Accession NOT approved. ",80),$C(7)

 . W !,$$CJ^XLFSTR("You must review all results before ANY can be released.",80),!!

 . W:$E(IOST,1,2)="C-" @LRVIDO W $$CJ^XLFSTR("Suggest you select 'ALL' tests for verification/review. ",80) W:$E(IOST,1,2)="C-" @LRVIDOF W !,$C(7)

 I $O(LRNOVER(0)) W !,"Has not been reviewed and has data.  Not approved.",! G EXIT

 I '$P($G(LRLABKY),U) W !,$C(7),"ENTERED BUT NOT APPROVED",! G EXIT

 I '$O(LRSB(0)) W !?5,"Nothing verified ",$C(7),! G EXIT

 N CNT S CNT=1

AGAIN ;

 ; R !,"Approve for release by entering your initials: ",LRINI:DTIME

 ; ----- BEGIN IHS/MSC/MKK - LR*5.2*1038

 S LRINI=$$GETINITS("Approve for release by entering your initials: ")

 ; ----- END IHS/MSC/MKK - LR*5.2*1038

 ; I $E(LRINI)="^" W !!?5,$C(7),"Nothing verified!" D READ G EXIT

 ;----- BEGIN IHS/OIT/MKK LR*5.2*1027 -- Pause 2 seconds to allow user to see the message

 I $E(LRINI)="^" W !!?5,$C(7),"*** Nothing verified! ***" W *7,!  H 2  D READ G EXIT

 ;----- END IHS/OIT/MKK LR*5.2*1027

 I LRINI'=LRUSI,$$UP^XLFSTR(LRINI)=$$UP^XLFSTR(LRUSI) S LRINI=LRUSI

 I $S($E(LRINI)="?":1,LRINI'=LRUSI&(CNT<2):1,1:0) W !,$C(7),"Please enter your correct initials" S:$E(LRINI)="?" CNT=0 S CNT=CNT+1 G AGAIN

 I LRINI'=LRUSI W !!?5,$C(7),"Nothing verified!" D READ G EXIT

V11 I $D(XRTL) D T0^%ZOSV ; START RESPONSE TIME LOGGING

 I +LRDPF=2&($G(LRSS)'="BB")&('$$CHKINP^LRBEBA4(LRDFN,LRODT)) D

 .D BAWRK^LRBEBA(LRODT,LRSN,1,.LRBEY,.LRTEST)

 D VER^LRVER3A

 I $P(LRPARAM,U,14),$P($G(^LRO(68,LRAA,0)),U,16) D LOOK^LRCAPV1

 N LRX

 S LRX=0

 F  S LRX=$O(^TMP("LR",$J,"TMP",LRX)) Q:LRX<1  S:'$D(^LRO(68,"AC",LRDFN,LRIDT,LRX)) ^(LRX)="" I LRVF S ^(LRX)=""

 I $P($G(LRORU3),U,3),$O(LRSB(0)) D LRORU3

 I $D(XRT0) S XRTN="V11^LRVER3" D T1^%ZOSV ; STOP RESPONSE TIME LOGGING

 S LRVF=1

EXIT Q

READ ;

 N X W !!,"Press ENTER or RETURN to continue: " R X:DTIME

CHG ; Check for changes, save results and create audit trail

 S LRUP=""

 S LRNOW=$$NOW^XLFDT    ; IHS/MSC/MKK - LR*5.2*1039 - LEDI IV

 F  S LRCHG=$O(LRSB(LRCHG)) Q:LRCHG<1  D

 . I '$D(LRSA(LRCHG)) S LRUP=1 Q

 . ; I $P(LRSA(LRCHG),"^")=""!($P(LRSA(LRCHG),"^")="pending") S LRSA(LRCHG,3)=1,LRUP=1 Q

 . ; ----- BEGIN IHS/MSC/MKK - LR*5.2*1039 - LEDI IV - Update release time

 . I $P(LRSA(LRCHG),"^")=""!($P(LRSA(LRCHG),"^")="pending") D  Q

 . . S LRSA(LRCHG,3)=1

 . . S LRUP=1

 . . S $P(LRSB(LRCHG),U,6)=LRNOW

 . ; ----- END IHS/MSC/MKK - LR*5.2*1039

 . I $P(LRSA(LRCHG),"^")'=$P(LRSB(LRCHG),"^") S LRUP=1,$P(LRSA(LRCHG,2),"^")=1 ; results changed

 . I $P(LRSA(LRCHG),"^",2)'=$P(LRSB(LRCHG),"^",2) S LRUP=1,$P(LRSA(LRCHG,2),"^",2)=1 ; normalcy flag changed

 . I $P(LRSA(LRCHG),"^",5)'=$P(LRSB(LRCHG),"^",5) D  ; units/normals changed

 . . N LRX,LRY

 . . S LRX=$$UP^XLFSTR($P(LRSA(LRCHG),"^",5)),LRX=$TR(LRX,"""")

 . . S LRY=$$UP^XLFSTR($P(LRSB(LRCHG),"^",5)),LRY=$TR(LRY,"""")

 . . I LRX'=LRY S LRUP=1,$P(LRSA(LRCHG,2),"^",5)=1

 . I $D(LRSA(LRCHG,2)) S $P(LRSB(LRCHG),U,6)=LRNOW  ; IHS/MSC/MKK - LR*5.2*1039 - LEDI IV - Update user/release time

 I 'LRUP S LREND=1 Q

 S LREND=0

 W !! W:IOST["C-" @LRVIDO W "Approve update of data by entering your initials: " W:IOST["C-" @LRVIDOF

 ; ----- BEGIN IHS/MSC/MKK - LR*5.2*1038

 S LRINI=$$GETINITS("")

 ; ----- BEGIN IHS/MSC/MKK - LR*5.2*1038

 I 'LREND,LRINI'=LRUSI,$$UP^XLFSTR(LRINI)=$$UP^XLFSTR(LRUSI) S LRINI=LRUSI

 I LRINI'=LRUSI S LREND=1

 I LREND W !,$C(7),"No updating occurred ",! Q

 F LRSB=1:0 S LRSB=$O(LRSB(LRSB)) Q:LRSB<1  D

 . K:'$D(^LR(LRDFN,LRSS,LRIDT,LRSB)) LRSA(LRSB)

 . S ^LR(LRDFN,LRSS,LRIDT,LRSB)=LRSB(LRSB)

 . I $D(LRSA(LRSB,1)),$D(LRSA(LRSB,2)) D DIDLE

 W !!

DIDLE ;

 ; Check if no previous result or pending result - no audit trail needed

 I $P(LRSA(LRSB),"^")=""!($P(LRSA(LRSB),"^")="pending") Q

 S LRF=1

 L +^LR(LRDFN,LRSS,LRIDT):999

NOW S LRNOW7=$$NOW^XLFDT

W !

 D ^LRDIDLE0

 I 'LROK K LRSA

 L -^LR(LRDFN,LRSS,LRIDT)

 S LRCORECT=1

RONLT ; (R)esolve (O)rder NLT code from file #68 original ordered test or

 ; use default when not specified for file #60 test.

 N LR60,LRX,LRY,X

 S LR60=+LRTS,LRY=$P(LRSB(LRSB),U,3)

 ; Try to determine order NLT from original ordered test

 F  Q:'LR60  D

 . S LRX=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LR60,0)),LR60=+$P(LRX,"^",9)

 . I LR60,LR60'=$P(LRX,"^") D

 . . S X=$$NLT^LRVER1(LR60)

 . . I X'="" S $P(LRY,"!")=X

 . I LR60=$P(LRX,"^") S LR60=0

 ; Otherwise use default for lab package

 I $P(LRY,"!")="" S $P(LRY,"!")=$P($$DEFCODE^LA7VHLU5(LRSS,LRSB,LRY,+LRSPEC),"!")

 S $P(LRSB(LRSB),U,3)=LRY

LRORU3 ;

SET ;

 N LR64,LR7V,LRDN,LROTA,LRT,LRTPN,LRTPNN,LRTYPE,X

 ; Go through LRSB array and sort results by order NLT code

 ; and put into ordered test array (LROTA).

 S LRDN=0

 F  S LRDN=$O(LRSB(LRDN)) Q:'LRDN  D

 . I $P(LRSB(LRDN),"^")="" Q

 . S LRTPNN=$P($P(LRSB(LRDN),U,3),"!"),LRT=+$G(^TMP("LR",$J,"TMP",LRDN))

 . I LRTPNN="" Q

 . S LRTYPE=$P($G(^LAB(60,LRT,0)),U,3)

 . I LRTYPE=""!("OB"'[LRTYPE) Q

 . S LROTA(LRTPNN,LRDN)=LRT

 . I $D(LRSA(LRDN,2)) S LROTA(LRTPNN,LRDN,1)="C"

 ; For each order NLT code setup call to put results into #62.49 queue

 S LRTPNN=""

 F  S LRTPNN=$O(LROTA(LRTPNN)) Q:LRTPNN=""  D

 . S LR64=+$O(^LAM("C",LRTPNN_" ",0)),LRTPN=$$GET1^DIQ(64,LR64_",",.01)

 . K LR7V

 . M LR7V=LROTA(LRTPNN)

 . D SET^LA7VMSG($P(LRORU3,U,4),$P(LRORU3,U,2),$P(LRORU3,U,5),$P(LRORU3,U,3),LRTPN,LRTPNN,LRIDT,LRSS,LRDFN,LRODT,.LR7V)

 ; ----- BEGIN IHS/MSC/MKK - LR*5.2*1038

GETINITS(PROMPT) ; EP - Get Initials.  Mask User input.

 NEW ANSWER,STEP,TEXT

 W:$L($G(PROMPT)) !,PROMPT

 S ANSWER=""

 ; F STEP=1:1:4  R TEXT#1  S:TEXT="^" ANSWER="^"  Q:TEXT="^"!(TEXT="")  S ANSWER=ANSWER_TEXT  W $C(8),"*"

 F STEP=1:1:6  R TEXT#1  S:TEXT="^" ANSWER="^"  Q:TEXT="^"!(TEXT="")  S ANSWER=ANSWER_TEXT  W $C(8),"*"  ; IHS/MSC/MKK - LR*5.2*1039 - Initials can be 5 characters long

 Q ANSWER

 ; ----- END IHS/MSC/MKK - LR*5.2*1038

LRVER3    ;DALOI/CJS/JAH - DATA VERIFICATION ; 03-Oct-2016 10:28 ; MKK

 +1       ;;5.2;LAB SERVICE;**42,100,121,140,171,1010,153,1018,286,1027,291,1031,406,1033,1038,1039**;NOV 1, 1997;Build 38

 +2       ;

 +3       ; NOTE: LR*5.2*1031 restores LR*5.2*1027 modifications

 +4       ;

EP        ; EP - LR*5.2*1031

 +1        DO V1

 +2        IF $DATA(LRLOCKER)#2

               LOCK -@(LRLOCKER)

               KILL LRLOCKER

 +3        QUIT

 +4       ;

 +5       ;

V1         IF $DATA(LRLOCKER)#2

               LOCK -@(LRLOCKER)

 +1        SET LRLOCKER="^LR("_LRDFN_","""_LRSS_""","_LRIDT_")"

 +2        LOCK +@(LRLOCKER):1

 +3        IF '$TEST

               WRITE !," This entry is being edited by someone else."

               QUIT

 +4        IF $DATA(LRGVP)

               SET X="1-"_LRNTN

               DO RANGE^LRWU2

               GOTO L10

 +5        SET LRALL=""

           SET LRALERT=LROUTINE

           SET LRLCT=6

 +6       ;

 +7       ; List any not performed tests.

 +8        SET I=0

 +9        FOR

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

               IF I<1

                   QUIT

               Begin DoDot:1

 +10               SET LRX=$GET(^LRO(68,LRAA,1,LRAD,1,LRAN,4,I,0))

 +11               IF $PIECE(LRX,"^",6)'="*Not Performed"

                       QUIT

 +12               WRITE !,?3,$PIECE(^LAB(60,I,0),"^"),?25," ",$PIECE(LRX,"^",6)

 +13               SET LRLCT=LRLCT+1

                   IF LRLCT>22

                       DO WT^LRVER4

               End DoDot:1

 +14      ;

 +15      ; No tests to edit

 +16       IF LRNTN=0

               DO COM^LRVR4

               GOTO EXIT

 +17      ;

 +18       FOR I=1:1:LRNTN

               IF $DATA(LRNAME(I))

                   Begin DoDot:1

 +19                   SET LRALL=LRALL_","_I

                       WRITE !,I,"  ",LRNAME(I)

 +20                   IF $DATA(^LRO(68,LRAA,1,LRAD,1,LRAN,4,$ORDER(LRNAME(I,0)),0))#2

                           Begin DoDot:2

 +21                           SET LRX=^LRO(68,LRAA,1,LRAD,1,LRAN,4,$ORDER(LRNAME(I,0)),0)

 +22                           SET LRAL=$PIECE(LRX,U,2)#50

 +23                           IF $PIECE(LRX,U,5)

                                   WRITE ?25,$SELECT($PIECE(LRX,U,6)'="":$PIECE(LRX,U,6),1:" verified")

 +24                           IF LRAL

                                   SET LRALERT=$SELECT(LRAL<LRALERT:LRAL,1:LRALERT)

                           End DoDot:2

 +25                   SET LRLCT=LRLCT+1

                       IF LRLCT>22

                           DO WT^LRVER4

                   End DoDot:1

 +26      ;

 +27       IF $DATA(LRALERT)

               IF LRALERT<($PIECE(LRPARAM,U,20)+1)

                   Begin DoDot:1

 +28                   WRITE !?15

                       IF IOST["C-"

                           WRITE @LRVIDO

 +29                   WRITE "Test ordered "_$PIECE($GET(^LAB(62.05,+LRALERT,0)),U)

 +30                   IF IOST["C-"

                           WRITE @LRVIDOF

                       WRITE !,$CHAR(7)

                   End DoDot:1

 +31      ;

 +32       SET X9=""

           IF LRNTN=1

               SET T1=1

               GOTO L10

V9         SET LRALL=$PIECE(LRALL,",",2,99)

 +1        READ !!,"TEST #(s) (or ""ALL""): ",X:DTIME

           IF '$TEST

               SET X=U

           IF X["A"

               SET X=LRALL

 +2        IF X["?"

               WRITE !,"Enter for example 1,2,5-9."

               GOTO V9

 +3        IF X[U!(X="")

               QUIT

           DO RANGE^LRWU2

           IF X9=""

               GOTO EXIT

           XECUTE (X9_"S:'$D(LRNAME(T1)) X=0")

           IF X=0

               GOTO EXIT

L10       ;

 +1        NEW LRCORECT

           SET LRCORECT=0

 +2        SET LRNX=0

           XECUTE (X9_"D EX1^LRVER1")

 +3        DO V7^LRVER2

 +4        SET LRCMTDSP=$$CHKCDSP^LRVERA

 +5        KILL LRSA,LRSB,LRORU3

 +6        FOR LRSB=1:0

               SET LRSB=$ORDER(^LR(LRDFN,LRSS,LRIDT,LRSB))

               IF LRSB<1

                   QUIT

               Begin DoDot:1

 +7       ; IHS/OIT/MKK LR*5.2*1027 - Skip E-SIG ENTRY

                   IF LRSB=9009027

                       QUIT

 +8       ; IHS/MSC/MKK - LR*5.2*1033 - Skip "empty" node

                   IF $GET(^(LRSB))=""

                       QUIT

 +9                SET LRSB(LRSB)=^(LRSB)

                   SET LRSB(LRSB,"P")=$PIECE(LRSB(LRSB),U,3)

 +10               IF $DATA(LRNOVER)

                       SET LRNOVER(LRSB)=""

               End DoDot:1

 +11       SET LREDIT=1

 +12       DO ^LRVER4

 +13      ;

 +14      ; If group data review then quit before updating results

 +15       IF $DATA(LRGVP)

               GOTO EXIT

 +16      ;

 +17       IF '$ORDER(LRORD(0))

               GOTO EXIT

 +18      ; I '$G(LRCHG),'LRVF F LRSB=1:0 S LRSB=$O(LRSB(LRSB)) Q:LRSB<1  S:LRSB(LRSB)'="" ^LR(LRDFN,LRSS,LRIDT,LRSB)=LRSB(LRSB)

 +19      ;

 +20      ; ----- BEGIN IHS/MSC/MKK - LR*5.2*1039 - Add in LEDI IV update to put Result Date into File 63

 +21       IF '$GET(LRCHG)

               IF 'LRVF

                   Begin DoDot:1

 +22                   NEW LRNOW

                       SET LRNOW=$$NOW^XLFDT

 +23                   FOR LRSB=1:0

                           SET LRSB=$ORDER(LRSB(LRSB))

                           IF LRSB<1

                               QUIT

                           IF $PIECE(LRSB(LRSB),"^")'=""

                               Begin DoDot:2

 +24                               SET $PIECE(LRSB(LRSB),U,6)=LRNOW

 +25                               SET ^LR(LRDFN,LRSS,LRIDT,LRSB)=LRSB(LRSB)

                               End DoDot:2

                   End DoDot:1

 +26      ; ----- END IHS/MSC/MKK - LR*5.2*1039 - Add in LEDI IV update

 +27      ;

 +28       IF $GET(LRCHG)

               DO CHG

               KILL LRCHG,LRUP

               IF $GET(LREND)

                   SET LREND=0

                   GOTO EXIT

 +29      ;

 +30       IF $DATA(LRSA)

               IF $DATA(LRF)

                   KILL LRF

                   SET X=$PIECE(^LR(LRDFN,LRSS,LRIDT,0),U,9)

                   IF $LENGTH(X)&($EXTRACT(X)'["-")

                       SET $PIECE(^(0),U,9)="-"_X

                   GOTO V11

 +31       IF $DATA(LRGVP)

               GOTO EXIT

           IF LRVF&$DATA(LRSA)

               GOTO V11

           IF LRVF&(LRNTN>1)

               GOTO V1

           IF LRVF

               GOTO EXIT

 +32      ;

NOVER      IF $ORDER(LRNOVER(0))

               Begin DoDot:1

 +1                FOR I=0:0

                       SET I=+$ORDER(LRNOVER(I))

                       IF I<2

                           QUIT

                       WRITE !,"Test Not Reviewed: ",$PIECE(^DD(63.04,I,0),U)

                       IF $DATA(LRSB(I))#2

                           WRITE " = "_$PIECE(LRSB(I),U)_" "_$PIECE(LRSB(I),U,2)

 +2                WRITE !,$$CJ^XLFSTR("The above test(s) have results already entered,",80)

 +3                WRITE !,$$CJ^XLFSTR("but you did not select them for review.",80)

 +4                WRITE !,$$CJ^XLFSTR(" Accession NOT approved. ",80),$CHAR(7)

 +5                WRITE !,$$CJ^XLFSTR("You must review all results before ANY can be released.",80),!!

 +6                IF $EXTRACT(IOST,1,2)="C-"

                       WRITE @LRVIDO

                   WRITE $$CJ^XLFSTR("Suggest you select 'ALL' tests for verification/review. ",80)

                   IF $EXTRACT(IOST,1,2)="C-"

                       WRITE @LRVIDOF

                   WRITE !,$CHAR(7)

               End DoDot:1

               GOTO EXIT

 +7        IF $ORDER(LRNOVER(0))

               WRITE !,"Has not been reviewed and has data.  Not approved.",!

               GOTO EXIT

 +8        IF '$PIECE($GET(LRLABKY),U)

               WRITE !,$CHAR(7),"ENTERED BUT NOT APPROVED",!

               GOTO EXIT

 +9        IF '$ORDER(LRSB(0))

               WRITE !?5,"Nothing verified ",$CHAR(7),!

               GOTO EXIT

 +10       NEW CNT

           SET CNT=1

AGAIN     ;

 +1       ; R !,"Approve for release by entering your initials: ",LRINI:DTIME

 +2       ;

 +3       ; ----- BEGIN IHS/MSC/MKK - LR*5.2*1038

 +4        SET LRINI=$$GETINITS("Approve for release by entering your initials: ")

 +5       ; ----- END IHS/MSC/MKK - LR*5.2*1038

 +6       ;

 +7       ; I $E(LRINI)="^" W !!?5,$C(7),"Nothing verified!" D READ G EXIT

 +8       ;

 +9       ;----- BEGIN IHS/OIT/MKK LR*5.2*1027 -- Pause 2 seconds to allow user to see the message

 +10       IF $EXTRACT(LRINI)="^"

               WRITE !!?5,$CHAR(7),"*** Nothing verified! ***"

               WRITE *7,!

               HANG 2

               DO READ

               GOTO EXIT

 +11      ;----- END IHS/OIT/MKK LR*5.2*1027

 +12      ;

 +13       IF LRINI'=LRUSI

               IF $$UP^XLFSTR(LRINI)=$$UP^XLFSTR(LRUSI)

                   SET LRINI=LRUSI

 +14       IF $SELECT($EXTRACT(LRINI)="?":1,LRINI'=LRUSI&(CNT<2):1,1:0)

               WRITE !,$CHAR(7),"Please enter your correct initials"

               IF $EXTRACT(LRINI)="?"

                   SET CNT=0

               SET CNT=CNT+1

               GOTO AGAIN

 +15       IF LRINI'=LRUSI

               WRITE !!?5,$CHAR(7),"Nothing verified!"

               DO READ

               GOTO EXIT

V11       ; START RESPONSE TIME LOGGING

           IF $DATA(XRTL)

               DO T0^%ZOSV

 +1        IF +LRDPF=2&($GET(LRSS)'="BB")&('$$CHKINP^LRBEBA4(LRDFN,LRODT))

               Begin DoDot:1

 +2                DO BAWRK^LRBEBA(LRODT,LRSN,1,.LRBEY,.LRTEST)

               End DoDot:1

 +3        DO VER^LRVER3A

 +4        IF $PIECE(LRPARAM,U,14)

               IF $PIECE($GET(^LRO(68,LRAA,0)),U,16)

                   DO LOOK^LRCAPV1

 +5        NEW LRX

 +6        SET LRX=0

 +7        FOR

               SET LRX=$ORDER(^TMP("LR",$JOB,"TMP",LRX))

               IF LRX<1

                   QUIT

               IF '$DATA(^LRO(68,"AC",LRDFN,LRIDT,LRX))

                   SET ^(LRX)=""

               IF LRVF

                   SET ^(LRX)=""

 +8        IF $PIECE($GET(LRORU3),U,3)

               IF $ORDER(LRSB(0))

                   DO LRORU3

 +9       ; STOP RESPONSE TIME LOGGING

           IF $DATA(XRT0)

               SET XRTN="V11^LRVER3"

               DO T1^%ZOSV

 +10       SET LRVF=1

 +11       QUIT

 +12      ;

 +13      ;

EXIT       QUIT

 +1       ;

 +2       ;

READ      ;

 +1        NEW X

           WRITE !!,"Press ENTER or RETURN to continue: "

           READ X:DTIME

 +2        QUIT

 +3       ;

 +4       ;

CHG       ; Check for changes, save results and create audit trail

 +1        SET LRUP=""

 +2       ; IHS/MSC/MKK - LR*5.2*1039 - LEDI IV

           SET LRNOW=$$NOW^XLFDT

 +3        FOR

               SET LRCHG=$ORDER(LRSB(LRCHG))

               IF LRCHG<1

                   QUIT

               Begin DoDot:1

 +4                IF '$DATA(LRSA(LRCHG))

                       SET LRUP=1

                       QUIT

 +5       ; I $P(LRSA(LRCHG),"^")=""!($P(LRSA(LRCHG),"^")="pending") S LRSA(LRCHG,3)=1,LRUP=1 Q

 +6       ; ----- BEGIN IHS/MSC/MKK - LR*5.2*1039 - LEDI IV - Update release time

 +7                IF $PIECE(LRSA(LRCHG),"^")=""!($PIECE(LRSA(LRCHG),"^")="pending")

                       Begin DoDot:2

 +8                        SET LRSA(LRCHG,3)=1

 +9                        SET LRUP=1

 +10                       SET $PIECE(LRSB(LRCHG),U,6)=LRNOW

                       End DoDot:2

                       QUIT

 +11      ; ----- END IHS/MSC/MKK - LR*5.2*1039

 +12      ; results changed

                   IF $PIECE(LRSA(LRCHG),"^")'=$PIECE(LRSB(LRCHG),"^")

                       SET LRUP=1

                       SET $PIECE(LRSA(LRCHG,2),"^")=1

 +13      ; normalcy flag changed

                   IF $PIECE(LRSA(LRCHG),"^",2)'=$PIECE(LRSB(LRCHG),"^",2)

                       SET LRUP=1

                       SET $PIECE(LRSA(LRCHG,2),"^",2)=1

 +14      ; units/normals changed

                   IF $PIECE(LRSA(LRCHG),"^",5)'=$PIECE(LRSB(LRCHG),"^",5)

                       Begin DoDot:2

 +15                       NEW LRX,LRY

 +16                       SET LRX=$$UP^XLFSTR($PIECE(LRSA(LRCHG),"^",5))

                           SET LRX=$TRANSLATE(LRX,"""")

 +17                       SET LRY=$$UP^XLFSTR($PIECE(LRSB(LRCHG),"^",5))

                           SET LRY=$TRANSLATE(LRY,"""")

 +18                       IF LRX'=LRY

                               SET LRUP=1

                               SET $PIECE(LRSA(LRCHG,2),"^",5)=1

                       End DoDot:2

 +19      ; IHS/MSC/MKK - LR*5.2*1039 - LEDI IV - Update user/release time

                   IF $DATA(LRSA(LRCHG,2))

                       SET $PIECE(LRSB(LRCHG),U,6)=LRNOW

               End DoDot:1

 +20       IF 'LRUP

               SET LREND=1

               QUIT

 +21       SET LREND=0

 +22       WRITE !!

           IF IOST["C-"

               WRITE @LRVIDO

           WRITE "Approve update of data by entering your initials: "

           IF IOST["C-"

               WRITE @LRVIDOF

 +23      ;

 +24      ; ----- BEGIN IHS/MSC/MKK - LR*5.2*1038

 +25       SET LRINI=$$GETINITS("")

 +26      ; ----- BEGIN IHS/MSC/MKK - LR*5.2*1038

 +27      ;

 +28       IF 'LREND

               IF LRINI'=LRUSI

                   IF $$UP^XLFSTR(LRINI)=$$UP^XLFSTR(LRUSI)

                       SET LRINI=LRUSI

 +29       IF LRINI'=LRUSI

               SET LREND=1

 +30       IF LREND

               WRITE !,$CHAR(7),"No updating occurred ",!

               QUIT

 +31      ;

 +32       FOR LRSB=1:0

               SET LRSB=$ORDER(LRSB(LRSB))

               IF LRSB<1

                   QUIT

               Begin DoDot:1

 +33               IF '$DATA(^LR(LRDFN,LRSS,LRIDT,LRSB))

                       KILL LRSA(LRSB)

 +34               SET ^LR(LRDFN,LRSS,LRIDT,LRSB)=LRSB(LRSB)

 +35               IF $DATA(LRSA(LRSB,1))

                       IF $DATA(LRSA(LRSB,2))

                           DO DIDLE

               End DoDot:1

 +36       WRITE !!

 +37       QUIT

 +38      ;

 +39      ;

DIDLE     ;

 +1       ; Check if no previous result or pending result - no audit trail needed

 +2        IF $PIECE(LRSA(LRSB),"^")=""!($PIECE(LRSA(LRSB),"^")="pending")

               QUIT

 +3       ;

 +4        SET LRF=1

 +5        LOCK +^LR(LRDFN,LRSS,LRIDT):999

NOW        SET LRNOW7=$$NOW^XLFDT

 +1        WRITE !

 +2        DO ^LRDIDLE0

 +3        IF 'LROK

               KILL LRSA

 +4        LOCK -^LR(LRDFN,LRSS,LRIDT)

 +5        SET LRCORECT=1

 +6        QUIT

 +7       ;

 +8       ;

RONLT     ; (R)esolve (O)rder NLT code from file #68 original ordered test or

 +1       ; use default when not specified for file #60 test.

 +2       ;

 +3        NEW LR60,LRX,LRY,X

 +4        SET LR60=+LRTS

           SET LRY=$PIECE(LRSB(LRSB),U,3)

 +5       ;

 +6       ; Try to determine order NLT from original ordered test

 +7        FOR

               IF 'LR60

                   QUIT

               Begin DoDot:1

 +8                SET LRX=$GET(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LR60,0))

                   SET LR60=+$PIECE(LRX,"^",9)

 +9                IF LR60

                       IF LR60'=$PIECE(LRX,"^")

                           Begin DoDot:2

 +10                           SET X=$$NLT^LRVER1(LR60)

 +11                           IF X'=""

                                   SET $PIECE(LRY,"!")=X

                           End DoDot:2

 +12               IF LR60=$PIECE(LRX,"^")

                       SET LR60=0

               End DoDot:1

 +13      ;

 +14      ; Otherwise use default for lab package

 +15       IF $PIECE(LRY,"!")=""

               SET $PIECE(LRY,"!")=$PIECE($$DEFCODE^LA7VHLU5(LRSS,LRSB,LRY,+LRSPEC),"!")

 +16      ;

 +17       SET $PIECE(LRSB(LRSB),U,3)=LRY

 +18      ;

 +19       QUIT

 +20      ;

 +21      ;

LRORU3    ;

SET       ;

 +1        NEW LR64,LR7V,LRDN,LROTA,LRT,LRTPN,LRTPNN,LRTYPE,X

 +2       ;

 +3       ; Go through LRSB array and sort results by order NLT code

 +4       ; and put into ordered test array (LROTA).

 +5        SET LRDN=0

 +6        FOR

               SET LRDN=$ORDER(LRSB(LRDN))

               IF 'LRDN

                   QUIT

               Begin DoDot:1

 +7                IF $PIECE(LRSB(LRDN),"^")=""

                       QUIT

 +8                SET LRTPNN=$PIECE($PIECE(LRSB(LRDN),U,3),"!")

                   SET LRT=+$GET(^TMP("LR",$JOB,"TMP",LRDN))

 +9                IF LRTPNN=""

                       QUIT

 +10               SET LRTYPE=$PIECE($GET(^LAB(60,LRT,0)),U,3)

 +11               IF LRTYPE=""!("OB"'[LRTYPE)

                       QUIT

 +12               SET LROTA(LRTPNN,LRDN)=LRT

 +13               IF $DATA(LRSA(LRDN,2))

                       SET LROTA(LRTPNN,LRDN,1)="C"

               End DoDot:1

 +14      ;

 +15      ; For each order NLT code setup call to put results into #62.49 queue

 +16       SET LRTPNN=""

 +17       FOR

               SET LRTPNN=$ORDER(LROTA(LRTPNN))

               IF LRTPNN=""

                   QUIT

               Begin DoDot:1

 +18               SET LR64=+$ORDER(^LAM("C",LRTPNN_" ",0))

                   SET LRTPN=$$GET1^DIQ(64,LR64_",",.01)

 +19               KILL LR7V

 +20               MERGE LR7V=LROTA(LRTPNN)

 +21               DO SET^LA7VMSG($PIECE(LRORU3,U,4),$PIECE(LRORU3,U,2),$PIECE(LRORU3,U,5),$PIECE(LRORU3,U,3),LRTPN,LRTPNN,LRIDT,LRSS,LRDFN,LRODT,.LR7V)

               End DoDot:1

 +22       QUIT

 +23      ;

 +24      ;

 +25      ; ----- BEGIN IHS/MSC/MKK - LR*5.2*1038

GETINITS(PROMPT) ; EP - Get Initials.  Mask User input.

 +1        NEW ANSWER,STEP,TEXT

 +2       ;

 +3        IF $LENGTH($GET(PROMPT))

               WRITE !,PROMPT

 +4        SET ANSWER=""

 +5       ; F STEP=1:1:4  R TEXT#1  S:TEXT="^" ANSWER="^"  Q:TEXT="^"!(TEXT="")  S ANSWER=ANSWER_TEXT  W $C(8),"*"

 +6       ; IHS/MSC/MKK - LR*5.2*1039 - Initials can be 5 characters long

           FOR STEP=1:1:6

               READ TEXT#1

               IF TEXT="^"

                   SET ANSWER="^"

               IF TEXT="^"!(TEXT="")

                   QUIT

               SET ANSWER=ANSWER_TEXT

               WRITE $CHAR(8),"*"

 +7        QUIT ANSWER

 +8       ; ----- END IHS/MSC/MKK - LR*5.2*1038

LRVER3.m