source: FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LRVER3.m@ 1800

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

initial load of FOIAVistA 6/30/08 version
File size: 7.0 KB
Line 
1LRVER3 ;DALOI/CJS/JAH - DATA VERIFICATION ;8/10/04
2 ;;5.2;LAB SERVICE;**42,100,121,140,171,153,221,286,291**;Sep 27, 1994
3 ;
4 D V1
5 I $D(LRLOCKER)#2 L -@(LRLOCKER) K LRLOCKER
6 Q
7 ;
8 ;
9V1 I $D(LRLOCKER)#2 L -@(LRLOCKER)
10 S LRLOCKER="^LR("_LRDFN_","""_LRSS_""","_LRIDT_")"
11 L +@(LRLOCKER):1
12 I '$T W !," This entry is being edited by someone else." Q
13 I $D(LRGVP) S X="1-"_LRNTN D RANGE^LRWU2 G L10
14 S LRALL="",LRALERT=LROUTINE,LRLCT=6
15 ;
16 ; List any not performed tests.
17 S I=0
18 F S I=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,4,I)) Q:I<1 D
19 . S LRX=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,4,I,0))
20 . I $P(LRX,"^",6)'="*Not Performed" Q
21 . W !,?3,$P(^LAB(60,I,0),"^"),?25," ",$P(LRX,"^",6)
22 . S LRLCT=LRLCT+1 D:LRLCT>22 WT^LRVER4
23 ;
24 ; No tests to edit
25 I LRNTN=0 D COM^LRVR4 G EXIT
26 ;
27 F I=1:1:LRNTN I $D(LRNAME(I)) D
28 . S LRALL=LRALL_","_I W !,I," ",LRNAME(I)
29 . I $D(^LRO(68,LRAA,1,LRAD,1,LRAN,4,$O(LRNAME(I,0)),0))#2 D
30 . . S LRX=^LRO(68,LRAA,1,LRAD,1,LRAN,4,$O(LRNAME(I,0)),0)
31 . . S LRAL=$P(LRX,U,2)#50
32 . . I $P(LRX,U,5) W ?25,$S($P(LRX,U,6)'="":$P(LRX,U,6),1:" verified")
33 . . I LRAL S LRALERT=$S(LRAL<LRALERT:LRAL,1:LRALERT)
34 . S LRLCT=LRLCT+1 D:LRLCT>22 WT^LRVER4
35 ;
36 I $D(LRALERT),LRALERT<($P(LRPARAM,U,20)+1) D
37 . W !?15 W:IOST["C-" @LRVIDO
38 . W "Test ordered "_$P($G(^LAB(62.05,+LRALERT,0)),U)
39 . W:IOST["C-" @LRVIDOF W !,$C(7)
40 ;
41 S X9="" I LRNTN=1 S T1=1 G L10
42V9 S LRALL=$P(LRALL,",",2,99)
43 R !!,"TEST #(s) (or ""ALL""): ",X:DTIME S:'$T X=U S:X["A" X=LRALL
44 I X["?" W !,"Enter for example 1,2,5-9." G V9
45 Q:X[U!(X="") D RANGE^LRWU2 G EXIT:X9="" X (X9_"S:'$D(LRNAME(T1)) X=0") G EXIT:X=0
46L10 ;
47 N LRCORECT S LRCORECT=0
48 S LRNX=0 X (X9_"D EX1^LRVER1")
49 D V7^LRVER2
50 S LRCMTDSP=$$CHKCDSP^LRVERA
51 K LRSA,LRSB,LRORU3
52 F LRSB=1:0 S LRSB=$O(^LR(LRDFN,LRSS,LRIDT,LRSB)) Q:LRSB<1 D
53 . S LRSB(LRSB)=^(LRSB),LRSB(LRSB,"P")=$P(LRSB(LRSB),U,3)
54 . I $D(LRNOVER) S LRNOVER(LRSB)=""
55 S LREDIT=1
56 D ^LRVER4
57 ;
58 ; If group data review then quit before updating results
59 I $D(LRGVP) G EXIT
60 ;
61 I '$O(LRORD(0)) G EXIT
62 I '$G(LRCHG),'LRVF F LRSB=1:0 S LRSB=$O(LRSB(LRSB)) Q:LRSB<1 S:LRSB(LRSB)'="" ^LR(LRDFN,LRSS,LRIDT,LRSB)=LRSB(LRSB)
63 I $G(LRCHG) D CHG K LRCHG,LRUP I $G(LREND) S LREND=0 G EXIT
64 ;
65 I $D(LRSA),$D(LRF) K LRF S X=$P(^LR(LRDFN,LRSS,LRIDT,0),U,9) S:$L(X)&($E(X)'["-") $P(^(0),U,9)="-"_X G V11
66 G EXIT:$D(LRGVP),V11:LRVF&$D(LRSA),V1:LRVF&(LRNTN>1),EXIT:LRVF
67 ;
68NOVER I $O(LRNOVER(0)) D G EXIT
69 . F I=0:0 S I=+$O(LRNOVER(I)) Q:I<2 W !,"Test Not Reviewed: ",$P(^DD(63.04,I,0),U) W:$D(LRSB(I))#2 " = "_$P(LRSB(I),U)_" "_$P(LRSB(I),U,2)
70 . W !,$$CJ^XLFSTR("The above test(s) have results already entered,",80)
71 . W !,$$CJ^XLFSTR("but you did not select them for review.",80)
72 . W !,$$CJ^XLFSTR(" Accession NOT approved. ",80),$C(7)
73 . W !,$$CJ^XLFSTR("You must review all results before ANY can be released.",80),!!
74 . W:$E(IOST,1,2)="C-" @LRVIDO W $$CJ^XLFSTR("Suggest you select 'ALL' tests for verification/review. ",80) W:$E(IOST,1,2)="C-" @LRVIDOF W !,$C(7)
75 I $O(LRNOVER(0)) W !,"Has not been reviewed and has data. Not approved.",! G EXIT
76 I '$P($G(LRLABKY),U) W !,$C(7),"ENTERED BUT NOT APPROVED",! G EXIT
77 I '$O(LRSB(0)) W !?5,"Nothing verified ",$C(7),! G EXIT
78 N CNT S CNT=1
79AGAIN ;
80 R !,"Approve for release by entering your initials: ",LRINI:DTIME
81 I $E(LRINI)="^" W !!?5,$C(7),"Nothing verified!" D READ G EXIT
82 I LRINI'=LRUSI,$$UP^XLFSTR(LRINI)=$$UP^XLFSTR(LRUSI) S LRINI=LRUSI
83 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
84 I LRINI'=LRUSI W !!?5,$C(7),"Nothing verified!" D READ G EXIT
85V11 I $D(XRTL) D T0^%ZOSV ; START RESPONSE TIME LOGGING
86 I +LRDPF=2&($G(LRSS)'="BB")&('$$CHKINP^LRBEBA4(LRDFN,LRODT)) D
87 .D BAWRK^LRBEBA(LRODT,LRSN,1,.LRBEY,.LRTEST)
88 D VER^LRVER3A
89 I $P(LRPARAM,U,14),$P($G(^LRO(68,LRAA,0)),U,16) D LOOK^LRCAPV1
90 N LRX
91 S LRX=0
92 F S LRX=$O(^TMP("LR",$J,"TMP",LRX)) Q:LRX<1 S:'$D(^LRO(68,"AC",LRDFN,LRIDT,LRX)) ^(LRX)="" I LRVF S ^(LRX)=""
93 I $P($G(LRORU3),U,3),$O(LRSB(0)) D LRORU3
94 I $D(XRT0) S XRTN="V11^LRVER3" D T1^%ZOSV ; STOP RESPONSE TIME LOGGING
95 S LRVF=1
96 Q
97 ;
98 ;
99EXIT Q
100 ;
101 ;
102READ ;
103 N X W !!,"Press ENTER or RETURN to continue: " R X:DTIME
104 Q
105 ;
106 ;
107CHG ; Check for changes, save results and create audit trail
108 S LRUP=""
109 F S LRCHG=$O(LRSB(LRCHG)) Q:LRCHG<1 D
110 . I '$D(LRSA(LRCHG)) S LRUP=1 Q
111 . I $P(LRSA(LRCHG),"^")=""!($P(LRSA(LRCHG),"^")="pending") S LRUP=1 Q
112 . I $P(LRSA(LRCHG),"^")'=$P(LRSB(LRCHG),"^") S LRUP=1,$P(LRSA(LRCHG,2),"^")=1 ; results changed
113 . I $P(LRSA(LRCHG),"^",2)'=$P(LRSB(LRCHG),"^",2) S LRUP=1,$P(LRSA(LRCHG,2),"^",2)=1 ; normalcy flag changed
114 . I $P(LRSA(LRCHG),"^",5)'=$P(LRSB(LRCHG),"^",5) D ; units/normals changed
115 . . N LRX,LRY
116 . . S LRX=$$UP^XLFSTR($P(LRSA(LRCHG),"^",5)),LRX=$TR(LRX,"""")
117 . . S LRY=$$UP^XLFSTR($P(LRSB(LRCHG),"^",5)),LRY=$TR(LRY,"""")
118 . . I LRX'=LRY S LRUP=1,$P(LRSA(LRCHG,2),"^",5)=1
119 I 'LRUP S LREND=1 Q
120 S LREND=0
121 W !! W:IOST["C-" @LRVIDO W "Approve update of data by entering your initials: " W:IOST["C-" @LRVIDOF
122 R LRINI:DTIME
123 I '$T S LREND=1
124 I 'LREND,LRINI'=LRUSI,$$UP^XLFSTR(LRINI)=$$UP^XLFSTR(LRUSI) S LRINI=LRUSI
125 I LRINI'=LRUSI S LREND=1
126 I LREND W !,$C(7),"No updating occurred ",! Q
127 ;
128 F LRSB=1:0 S LRSB=$O(LRSB(LRSB)) Q:LRSB<1 D
129 . K:'$D(^LR(LRDFN,LRSS,LRIDT,LRSB)) LRSA(LRSB)
130 . S ^LR(LRDFN,LRSS,LRIDT,LRSB)=LRSB(LRSB)
131 . I $D(LRSA(LRSB,1)),$D(LRSA(LRSB,2)) D DIDLE
132 W !!
133 Q
134 ;
135 ;
136DIDLE ;
137 ; Check if no previous result or pending result - no audit trail needed
138 I $P(LRSA(LRSB),"^")=""!($P(LRSA(LRSB),"^")="pending") Q
139 ;
140 S LRF=1
141 L +^LR(LRDFN,LRSS,LRIDT):999
142NOW S LRNOW7=$$NOW^XLFDT
143 W !
144 D ^LRDIDLE0
145 I 'LROK K LRSA
146 L -^LR(LRDFN,LRSS,LRIDT)
147 S LRCORECT=1
148 Q
149 ;
150 ;
151RONLT ; (R)esolve (O)rder NLT code from file #68 original ordered test or
152 ; use default when not specified for file #60 test.
153 ;
154 N LR60,LRX,LRY,X
155 S LR60=+LRTS,LRY=$P(LRSB(LRSB),U,3)
156 ;
157 ; Try to determine order NLT from original ordered test
158 F Q:'LR60 D
159 . S LRX=$G(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LR60,0)),LR60=+$P(LRX,"^",9)
160 . I LR60,LR60'=$P(LRX,"^") D
161 . . S X=$$NLT^LRVER1(LR60)
162 . . I X'="" S $P(LRY,"!")=X
163 . I LR60=$P(LRX,"^") S LR60=0
164 ;
165 ; Otherwise use default for lab package
166 I $P(LRY,"!")="" S $P(LRY,"!")=$P($$DEFCODE^LA7VHLU5(LRSS,LRSB,LRY,+LRSPEC),"!")
167 ;
168 S $P(LRSB(LRSB),U,3)=LRY
169 ;
170 Q
171 ;
172 ;
173LRORU3 ;
174SET ;
175 N LR64,LR7V,LRDN,LROTA,LRT,LRTPN,LRTPNN,LRTYPE,X
176 ;
177 ; Go through LRSB array and sort results by order NLT code
178 ; and put into ordered test array (LROTA).
179 S LRDN=0
180 F S LRDN=$O(LRSB(LRDN)) Q:'LRDN D
181 . I $P(LRSB(LRDN),"^")="" Q
182 . S LRTPNN=$P($P(LRSB(LRDN),U,3),"!"),LRT=+$G(^TMP("LR",$J,"TMP",LRDN))
183 . I LRTPNN="" Q
184 . S LRTYPE=$P($G(^LAB(60,LRT,0)),U,3)
185 . I LRTYPE=""!("OB"'[LRTYPE) Q
186 . S LROTA(LRTPNN,LRDN)=LRT
187 . I $D(LRSA(LRDN,2)) S LROTA(LRTPNN,LRDN,1)="C"
188 ;
189 ; For each order NLT code setup call to put results into #62.49 queue
190 S LRTPNN=""
191 F S LRTPNN=$O(LROTA(LRTPNN)) Q:LRTPNN="" D
192 . S LR64=+$O(^LAM("C",LRTPNN_" ",0)),LRTPN=$$GET1^DIQ(64,LR64_",",.01)
193 . K LR7V
194 . M LR7V=LROTA(LRTPNN)
195 . D SET^LA7VMSG($P(LRORU3,U,4),$P(LRORU3,U,2),$P(LRORU3,U,5),$P(LRORU3,U,3),LRTPN,LRTPNN,LRIDT,LRSS,LRDFN,LRODT,.LR7V)
196 Q
Note: See TracBrowser for help on using the repository browser.