Routine: LRVRW

LRVRW ;DALOI/STAFF - LAB ROUTINE DATA VERIFICATION BY WORKLIST ;06/24/10  16:53

 ;;5.2;LAB SERVICE;**153,221,350**;Sep 27, 1994;Build 230

1 D INIT^LRVR

 N LRBETST,LRBEY

 I $G(LREND) D QUIT Q

 S LRTRAY=1,LRCUP=0

 D NEXT

L10 ;

 K LRTEST,C5,LRSET,LRLDT,DIC,LRNM,LRNG,LRDEL,T,LRFP,LRAB,LRVER,Y,Z

 D WLN

 I $G(LREND) D END Q

 S X=^LRO(68.2,LRLL,1,LRTRAY,1,LRCUP,0),LRAA=+X,LRAD=$P(X,U,2),LRAN=$P(X,U,3)

 I '$D(^LRO(68,LRAA,1,LRAD,1,LRAN,0)) W "  ACCESSION MISSING" G L10

 D FIND I '$D(LRPRGSQ) D ISEQ

 I $D(^LAH(LRLL,1,LRSQ,0)),$P(^(0),U,3),($P(^(0),U,5)'=LRAN) W !!,"Can't use.  Entry has data from accession # ",$P(^(0),U,5),!,"Suggest you Clear instrument/worklist data." D NEXT G L10

 S X=^LRO(68,LRAA,1,LRAD,1,LRAN,0),LRORU3=$G(^(.3))

 S LRODT=$P(X,U,4),LRSN=$P(X,U,5),LRDFN=+X,LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3) D PT^LRX

 I $G(LREND) S LREND=0 W !?5," Error in Patient Lookup",! D NEXT G L10

 W !,PNM,?40,SSN

 D VER^LRVR1 G END:$G(LREND) D NEXT

 G L10

YN R X:DTIME Q:X=""!(X["N")!(X["Y")  W !,"Answer 'Y' or 'N': " G YN

WLN ;

 G WLN2:LRTYPE

 S LRTRAY=1 W !!!,"SEQUENCE #: ",LRCUP,"//" R X3:DTIME S:X3="" X3=LRCUP S:X3[U LREND=1 Q:LREND

 I X3["?" W !,"ENTER A VALID SEQUENCE NUMBER" G WLN

 I '$D(^LRO(68.2,LRLL,1,LRTRAY,1,X3,0)) W !,"SEQUENCE NUMBER DOESN'T EXIST" G WLN

 S LRCUP=X3

WLN2 ;

 W !!!,"TRAY: ",LRTRAY,"//" R X2:DTIME S:X2="" X2=LRTRAY S:X2[U LREND=1 Q:LREND

 W "  CUP: ",LRCUP,"//" R X3:DTIME S:X3="" X3=LRCUP S:X3[U LREND=1 Q:LREND

 I X2_X3["?" W !,"ENTER A VALID TRAY, CUP FROM THE LOAD/WORK LIST" G WLN2

 I '$D(^LRO(68.2,LRLL,1,X2,1,X3,0)) W !,"TRAY, CUP DOESN'T EXIST" G WLN2

 S LRTRAY=X2,LRCUP=X3

END ;

 I $D(LRAN),$D(LRAD) S:'$D(^LRO(68,LRAA,1,LRAD,2)) ^(2)="^^" S ^(2)=$P(^(2),U,1,3)_U_LRAN_U_$P(^(2),U,5,99),LREND=1

 D QUIT

NEXT S X2=LRTRAY,X3=LRCUP

NX2 S X3=$O(^LRO(68.2,LRLL,1,X2,1,X3)) I X3<1 S X3=0,X2=$O(^LRO(68.2,LRLL,1,X2)) G:X2>0 NX2

 I X3<1&(X2<1) W !,"LAST IN LIST" S (LRTRAY,LRCUP)=U Q

 S:X2>0 LRTRAY=X2 S:X3>0 LRCUP=X3

LIST W " the following tests: " S I=0 F  S I=$O(LRTST(I)) Q:I<1  W !,?10,$P(LRTST(I),"^",1)

STOP ;

 S LREND=1

ISEQ ;

 L +^LAH(LRLL):99

 S (^LAH(LRLL),LRSQ)=1+$G(^LAH(LRLL))

 S ^LAH(LRLL,1,LRSQ,0)=LRTRAY_U_LRCUP_U_LRAA_U_LRAD_U_LRAN_"^^MANUAL"

 D UID^LAGEN(LRLL,LRSQ,$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,.3)),"^"))

 D UPDT^LAGEN(LRLL,LRSQ)

 S ^LAH(LRLL,1,"B",(+LRTRAY)_";"_(+LRCUP),LRSQ)=""

 S ^LAH(LRLL,1,"C",LRAN,LRSQ)=""

 L -^LAH(LRLL)

 S ^LRO(68.2,LRLL,1,LRTRAY,1,LRCUP,4,LRSQ)=""

FIND ;

 K LRPRGSQ

 S N=0,LRTRCP=LRTRAY_";"_LRCUP,I=0

 F  S I=$O(^LAH(LRLL,1,"B",LRTRCP,I)) Q:I=""  S N=N+1,LRSQ=I,LRPRGSQ(I)="" W !,?5,I

 S I=0

 F  S I=$O(^LRO(68.2,LRLL,1,LRTRAY,1,LRCUP,4,I)) Q:I=""  I $D(^LAH(LRLL,1,I,0)),'$D(LRPRGSQ(I)) S N=N+1,LRSQ=I,LRPRGSQ(I)=""

T3 S X=N I N=0 W !,"No data for that tray & cup" Q

 I N>1 R !,"Choose sequence number: ",X:DTIME Q:'$T  I X["?"!(X'?.N) W !,"Enter a number" G T3

 I X["^"!(X="") K LRPRGSQ Q

 S:N'=1 LRSQ=X I '$D(^LAH(LRLL,1,LRSQ,0)) K LRPRGSQ(LRSQ) W !,"No data there"

QUIT ;

 I $D(LRCSQ),'$O(^XTMP("LRCAP",LRCSQ,DUZ,0)) K ^XTMP("LRCAP",LRCSQ,DUZ)

 E  I $D(LRAA) D:$P(LRPARAM,U,14)&($P($G(^LRO(68,+LRAA,0)),U,16)) STD^LRCAPV

 K LRORU3

 D ^LRGVK,^LRCAPV2

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRVRW   3339     printed  Mar 13, 2025@21:27:27                                                                                                                                                                                                       Page 2

LRVRW     ;DALOI/STAFF - LAB ROUTINE DATA VERIFICATION BY WORKLIST ;06/24/10  16:53

 +1       ;;5.2;LAB SERVICE;**153,221,350**;Sep 27, 1994;Build 230

 +2       ;

 +3       ;

1          DO INIT^LRVR

 +1        NEW LRBETST,LRBEY

 +2        IF $GET(LREND)

               DO QUIT

               QUIT

 +3        SET LRTRAY=1

           SET LRCUP=0

 +4        DO NEXT

 +5       ;

L10       ;

 +1        KILL LRTEST,C5,LRSET,LRLDT,DIC,LRNM,LRNG,LRDEL,T,LRFP,LRAB,LRVER,Y,Z

 +2        DO WLN

 +3        IF $GET(LREND)

               DO END

               QUIT

 +4        SET X=^LRO(68.2,LRLL,1,LRTRAY,1,LRCUP,0)

           SET LRAA=+X

           SET LRAD=$PIECE(X,U,2)

           SET LRAN=$PIECE(X,U,3)

 +5        IF '$DATA(^LRO(68,LRAA,1,LRAD,1,LRAN,0))

               WRITE "  ACCESSION MISSING"

               GOTO L10

 +6        DO FIND

           IF '$DATA(LRPRGSQ)

               DO ISEQ

 +7        IF $DATA(^LAH(LRLL,1,LRSQ,0))

               IF $PIECE(^(0),U,3)

                   IF ($PIECE(^(0),U,5)'=LRAN)

                       WRITE !!,"Can't use.  Entry has data from accession # ",$PIECE(^(0),U,5),!,"Suggest you Clear instrument/worklist data."

                       DO NEXT

                       GOTO L10

 +8        SET X=^LRO(68,LRAA,1,LRAD,1,LRAN,0)

           SET LRORU3=$GET(^(.3))

 +9        SET LRODT=$PIECE(X,U,4)

           SET LRSN=$PIECE(X,U,5)

           SET LRDFN=+X

           SET LRDPF=$PIECE(^LR(LRDFN,0),U,2)

           SET DFN=$PIECE(^(0),U,3)

           DO PT^LRX

 +10       IF $GET(LREND)

               SET LREND=0

               WRITE !?5," Error in Patient Lookup",!

               DO NEXT

               GOTO L10

 +11       WRITE !,PNM,?40,SSN

 +12       DO VER^LRVR1

           if $GET(LREND)

               GOTO END

           DO NEXT

 +13       GOTO L10

 +14      ;

 +15      ;

YN         READ X:DTIME

           if X=""!(X["N")!(X["Y")

               QUIT

           WRITE !,"Answer 'Y' or 'N': "

           GOTO YN

 +1       ;

 +2       ;

WLN       ;

 +1        if LRTYPE

               GOTO WLN2

 +2        SET LRTRAY=1

           WRITE !!!,"SEQUENCE #: ",LRCUP,"//"

           READ X3:DTIME

           if X3=""

               SET X3=LRCUP

           if X3[U

               SET LREND=1

           if LREND

               QUIT

 +3        IF X3["?"

               WRITE !,"ENTER A VALID SEQUENCE NUMBER"

               GOTO WLN

 +4        IF '$DATA(^LRO(68.2,LRLL,1,LRTRAY,1,X3,0))

               WRITE !,"SEQUENCE NUMBER DOESN'T EXIST"

               GOTO WLN

 +5        SET LRCUP=X3

 +6        QUIT

 +7       ;

WLN2      ;

 +1        WRITE !!!,"TRAY: ",LRTRAY,"//"

           READ X2:DTIME

           if X2=""

               SET X2=LRTRAY

           if X2[U

               SET LREND=1

           if LREND

               QUIT

 +2        WRITE "  CUP: ",LRCUP,"//"

           READ X3:DTIME

           if X3=""

               SET X3=LRCUP

           if X3[U

               SET LREND=1

           if LREND

               QUIT

 +3        IF X2_X3["?"

               WRITE !,"ENTER A VALID TRAY, CUP FROM THE LOAD/WORK LIST"

               GOTO WLN2

 +4        IF '$DATA(^LRO(68.2,LRLL,1,X2,1,X3,0))

               WRITE !,"TRAY, CUP DOESN'T EXIST"

               GOTO WLN2

 +5        SET LRTRAY=X2

           SET LRCUP=X3

 +6        QUIT

 +7       ;

 +8       ;

END       ;

 +1        IF $DATA(LRAN)

               IF $DATA(LRAD)

                   if '$DATA(^LRO(68,LRAA,1,LRAD,2))

                       SET ^(2)="^^"

                   SET ^(2)=$PIECE(^(2),U,1,3)_U_LRAN_U_$PIECE(^(2),U,5,99)

                   SET LREND=1

 +2        DO QUIT

 +3        QUIT

 +4       ;

 +5       ;

NEXT       SET X2=LRTRAY

           SET X3=LRCUP

NX2        SET X3=$ORDER(^LRO(68.2,LRLL,1,X2,1,X3))

           IF X3<1

               SET X3=0

               SET X2=$ORDER(^LRO(68.2,LRLL,1,X2))

               if X2>0

                   GOTO NX2

 +1        IF X3<1&(X2<1)

               WRITE !,"LAST IN LIST"

               SET (LRTRAY,LRCUP)=U

               QUIT

 +2        if X2>0

               SET LRTRAY=X2

           if X3>0

               SET LRCUP=X3

 +3        QUIT

 +4       ;

 +5       ;

LIST       WRITE " the following tests: "

           SET I=0

FOR

               SET I=$ORDER(LRTST(I))

               if I<1

                   QUIT

               WRITE !,?10,$PIECE(LRTST(I),"^",1)

 +1        QUIT

 +2       ;

 +3       ;

STOP      ;

 +1        SET LREND=1

 +2        QUIT

 +3       ;

 +4       ;

ISEQ      ;

 +1        LOCK +^LAH(LRLL):99

 +2        SET (^LAH(LRLL),LRSQ)=1+$GET(^LAH(LRLL))

 +3        SET ^LAH(LRLL,1,LRSQ,0)=LRTRAY_U_LRCUP_U_LRAA_U_LRAD_U_LRAN_"^^MANUAL"

 +4        DO UID^LAGEN(LRLL,LRSQ,$PIECE($GET(^LRO(68,LRAA,1,LRAD,1,LRAN,.3)),"^"))

 +5        DO UPDT^LAGEN(LRLL,LRSQ)

 +6        SET ^LAH(LRLL,1,"B",(+LRTRAY)_";"_(+LRCUP),LRSQ)=""

 +7        SET ^LAH(LRLL,1,"C",LRAN,LRSQ)=""

 +8        LOCK -^LAH(LRLL)

 +9        SET ^LRO(68.2,LRLL,1,LRTRAY,1,LRCUP,4,LRSQ)=""

 +10       QUIT

 +11      ;

 +12      ;

FIND      ;

 +1        KILL LRPRGSQ

 +2        SET N=0

           SET LRTRCP=LRTRAY_";"_LRCUP

           SET I=0

 +3        FOR

               SET I=$ORDER(^LAH(LRLL,1,"B",LRTRCP,I))

               if I=""

                   QUIT

               SET N=N+1

               SET LRSQ=I

               SET LRPRGSQ(I)=""

               WRITE !,?5,I

 +4        SET I=0

 +5        FOR

               SET I=$ORDER(^LRO(68.2,LRLL,1,LRTRAY,1,LRCUP,4,I))

               if I=""

                   QUIT

               IF $DATA(^LAH(LRLL,1,I,0))

                   IF '$DATA(LRPRGSQ(I))

                       SET N=N+1

                       SET LRSQ=I

                       SET LRPRGSQ(I)=""

T3         SET X=N

           IF N=0

               WRITE !,"No data for that tray & cup"

               QUIT

 +1        IF N>1

               READ !,"Choose sequence number: ",X:DTIME

               if '$TEST

                   QUIT

               IF X["?"!(X'?.N)

                   WRITE !,"Enter a number"

                   GOTO T3

 +2        IF X["^"!(X="")

               KILL LRPRGSQ

               QUIT

 +3        if N'=1

               SET LRSQ=X

           IF '$DATA(^LAH(LRLL,1,LRSQ,0))

               KILL LRPRGSQ(LRSQ)

               WRITE !,"No data there"

 +4        QUIT

 +5       ;

 +6       ;

QUIT      ;

 +1        IF $DATA(LRCSQ)

               IF '$ORDER(^XTMP("LRCAP",LRCSQ,DUZ,0))

                   KILL ^XTMP("LRCAP",LRCSQ,DUZ)

 +2       IF '$TEST

               IF $DATA(LRAA)

                   if $PIECE(LRPARAM,U,14)&($PIECE($GET(^LRO(68,+LRAA,0)),U,16))

                       DO STD^LRCAPV

 +3        KILL LRORU3

 +4        DO ^LRGVK

           DO ^LRCAPV2

 +5        QUIT

LRVRW.m