source: FOIAVistA/trunk/r/AUTOMATED_LAB_INSTRUMENTS-LA/LAKDIFF.m@ 1328

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

initial load of FOIAVistA 6/30/08 version
File size: 4.6 KB
Line 
1LAKDIFF ;DALOI/RWF - KEYBOARD DIFFERENTIAL COUNTER ;8/16/90 10:38
2 ;;5.2;AUTOMATED LAB INSTRUMENTS;**13,52**;Sep 27, 1994
3 ;
4 ; Cross link by id = accession
5 ;
6LA1 ;
7 I '$D(LRPARAM) D ^LRPARAM
8 ;
9 D HOME^%ZIS
10 ;
11 S LANM=$T(+0),TSK=$O(^LAB(62.4,"C",LANM,0)),U="^"
12 I TSK<1 D Q
13 . W !,"Unable to find entry in AUTO INSTRUMENT file using ",LANM," as PROGRAM NAME"
14 . D QUIT
15 ;
16 W !!?20,"KEYPAD DIFF ENTRY",!!
17 ;
18 S LREND=0,LRTOP=$P(^LAB(69.9,1,1),U,1)
19 D ^LASET
20 I 'TSK D Q
21 . W $C(7),!!,"AUTO INSTRUMENT file is incompletly defined for the Keypad Diff."
22 . D QUIT
23 ;
24 I LALCT="N" D Q
25 . W $C(7),!!,"Field LOAD CHEM TESTS is configured incorrectly in AUTO INSTRUMENT File"
26 . W !,"Set it to either 'TC ARRAY' or 'TMP GLOBAL'."
27 . D QUIT
28 ;
29 K ^LA("LOCK",TSK)
30 ;
31 S DTIME=$$DTIME^XUP(DUZ)
32 S DT=$$DT^XLFDT
33 ;
34 D DISPLAY
35 I LREND D QUIT Q
36 ;
37 ; Select accession date to use
38 S LRAA=+$G(WL)
39 I LRAA<1 D QUIT Q
40 D ADATE^LRWU
41 I LREND D QUIT Q
42 ;
43 ; Get last accession used on this date if any
44 S LRAN=+$P($G(^LRO(68,LRAA,1,LRAD,2)),"^",4)
45 ;
46 I $P(LRPARAM,U,14),$P($G(^LRO(68,LRAA,0)),U,16) D ^LRCAPV
47 I LREND D QUIT Q
48 ;
49 D INT
50 ;
51 ; Setup screen and keyboard
52 S LAXGF=1 D PREP^XGF
53 ;
54 ; Set read terminator to <CR>. Otherwise problems in scroll&roll sections.
55 D INITKB^XGF($C(13))
56 ;
57 ; Turn on echo, cursor, keypad in numeric mode
58 X ^%ZOSF("EON") W IOCUON_IOKPNM
59 ;
60 ; Get code to erase entire display
61 S X="IOEDALL" D ENDR^%ZISS
62 ;
63 F D LA2 Q:LREND
64 D QUIT
65 ;
66 Q
67 ;
68LA2 ;
69 N CUP,FLAG,I,ID,IDE,LADFN,LADT,LAOK,TRAY,TV,X,Y
70 ;
71 S RMK=""
72 F D WLN Q:LREND!(LAOK)
73 I LREND Q
74 S FLAG=0
75 ;
76 ; Save value of LRDFN, call to LAGEN sets it to 0
77 S LADFN=LRDFN
78 S (ID,LOG)=LRAN,IDE=0,LADT=LRAD
79 S TRAY=1,CUP=""
80 ;Can be changed by the cross-link code
81 X LAGEN
82 I 'ISQN D Q
83 . W !!,$C(7),"Unable to create entry in LAH global",!
84 ;
85 S LRDFN=LADFN
86 ;
87 D ^LAKDIFF1
88 I 'FLAG D ^LAKDIFF2
89 I FLAG Q
90 ;
91 S I=0
92 F S I=$O(TV(I)) Q:I<1 S:TV(I,1)]"" ^LAH(LWL,1,ISQN,I)=TV(I,1)
93 I $L($G(RMK)) D RMK^LASET
94 ;
95 D ^LAKDIFF3
96 Q
97 ;
98WLN ; Select accession/patient to work with
99 N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
100 ;
101 S LAOK=0
102 S LRAN=$O(^LRO(68,LRAA,1,LRAD,1,LRAN))
103 I LRAN'>0 S LRAN="^"
104 S DIR(0)="NO^1:9999999:0^K:'$D(^LRO(68,LRAA,1,LRAD,1,X,0)) X"
105 S DIR("A")="Accession Number",DIR("B")=LRAN
106 S DIR("?")="Enter a valid accession number to enter DIFF results on."
107 D ^DIR
108 I $D(DIRUT) S LREND=1 Q
109 S LRAN=Y
110 ;
111 S LRDFN=+^LRO(68,LRAA,1,LRAD,1,LRAN,0),LRACC=$S($D(^(.2)):^(.2),1:"")
112 S LRODT=$S($P(^LRO(68,LRAA,1,LRAD,1,LRAN,0),U,4):$P(^(0),U,4),1:$P(^(0),U,3)),LRSN=$P(^(0),U,5)
113 S LRIDT=$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,3)),"^",5)
114 ;
115 S LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3)
116 D PT^LRX
117 ;
118 K DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
119 ;
120 S DIR(0)="YO"
121 S DIR("A",1)="Patient name: "_PNM_" SSN: "_SSN_" Acc: "_LRACC
122 S DIR("A")="Is this the correct patient"
123 S DIR("B")="YES"
124 D ^DIR
125 ;
126 I $D(DIRUT) S LREND=1 Q
127 I Y=1 S LAOK=1
128 Q
129 ;
130INT ;
131 N I1,I2,I3,I4,LAI,LAJ,X
132 ;
133 K KEY
134 ;
135 I LALCT="T" D
136 . M ^TMP("LA",$J)=TC
137 . K TC
138 ;
139 S LAI=0
140 F S LAI=$O(^TMP("LA",$J,LAI)) Q:LAI'>0 D
141 . S LAJ=$S(LAI<30:"W",1:"R")
142 . S I3=^(LAI,3),I4=^(4),X=^(0)
143 . ;
144 . I $D(KEY(LAJ,I4)) D Q
145 . . W $C(7),!!,">> The same KEY (",I4,") is set for more than one TEST<<",!!,$C(7)
146 . ;
147 . S I1=$P(^LAB(60,X,.1),U,1),I2=+^(.2)
148 . S ^TMP("LA",$J,LAI,.1)=I1,^(.2)=I2
149 . S ^TMP($J,LAJ,LAI)=I4,KEY(LAJ,I4)=""
150 . I I3=2 S ^TMP($J,"NC",LAI)=""
151 Q
152 ;
153DISPLAY ; Ask user if display should be updated on each key press
154 ;
155 N DIR,DIROUT,DIRUT,DTOUT,LAXPAR,X,Y
156 ;
157 ; Get stored value from parameter tool
158 S X=$$GET^XPAR("USR","LA KDIFF DISPLAY UPDATE",1,"E")
159 ;
160 I $L(X) S DIR("B")=X
161 E S DIR("B")="YES"
162 S DIR(0)="YO"
163 S DIR("A")="Update display on each key press"
164 D ^DIR
165 I $D(DIRUT) S LREND=1 Q
166 ;
167 S LAUPDATE=Y
168 ; Save parameter for future use
169 D EN^XPAR("USR","LA KDIFF DISPLAY UPDATE",1,Y,.LAXPAR)
170 Q
171 ;
172QUIT ;
173 ;
174 I $D(ZTQUEUED) S ZTREQ="@"
175 ;
176 I $G(LAXGF) D
177 . D CLEAN^XGF
178 . D KILL^%ZISS
179 ;
180 S LREND=0
181 I $D(LRCSQ),'$O(^XTMP("LRCAP",LRCSQ,DUZ,0)) D
182 . K ^XTMP("LRCAP",LRCSQ,DUZ)
183 . K LRCSQ
184 ;
185 I $D(LRCSQ),$G(LRAA),$P($G(^LRO(68,+LRAA,0)),U,16) D STD^LRCAPV
186 ;
187 D STOP^LRCAPV
188 D ^LRGVK
189 ;
190 K %,ACK,ASK,BASE,C,CENUM,CHK,CNT,CODE,CONT,CUP,DA,DATYP,DFN,DONE,DPF,ECHOALL,ER,FLAG,HDR,HOME,HRD,I,I1,I3,I4,ID,IDE,IDENT,IDT,IN,ISQN,J,K,KEY,L,LAGEN,LACT,LALCT,LANM,LAUPDATE,LAXGF,LINE
191 K LINK,LOG,LRAA,LRACC,LRAD,LRAN,LRDFN,LRDPF,LRDY,LREND,LRIDT,LRIO,LRLL,LRODT,LROVER,LRPGM,LRSET,LRSN,LRSUBS,LRTIME,LRTOP,LRTST,LWL,M,METH,NAK,NC,NOW,OUT,PNM,Q,RMK,RT,SS
192 K SSN,STORE,T,T1,T2,TC,TEMP,TOTAL,TOUT,TP,TQ,TRAP,TRAY,TRY,TSK,TV,TY,TYPE,V,WDT,WL,X,Y,YY,Z,ZTSK
193 ;
194 K ^TMP($J),^TMP("LA",$J),^TMP("LR",$J)
195 Q
196 ;
197TRAP ; Error Trap
198 D ^LABERR
199 S T=TSK D SET^LAB
200 G @("LA2^"_LANM)
Note: See TracBrowser for help on using the repository browser.