| 1 | LAXSYM ;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 | ;
|
|---|
| 5 | LAPX ; 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 | ;
|
|---|
| 12 | LA1 ; 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 | ;
|
|---|
| 17 | LA2 ; 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 | ;
|
|---|
| 29 | LA3 ; 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 | ;
|
|---|
| 36 | H ; Header node TYPE: P=pt, Q=qc
|
|---|
| 37 | S HTYPE=$P(IN,D,12)
|
|---|
| 38 | Q
|
|---|
| 39 | ;
|
|---|
| 40 | P ; Patient node
|
|---|
| 41 | S DFN=$P($P(IN,D,5),U)
|
|---|
| 42 | Q
|
|---|
| 43 | ;
|
|---|
| 44 | O ; 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 | ;
|
|---|
| 58 | R ; 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 | ;
|
|---|
| 78 | L ; Packet termination node
|
|---|
| 79 | Q
|
|---|
| 80 | ;
|
|---|
| 81 | C ; 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 | ;
|
|---|
| 85 | Q ; 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 | ;
|
|---|
| 96 | M ; Manufacturer node
|
|---|
| 97 | Q
|
|---|
| 98 | ;
|
|---|
| 99 | S ; Scientific (not used)
|
|---|
| 100 | Q
|
|---|
| 101 | ;
|
|---|
| 102 | ACCN() ; 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 | ;
|
|---|
| 109 | NUM ;- 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 | ;
|
|---|
| 114 | IN 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 | ;
|
|---|
| 121 | QUIT 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 | ;
|
|---|
| 127 | TRAP ; 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
|
|---|
