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
Q
;
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
Q
;
;
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
Q
;
;
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
Q
;
;
LIST W " the following tests: " S I=0 F S I=$O(LRTST(I)) Q:I<1 W !,?10,$P(LRTST(I),"^",1)
Q
;
;
STOP ;
S LREND=1
Q
;
;
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)=""
Q
;
;
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"
Q
;
;
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
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRVRW 3339 printed Dec 13, 2024@02:22:58 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
