source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRGV2.m@ 1005

Last change on this file since 1005 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 2.9 KB
RevLine 
[613]1LRGV2 ;DALOI/RWF - PART2 OF INSTRUMENT GROUP VERIFY DATA ;8/11/97
2 ;;5.2;LAB SERVICE;**121,153,269**;Sep 27, 1994
3 ;
4 N LRGVP,LRSB,LRX
5 ;
6 I $P(LR0,U,8)'[LRMETH S $P(^LR(LRDFN,"CH",LRIDT,0),U,8)=LRMETH_";"_$P(LR0,U,8)
7 S LRLDT=LRIDT
8 D FINDPS
9 I LRLDT="" W !,"NO DELTA SAMPLE",!
10 ;
11 ; If results exist in ^LR then delete results from LAH.
12 I LRVF D
13 . S LRX=1
14 . F S LRX=$O(^LR(LRDFN,"CH",LRIDT,LRX)) Q:LRX'>0 I ^(LRX)'["pending" K ^LAH(LRLL,1,LRSQ,LRX)
15 ;
16 S LRX=1
17 F S LRX=$O(^LAH(LRLL,1,LRSQ,LRX)) Q:LRX'>0 S LRSB(LRX)=^LAH(LRLL,1,LRSQ,LRX)
18 ;
19 S LRVRM=1,(LRDELTA,LRCRIT,LRCNT,LRNX)=0
20 F S LRNX=$O(LRORD(LRNX)) Q:LRNX'>0 D DC
21 ;
22 I 'LRVRFYAL,(LRDELTA!LRCRIT) D NOP Q
23 ;
24 S LREXEC=LRCFL D ^LREXEC:LRCFL]""
25 ;
26 S:'$P(^LR(LRDFN,"CH",LRIDT,0),U,5) $P(^LR(LRDFN,"CH",LRIDT,0),U,5)=LRSPEC
27 ;
28 ; Move comments from LAH to LR
29 I $O(^LAH(LRLL,1,LRSQ,1,0)) D LRSBCOM^LRVR4
30 ;
31 ; Verify results and update files.
32 K LRPRGSQ
33 D V11^LRVR3
34 W !!,">> Accession #: ",LRAN," VERIFIED <<"
35 ;
36 ; Display results which were not verified.
37 I $O(^LAH(LRLL,1,LRSQ,1))>1 D
38 . W !," STILL TO BE VERIFIED:"
39 . S LRX=1
40 . F S LRX=$O(^LAH(LRLL,1,LRSQ,LRX)) Q:LRX<1 W ?25,$$GET1^DID(63.04,LRX,"","LABEL"),!
41 ;
42 D DASH^LRX
43 ;
44 K LRSB
45 Q
46 ;
47 ;
48DC ; Perform range and delta checks
49 ;
50 N LRCW,LRQ,X,Y
51 ;
52 S LRSB=+LRORD(LRNX),LRTS=$S($D(^TMP("LR",$J,"TMP",LRSB)):^(LRSB),1:0) Q:'LRTS
53 S X=$P($G(LRSB(LRSB)),U),X1="",LRFLG=""
54 I X=""!(X["pending") Q
55 I LRLDT'="" S X1=$G(^LR(LRDFN,"CH",LRLDT,LRSB))
56 ;
57 ; Setup variable for range and delta checking
58 D V25^LRVER5
59 ;
60 ; Do range checking
61 S LRQ=""
62 D RANGE^LRVR4
63 I LRFLG["*" S LRCRIT=1
64 ;
65 ; Display test name, results, flags and units
66 S X=$P(LRSB(LRSB),"^"),LRCW=8
67 ;W !,$P(^LAB(60,+LRTS,0),"^"),?31,@LRFP," ",$$LJ^XLFSTR(LRFLG,2)," ",$$LJ^XLFSTR($P(LRNGS,"^",7),10)
68 W !,$P(^LAB(60,+LRTS,0),"^"),?31,@LRFP," ",$$LJ^XLFSTR(LRFLG,2)," ",$P(LRNGS,"^",7)
69 I LRFLG["*" D
70 . N X
71 . S X="CRITICAL "_$S(LRFLG["L":"LOW",LRFLG["H":"HIGH",1:"")_"!!"
72 . I $E(IOST,1,2)="C-" W " ",@LRVIDO,X,@LRVIDOF,$C(7,7,7)
73 . E W " ",X
74 ;
75 ; Do delta checking
76 S X=$P(LRSB(LRSB),"^")
77 S Y=0 I LRDEL'="" X LRDEL S:Y LRDELTA=Y
78 Q
79 ;
80 ;
81NOP ;
82 W !,">> Accession #: ",LRAN," NOT VERIFIED"
83 I LRDELTA W " - DELTA check flag"
84 I LRCRIT W " - CRITICAL range flag"
85 W " <<"
86 I $E(IOST,1,2)="C-" W $C(7)
87 Q
88 ;
89 ;
90INFO ;
91 W !,"Sequence #: ",LRSQ
92 S X=$P(^LAH(LRLL,1,LRSQ,0),"^",1),Y=$P(^(0),"^",2)
93 W:$L(X)!$L(Y) ?20,"TRAY: ",X,?33,"CUP: ",Y,?45,"DUPLICATE "
94 Q
95 ;
96 ;
97FINDPS ; Find previous specimen to use for delta check
98 ; Specimen needs to be within "days back (LRTM60)" parameter and have
99 ; a dataname in common with a dataname on the sequence entry in LAH.
100 ;
101 N LRQUIT,LRX
102 ;
103 S LRQUIT=0
104 F S LRLDT=$O(^LR(LRDFN,"CH",LRLDT)) Q:'LRLDT D Q:LRQUIT
105 . I LRLDT>LRTM60 S LRLDT="",LRQUIT=1 Q
106 . S LRX=$G(^LR(LRDFN,"CH",LRLDT,0))
107 . I $P(LRX,U,5)'=LRSPEC!('$P(LRX,U,3)) Q
108 . S LRX=1
109 . F S LRX=$O(^LAH(LRLL,1,LRSQ,LRX)) Q:LRX'>0 I $D(^LR(LRDFN,"CH",LRLDT,LRX)) S LRQUIT=1 Q
110 ;
111 Q
Note: See TracBrowser for help on using the repository browser.