LRVER2 ;SLC/CJS - LAB ROUTINE DATA VERIFICATION ;2/7/91 11:36 ;
;;5.2;LAB SERVICE;**153,201**;Sep 27, 1994
S LRSPEC="",X=DUZ D DUZ^LRX S:'$D(LREAL) LREAL=1
V3 G:$D(^LR(LRDFN,LRSS,LRIDT,0)) V5 G:"AP EM"[LRSS V4
V3A IF LRSAMP'="" S LRSPEC=$P(^LAB(62,LRSAMP,0),U,2) G:$D(^LAB(61,+LRSPEC,0)) V4
I LRDPF'=62.3 Q:$D(LRGVP) S DIC="^LAB(61,",DIC(0)="AEOQ" D ^DIC S LRSPEC=+Y IF LRSPEC=-1 W !,"The specimen MUST be defined." Q
V4 I '$D(^LR(LRDFN,LRSS,0)) S ^LR(LRDFN,LRSS,0)=U_$P(^DD(63,$O(^DD(63,"GL",LRSS,0,0)),0),U,2)_U
L +^LR(LRDFN,LRSS) S ^LR(LRDFN,LRSS,0)=$P(^LR(LRDFN,LRSS,0),U,1,2)_U_LRIDT_U_(1+$P(^(0),U,4))
IF "AP EM"[LRSS S ^LR(LRDFN,LRSS,LRIDT,0)=LRCDT_U_LREAL L -^LR(LRDFN,LRSS) G V5
S LRVOL="" S:$D(^LRO(69,LRODT,1,LRSN,1)) LRVOL=$P(^(1),U,5) S ^LR(LRDFN,LRSS,LRIDT,0)=LRCDT_U_LREAL_U_U_U_LRSPEC_U_LRAN_U_LRVOL_U_LRMETH_U L -^LR(LRDFN,LRSS)
V5 I LRDPF=62.3 S LRSPEC=$S($D(^LR(LRDFN,LRSS,LRIDT,0)):$P(^(0),U,5),1:"")
S LRLDT=LRIDT,LRVF=0 G V6:'$L($P(^LR(LRDFN,LRSS,LRIDT,0),U,3)) S LRVF=1,X=$P(^(0),U,4),T=$P(^(0),U,3)
W:'X&(LRDPF=62.3) !,"This control has been automatically verified" W:'X&(LRDPF'=62.3) !,"Verified"
I X W !,"These results have been approved by ",$S($D(^VA(200,X,0)):$P(^(0),"^",1),1:"Unknown"),!," on ",$$FMTE^XLFDT(T)
V6 I LRDPF'=62.3 S LRSPEC=$P(^LR(LRDFN,LRSS,LRIDT,0),U,5) G:'+LRSPEC V3A
W:$D(^LAB(61,+LRSPEC,0)) !,"Specimen: ",$P(^(0),U)
K LRNOVER I LRSS="CH",'LRVF S LRNOVER=""
K ^TMP("LR",$J,"VTO") S LRCFL="" D ^LRVER3
K LRSA,LRSB,LRNOVER,LRACC,LRCAPWA,Y,Z,Z1,Z2,K1,LRURG
K DA,DIC,DIE,LRNG,LRNG2,LRNG3,LRNG4,LRNG5,LREDIT,LREXEC,DR
Q ;LEAVE LRVER2, BACK TO LRVER1
V7 ;from LRVER3
S LRLDT=$O(^LR(LRDFN,LRSS,LRLDT)) G V8:LRLDT<1 S:LRLDT>LRTM60 LRLDT=-1 G V8:LRLDT=-1,V7:'$D(^LR(LRDFN,LRSS,LRLDT,0)) D V9 G:$P(^LR(LRDFN,LRSS,LRLDT,0),U,5)'=LRSPEC!'$P(^(0),U,3)!'$D(LRMA) V7
V8 S LRDAT(2)="",Z2="" I LRLDT>0 S Z2=^LR(LRDFN,"CH",LRLDT,0),X=+Z2,Z=Z2 D DAT S LRDAT(2)=LRDAT
S Z1=^LR(LRDFN,"CH",LRIDT,0),X=+Z1,Z=Z1 D DAT
Q
DAT N LRX
S LRX=$$FMTE^XLFDT(X,"5M")
S LRDAT=$P(LRX,"/",1,2)_" "_$P(LRX,"@",2)_$S($P(Z,U,2)!(X'["."):"r",1:"d") Q
V9 K LRMA S I=0 F S I=$O(^TMP("LR",$J,"TMP",I)) Q:I<1 I $D(^LR(LRDFN,LRSS,LRLDT,I)) S LRMA=1 Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRVER2 2213 printed Nov 22, 2024@17:32:34 Page 2
LRVER2 ;SLC/CJS - LAB ROUTINE DATA VERIFICATION ;2/7/91 11:36 ;
+1 ;;5.2;LAB SERVICE;**153,201**;Sep 27, 1994
+2 SET LRSPEC=""
SET X=DUZ
DO DUZ^LRX
if '$DATA(LREAL)
SET LREAL=1
V3 if $DATA(^LR(LRDFN,LRSS,LRIDT,0))
GOTO V5
if "AP EM"[LRSS
GOTO V4
V3A IF LRSAMP'=""
SET LRSPEC=$PIECE(^LAB(62,LRSAMP,0),U,2)
if $DATA(^LAB(61,+LRSPEC,0))
GOTO V4
+1 IF LRDPF'=62.3
if $DATA(LRGVP)
QUIT
SET DIC="^LAB(61,"
SET DIC(0)="AEOQ"
DO ^DIC
SET LRSPEC=+Y
IF LRSPEC=-1
WRITE !,"The specimen MUST be defined."
QUIT
V4 IF '$DATA(^LR(LRDFN,LRSS,0))
SET ^LR(LRDFN,LRSS,0)=U_$PIECE(^DD(63,$ORDER(^DD(63,"GL",LRSS,0,0)),0),U,2)_U
+1 LOCK +^LR(LRDFN,LRSS)
SET ^LR(LRDFN,LRSS,0)=$PIECE(^LR(LRDFN,LRSS,0),U,1,2)_U_LRIDT_U_(1+$PIECE(^(0),U,4))
+2 IF "AP EM"[LRSS
SET ^LR(LRDFN,LRSS,LRIDT,0)=LRCDT_U_LREAL
LOCK -^LR(LRDFN,LRSS)
GOTO V5
+3 SET LRVOL=""
if $DATA(^LRO(69,LRODT,1,LRSN,1))
SET LRVOL=$PIECE(^(1),U,5)
SET ^LR(LRDFN,LRSS,LRIDT,0)=LRCDT_U_LREAL_U_U_U_LRSPEC_U_LRAN_U_LRVOL_U_LRMETH_U
LOCK -^LR(LRDFN,LRSS)
V5 IF LRDPF=62.3
SET LRSPEC=$SELECT($DATA(^LR(LRDFN,LRSS,LRIDT,0)):$PIECE(^(0),U,5),1:"")
+1 SET LRLDT=LRIDT
SET LRVF=0
if '$LENGTH($PIECE(^LR(LRDFN,LRSS,LRIDT,0),U,3))
GOTO V6
SET LRVF=1
SET X=$PIECE(^(0),U,4)
SET T=$PIECE(^(0),U,3)
+2 if 'X&(LRDPF=62.3)
WRITE !,"This control has been automatically verified"
if 'X&(LRDPF'=62.3)
WRITE !,"Verified"
+3 IF X
WRITE !,"These results have been approved by ",$SELECT($DATA(^VA(200,X,0)):$PIECE(^(0),"^",1),1:"Unknown"),!," on ",$$FMTE^XLFDT(T)
V6 IF LRDPF'=62.3
SET LRSPEC=$PIECE(^LR(LRDFN,LRSS,LRIDT,0),U,5)
if '+LRSPEC
GOTO V3A
+1 if $DATA(^LAB(61,+LRSPEC,0))
WRITE !,"Specimen: ",$PIECE(^(0),U)
+2 KILL LRNOVER
IF LRSS="CH"
IF 'LRVF
SET LRNOVER=""
+3 KILL ^TMP("LR",$JOB,"VTO")
SET LRCFL=""
DO ^LRVER3
+4 KILL LRSA,LRSB,LRNOVER,LRACC,LRCAPWA,Y,Z,Z1,Z2,K1,LRURG
+5 KILL DA,DIC,DIE,LRNG,LRNG2,LRNG3,LRNG4,LRNG5,LREDIT,LREXEC,DR
+6 ;LEAVE LRVER2, BACK TO LRVER1
QUIT
V7 ;from LRVER3
+1 SET LRLDT=$ORDER(^LR(LRDFN,LRSS,LRLDT))
if LRLDT<1
GOTO V8
if LRLDT>LRTM60
SET LRLDT=-1
if LRLDT=-1
GOTO V8
if '$DATA(^LR(LRDFN,LRSS,LRLDT,0))
GOTO V7
DO V9
if $PIECE(^LR(LRDFN,LRSS,LRLDT,0),U,5)'=LRSPEC!'$PIECE(^(0),U,3)!'$DATA(LRMA)
GOTO V7
V8 SET LRDAT(2)=""
SET Z2=""
IF LRLDT>0
SET Z2=^LR(LRDFN,"CH",LRLDT,0)
SET X=+Z2
SET Z=Z2
DO DAT
SET LRDAT(2)=LRDAT
+1 SET Z1=^LR(LRDFN,"CH",LRIDT,0)
SET X=+Z1
SET Z=Z1
DO DAT
+2 QUIT
DAT NEW LRX
+1 SET LRX=$$FMTE^XLFDT(X,"5M")
+2 SET LRDAT=$PIECE(LRX,"/",1,2)_" "_$PIECE(LRX,"@",2)_$SELECT($PIECE(Z,U,2)!(X'["."):"r",1:"d")
QUIT
V9 KILL LRMA
SET I=0
FOR
SET I=$ORDER(^TMP("LR",$JOB,"TMP",I))
if I<1
QUIT
IF $DATA(^LR(LRDFN,LRSS,LRLDT,I))
SET LRMA=1
QUIT
+1 QUIT
