- LRGV2 ;DALOI/STAFF - PART2 OF INSTRUMENT GROUP VERIFY DATA ;02/11/11 12:21
- ;;5.2;LAB SERVICE;**121,153,269,350,438,519**;Sep 27, 1994;Build 16
- ;
- ;removed NEW of LRGVP in line below - LR*5.2*519
- N LRSB,LRX
- ;
- I $P(LR0,U,8)'[LRMETH S $P(^LR(LRDFN,"CH",LRIDT,0),U,8)=LRMETH_";"_$P(LR0,U,8)
- S LRLDT=LRIDT
- D FINDPS
- I LRLDT="" W !,"NO DELTA SAMPLE",!
- ;
- ; If results exist in ^LR then delete results from LAH.
- I LRVF D
- . S LRX=1
- . F S LRX=$O(^LR(LRDFN,"CH",LRIDT,LRX)) Q:LRX'>0 I ^(LRX)'["pending" K ^LAH(LRLL,1,LRSQ,LRX)
- ;
- S LRX=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)
- ;
- S LRVRM=1,(LRDELTA,LRCRIT,LRCNT,LRNX)=0
- F S LRNX=$O(LRORD(LRNX)) Q:LRNX'>0 D DC
- ;
- I 'LRVRFYAL,(LRDELTA!LRCRIT) D NOP Q
- ;
- S LREXEC=LRCFL D ^LREXEC:LRCFL]""
- ;
- S:'$P(^LR(LRDFN,"CH",LRIDT,0),U,5) $P(^LR(LRDFN,"CH",LRIDT,0),U,5)=LRSPEC
- ;
- ; Move comments from LAH to LR
- I $O(^LAH(LRLL,1,LRSQ,1,0)) D LRSBCOM^LRVR4
- ;
- ; Verify results and update files.
- K LRPRGSQ
- D V11^LRVR3
- W !!,">> Accession #: ",LRAN," VERIFIED <<"
- ;
- ; Display results which were not verified.
- I $O(^LAH(LRLL,1,LRSQ,1))>1 D
- . W !," STILL TO BE VERIFIED:"
- . S LRX=1
- . F S LRX=$O(^LAH(LRLL,1,LRSQ,LRX)) Q:LRX<1 W ?25,$$GET1^DID(63.04,LRX,"","LABEL"),!
- ;
- D DASH^LRX
- ;
- K LRSB
- Q
- ;
- ;
- DC ; Perform range and delta checks
- ;
- N LRCW,LRQ,X,Y
- ;
- S LRSB=+LRORD(LRNX),LRTS=$S($D(^TMP("LR",$J,"TMP",LRSB)):^(LRSB),1:0) Q:'LRTS
- S X=$P($G(LRSB(LRSB)),U),X1="",LRFLG=""
- I X=""!(X["pending") Q
- I LRLDT'="" S X1=$G(^LR(LRDFN,"CH",LRLDT,LRSB))
- ;
- ; Setup variable for range and delta checking
- D V25^LRVER5
- ;
- ; Display test name, results
- S X=$P(LRSB(LRSB),"^"),LRCW=8
- W !,$P(^LAB(60,+LRTS,0),"^"),?31,@LRFP," "
- ;
- ; Do delta checking
- S X=$P(LRSB(LRSB),"^"),Y=0,LRQ=""
- I LRDEL'="" S LRQ=1 D XDELTACK^LRVERA S:Y LRDELTA=Y
- ;
- ; Do range checking
- D RANGE^LRVR4
- I LRFLG["*" S LRCRIT=1
- ;
- ; Display test flags and units
- W $$LJ^XLFSTR(LRFLG,2),?56," ",$P(LRNGS,"^",7)
- I LRFLG["*" D DISPFLG^LRVER4
- ;
- Q
- ;
- ;
- NOP ;
- W !,">> Accession #: ",LRAN," NOT VERIFIED"
- I LRDELTA W " - DELTA check flag"
- I LRCRIT W " - CRITICAL range flag"
- W " <<"
- I $E(IOST,1,2)="C-" W $C(7)
- Q
- ;
- ;
- INFO ;
- W !,"Sequence #: ",LRSQ
- S X=$P(^LAH(LRLL,1,LRSQ,0),"^",1),Y=$P(^(0),"^",2)
- W:$L(X)!$L(Y) ?20,"TRAY: ",X,?33,"CUP: ",Y,?45,"DUPLICATE "
- Q
- ;
- ;
- FINDPS ; Find previous specimen to use for delta check
- ; Specimen needs to be within "days back (LRTM60)" parameter and have
- ; a dataname in common with a dataname on the sequence entry in LAH.
- ;
- N LRQUIT,LRX
- ;
- S LRQUIT=0
- F S LRLDT=$O(^LR(LRDFN,"CH",LRLDT)) Q:'LRLDT D Q:LRQUIT
- . I LRLDT>LRTM60 S LRLDT="",LRQUIT=1 Q
- . S LRX=$G(^LR(LRDFN,"CH",LRLDT,0))
- . I $P(LRX,U,5)'=LRSPEC!('$P(LRX,U,3)) Q
- . S LRX=1
- . F S LRX=$O(^LAH(LRLL,1,LRSQ,LRX)) Q:LRX'>0 I $D(^LR(LRDFN,"CH",LRLDT,LRX)) S LRQUIT=1 Q
- ;
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRGV2 3004 printed Feb 18, 2025@23:40:52 Page 2
- 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
- +2 ;
- +3 ;removed NEW of LRGVP in line below - LR*5.2*519
- +4 NEW LRSB,LRX
- +5 ;
- +6 IF $PIECE(LR0,U,8)'[LRMETH
- SET $PIECE(^LR(LRDFN,"CH",LRIDT,0),U,8)=LRMETH_";"_$PIECE(LR0,U,8)
- +7 SET LRLDT=LRIDT
- +8 DO FINDPS
- +9 IF LRLDT=""
- WRITE !,"NO DELTA SAMPLE",!
- +10 ;
- +11 ; If results exist in ^LR then delete results from LAH.
- +12 IF LRVF
- Begin DoDot:1
- +13 SET LRX=1
- +14 FOR
- SET LRX=$ORDER(^LR(LRDFN,"CH",LRIDT,LRX))
- if LRX'>0
- QUIT
- IF ^(LRX)'["pending"
- KILL ^LAH(LRLL,1,LRSQ,LRX)
- End DoDot:1
- +15 ;
- +16 SET LRX=1
- +17 FOR
- SET LRX=$ORDER(^LAH(LRLL,1,LRSQ,LRX))
- if LRX'>0
- QUIT
- IF $DATA(^TMP("LR",$JOB,"TMP",LRX))
- SET LRSB(LRX)=^LAH(LRLL,1,LRSQ,LRX)
- +18 ;
- +19 SET LRVRM=1
- SET (LRDELTA,LRCRIT,LRCNT,LRNX)=0
- +20 FOR
- SET LRNX=$ORDER(LRORD(LRNX))
- if LRNX'>0
- QUIT
- DO DC
- +21 ;
- +22 IF 'LRVRFYAL
- IF (LRDELTA!LRCRIT)
- DO NOP
- QUIT
- +23 ;
- +24 SET LREXEC=LRCFL
- if LRCFL]""
- DO ^LREXEC
- +25 ;
- +26 if '$PIECE(^LR(LRDFN,"CH",LRIDT,0),U,5)
- SET $PIECE(^LR(LRDFN,"CH",LRIDT,0),U,5)=LRSPEC
- +27 ;
- +28 ; Move comments from LAH to LR
- +29 IF $ORDER(^LAH(LRLL,1,LRSQ,1,0))
- DO LRSBCOM^LRVR4
- +30 ;
- +31 ; Verify results and update files.
- +32 KILL LRPRGSQ
- +33 DO V11^LRVR3
- +34 WRITE !!,">> Accession #: ",LRAN," VERIFIED <<"
- +35 ;
- +36 ; Display results which were not verified.
- +37 IF $ORDER(^LAH(LRLL,1,LRSQ,1))>1
- Begin DoDot:1
- +38 WRITE !," STILL TO BE VERIFIED:"
- +39 SET LRX=1
- +40 FOR
- SET LRX=$ORDER(^LAH(LRLL,1,LRSQ,LRX))
- if LRX<1
- QUIT
- WRITE ?25,$$GET1^DID(63.04,LRX,"","LABEL"),!
- End DoDot:1
- +41 ;
- +42 DO DASH^LRX
- +43 ;
- +44 KILL LRSB
- +45 QUIT
- +46 ;
- +47 ;
- DC ; Perform range and delta checks
- +1 ;
- +2 NEW LRCW,LRQ,X,Y
- +3 ;
- +4 SET LRSB=+LRORD(LRNX)
- SET LRTS=$SELECT($DATA(^TMP("LR",$JOB,"TMP",LRSB)):^(LRSB),1:0)
- if 'LRTS
- QUIT
- +5 SET X=$PIECE($GET(LRSB(LRSB)),U)
- SET X1=""
- SET LRFLG=""
- +6 IF X=""!(X["pending")
- QUIT
- +7 IF LRLDT'=""
- SET X1=$GET(^LR(LRDFN,"CH",LRLDT,LRSB))
- +8 ;
- +9 ; Setup variable for range and delta checking
- +10 DO V25^LRVER5
- +11 ;
- +12 ; Display test name, results
- +13 SET X=$PIECE(LRSB(LRSB),"^")
- SET LRCW=8
- +14 WRITE !,$PIECE(^LAB(60,+LRTS,0),"^"),?31,@LRFP," "
- +15 ;
- +16 ; Do delta checking
- +17 SET X=$PIECE(LRSB(LRSB),"^")
- SET Y=0
- SET LRQ=""
- +18 IF LRDEL'=""
- SET LRQ=1
- DO XDELTACK^LRVERA
- if Y
- SET LRDELTA=Y
- +19 ;
- +20 ; Do range checking
- +21 DO RANGE^LRVR4
- +22 IF LRFLG["*"
- SET LRCRIT=1
- +23 ;
- +24 ; Display test flags and units
- +25 WRITE $$LJ^XLFSTR(LRFLG,2),?56," ",$PIECE(LRNGS,"^",7)
- +26 IF LRFLG["*"
- DO DISPFLG^LRVER4
- +27 ;
- +28 QUIT
- +29 ;
- +30 ;
- NOP ;
- +1 WRITE !,">> Accession #: ",LRAN," NOT VERIFIED"
- +2 IF LRDELTA
- WRITE " - DELTA check flag"
- +3 IF LRCRIT
- WRITE " - CRITICAL range flag"
- +4 WRITE " <<"
- +5 IF $EXTRACT(IOST,1,2)="C-"
- WRITE $CHAR(7)
- +6 QUIT
- +7 ;
- +8 ;
- INFO ;
- +1 WRITE !,"Sequence #: ",LRSQ
- +2 SET X=$PIECE(^LAH(LRLL,1,LRSQ,0),"^",1)
- SET Y=$PIECE(^(0),"^",2)
- +3 if $LENGTH(X)!$LENGTH(Y)
- WRITE ?20,"TRAY: ",X,?33,"CUP: ",Y,?45,"DUPLICATE "
- +4 QUIT
- +5 ;
- +6 ;
- FINDPS ; Find previous specimen to use for delta check
- +1 ; Specimen needs to be within "days back (LRTM60)" parameter and have
- +2 ; a dataname in common with a dataname on the sequence entry in LAH.
- +3 ;
- +4 NEW LRQUIT,LRX
- +5 ;
- +6 SET LRQUIT=0
- +7 FOR
- SET LRLDT=$ORDER(^LR(LRDFN,"CH",LRLDT))
- if 'LRLDT
- QUIT
- Begin DoDot:1
- +8 IF LRLDT>LRTM60
- SET LRLDT=""
- SET LRQUIT=1
- QUIT
- +9 SET LRX=$GET(^LR(LRDFN,"CH",LRLDT,0))
- +10 IF $PIECE(LRX,U,5)'=LRSPEC!('$PIECE(LRX,U,3))
- QUIT
- +11 SET LRX=1
- +12 FOR
- SET LRX=$ORDER(^LAH(LRLL,1,LRSQ,LRX))
- if LRX'>0
- QUIT
- IF $DATA(^LR(LRDFN,"CH",LRLDT,LRX))
- SET LRQUIT=1
- QUIT
- End DoDot:1
- if LRQUIT
- QUIT
- +13 ;
- +14 QUIT