LRMIV1 ;SLC/DLG - LAB ROUTINE DATA VERIFICATION ;2/25/03 22:44
;;5.2;LAB SERVICE;**295**;Sep 27, 1994
PAT S X=LRAN F I=0:0 R:'$D(LRAN) !!,"Accession #: ",X:DTIME Q:X=""!(X[U) S LRANOK=1,LRCAPOK=1 D LRANX^LRMIU4 D:LRANOK PAT1 D:LRCAPOK&(LRANOK)&($P(LRPARAM,U,14)) LOOK^LRCAPV1 K:LRANOK LRAN I 'LRANOK W !,"Enter the accession number" K LRAN
Q
PAT1 ;
K LRPRGSQ S N=0,I=0 F S I=$O(^LAH(LRLL,1,"C",LRAN,I)) Q:I<1 S N=N+1,LRSQ=I,LRPRGSQ(I)="" W !,?5,I
G T4:N=1,T3 Q
T1 R !,"What tray: ",X:DTIME Q:X["^"!'$T I X["?"!(X'?.N) W !,"Enter a number" G T1
I X'="" S LRTRAY=X G T2
I $D(^LRO(68.2,"AS",LRLL)) W !,"Can't MANUALLY add to a SEQUENCE instrument data file." Q
W !,"Enter manually" S %=1 D YN^DICN Q:%<1 G T1:%=2 S LRSQ=-1 G T3
G T3
T2 R !,"What cup: ",X:DTIME Q:X["^"!'$T I X["?"!(X'?.N) W !,"Enter a number" G T2
Q:X="" S LRTRCP=LRTRAY_";"_X
K LRPRGSQ S N=0,I=0 F S I=$O(^LAH(LRLL,1,"B",LRTRCP,I)) Q:I<1 S N=N+1,LRSQ=I,LRPRGSQ(I)="" W !,?5,I
T3 I N=0 W !,"No data for that accession." 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)) W !,"No data there" G T3
T4 Q:LRSQ'>0 K LRPRGSQ(LRSQ)
S LRDFN=+^LRO(68,LRAA,1,LRAD,1,LRAN,0),LRIDT=9999999-^(3),LRCDT=+^(3),LREAL=$P(^(3),U,2),LRI=+$O(^(5,0)),LRSPEC=$S($D(^(LRI,0)):+^(0),1:"")
I $D(^LR(LRDFN,"MI",LRIDT,0)) S Y(0)=^(0)
I '$D(^LR(LRDFN,"MI",LRIDT,3,0)) D:'$D(^LR(LRDFN,"MI",LRIDT,0)) BB^LRMIV2 S ^LR(LRDFN,"MI",LRIDT,3,0)="^63.3PA^^"
S LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3),LRUNDO=0 D PT^LRX W ?25," ",PNM,?47," ",SSN
T5 S %=2 I $D(^LR(LRDFN,"MI",LRIDT,1)),+^(1) W !,"The Bact data has been approved, ADDING Data MAY change previous reported",!,"values. Are you sure you want to do this " D YN^DICN I %=2 W !,"DATA NOT LOADED.",! K % Q
I %<1 W !,"Enter YES to reload data. NO to not reload data." K % G T5
K % I $P(^LR(LRDFN,"MI",LRIDT,0),U,3)!$P(^LR(LRDFN,"MI",LRIDT,0),U,9) S LRUNDO=1 ;W:$P(^(0),U,9) !,"(This is an AMENDED report)",!
K LRORG S LRORG=0 F I1=0:0 S I1=$O(^LR(LRDFN,"MI",LRIDT,3,I1)) Q:I1'>0 S LRORG(+^(I1,0))=I1,LRORG=I1
F I1=0:0 S I1=$O(^LAH(LRLL,1,LRSQ,3,I1)) Q:I1'>0 S X=+^(I1,0),I2=$S($D(LRORG(X)):LRORG(X),1:0) D MOVE
S X=^LAH(LRLL,1,LRSQ,0) K ^LAH(LRLL,1,LRSQ),^LAH(LRLL,1,"B",($P(X,U,1)_";"_$P(X,U,2)),LRSQ),^LAH(LRLL,1,"C",+$P(X,U,5),LRSQ)
W !!,"Data moved over" S LRHC=1
T51 D BRMK^LRMIPSZ2 S DIE="^LR(LRDFN,""MI"",LRIDT,",DA(1)=LRDFN,DA=LRIDT,DR=5,DR(1,63)=5,DR(2,63.05)="11;11.5;11.6;12;13;",DR(3,63.29)=".01;",DR(3,63.3)=".01;1;",DR(3,63.33)=".01;" D ^DIE
S LREND=0 D BACT^LRMIV4
T6 R !,"ENTER 'E' TO EDIT OR INITIALS TO VERIFY: ",X:DTIME
I X="E" D PAT1^LRMIV2 K LRPRGSQ W !,"DATA APPROVED BUT NOT VERIFIED",! D UPDATE^LRPXRM(LRDFN,"MI",LRIDT) G T51
I $L(X)>1,$O(^VA(200,"C",X,0))=DUZ S $P(^LR(LRDFN,"MI",LRIDT,0),U,3)=DT,^(1)=DT_"^F^"_DUZ W !,"DATA APPROVED AND VERIFIED",! D UPDATE^LRPXRM(LRDFN,"MI",LRIDT) Q
I X=""!X="^" W "DATA NOT APPROVED OR VERIFIED. " Q
I $L(X)>1,$O(^VA(200,"C",X,0))'=DUZ W "INITIALS DO NOT MATCH." G T6
Q
WAIT W !,"Type ""^"" to skip "
WAIT1 R X:10 G LRMIV1:X[U,WAIT1:$O(^LAH(LRLL,1,"C",LRAN,0))<1 G LRMIV1
Q
MOVE ;Move data into ^LR(LRDFN,"MI",LRIDT,3,
I I2'>0 S X=^LAH(LRLL,1,LRSQ,3,I1,0),DIC="^LR(LRDFN,""MI"",LRIDT,3,",DIC(0)="AMQ",DA(1)=LRIDT,DA(2)=LRDFN D FILE^DICN S I2=+Y K DIC
S %X="^LAH(LRLL,1,LRSQ,3,I1,",%Y="^LR(LRDFN,""MI"",LRIDT,3,I2," D %XY^%RCR
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRMIV1 3480 printed Oct 16, 2024@18:18:28 Page 2
LRMIV1 ;SLC/DLG - LAB ROUTINE DATA VERIFICATION ;2/25/03 22:44
+1 ;;5.2;LAB SERVICE;**295**;Sep 27, 1994
PAT SET X=LRAN
FOR I=0:0
if '$DATA(LRAN)
READ !!,"Accession #: ",X:DTIME
if X=""!(X[U)
QUIT
SET LRANOK=1
SET LRCAPOK=1
DO LRANX^LRMIU4
if LRANOK
DO PAT1
if LRCAPOK&(LRANOK)&($PIECE(LRPARAM,U,14))
DO LOOK^LRCAPV1
if LRANOK
KILL LRAN
IF 'LRANOK
WRITE !,"Enter the accession number"
KILL LRAN
+1 QUIT
PAT1 ;
+1 KILL LRPRGSQ
SET N=0
SET I=0
FOR
SET I=$ORDER(^LAH(LRLL,1,"C",LRAN,I))
if I<1
QUIT
SET N=N+1
SET LRSQ=I
SET LRPRGSQ(I)=""
WRITE !,?5,I
+2 if N=1
GOTO T4
GOTO T3
QUIT
T1 READ !,"What tray: ",X:DTIME
if X["^"!'$TEST
QUIT
IF X["?"!(X'?.N)
WRITE !,"Enter a number"
GOTO T1
+1 IF X'=""
SET LRTRAY=X
GOTO T2
+2 IF $DATA(^LRO(68.2,"AS",LRLL))
WRITE !,"Can't MANUALLY add to a SEQUENCE instrument data file."
QUIT
+3 WRITE !,"Enter manually"
SET %=1
DO YN^DICN
if %<1
QUIT
if %=2
GOTO T1
SET LRSQ=-1
GOTO T3
+4 GOTO T3
T2 READ !,"What cup: ",X:DTIME
if X["^"!'$TEST
QUIT
IF X["?"!(X'?.N)
WRITE !,"Enter a number"
GOTO T2
+1 if X=""
QUIT
SET LRTRCP=LRTRAY_";"_X
+2 KILL LRPRGSQ
SET N=0
SET I=0
FOR
SET I=$ORDER(^LAH(LRLL,1,"B",LRTRCP,I))
if I<1
QUIT
SET N=N+1
SET LRSQ=I
SET LRPRGSQ(I)=""
WRITE !,?5,I
T3 IF N=0
WRITE !,"No data for that accession."
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))
WRITE !,"No data there"
GOTO T3
T4 if LRSQ'>0
QUIT
KILL LRPRGSQ(LRSQ)
+1 SET LRDFN=+^LRO(68,LRAA,1,LRAD,1,LRAN,0)
SET LRIDT=9999999-^(3)
SET LRCDT=+^(3)
SET LREAL=$PIECE(^(3),U,2)
SET LRI=+$ORDER(^(5,0))
SET LRSPEC=$SELECT($DATA(^(LRI,0)):+^(0),1:"")
+2 IF $DATA(^LR(LRDFN,"MI",LRIDT,0))
SET Y(0)=^(0)
+3 IF '$DATA(^LR(LRDFN,"MI",LRIDT,3,0))
if '$DATA(^LR(LRDFN,"MI",LRIDT,0))
DO BB^LRMIV2
SET ^LR(LRDFN,"MI",LRIDT,3,0)="^63.3PA^^"
+4 SET LRDPF=$PIECE(^LR(LRDFN,0),U,2)
SET DFN=$PIECE(^(0),U,3)
SET LRUNDO=0
DO PT^LRX
WRITE ?25," ",PNM,?47," ",SSN
T5 SET %=2
IF $DATA(^LR(LRDFN,"MI",LRIDT,1))
IF +^(1)
WRITE !,"The Bact data has been approved, ADDING Data MAY change previous reported",!,"values. Are you sure you want to do this "
DO YN^DICN
IF %=2
WRITE !,"DATA NOT LOADED.",!
KILL %
QUIT
+1 IF %<1
WRITE !,"Enter YES to reload data. NO to not reload data."
KILL %
GOTO T5
+2 ;W:$P(^(0),U,9) !,"(This is an AMENDED report)",!
KILL %
IF $PIECE(^LR(LRDFN,"MI",LRIDT,0),U,3)!$PIECE(^LR(LRDFN,"MI",LRIDT,0),U,9)
SET LRUNDO=1
+3 KILL LRORG
SET LRORG=0
FOR I1=0:0
SET I1=$ORDER(^LR(LRDFN,"MI",LRIDT,3,I1))
if I1'>0
QUIT
SET LRORG(+^(I1,0))=I1
SET LRORG=I1
+4 FOR I1=0:0
SET I1=$ORDER(^LAH(LRLL,1,LRSQ,3,I1))
if I1'>0
QUIT
SET X=+^(I1,0)
SET I2=$SELECT($DATA(LRORG(X)):LRORG(X),1:0)
DO MOVE
+5 SET X=^LAH(LRLL,1,LRSQ,0)
KILL ^LAH(LRLL,1,LRSQ),^LAH(LRLL,1,"B",($PIECE(X,U,1)_";"_$PIECE(X,U,2)),LRSQ),^LAH(LRLL,1,"C",+$PIECE(X,U,5),LRSQ)
+6 WRITE !!,"Data moved over"
SET LRHC=1
T51 DO BRMK^LRMIPSZ2
SET DIE="^LR(LRDFN,""MI"",LRIDT,"
SET DA(1)=LRDFN
SET DA=LRIDT
SET DR=5
SET DR(1,63)=5
SET DR(2,63.05)="11;11.5;11.6;12;13;"
SET DR(3,63.29)=".01;"
SET DR(3,63.3)=".01;1;"
SET DR(3,63.33)=".01;"
DO ^DIE
+1 SET LREND=0
DO BACT^LRMIV4
T6 READ !,"ENTER 'E' TO EDIT OR INITIALS TO VERIFY: ",X:DTIME
+1 IF X="E"
DO PAT1^LRMIV2
KILL LRPRGSQ
WRITE !,"DATA APPROVED BUT NOT VERIFIED",!
DO UPDATE^LRPXRM(LRDFN,"MI",LRIDT)
GOTO T51
+2 IF $LENGTH(X)>1
IF $ORDER(^VA(200,"C",X,0))=DUZ
SET $PIECE(^LR(LRDFN,"MI",LRIDT,0),U,3)=DT
SET ^(1)=DT_"^F^"_DUZ
WRITE !,"DATA APPROVED AND VERIFIED",!
DO UPDATE^LRPXRM(LRDFN,"MI",LRIDT)
QUIT
+3 IF X=""!X="^"
WRITE "DATA NOT APPROVED OR VERIFIED. "
QUIT
+4 IF $LENGTH(X)>1
IF $ORDER(^VA(200,"C",X,0))'=DUZ
WRITE "INITIALS DO NOT MATCH."
GOTO T6
+5 QUIT
WAIT WRITE !,"Type ""^"" to skip "
WAIT1 READ X:10
if X[U
GOTO LRMIV1
if $ORDER(^LAH(LRLL,1,"C",LRAN,0))<1
GOTO WAIT1
GOTO LRMIV1
+1 QUIT
MOVE ;Move data into ^LR(LRDFN,"MI",LRIDT,3,
+1 IF I2'>0
SET X=^LAH(LRLL,1,LRSQ,3,I1,0)
SET DIC="^LR(LRDFN,""MI"",LRIDT,3,"
SET DIC(0)="AMQ"
SET DA(1)=LRIDT
SET DA(2)=LRDFN
DO FILE^DICN
SET I2=+Y
KILL DIC
+2 SET %X="^LAH(LRLL,1,LRSQ,3,I1,"
SET %Y="^LR(LRDFN,""MI"",LRIDT,3,I2,"
DO %XY^%RCR
