Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LAXSYM

LAXSYM.m

Go to the documentation of this file. 
  1. LAXSYM ;MLD/ABBOTT/SLC/RAF - TEMPLATE ROUTINE FOR AUTOMATED DATA ;6/13/96 0900 ; [ 01/12/98  11:20 AM ]
  1.  ;;5.2;LA;**1001**;DEC 10, 1997
  1.  ;;5.2;AUTOMATED LAB INSTRUMENTS;**11,19**;Sep 27, 1994
  1.  ;CROSS LINK BY ID OR IDE
  1.  ;
  1. LAPX ; orig routine name, copied to LAXSYM (for Abbott AxSYM) 5/3/94 /mld
  1.  ;
  1.  N FR,LANM,TSK,LANM,A,I,X,Y,TC,TV,V1,TOUT,BAD,ID,IDE,TRAY,CUP,LANOCTL1,TP
  1.  N LATEST,RMK,DATE,CNT,LAGEN,RESCOM,RESTYPE,HCNT,DFN,HTYPE,IN,OUT,D
  1.  N LALCT,LAZZ,LINK,LOG,LRDFN,LROVER,LWL,METH,NOW,WL,ALPHA,TST60,TSK
  1.  N ISQN,LADT
  1.  ;
  1. LA1 ; Init vars/arrays
  1.  S LANM=$T(+0),TSK=$O(^LAB(62.4,"C",LANM,0)) Q:TSK<1
  1.  K LATOP D ^LASET Q:'TSK
  1.  D LA1INIT^LAXSYMU ; init vars in util routine
  1.  ;
  1. LA2 ; Begin here to parse out data
  1.  K TV,Y
  1.  S (TST60,TOUT)=0,(A,TRAY)=1,(CUP,ID,IDE,RMK)="",D="|"
  1.  D IN ; get data
  1.  G QUIT:TOUT,LA2:IN=""!(V1'="H") ; 'H' is start of packet
  1.  G:$F("HPORLCQMS",V1)<2 LA2 ; frame hdr = line tag
  1.  I V1="H" S HCNT=CNT-1 ; get hdr count for error trapping
  1.  D @V1 ; get hdr info
  1.  ;
  1.  ; loop thru single packet, L=end of packet
  1.  F A=2:1 D IN Q:TOUT!(V1="L")  I $F("ORLCQMS",V1)>1 D @V1 ; bypass HP
  1.  ;
  1. LA3 ; Now process the packet
  1.  G:'$G(ID) LA2 ; not valid or incomplete record
  1.  X LAGEN G LA2:'ISQN ; Can be changed by the cross-link code
  1.  F I=0:0 S I=$O(TV(I)) Q:I<1  S:TV(I,1)]"" ^LAH(LWL,1,ISQN,I)=TV(I,1)
  1.  I RMK]"" D RMK^LASET
  1.  G LA2
  1.  ;
  1. H ; Header node TYPE: P=pt, Q=qc
  1.  S HTYPE=$P(IN,D,12)
  1.  Q
  1.  ;
  1. P ; Patient node
  1.  S DFN=$P($P(IN,D,5),U)
  1.  Q
  1.  ;
  1. O ; Order node.
  1.  N SPECID,TNUM,PTYPE,X,AN,L
  1.  S SPECID=$P(IN,D,4),AN=$P(SPECID,U),L=$L(AN)
  1.  ; AN is the numeric value of the last 4 characters of SID field!
  1.  S AN=+$TR($E(AN,(L-4),L),ALPHA) ; just the #
  1.  S TNUM=+$P($P(IN,D,5),U,4)
  1.  Q:'TNUM  Q:'AN  ; no AxSYM test or Accn Num
  1.  S TST60=$$ACCN ; get file 60 test num (TST60)
  1.  Q:'TST60  ; invalid test
  1.  S PTYPE=$P(IN,D,12) ; ""=pt, Q=QC
  1.  Q:$P(IN,D,26)'="F"  ; 'F'inal, X=could not run tst
  1.  S (ID,IDE)=AN ; should be OK
  1.  Q
  1.  ;
  1. R ; Results node
  1.  Q:'ID  ; no accn to put results to!
  1.  N TST,TNUM,TRES,V,DEC,FLAG
  1.  S FLAG=$P(IN,D,7) Q:FLAG="<"  Q:FLAG=">"  ; test out of range
  1.  ;
  1.  S TST=$P(IN,D,3) ; eg., TST = "^^^211^GLUCOSE^UNDILUTED"
  1.  S TNUM=+$P(TST,U,4) ; AxSYM's internal test number
  1.  Q:'$D(LATEST(TNUM,TST60))  ; invalid AxSYM/DHCP test match
  1.  ;
  1.  S TRES=$P(TST,U,8),V=$P(IN,D,4)
  1.  I TRES="X" S ^LA(INST,"ERX",$H)=IN Q  ; Xception results (error msg)
  1.  Q:"F"'[TRES  ; type result should be "F"inal or NULL
  1.  Q:V=""  ; no result!
  1.  ;
  1.  S DEC=TC(+LATEST(TNUM,TST60),3)
  1.  I $L(DEC) S V=$J(V,1,DEC) ; # dec'mls (Param 2)
  1.  X:$L(TC(+LATEST(TNUM,TST60),2)) TC(+LATEST(TNUM,TST60),2) ; use param 1
  1.  S @TC(+LATEST(TNUM,TST60),1)=V ; save to TV array
  1.  Q
  1.  ;
  1. L ; Packet termination node
  1.  Q
  1.  ;
  1. C ; Comments node.  type = G if result comment, = I if Exception string
  1.  S (RMK,RESCOM)=$P(IN,D,4),RESTYPE=$P(IN,D,5)
  1.  Q
  1.  ;
  1. Q ; Set-up Query node
  1.  N LRAN,LRAA,LRDT,LRNAME,SSN,LRFRM,BAD,LRAD,INST
  1.  S LRAA=WL,(LRDT,LRAD)=LADT,LRNAME="",LRFRM=0,BAD=0,INST=TSK
  1.  S LRAN=$P($P(IN,D,3),U,2)
  1.  D PNM^LAXSYMBL
  1.  ; chk for valid request
  1.  I LRNAME=""!('$F(IN,"^^ALL")) S $P(IN,"|",13)="X",BAD=1
  1.  D HQSET^LAXSYMHQ ; builds H/Q/L frames for downloading
  1.  S X="TRAP^"_LANM,@^%ZOSF("TRAP") ; reset error trap
  1.  Q
  1.  ;
  1. M ; Manufacturer node
  1.  Q
  1.  ;
  1. S ; Scientific (not used)
  1.  Q
  1.  ;
  1. ACCN() ; Chk file 68 for Accn'd test (file 60)
  1.  N I,J,N S (I,J,N)=0
  1.  F  S I=$O(LATEST(TNUM,I)) Q:'I  I $D(^LRO(68,WL,1,LADT,1,AN,4,I)) Q
  1.  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
  1.  .F  S I=$O(^LAB(60,J,2,I)) Q:'I  I $D(LATEST(TNUM,^(I,0))) S N=^(0) Q
  1.  Q +I
  1.  ;
  1. NUM ;- not used here - IN+3,4 replaces this (slower) code  /mld
  1.  S X="" F JJ=1:1:$L(V) S:$A(V,JJ)>32 X=X_$E(V,JJ)
  1.  S V=X
  1.  Q
  1.  ;
  1. IN S CNT=^LA(TSK,"I",0)+1 IF '$D(^(CNT)) S TOUT=TOUT+1 Q:TOUT>5  H 5 G IN
  1.  S ^LA(TSK,"I",0)=CNT,IN=^(CNT),TOUT=0
  1.  ; strip contl chars, get FRame num and hdr node (H,P,O,R,L)
  1.  ; NOTE: $TR(IN,LANOCTL1) replaces 'D NUM' code in template routine /mld
  1.  S IN=$TR(IN,LANOCTL1),FR=+IN,V1=$TR($P(IN,D),FR)
  1.  Q
  1.  ;
  1. QUIT L +^LA(TSK,"I")
  1.  K ^LA(TSK,"I"),^LA("LOCK",TSK),^TMP($J),^TMP("LA",$J)
  1.  I $D(ZTSK) D KILL^%ZTLOAD K ZTSK
  1.  L -^LA(TSK,"I")
  1.  Q
  1.  ;
  1. TRAP ; Process errors
  1.  D ^LABERR S T=TSK
  1.  S ^LA(TSK,"I",0)=+$G(HCNT) ; keeps last HDR frame location
  1.  D SET^LAB G LA2