| [613] | 1 | LRVRW ;SLC/CJS-LAB ROUTINE DATA VERIFICATION BY WORKLIST ;6/2/86 9:18 AM
|
|---|
| 2 | ;;5.2;LAB SERVICE;**153,221**;Sep 27, 1994
|
|---|
| 3 | 1 D INIT^LRVR G QUIT:$G(LREND)
|
|---|
| 4 | S LRTRAY=1,LRCUP=0,%H=$H-60 D NEXT D YMD^LRX S LRTM60=9999999-X
|
|---|
| 5 | L10 K LRTEST,C5,LRSET,LRLDT,DIC,LRNM,LRNG,LRDEL,T,LRFP,LRAB,LRVER,Y,Z
|
|---|
| 6 | D WLN G END:$G(LREND) 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
|
|---|
| 7 | D FIND I '$D(LRPRGSQ) D ISEQ
|
|---|
| 8 | 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
|
|---|
| 9 | S X=^LRO(68,LRAA,1,LRAD,1,LRAN,0),LRORU3=$G(^(.3))
|
|---|
| 10 | 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
|
|---|
| 11 | I $G(LREND) S LREND=0 W !?5," Error in Patient Lookup",! D NEXT G L10
|
|---|
| 12 | W !,PNM,?40,SSN
|
|---|
| 13 | D VER^LRVR1 G END:$G(LREND) D NEXT
|
|---|
| 14 | G L10
|
|---|
| 15 | YN R X:DTIME Q:X=""!(X["N")!(X["Y") W !,"Answer 'Y' or 'N': " G YN
|
|---|
| 16 | WLN G WLN2:LRTYPE S LRTRAY=1 W !!!,"SEQUENCE #: ",LRCUP,"//" R X3:DTIME S:X3="" X3=LRCUP S:X3[U LREND=1 Q:LREND
|
|---|
| 17 | I X3["?" W !,"ENTER A VALID SEQUENCE NUMBER" G WLN
|
|---|
| 18 | I '$D(^LRO(68.2,LRLL,1,LRTRAY,1,X3,0)) W !,"SEQUENCE NUMBER DOESN'T EXIST" G WLN
|
|---|
| 19 | S LRCUP=X3 Q
|
|---|
| 20 | 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
|
|---|
| 21 | I X2_X3["?" W !,"ENTER A VALID TRAY, CUP FROM THE LOAD/WORK LIST" G WLN2
|
|---|
| 22 | I '$D(^LRO(68.2,LRLL,1,X2,1,X3,0)) W !,"TRAY, CUP DOESN'T EXIST" G WLN2
|
|---|
| 23 | S LRTRAY=X2,LRCUP=X3 Q
|
|---|
| 24 | Q
|
|---|
| 25 | 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
|
|---|
| 26 | G QUIT
|
|---|
| 27 | NEXT S X2=LRTRAY,X3=LRCUP
|
|---|
| 28 | 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
|
|---|
| 29 | I X3<1&(X2<1) W !,"LAST IN LIST" S (LRTRAY,LRCUP)=U Q
|
|---|
| 30 | S:X2>0 LRTRAY=X2 S:X3>0 LRCUP=X3 Q
|
|---|
| 31 | LIST W " the following tests: " F I=0:0 S I=$O(LRTST(I)) Q:I<1 W !,?10,$P(LRTST(I),"^",1)
|
|---|
| 32 | Q
|
|---|
| 33 | STOP S LREND=1 Q
|
|---|
| 34 | ISEQ ;
|
|---|
| 35 | L +^LAH(LRLL)
|
|---|
| 36 | S (^LAH(LRLL),LRSQ)=1+$G(^LAH(LRLL))
|
|---|
| 37 | S ^LAH(LRLL,1,LRSQ,0)=LRTRAY_U_LRCUP_U_LRAA_U_LRAD_U_LRAN_"^^MANUAL"
|
|---|
| 38 | D UID^LAGEN(LRLL,LRSQ,$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,.3)),"^"))
|
|---|
| 39 | D UPDT^LAGEN(LRLL,LRSQ)
|
|---|
| 40 | S ^LAH(LRLL,1,"B",(+LRTRAY)_";"_(+LRCUP),LRSQ)=""
|
|---|
| 41 | S ^LAH(LRLL,1,"C",LRAN,LRSQ)=""
|
|---|
| 42 | L -^LAH(LRLL)
|
|---|
| 43 | S ^LRO(68.2,LRLL,1,LRTRAY,1,LRCUP,4,LRSQ)=""
|
|---|
| 44 | Q
|
|---|
| 45 | FIND K LRPRGSQ S N=0,LRTRCP=LRTRAY_";"_LRCUP F I=0:0 S I=$O(^LAH(LRLL,1,"B",LRTRCP,I)) Q:I="" S N=N+1,LRSQ=I,LRPRGSQ(I)="" W !,?5,I
|
|---|
| 46 | F I=0:0 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,LRPRGSQ(I)=""
|
|---|
| 47 | T3 S X=N I N=0 W !,"No data for that tray & cup" Q
|
|---|
| 48 | I N>1 R !,"Choose sequence number: ",X:DTIME Q:'$T I X["?"!(X'?.N) W !,"Enter a number" G T3
|
|---|
| 49 | I X["^"!(X="") K LRPRGSQ Q
|
|---|
| 50 | S:N'=1 LRSQ=X I '$D(^LAH(LRLL,1,LRSQ,0)) K LRPRGSQ(LRSQ) W !,"No data there"
|
|---|
| 51 | Q
|
|---|
| 52 | QUIT I $D(LRCSQ),'$O(^XTMP("LRCAP",LRCSQ,DUZ,0)) K ^XTMP("LRCAP",LRCSQ,DUZ)
|
|---|
| 53 | E I $D(LRAA) D:$P(LRPARAM,U,14)&($P($G(^LRO(68,+LRAA,0)),U,16)) STD^LRCAPV
|
|---|
| 54 | K LRORU3 D ^LRGVK,^LRCAPV2
|
|---|
| 55 | Q
|
|---|
