source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRVR3.m@ 1211

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

initial load of WorldVistAEHR

File size: 5.6 KB
Line 
1LRVR3 ;DALOI/CJS/JAH - LAB ROUTINE DATA VERIFICATION ;8/10/04
2 ;;5.2;LAB SERVICE;**42,121,153,286,291**;Sep 27, 1994
3 D V1
4 I $D(LRLOCKER)#2 L -@(LRLOCKER) K LRLOCKER
5 K LRSA,LRSB,LRNOVER,LRSBCOM,LRLKOK
6 Q ;Leave LRVR3, back to LRVR2
7 ;
8 ;
9V1 S LRTN=1
10 I $D(LRLOCKER)#2 L -@(LRLOCKER)
11 S LRLOCKER="^LR("_LRDFN_","""_LRSS_""","_LRIDT_")"
12 L +@(LRLOCKER):1
13 I '$T W !," This entry is being edited by someone else." Q
14 ;LRNOVER set in LRVR2
15 K LRLKOK D LINK Q:'$D(LRLKOK) K LRLKOK D LKCHK Q:'$D(LRLKOK)
16 K LRSA,LRSB,LRSBCOM
17 ;
18 S LRCMTDSP=$$CHKCDSP^LRVERA
19 N LRX
20 S LRX=1
21 F S LRX=$O(^LAH(LRLL,1,LRSQ,LRX)) Q:LRX<1 D
22 . S LRSB(LRX)=^LAH(LRLL,1,LRSQ,LRX)
23 . I $D(LRNOVER),$D(LRVTS(LRX)),$D(^TMP("LR",$J,"TMP",LRX)) S LRNOVER(LRX)=""
24 ; Copy comments from LAH
25 S LRX=0
26 F S LRX=$O(^LAH(LRLL,1,LRSQ,1,LRX)) Q:LRX="" S LRSBCOM(LRX)=^(LRX)
27 ;
28EDIT I $D(^LAH(LRLL,1,LRSQ,0)) D
29 . N X
30 . S LREDIT=1
31 . F LRX=0,.1,.3 M X(LRX)=^LAH(LRLL,1,LRSQ,LRX)
32 . K ^LAH(LRLL,1,LRSQ),LRNUF
33 . F LRX=0,.1,.3 M ^LAH(LRLL,1,LRSQ,LRX)=X(LRX) K X(LRX)
34 . D ^LRVR4
35 . F LRX=1:0 S LRX=$O(LRSB(LRX)) Q:LRX<1 S ^LAH(LRLL,1,LRSQ,LRX)=LRSB(LRX)
36 I $O(^LAH(LRLL,1,LRSQ,1))<1 W !,"NO DATA TO APPROVE" Q
37 Q:$D(LRGVP)
38 F I=0:0 S I=$O(LRNOVER(I)) Q:I="" W !,$P(^DD(63.04,I,0),U)
39 I $O(LRNOVER(0)) W !,"Have not been reviewed and have data. Not approved." QUIT
40 I '$P($G(LRLABKY),U) W !,$C(7),"ENTERED BUT NOT APPROVED" QUIT
41 N CNT S CNT=1
42AGAIN ;
43 R !,"Approve for release by entering your initials: ",LRINI:DTIME
44 I $E(LRINI)="^" W !!?5,$C(7),"Nothing verified!" D READ Q
45 I LRINI'=LRUSI,$$UP^XLFSTR(LRINI)=$$UP^XLFSTR(LRUSI) S LRINI=LRUSI
46 I $S($E(LRINI)="?":1,LRINI'=LRUSI&(CNT<2):1,1:0) W !,$C(7),"Please enter your correct initials" S:$E(LRINI)="?" CNT=0 S CNT=CNT+1 G AGAIN
47 I LRINI'=LRUSI W !!?5,$C(7),"Nothing verified!" D READ Q
48 ;
49V11 ;Still locked from V1 L ^LR(LRDFN,LRSS,LRIDT)
50 N LRCORECT S LRCORECT=0
51 N LRX
52 S LRX=0
53 F S LRX=$O(^TMP("LR",$J,"TMP",LRX)) Q:LRX<1 I $D(LRVTS(LRX)),$D(LRSB(LRX)),$D(^(LRX)) D
54 . K ^LAH(LRLL,1,LRSQ,LRX)
55 . I LRSB(LRX)'="" S ^LR(LRDFN,LRSS,LRIDT,LRX)=LRSB(LRX) S:'$D(^LRO(68,"AC",LRDFN,LRIDT,LRX)) ^(LRX)="" I LRVF S ^(LRX)=""
56 ;
57 I $P($G(LRORU3),U,3),$O(LRSB(0)) D LRORU3^LRVER3
58 ;
59A3 I +LRDPF=2&($G(LRSS)'="BB")&('$$CHKINP^LRBEBA4(LRDFN,LRODT)) D
60 .D BAWRK^LRBEBA(LRODT,LRSN,1,.LRBEY,.LRBETST)
61 D VER^LRVER3A ;unlocked in LRVER
62 K LRSBCOM
63 D:$P(LRPARAM,U,14)&($P($G(^LRO(68,LRAA,0)),U,16)) LOOK^LRCAPV1
64 ; Check for LEDI tests not reviewed
65 I $G(LRDUZ(2)),LRDUZ(2)'=DUZ(2),LRSS="CH",'$D(ZTQUEUED) D TNR
66 ;
67 I +$O(^LAH(LRLL,1,LRSQ,1))<1 D ZAPALL(LRLL,LRSQ)
68 I $D(LRPRGSQ),'$D(ZTQUEUED) D
69 . W !,"Purge data from sequence number(s): "
70 . F I=0:0 S I=$O(LRPRGSQ(I)) Q:I<1 W " ",I
71 . S %=1 D YN^DICN Q:%'=1
72 . N LAIEN
73 . S LAIEN=0
74 . F S LAIEN=$O(LRPRGSQ(LAIEN)) Q:LAIEN<1 D ZAPALL(LRLL,LAIEN)
75 Q
76 ;
77 ;
78ZAP ; from LRLLS3
79 D ZAPALL(LRLL,I)
80 Q
81 ;
82 ;
83LINK ; Check and save link
84 D LKCHK Q:$D(LRLKOK) S X=$S($D(^LRO(68,+$P(LRLK,U,3),1,+$P(LRLK,U,4),1,+$P(LRLK,U,5),0)):+^(0),1:"") G LINKOK:+X=LRDFN
85 S S1=PNM,S2=SSN,S3=LRDPF W !,$C(7),"WARNING - NO MATCHING ACCESSION WAS FOUND.",!,"You may need to Clear instrument/worklist data,",!,"or correctly identify the sample to the system."
86 I X S LRDPF=$P(^LR(X,0),U,2),DFN=$P(^(0),U,3) D PT^LRX W !,PNM,?30,SSN,!,$C(7) S PNM=S1,SSN=S2,LRDPF=S3
87 K S1,S2,S3 Q:$D(LRGVP) W !,"ARE YOU SURE THIS IS THE CORRECT DATA" S %=2 D YN^DICN Q:%'=1
88LINKOK K:$P(LRLK,U,5) ^LAH(LRLL,1,"C",+$P(LRLK,U,5),LRSQ)
89 S ^LAH(LRLL,1,"C",LRAN,LRSQ)="",$P(^LAH(LRLL,1,LRSQ,0),U,3,5)=LRAA_U_LRAD_U_LRAN,LRLKOK=1
90 Q
91 ;
92LKCHK S LRLK=$S($D(^LAH(LRLL,1,LRSQ,0)):^(0),1:"") I $P(LRLK,U,3)=LRAA&($P(LRLK,U,4)=LRAD)&($P(LRLK,U,5)=LRAN) S LRLKOK=1
93 Q
94 ;
95 ;
96ZAP2 ;Clear ^LAH(
97 D ZAPALL(LRLL,I)
98 Q
99 ;
100 ;
101ZAPALL(LRLL,LAIEN) ;Clean up
102 N I,NODE,SEG,SUB
103 Q:'$G(LRLL)!('$G(LAIEN))
104 ;
105 S NODE=$G(^LAH(LRLL,1,LAIEN,0))
106 K ^LAH(LRLL,1,"B",+$P(NODE,U)_";"_+$P(NODE,U,2),LAIEN)
107 K ^LAH(LRLL,1,"C",+$P(NODE,U,5),LAIEN)
108 K ^LAH(LRLL,1,"D",+$P(NODE,U,6),LAIEN)
109 K ^LAH(LRLL,1,"E",+$P(NODE,U,8),LAIEN)
110 ;
111 S NODE("U")=$P($G(^LAH(LRLL,1,LAIEN,.3)),U)
112 I NODE("U")'="" D
113 . K ^LAH(LRLL,1,"U",NODE("U"),LAIEN)
114 . S I=0
115 . F S I=$O(^LAH("LA7 AMENDED RESULTS",NODE("U"),I)) Q:'I D
116 . . K ^LAH("LA7 AMENDED RESULTS",NODE("U"),I,LRLL,LAIEN)
117 ;
118 S SEG=""
119 F S SEG=$O(^LAH(LRLL,1,LAIEN,.1,SEG)) Q:SEG="" D
120 . S SEGID=""
121 . F S SEGID=$O(^LAH(LRLL,1,LAIEN,.1,SEG,SEGID)) Q:SEGID="" D
122 . . S SUB=$P($G(^LAH(LRLL,1,LAIEN,.1,SEG,SEGID)),U)
123 . . I SUB'="" K ^LAH(LRLL,1,"A"_SEGID,SUB,LAIEN)
124 ;
125 K ^LAH(LRLL,1,LAIEN)
126 ;
127 ; Reset counter if loadlist is clear.
128 I '$O(^LAH(LRLL,1,0)) D
129 . L +^LAH(LRLL):1 Q:'$T
130 . S ^LAH(LRLL)=0
131 . L -^LAH(LRLL)
132 ;
133 Q
134 ;
135 ;
136TNR ; List tests not reviewed and ask if user wants to delete.
137 ;
138 N DIR,DIROUT,DIRUT,DUOUT,LR60,I,X,Y
139 ;
140 ; Check if these results have already been verified
141 S I=1
142 F S I=$O(^LAH(LRLL,1,LRSQ,I)) Q:'I D
143 . S X=^LAH(LRLL,1,LRSQ,I)
144 . I $P(X,"^")=$P($G(^LR(LRDFN,LRSS,LRIDT,I)),"^") K ^LAH(LRLL,1,LRSQ,I)
145 ;
146 ; Quit if no unreviewed results
147 I +$O(^LAH(LRLL,1,LRSQ,1))'>1 Q
148 ;
149 W !,"Test(s) Not Reviewed:",!
150 S I=1
151 F S I=$O(^LAH(LRLL,1,LRSQ,I)) Q:'I D
152 . S X=^LAH(LRLL,1,LRSQ,I)
153 . S LR60=+$O(^LAB(60,"C","CH;"_I_";1",0))
154 . I LR60 W $$GET1^DIQ(60,LR60_",",.01)
155 . E W $$GET1^DID(63.04,I,"","LABEL")
156 . W " = "_$P(X,"^")_" "_$P(X,"^",2)_" "_$P($P(X,"^",5),"!",7),!
157 ;
158 S DIR(0)="Y",DIR("A")="Purge these test results",DIR("B")="NO"
159 S DIR("?",1)="Answer 'NO' if you want to keep these results for later verification."
160 S DIR("?",2)="You may need to add these tests to the loadlist profile your using"
161 S DIR("?")="and/or add these tests to the accession your verifying."
162 D ^DIR Q:$D(DIRUT)
163 ;
164 I Y=1 D ZAPALL(LRLL,LRSQ)
165 Q
166 ;
167 ;
168READ ;
169 N X W !!,"Press ENTER or RETURN to continue: " R X:DTIME
170 Q
Note: See TracBrowser for help on using the repository browser.