source: WorldVistAEHR/trunk/r/AUTOMATED_LAB_INSTRUMENTS-LA/LAKDIFF1.m@ 623

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

initial load of WorldVistAEHR

File size: 5.5 KB
Line 
1LAKDIFF1 ;DALOI/RWF/LL/RES - KEYBOARD DIFF PART 2 ; 7/14/87 08:02
2 ;;5.2;AUTOMATED LAB INSTRUMENTS;**52**;Sep 27, 1994
3 ; WBC DIFF CELL COUNTER
4 ;
5A ;
6 N LAI
7 ;
8 K KEY,NC,TY,T1,T2
9 ;
10 S KEY="",LAI=0
11 F S LAI=$O(^TMP($J,"W",LAI)) Q:LAI="" D
12 . S K=^TMP($J,"W",LAI),KEY(K)=LAI,KEY=KEY_K,TY(K)=""
13 . I $D(^TMP($J,"NC",LAI)) S NC(K)=""
14 ;
15 F LAI=1:1:27 D Q:$O(^TMP($J,"W",LAI))=""
16 . S X=$G(^TMP("LA",$J,LAI,4))
17 . S Y=$G(^TMP("LA",$J,LAI,.1))
18 . S ^TMP($J,"A",LAI\9+1,LAI#9)=X_"^"_Y,T2=LAI
19 ;
20 S T1=1,(T1(1),T2(1))=""
21 ;
22 F LAI=1:1:T2 D
23 . S X=^TMP($J,"A",LAI\9+1,LAI#9)
24 . S T1(T1)=T1(T1)_$J($P(X,U,1),8)
25 . S T2(T1)=T2(T1)_$J($P(X,U,2),8)
26 . I '(LAI#9) S T1=T1+1,(T1(T1),T2(T1))=""
27 ;
28 S (TOTAL,FLAG,STORE)=0
29 D HD1,HD4,HD2
30 ;
31 F Q:TOTAL=200!FLAG!STORE D
32 . N DTOUT
33 . D SAY^XGF(IOSL-1,0,"WBC: ")
34 . S TYPE=$$READ^XGF(1,DTIME)
35 . I TYPE="^"!($D(DTOUT)) S FLAG=1 Q
36 . S LINE=$S(TYPE="":"STOP",TYPE="-":"MINUS",TYPE="!":"COM",KEY'[TYPE:"HELP",1:"COUNT")
37 . D @LINE
38 ;
39 D STORE:(TOTAL=200)!(STORE)
40 ;
41 K TEMP,T1,T2,KEY,NC,CONT,J,L,TOTAL,CHK,STORE
42 Q
43 ;
44COUNT ; Add key to cell count
45 ;
46 ; Count key
47 I '$D(NC(TYPE)) S TOTAL=TOTAL+1
48 ;
49 S TY(TYPE)=TY(TYPE)+1
50 I LAUPDATE D SHOWCNT
51 D HD3
52 I '$D(NC(TYPE)),(TOTAL=100!(TOTAL=200)) D EVAL
53 Q
54 ;
55HELP ;
56 ;
57 I TYPE'="?" D Q
58 . D CLEAR^XGF(IOSL-1,0,IOSL-1,IOM-1)
59 . D SAY^XGF(IOSL-1,0,$C(7)_"INVALID WBC CELL KEY")
60 . H 2
61 . D CLEAR^XGF(IOSL-1,0,IOSL-1,IOM-1)
62 . D HD3
63 ;
64 D SHOWCNT,HD3
65 Q
66 ;
67SHOWCNT ; Display current cell count
68 ;
69 N I,I1,X,K
70 ;
71 S $Y=LRDY
72 F I1=1:9:T2 D
73 . S $Y=$Y+3,$X=6
74 . F I=I1:1:I1+8 Q:I>T2 D
75 . . S X=$G(^TMP($J,"W",I),"^"),K=$G(TY(X))
76 . . I '$L(K) S $X=$X+8
77 . . E D SAY^XGF($Y,$X+(9-$L(K)),K,"R1")
78 . S $Y=$Y+1
79 Q
80 ;
81STOP ;
82 D EVAL
83 ;
84 N DIR,DIROUT,DTOUT,DUOUT,X,Y
85 ;
86 S DIR(0)="YO",DIR("B")="Y"
87 I TOTAL<100 S DIR("A",1)=$C(7)_"* You have counted "_TOTAL_" CELLS *"
88 S DIR("A")="Are you finished with the WBC cell count"
89 D ^DIR
90 I $D(DIRUT) S FLAG=1 Q
91 I Y=1 S STORE=1
92 I FLAG=STORE D HD1,HD4,HD2,SHOWCNT
93 Q
94 ;
95EVAL ;
96 N LAI
97 ;
98 W $C(7) D HD1
99 I TOTAL<100 W $C(7),!,"NOTE: ONLY ",TOTAL," CELLS COUNTED",!! Q:TOTAL=0
100 W !,"Test",?11,"Count Value"
101 S LAI=0
102 F S LAI=$O(^TMP($J,"W",LAI)) Q:LAI="" D
103 . S K=^TMP($J,"W",LAI)
104 . W !,$$LJ^XLFSTR(^TMP("LA",$J,LAI,.1),11,".")
105 . S V=TY(K)
106 . W $J(V,5)," "
107 . X ^TMP("LA",$J,LAI,2)
108 . W $J(V,5)
109 ;
110 W !,$$LJ^XLFSTR("Total",11,".")," ",$J(TOTAL,5),!
111 I '(TOTAL=100!(TOTAL=200)) Q
112 I TOTAL=100 D TWO
113 Q
114 ;
115TWO ;
116 N DIR,DIROUT,DTOUT,DUOUT,X,Y
117 ;
118 ; Flush buffer
119 F S X=$$READ^XGF(1,1) Q:$D(DTOUT)
120 ;
121 S DIR(0)="SBO^C:CONTINUE;S:STOP"
122 S DIR("A",1)="100 Cells counted"
123 S DIR("A")="CONTINUE counting to 200 or STOP"
124 S DIR("B")="STOP"
125 D ^DIR
126 I $D(DIRUT) S FLAG=1 Q
127 I Y="S" S STORE=1
128 I Y="C" D
129 . N TYPE
130 . D HD1,HD4,HD2
131 . I LAUPDATE S TYPE="?" D HELP
132 ;
133 Q
134 ;
135STORE ;
136 N LAI
137 ;
138 S LAI=0
139 F S LAI=$O(^TMP($J,"W",LAI)) Q:LAI="" D
140 . S K=^(LAI),V=TY(K)
141 . X ^TMP("LA",$J,LAI,2)
142 . S @^TMP("LA",$J,LAI,1)=V
143 Q
144 ;
145MINUS ;
146 ; Clear line on screen display
147 D CLEAR^XGF(IOSL-1,0,IOSL-1,IOM-1)
148 ;
149 D SAY^XGF(IOSL-1,0,"SUBTRACT WHICH CELL TYPE: ")
150 ;
151 S TYPE=$$READ^XGF(1,DTIME)
152 ;
153 ; Clear line on screen display
154 D CLEAR^XGF(IOSL-1,0,IOSL-1,IOM-1)
155 ;
156 I $D(DTOUT) S FLAG=1 Q
157 I $L(TYPE) D
158 . I KEY'[TYPE D Q
159 . . D CLEAR^XGF(IOSL-1,0,IOSL-1,IOM-1)
160 . . D SAY^XGF(IOSL-1,0,"INVALID WBC CELL KEY")
161 . . H 2
162 . . D CLEAR^XGF(IOSL-1,0,IOSL-1,IOM-1)
163 . I TY(TYPE)>0 D
164 . . S TY(TYPE)=TY(TYPE)-1
165 . . I '$D(NC(TYPE)),TOTAL>0 S TOTAL=TOTAL-1
166 ;
167 D HD1,HD4,HD2
168 I LAUPDATE D SHOWCNT
169 Q
170 ;
171HD1 ;
172 W IOEDALL
173 D SAY^XGF(0,0,"Patient name: "_PNM)
174 D SAY^XGF(0,45,"SSN: "_SSN)
175 Q
176 ;
177HD2 ;
178 D SAY^XGF("+2",0,"CELL DIFFERENTIAL ('?' = DISPLAY, '!' = COMMENTS, '-' = MINUS, <RETURN> = EXIT)")
179 S LRDY=$Y
180 F I=1:1:T1 D
181 . D SAY^XGF("+",0,$$LJ^XLFSTR("KEY",7)_T1(I))
182 . D SAY^XGF("+",0,$$LJ^XLFSTR("TEST",7)_T2(I))
183 . S $Y=$Y+2
184 ;
185HD3 ;
186 ; Clear line on screen display
187 D CLEAR^XGF(IOSL-1,0,IOSL-1,IOM-1)
188 ;
189 D SAY^XGF(IOSL-1,18,"TOTAL: ")
190 D SAY^XGF(IOSL-1,$X+(3-$L(TOTAL)),TOTAL,"R1")
191 Q
192 ;
193HD4 ;
194 N C,I,LADY,LAPN,LAQUIT,LAROW,LAYOFF,X,Y,V
195 ;
196 K ^TMP("LADATA",$J)
197 ;
198 D SAY^XGF($Y+1,0,$$CJ^XLFSTR("> CBC PROFILE *=unverified <",IOM))
199 S LADY=$Y+1
200 ;
201 ; Find unverified results in LAH
202 S C=1
203 F S C=$O(^LAH(LWL,1,ISQN,C)) Q:C<1 D
204 . S V=^LAH(LWL,1,ISQN,C)
205 . S LAPN=$$PN(C)
206 . S ^TMP("LADATA",$J,C)="*"_$$LJ^XLFSTR(LAPN,8,".")_" "_$P(V,U,1)_" "_$P(V,U,2)
207 ;
208 ; Find verified results in LR, overwrite any LAH unverified results.
209 S C=1
210 F S C=$O(^LR(LRDFN,"CH",LRIDT,C)) Q:C<1 D
211 . S V=^LR(LRDFN,"CH",LRIDT,C)
212 . S LAPN=$$PN(C)
213 . S ^TMP("LADATA",$J,C)=" "_$$LJ^XLFSTR(LAPN,8,".")_" "_$P(V,U,1)_" "_$P(V,U,2)
214 ;
215 ; Determine number of key rows and screen cutoff
216 S LAROW=$O(T1(""),-1)
217 S LAYOFF=$P("8^13^17","^",LAROW)
218 ;
219 S C=1,(I,LAQUIT)=0
220 F S C=$O(^TMP("LADATA",$J,C)) Q:'C D Q:LAQUIT
221 . S V=^TMP("LADATA",$J,C)
222 . D SAY^XGF(LADY,I*25,V)
223 . S I=I+1
224 . I I>2 D
225 . . S I=0,LADY=LADY+1
226 . . I (IOSL-LAYOFF)<LADY,$O(^TMP("LADATA",$J,C)) D
227 . . . D SAY^XGF(LADY,0,$$CJ^XLFSTR("*** RESULTS TRUNCATED - INSUFFICIENT DISPLAY SPACE ***",IOM))
228 . . . S LAQUIT=1
229 ;
230 K ^TMP("LADATA",$J)
231 Q
232 ;
233PN(LA60) ; get print name for result
234 ; Call with LA60 = ien of file #63 dataname
235 ; Returns print name
236 ;
237 N LAPN,X
238 ;
239 S LAPN=""
240 ;
241 S X=$O(^LAB(60,"C","CH;"_LA60_";1",0))
242 I X>0 D
243 . S LAPN=$P($G(^LAB(60,X,.1)),"^")
244 . ; If no print name use full name
245 . I LAPN="" S LAPN=$P($G(^LAB(60,X,0)),"^")
246 ;
247 Q LAPN
248 ;
249COM ;
250 D COM1
251 D HD1,HD4,HD2
252 I LAUPDATE D SHOWCNT
253 Q
254 ;
255COM1 ;
256 ;
257 N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
258 ;
259 S DIR(0)="FO^1:68",DIR("A")="Comment"
260 I $L($G(RMK)) S DIR("B")=RMK
261 D ^DIR
262 I $D(DIRUT) D Q
263 . I X="@" S RMK=""
264 S RMK=Y
265 ;
266 Q
Note: See TracBrowser for help on using the repository browser.