Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LRGV2

LRGV2.m

Go to the documentation of this file.
  1. LRGV2 ;DALOI/STAFF - PART2 OF INSTRUMENT GROUP VERIFY DATA ;02/11/11 12:21
  1. ;;5.2;LAB SERVICE;**121,153,269,350,438,519**;Sep 27, 1994;Build 16
  1. ;
  1. ;removed NEW of LRGVP in line below - LR*5.2*519
  1. N LRSB,LRX
  1. ;
  1. I $P(LR0,U,8)'[LRMETH S $P(^LR(LRDFN,"CH",LRIDT,0),U,8)=LRMETH_";"_$P(LR0,U,8)
  1. S LRLDT=LRIDT
  1. D FINDPS
  1. I LRLDT="" W !,"NO DELTA SAMPLE",!
  1. ;
  1. ; If results exist in ^LR then delete results from LAH.
  1. I LRVF D
  1. . S LRX=1
  1. . F S LRX=$O(^LR(LRDFN,"CH",LRIDT,LRX)) Q:LRX'>0 I ^(LRX)'["pending" K ^LAH(LRLL,1,LRSQ,LRX)
  1. ;
  1. S LRX=1
  1. F S LRX=$O(^LAH(LRLL,1,LRSQ,LRX)) Q:LRX'>0 I $D(^TMP("LR",$J,"TMP",LRX)) S LRSB(LRX)=^LAH(LRLL,1,LRSQ,LRX)
  1. ;
  1. S LRVRM=1,(LRDELTA,LRCRIT,LRCNT,LRNX)=0
  1. F S LRNX=$O(LRORD(LRNX)) Q:LRNX'>0 D DC
  1. ;
  1. I 'LRVRFYAL,(LRDELTA!LRCRIT) D NOP Q
  1. ;
  1. S LREXEC=LRCFL D ^LREXEC:LRCFL]""
  1. ;
  1. S:'$P(^LR(LRDFN,"CH",LRIDT,0),U,5) $P(^LR(LRDFN,"CH",LRIDT,0),U,5)=LRSPEC
  1. ;
  1. ; Move comments from LAH to LR
  1. I $O(^LAH(LRLL,1,LRSQ,1,0)) D LRSBCOM^LRVR4
  1. ;
  1. ; Verify results and update files.
  1. K LRPRGSQ
  1. D V11^LRVR3
  1. W !!,">> Accession #: ",LRAN," VERIFIED <<"
  1. ;
  1. ; Display results which were not verified.
  1. I $O(^LAH(LRLL,1,LRSQ,1))>1 D
  1. . W !," STILL TO BE VERIFIED:"
  1. . S LRX=1
  1. . F S LRX=$O(^LAH(LRLL,1,LRSQ,LRX)) Q:LRX<1 W ?25,$$GET1^DID(63.04,LRX,"","LABEL"),!
  1. ;
  1. D DASH^LRX
  1. ;
  1. K LRSB
  1. Q
  1. ;
  1. ;
  1. DC ; Perform range and delta checks
  1. ;
  1. N LRCW,LRQ,X,Y
  1. ;
  1. S LRSB=+LRORD(LRNX),LRTS=$S($D(^TMP("LR",$J,"TMP",LRSB)):^(LRSB),1:0) Q:'LRTS
  1. S X=$P($G(LRSB(LRSB)),U),X1="",LRFLG=""
  1. I X=""!(X["pending") Q
  1. I LRLDT'="" S X1=$G(^LR(LRDFN,"CH",LRLDT,LRSB))
  1. ;
  1. ; Setup variable for range and delta checking
  1. D V25^LRVER5
  1. ;
  1. ; Display test name, results
  1. S X=$P(LRSB(LRSB),"^"),LRCW=8
  1. W !,$P(^LAB(60,+LRTS,0),"^"),?31,@LRFP," "
  1. ;
  1. ; Do delta checking
  1. S X=$P(LRSB(LRSB),"^"),Y=0,LRQ=""
  1. I LRDEL'="" S LRQ=1 D XDELTACK^LRVERA S:Y LRDELTA=Y
  1. ;
  1. ; Do range checking
  1. D RANGE^LRVR4
  1. I LRFLG["*" S LRCRIT=1
  1. ;
  1. ; Display test flags and units
  1. W $$LJ^XLFSTR(LRFLG,2),?56," ",$P(LRNGS,"^",7)
  1. I LRFLG["*" D DISPFLG^LRVER4
  1. ;
  1. Q
  1. ;
  1. ;
  1. NOP ;
  1. W !,">> Accession #: ",LRAN," NOT VERIFIED"
  1. I LRDELTA W " - DELTA check flag"
  1. I LRCRIT W " - CRITICAL range flag"
  1. W " <<"
  1. I $E(IOST,1,2)="C-" W $C(7)
  1. Q
  1. ;
  1. ;
  1. INFO ;
  1. W !,"Sequence #: ",LRSQ
  1. S X=$P(^LAH(LRLL,1,LRSQ,0),"^",1),Y=$P(^(0),"^",2)
  1. W:$L(X)!$L(Y) ?20,"TRAY: ",X,?33,"CUP: ",Y,?45,"DUPLICATE "
  1. Q
  1. ;
  1. ;
  1. FINDPS ; Find previous specimen to use for delta check
  1. ; Specimen needs to be within "days back (LRTM60)" parameter and have
  1. ; a dataname in common with a dataname on the sequence entry in LAH.
  1. ;
  1. N LRQUIT,LRX
  1. ;
  1. S LRQUIT=0
  1. F S LRLDT=$O(^LR(LRDFN,"CH",LRLDT)) Q:'LRLDT D Q:LRQUIT
  1. . I LRLDT>LRTM60 S LRLDT="",LRQUIT=1 Q
  1. . S LRX=$G(^LR(LRDFN,"CH",LRLDT,0))
  1. . I $P(LRX,U,5)'=LRSPEC!('$P(LRX,U,3)) Q
  1. . S LRX=1
  1. . F S LRX=$O(^LAH(LRLL,1,LRSQ,LRX)) Q:LRX'>0 I $D(^LR(LRDFN,"CH",LRLDT,LRX)) S LRQUIT=1 Q
  1. ;
  1. Q