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

LAMIVTLP.m

Go to the documentation of this file. 
  1. LAMIVTLP ;DALISC/PAC - VITEK MICRO DATA LITERAL PARSER; 5-24-95;
  1.  ;;5.2;AUTOMATED LAB INSTRUMENTS;**12,35**;Sep 27, 1994
  1.  ;Parses the literal data stream and calls LAMIVTLU
  1.  ;to stuff data in the LAH for verification
  1.  ;***** LOCAL PATCH *****
  1. LA1 S LANM=$T(+0),TSK=$O(^LAB(62.4,"C",LANM,0)) Q:TSK<1
  1.  Q:'$D(^LA(TSK,"I",0))
  1.  K LATOP D ^LASET Q:'TSK  S LROVER=1,X="TRAP^"_LANM,@^%ZOSF("TRAP")
  1.  S MTRSL="mtrsl|",RT="rt",PI="pi",CI="ci",SI="si",ZZ="zz",U="^"
  1.  S LABUG="o2",LADRUG="a2",LAMIC="a3",A4="a4"
  1.  ; FIELD HIEARCHY = "pi^si^ci^rt^zz"
  1.  S LABGNODE="o1",LANTIB="a1",LACOUNT=0
  1.  K ^TMP("VITEK") ;S LAFIN=0
  1. LA2 K LAIN,LAPD,LASI,LART,LACI,LARTX
  1.  S TOUT=0,LAIN=0,LASUM=0,ERR=0
  1.  ;Q:LAFIN=2
  1.  D IN G QUIT:TOUT,LA2:$E(IN,1,6)'=MTRSL
  1.  I IN["TEST PATTERN" G LA2
  1.  D AGAIN G:ERR LA2
  1.  D PARSE G:'$G(LACI(CI)) LA2
  1.  I $D(^LA("VITEK")) D DEBUG^LAMIVTLC
  1.  S ID=LACI(CI) ;G:$L(ID)<9 LA2
  1.  ;----------------------------------------------------------------
  1.  ; Entered to accomadate file 60 prefix field
  1.  ; point to micro det-up file
  1.  ; chk accn also
  1.  S:$D(^LAB(61.38,1,1)) LRPREFIX=^(1)
  1.  I $G(LRPREFIX)=1 D
  1.  .  I '$D(^LRO(68,WL,1,LADT,1,ID)) D
  1.  ..  I $L(ID)=6 S ID=+$E(ID,2,6)
  1. LA3 S DHZGEN="S LOG=+ID D LOG^LAMIVTLG" S IDE=+ID
  1.  S LROVER=0
  1.  X DHZGEN G LA2:'ISQN ;Can be changed by the cross-link code
  1.  D ^LAMIVTLC
  1.  ;CREATE^LAMIVTLC (DAVID'S RTN)
  1.  G LA2
  1. AGAIN ;store records in array
  1.  ;K LAHARCHY
  1. READ ;
  1.  S LAIN=LAIN+1
  1.  S LAIN(LAIN)=IN S LASUM=LASUM+$$CHK(IN)
  1.  I IN["~]" D IN D  Q
  1.  .S LAHEX=$$HEX(LASUM)
  1.  .S LAHEX=$E(LAHEX,$L(LAHEX)-1,$L(LAHEX))
  1.  .;D:LAHEX'[$E(IN,1,2) ERR("CHECKSUM") ;TAKEOFFLATER
  1.  D IN G AGAIN ;READ ;W !,"READ" G READ
  1. PARSE ;create separate arrays pat demographics, tests, results, etc.
  1.  S TERM=0,INT="",FIN=0,II=1,END=0
  1.  S INT=INT_LAIN(II)
  1.  S INT=$P(INT,MTRSL,2) ;D ADD
  1.  K LAPD,LASI,LACI,LARTX,LART
  1.  ;K LAPD pat demographics
  1. PID D PD(INT,SI) D ADD G:'TERM&('END) PID
  1.  Q:END  ;K LASI ;-> specimen demographics
  1. SID D SI(INT,CI) D ADD G:'TERM&('END) SID
  1.  Q:END  ;K LACI ;->culture demographics
  1. CID D CI(INT,RT) D ADD G:'TERM&('END) CID
  1.  Q:END  ;K LARTX,LART ;->results and other fields
  1. RTD D RT(INT,ZZ) D ADD G:'TERM&('END) RTD
  1.  Q:END
  1.  G:'FIN!('TERM) RTD
  1.  Q
  1. ADD ; 
  1.  I END QUIT
  1.  I FIN,INT["|zz|" Q
  1.  I LAIN>II D
  1.  . S II=II+1
  1.  . I $L(INT)<160 S INT=$TR(INT,"~^")_LAIN(II) Q
  1.  . I INT["~^" S INT=$TR(INT,"~^")_LAIN(II) Q
  1.  . S INT=$TR(INT,"~^")_LAIN(II)
  1.  S FIN=II=LAIN
  1.  Q
  1. PD(INPD,DELIM) ; patient demographics
  1.  S TERM=0
  1.  F J=1:1:$L(INPD,"|")-1 D  Q:TERM!(END)
  1.  . S LAPD=$$BLANKS($P(INPD,"|",J))
  1.  . S:$E(LAPD,1,2)=DELIM TERM=1  D
  1.  . . S LAPD=$P(INPD,"|",J) S:LAPD=ZZ END=1
  1.  . . Q:$L(LAPD)<3
  1.  . . S LAPD($E(LAPD,1,2))=$E(LAPD,3,$L(LAPD))
  1.  S INT=$S(INPD[LAPD:$P(INPD,LAPD_"|",2),1:INPD)
  1.  Q
  1. SI(INSD,DELIM) ; specimen demographics
  1.  S TERM=0
  1.  F J=1:1:$L(INSD,"|")-1 S:$E($P(INSD,"|",J),1,2)=DELIM TERM=1 Q:TERM!(END)  D
  1.  .S LASI=$$BLANKS($P(INSD,"|",J)) S:LASI=ZZ END=1 Q:END  I LASI'="" D
  1.  . .Q:$L(LASI)<3
  1.  . .S LASI($E(LASI,1,2))=$E(LASI,3,$L(LASI))
  1.  S INT=$S(INSD[LASI:$P(INSD,LASI_"|",2),1:INSD)
  1.  Q
  1. CI(INTD,DELIM) ; exam info, id etc
  1.  S TERM=0
  1.  F J=1:1:$L(INTD,"|")-1 S:$E($P(INTD,"|",J),1,2)=DELIM TERM=1 Q:TERM!(END)  D
  1.  . S LACI=$$BLANKS($P(INTD,"|",J)) S:LACI=ZZ END=1
  1.  . I LACI'="",$E(LACI)'="~" D
  1.  . .Q:$L(LACI)<3
  1.  . .S LACI($E(LACI,1,2))=$E(LACI,3,$L(LACI))
  1.  S INT=$S(INTD[LACI:$P(INTD,LACI_"|",2),1:INTD)
  1.  Q
  1. RT(INTR,DELIM) ; results including tests organism, drugs etc.
  1.  S TERM=0 S L=$L(INTR,"|") ;S:INTR["~]" FIN=1
  1.  F J=1:1:L S LART=$$BLANKS($P(INTR,"|",J)) S:$E(LART,1,2)=DELIM END=1 Q:END  Q:LART["~"  Q:LART=""  D  ;!($L(LART)<3)  D
  1.  .I LART["," D COMMA Q
  1.  .Q:$L(LART)<3
  1.  .I $D(SC) I SC="a3"&($E(LART,1,2)="a1") D
  1.  ..S LARTX("a4")=$S($G(LARTX("a4")):LARTX("a4")+1,1:1)
  1.  ..S LART("a4",LARTX("a4"))=LART("a3",LARTX("a4"))
  1.  .S SC=$E(LART,1,2)
  1.  .S LARTX(SC)=$S($G(LARTX(SC)):LARTX(SC)+1,1:1)
  1.  .S LART(SC,LARTX(SC))=$E(LART,3,$L(LART))
  1.  S INT=$P(INTR,"|",J,L)
  1.  S:II=LAIN&(END) FIN=1
  1.  Q
  1. COMMA I SC="rr" S LAMULTST=1 Q
  1.  I SC'="gn" Q
  1.  S GN=$L(LART,",") Q:GN'>1
  1.  F L=1:1:GN D
  1.  .S LARTGN=$P(LART,",",L)
  1.  .S LARTX(SC)=$S($G(LARTX(SC)):LARTX(SC)+1,1:1)
  1.  .S LART(SC,LARTX(SC))=$$BLANKS($E(LARTGN,3,$L(LARTGN)))
  1.  Q
  1. IN S CNT=^LA(TSK,"I",0)+1
  1.  IF '$D(^LA(TSK,"I",CNT)) S TOUT=TOUT+1 Q:TOUT>9  H 10 G IN
  1.  ;S:TOUT>9 LAFIN=LAFIN+1 Q:TOUT>9  H 10 G IN
  1.  S ^LA(TSK,"I",0)=CNT,IN=^(CNT),TOUT=0
  1.  S ^TMP("VITEK",$J,CNT)=IN
  1.  Q
  1. OUT S CNT=^LA(TSK,"O")+1,^("O")=CNT,^("O",CNT)=TSK_OUT
  1.  LOCK ^LA("Q") S Q=^LA("Q")+1,^("Q")=Q,^("Q",Q)=TSK LOCK
  1.  Q
  1. CHK(XX) ;
  1.  N X,I S XX=$TR(XX,"^"),X=0
  1.  F I=1:1:$L(XX) D
  1.  .S X=X+$S($E(XX,I)="~":30,$E(XX,I)="]":29,1:$A(XX,I))
  1.  Q X
  1.  ;
  1. QUIT I (^LA(TSK,"I")'=^LA(TSK,"I",0)) G LA2
  1.  I $D(^LA(TSK,"O",0)),^LA(TSK,"O")'=^LA(TSK,"O",0) G LA2
  1.  L ^LA(TSK) H 1
  1.  K ^LA(TSK),^LA("LOCK",TSK),^TMP($J),^TMP("LA",$J)
  1.  D KILL^%ZTLOAD
  1.  Q
  1. TRAP D ^LABERR S T=TSK D SET^LAB G @("LA2^"_LANM) ;ERROR TRAP
  1.  ;
  1. HEX(HEX) ;
  1.  Q:'$D(HEX) 0  Q:'(HEX?.N) "*ERROR"  Q:'HEX 0
  1.  N LADN,LADD,LADH S LADN=HEX,LADH=""
  1. L I LADN'=0 D  S LADH=LADD_LADH G L
  1.  .S LADD=LADN#16,LADN=LADN\16 Q:LADD<10  S LADD=$C($A("a")+LADD-10)
  1.  Q LADH
  1. ERR(ERTYPE) ;
  1.  N LL
  1.  F LL=CNT-LAIN:1:CNT D
  1.  .S ^TMP("LA",ERTYPE_" ERR",$J,LL)=^LA(TSK,"I",LL)
  1.  S ^TMP("VITEK",LL)=LAHEX_U_LASUM_U_^LA(TSK,"I",LL)
  1.  S ERR=1
  1.  Q
  1. BLANKS(XX) ;
  1.  N I,J
  1.  F I=$L(XX):-1:1 Q:$E(XX,I)'=" "
  1.  F J=1:1:$L(XX) Q:$E(XX,J)'=" "
  1.  Q $E(XX,J,I)