source: FOIAVistA/trunk/r/AUTOMATED_LAB_INSTRUMENTS-LA/LAXSYM.m

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

initial load of FOIAVistA 6/30/08 version

File size: 4.0 KB
Line 
1LAXSYM ;MLD/ABBOTT/SLC/RAF - TEMPLATE ROUTINE FOR AUTOMATED DATA ;6/13/96 0900 ;
2 ;;5.2;AUTOMATED LAB INSTRUMENTS;**11,19**;Sep 27, 1994
3 ;CROSS LINK BY ID OR IDE
4 ;
5LAPX ; orig routine name, copied to LAXSYM (for Abbott AxSYM) 5/3/94 /mld
6 ;
7 N FR,LANM,TSK,LANM,A,I,X,Y,TC,TV,V1,TOUT,BAD,ID,IDE,TRAY,CUP,LANOCTL1,TP
8 N LATEST,RMK,DATE,CNT,LAGEN,RESCOM,RESTYPE,HCNT,DFN,HTYPE,IN,OUT,D
9 N LALCT,LAZZ,LINK,LOG,LRDFN,LROVER,LWL,METH,NOW,WL,ALPHA,TST60,TSK
10 N ISQN,LADT
11 ;
12LA1 ; Init vars/arrays
13 S LANM=$T(+0),TSK=$O(^LAB(62.4,"C",LANM,0)) Q:TSK<1
14 K LATOP D ^LASET Q:'TSK
15 D LA1INIT^LAXSYMU ; init vars in util routine
16 ;
17LA2 ; Begin here to parse out data
18 K TV,Y
19 S (TST60,TOUT)=0,(A,TRAY)=1,(CUP,ID,IDE,RMK)="",D="|"
20 D IN ; get data
21 G QUIT:TOUT,LA2:IN=""!(V1'="H") ; 'H' is start of packet
22 G:$F("HPORLCQMS",V1)<2 LA2 ; frame hdr = line tag
23 I V1="H" S HCNT=CNT-1 ; get hdr count for error trapping
24 D @V1 ; get hdr info
25 ;
26 ; loop thru single packet, L=end of packet
27 F A=2:1 D IN Q:TOUT!(V1="L") I $F("ORLCQMS",V1)>1 D @V1 ; bypass HP
28 ;
29LA3 ; Now process the packet
30 G:'$G(ID) LA2 ; not valid or incomplete record
31 X LAGEN G LA2:'ISQN ; Can be changed by the cross-link code
32 F I=0:0 S I=$O(TV(I)) Q:I<1 S:TV(I,1)]"" ^LAH(LWL,1,ISQN,I)=TV(I,1)
33 I RMK]"" D RMK^LASET
34 G LA2
35 ;
36H ; Header node TYPE: P=pt, Q=qc
37 S HTYPE=$P(IN,D,12)
38 Q
39 ;
40P ; Patient node
41 S DFN=$P($P(IN,D,5),U)
42 Q
43 ;
44O ; Order node.
45 N SPECID,TNUM,PTYPE,X,AN,L
46 S SPECID=$P(IN,D,4),AN=$P(SPECID,U),L=$L(AN)
47 ; AN is the numeric value of the last 4 characters of SID field!
48 S AN=+$TR($E(AN,(L-4),L),ALPHA) ; just the #
49 S TNUM=+$P($P(IN,D,5),U,4)
50 Q:'TNUM Q:'AN ; no AxSYM test or Accn Num
51 S TST60=$$ACCN ; get file 60 test num (TST60)
52 Q:'TST60 ; invalid test
53 S PTYPE=$P(IN,D,12) ; ""=pt, Q=QC
54 Q:$P(IN,D,26)'="F" ; 'F'inal, X=could not run tst
55 S (ID,IDE)=AN ; should be OK
56 Q
57 ;
58R ; Results node
59 Q:'ID ; no accn to put results to!
60 N TST,TNUM,TRES,V,DEC,FLAG
61 S FLAG=$P(IN,D,7) Q:FLAG="<" Q:FLAG=">" ; test out of range
62 ;
63 S TST=$P(IN,D,3) ; eg., TST = "^^^211^GLUCOSE^UNDILUTED"
64 S TNUM=+$P(TST,U,4) ; AxSYM's internal test number
65 Q:'$D(LATEST(TNUM,TST60)) ; invalid AxSYM/DHCP test match
66 ;
67 S TRES=$P(TST,U,8),V=$P(IN,D,4)
68 I TRES="X" S ^LA(INST,"ERX",$H)=IN Q ; Xception results (error msg)
69 Q:"F"'[TRES ; type result should be "F"inal or NULL
70 Q:V="" ; no result!
71 ;
72 S DEC=TC(+LATEST(TNUM,TST60),3)
73 I $L(DEC) S V=$J(V,1,DEC) ; # dec'mls (Param 2)
74 X:$L(TC(+LATEST(TNUM,TST60),2)) TC(+LATEST(TNUM,TST60),2) ; use param 1
75 S @TC(+LATEST(TNUM,TST60),1)=V ; save to TV array
76 Q
77 ;
78L ; Packet termination node
79 Q
80 ;
81C ; Comments node. type = G if result comment, = I if Exception string
82 S (RMK,RESCOM)=$P(IN,D,4),RESTYPE=$P(IN,D,5)
83 Q
84 ;
85Q ; Set-up Query node
86 N LRAN,LRAA,LRDT,LRNAME,SSN,LRFRM,BAD,LRAD,INST
87 S LRAA=WL,(LRDT,LRAD)=LADT,LRNAME="",LRFRM=0,BAD=0,INST=TSK
88 S LRAN=$P($P(IN,D,3),U,2)
89 D PNM^LAXSYMBL
90 ; chk for valid request
91 I LRNAME=""!('$F(IN,"^^ALL")) S $P(IN,"|",13)="X",BAD=1
92 D HQSET^LAXSYMHQ ; builds H/Q/L frames for downloading
93 S X="TRAP^"_LANM,@^%ZOSF("TRAP") ; reset error trap
94 Q
95 ;
96M ; Manufacturer node
97 Q
98 ;
99S ; Scientific (not used)
100 Q
101 ;
102ACCN() ; Chk file 68 for Accn'd test (file 60)
103 N I,J,N S (I,J,N)=0
104 F S I=$O(LATEST(TNUM,I)) Q:'I I $D(^LRO(68,WL,1,LADT,1,AN,4,I)) Q
105 I 'I F S J=$O(^LRO(68,WL,1,LADT,1,AN,4,J)) Q:'J S I=0 D I N S I=N Q
106 .F S I=$O(^LAB(60,J,2,I)) Q:'I I $D(LATEST(TNUM,^(I,0))) S N=^(0) Q
107 Q +I
108 ;
109NUM ;- not used here - IN+3,4 replaces this (slower) code /mld
110 S X="" F JJ=1:1:$L(V) S:$A(V,JJ)>32 X=X_$E(V,JJ)
111 S V=X
112 Q
113 ;
114IN S CNT=^LA(TSK,"I",0)+1 IF '$D(^(CNT)) S TOUT=TOUT+1 Q:TOUT>5 H 5 G IN
115 S ^LA(TSK,"I",0)=CNT,IN=^(CNT),TOUT=0
116 ; strip contl chars, get FRame num and hdr node (H,P,O,R,L)
117 ; NOTE: $TR(IN,LANOCTL1) replaces 'D NUM' code in template routine /mld
118 S IN=$TR(IN,LANOCTL1),FR=+IN,V1=$TR($P(IN,D),FR)
119 Q
120 ;
121QUIT L +^LA(TSK,"I")
122 K ^LA(TSK,"I"),^LA("LOCK",TSK),^TMP($J),^TMP("LA",$J)
123 I $D(ZTSK) D KILL^%ZTLOAD K ZTSK
124 L -^LA(TSK,"I")
125 Q
126 ;
127TRAP ; Process errors
128 D ^LABERR S T=TSK
129 S ^LA(TSK,"I",0)=+$G(HCNT) ; keeps last HDR frame location
130 D SET^LAB G LA2
Note: See TracBrowser for help on using the repository browser.