| [613] | 1 | LAMIVTLP ;DALISC/PAC - VITEK MICRO DATA LITERAL PARSER; 5-24-95;
|
|---|
| 2 | ;;5.2;AUTOMATED LAB INSTRUMENTS;**12,35**;Sep 27, 1994
|
|---|
| 3 | ;Parses the literal data stream and calls LAMIVTLU
|
|---|
| 4 | ;to stuff data in the LAH for verification
|
|---|
| 5 | ;***** LOCAL PATCH *****
|
|---|
| 6 | LA1 S LANM=$T(+0),TSK=$O(^LAB(62.4,"C",LANM,0)) Q:TSK<1
|
|---|
| 7 | Q:'$D(^LA(TSK,"I",0))
|
|---|
| 8 | K LATOP D ^LASET Q:'TSK S LROVER=1,X="TRAP^"_LANM,@^%ZOSF("TRAP")
|
|---|
| 9 | S MTRSL="mtrsl|",RT="rt",PI="pi",CI="ci",SI="si",ZZ="zz",U="^"
|
|---|
| 10 | S LABUG="o2",LADRUG="a2",LAMIC="a3",A4="a4"
|
|---|
| 11 | ; FIELD HIEARCHY = "pi^si^ci^rt^zz"
|
|---|
| 12 | S LABGNODE="o1",LANTIB="a1",LACOUNT=0
|
|---|
| 13 | K ^TMP("VITEK") ;S LAFIN=0
|
|---|
| 14 | LA2 K LAIN,LAPD,LASI,LART,LACI,LARTX
|
|---|
| 15 | S TOUT=0,LAIN=0,LASUM=0,ERR=0
|
|---|
| 16 | ;Q:LAFIN=2
|
|---|
| 17 | D IN G QUIT:TOUT,LA2:$E(IN,1,6)'=MTRSL
|
|---|
| 18 | I IN["TEST PATTERN" G LA2
|
|---|
| 19 | D AGAIN G:ERR LA2
|
|---|
| 20 | D PARSE G:'$G(LACI(CI)) LA2
|
|---|
| 21 | I $D(^LA("VITEK")) D DEBUG^LAMIVTLC
|
|---|
| 22 | S ID=LACI(CI) ;G:$L(ID)<9 LA2
|
|---|
| 23 | ;----------------------------------------------------------------
|
|---|
| 24 | ; Entered to accomadate file 60 prefix field
|
|---|
| 25 | ; point to micro det-up file
|
|---|
| 26 | ; chk accn also
|
|---|
| 27 | S:$D(^LAB(61.38,1,1)) LRPREFIX=^(1)
|
|---|
| 28 | I $G(LRPREFIX)=1 D
|
|---|
| 29 | . I '$D(^LRO(68,WL,1,LADT,1,ID)) D
|
|---|
| 30 | .. I $L(ID)=6 S ID=+$E(ID,2,6)
|
|---|
| 31 | LA3 S DHZGEN="S LOG=+ID D LOG^LAMIVTLG" S IDE=+ID
|
|---|
| 32 | S LROVER=0
|
|---|
| 33 | X DHZGEN G LA2:'ISQN ;Can be changed by the cross-link code
|
|---|
| 34 | D ^LAMIVTLC
|
|---|
| 35 | ;CREATE^LAMIVTLC (DAVID'S RTN)
|
|---|
| 36 | G LA2
|
|---|
| 37 | AGAIN ;store records in array
|
|---|
| 38 | ;K LAHARCHY
|
|---|
| 39 | READ ;
|
|---|
| 40 | S LAIN=LAIN+1
|
|---|
| 41 | S LAIN(LAIN)=IN S LASUM=LASUM+$$CHK(IN)
|
|---|
| 42 | I IN["~]" D IN D Q
|
|---|
| 43 | .S LAHEX=$$HEX(LASUM)
|
|---|
| 44 | .S LAHEX=$E(LAHEX,$L(LAHEX)-1,$L(LAHEX))
|
|---|
| 45 | .;D:LAHEX'[$E(IN,1,2) ERR("CHECKSUM") ;TAKEOFFLATER
|
|---|
| 46 | D IN G AGAIN ;READ ;W !,"READ" G READ
|
|---|
| 47 | PARSE ;create separate arrays pat demographics, tests, results, etc.
|
|---|
| 48 | S TERM=0,INT="",FIN=0,II=1,END=0
|
|---|
| 49 | S INT=INT_LAIN(II)
|
|---|
| 50 | S INT=$P(INT,MTRSL,2) ;D ADD
|
|---|
| 51 | K LAPD,LASI,LACI,LARTX,LART
|
|---|
| 52 | ;K LAPD pat demographics
|
|---|
| 53 | PID D PD(INT,SI) D ADD G:'TERM&('END) PID
|
|---|
| 54 | Q:END ;K LASI ;-> specimen demographics
|
|---|
| 55 | SID D SI(INT,CI) D ADD G:'TERM&('END) SID
|
|---|
| 56 | Q:END ;K LACI ;->culture demographics
|
|---|
| 57 | CID D CI(INT,RT) D ADD G:'TERM&('END) CID
|
|---|
| 58 | Q:END ;K LARTX,LART ;->results and other fields
|
|---|
| 59 | RTD D RT(INT,ZZ) D ADD G:'TERM&('END) RTD
|
|---|
| 60 | Q:END
|
|---|
| 61 | G:'FIN!('TERM) RTD
|
|---|
| 62 | Q
|
|---|
| 63 | ADD ;
|
|---|
| 64 | I END QUIT
|
|---|
| 65 | I FIN,INT["|zz|" Q
|
|---|
| 66 | I LAIN>II D
|
|---|
| 67 | . S II=II+1
|
|---|
| 68 | . I $L(INT)<160 S INT=$TR(INT,"~^")_LAIN(II) Q
|
|---|
| 69 | . I INT["~^" S INT=$TR(INT,"~^")_LAIN(II) Q
|
|---|
| 70 | . S INT=$TR(INT,"~^")_LAIN(II)
|
|---|
| 71 | S FIN=II=LAIN
|
|---|
| 72 | Q
|
|---|
| 73 | PD(INPD,DELIM) ; patient demographics
|
|---|
| 74 | S TERM=0
|
|---|
| 75 | F J=1:1:$L(INPD,"|")-1 D Q:TERM!(END)
|
|---|
| 76 | . S LAPD=$$BLANKS($P(INPD,"|",J))
|
|---|
| 77 | . S:$E(LAPD,1,2)=DELIM TERM=1 D
|
|---|
| 78 | . . S LAPD=$P(INPD,"|",J) S:LAPD=ZZ END=1
|
|---|
| 79 | . . Q:$L(LAPD)<3
|
|---|
| 80 | . . S LAPD($E(LAPD,1,2))=$E(LAPD,3,$L(LAPD))
|
|---|
| 81 | S INT=$S(INPD[LAPD:$P(INPD,LAPD_"|",2),1:INPD)
|
|---|
| 82 | Q
|
|---|
| 83 | SI(INSD,DELIM) ; specimen demographics
|
|---|
| 84 | S TERM=0
|
|---|
| 85 | F J=1:1:$L(INSD,"|")-1 S:$E($P(INSD,"|",J),1,2)=DELIM TERM=1 Q:TERM!(END) D
|
|---|
| 86 | .S LASI=$$BLANKS($P(INSD,"|",J)) S:LASI=ZZ END=1 Q:END I LASI'="" D
|
|---|
| 87 | . .Q:$L(LASI)<3
|
|---|
| 88 | . .S LASI($E(LASI,1,2))=$E(LASI,3,$L(LASI))
|
|---|
| 89 | S INT=$S(INSD[LASI:$P(INSD,LASI_"|",2),1:INSD)
|
|---|
| 90 | Q
|
|---|
| 91 | CI(INTD,DELIM) ; exam info, id etc
|
|---|
| 92 | S TERM=0
|
|---|
| 93 | F J=1:1:$L(INTD,"|")-1 S:$E($P(INTD,"|",J),1,2)=DELIM TERM=1 Q:TERM!(END) D
|
|---|
| 94 | . S LACI=$$BLANKS($P(INTD,"|",J)) S:LACI=ZZ END=1
|
|---|
| 95 | . I LACI'="",$E(LACI)'="~" D
|
|---|
| 96 | . .Q:$L(LACI)<3
|
|---|
| 97 | . .S LACI($E(LACI,1,2))=$E(LACI,3,$L(LACI))
|
|---|
| 98 | S INT=$S(INTD[LACI:$P(INTD,LACI_"|",2),1:INTD)
|
|---|
| 99 | Q
|
|---|
| 100 | RT(INTR,DELIM) ; results including tests organism, drugs etc.
|
|---|
| 101 | S TERM=0 S L=$L(INTR,"|") ;S:INTR["~]" FIN=1
|
|---|
| 102 | 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
|
|---|
| 103 | .I LART["," D COMMA Q
|
|---|
| 104 | .Q:$L(LART)<3
|
|---|
| 105 | .I $D(SC) I SC="a3"&($E(LART,1,2)="a1") D
|
|---|
| 106 | ..S LARTX("a4")=$S($G(LARTX("a4")):LARTX("a4")+1,1:1)
|
|---|
| 107 | ..S LART("a4",LARTX("a4"))=LART("a3",LARTX("a4"))
|
|---|
| 108 | .S SC=$E(LART,1,2)
|
|---|
| 109 | .S LARTX(SC)=$S($G(LARTX(SC)):LARTX(SC)+1,1:1)
|
|---|
| 110 | .S LART(SC,LARTX(SC))=$E(LART,3,$L(LART))
|
|---|
| 111 | S INT=$P(INTR,"|",J,L)
|
|---|
| 112 | S:II=LAIN&(END) FIN=1
|
|---|
| 113 | Q
|
|---|
| 114 | COMMA I SC="rr" S LAMULTST=1 Q
|
|---|
| 115 | I SC'="gn" Q
|
|---|
| 116 | S GN=$L(LART,",") Q:GN'>1
|
|---|
| 117 | F L=1:1:GN D
|
|---|
| 118 | .S LARTGN=$P(LART,",",L)
|
|---|
| 119 | .S LARTX(SC)=$S($G(LARTX(SC)):LARTX(SC)+1,1:1)
|
|---|
| 120 | .S LART(SC,LARTX(SC))=$$BLANKS($E(LARTGN,3,$L(LARTGN)))
|
|---|
| 121 | Q
|
|---|
| 122 | IN S CNT=^LA(TSK,"I",0)+1
|
|---|
| 123 | IF '$D(^LA(TSK,"I",CNT)) S TOUT=TOUT+1 Q:TOUT>9 H 10 G IN
|
|---|
| 124 | ;S:TOUT>9 LAFIN=LAFIN+1 Q:TOUT>9 H 10 G IN
|
|---|
| 125 | S ^LA(TSK,"I",0)=CNT,IN=^(CNT),TOUT=0
|
|---|
| 126 | S ^TMP("VITEK",$J,CNT)=IN
|
|---|
| 127 | Q
|
|---|
| 128 | OUT S CNT=^LA(TSK,"O")+1,^("O")=CNT,^("O",CNT)=TSK_OUT
|
|---|
| 129 | LOCK ^LA("Q") S Q=^LA("Q")+1,^("Q")=Q,^("Q",Q)=TSK LOCK
|
|---|
| 130 | Q
|
|---|
| 131 | CHK(XX) ;
|
|---|
| 132 | N X,I S XX=$TR(XX,"^"),X=0
|
|---|
| 133 | F I=1:1:$L(XX) D
|
|---|
| 134 | .S X=X+$S($E(XX,I)="~":30,$E(XX,I)="]":29,1:$A(XX,I))
|
|---|
| 135 | Q X
|
|---|
| 136 | ;
|
|---|
| 137 | QUIT I (^LA(TSK,"I")'=^LA(TSK,"I",0)) G LA2
|
|---|
| 138 | I $D(^LA(TSK,"O",0)),^LA(TSK,"O")'=^LA(TSK,"O",0) G LA2
|
|---|
| 139 | L ^LA(TSK) H 1
|
|---|
| 140 | K ^LA(TSK),^LA("LOCK",TSK),^TMP($J),^TMP("LA",$J)
|
|---|
| 141 | D KILL^%ZTLOAD
|
|---|
| 142 | Q
|
|---|
| 143 | TRAP D ^LABERR S T=TSK D SET^LAB G @("LA2^"_LANM) ;ERROR TRAP
|
|---|
| 144 | ;
|
|---|
| 145 | HEX(HEX) ;
|
|---|
| 146 | Q:'$D(HEX) 0 Q:'(HEX?.N) "*ERROR" Q:'HEX 0
|
|---|
| 147 | N LADN,LADD,LADH S LADN=HEX,LADH=""
|
|---|
| 148 | L I LADN'=0 D S LADH=LADD_LADH G L
|
|---|
| 149 | .S LADD=LADN#16,LADN=LADN\16 Q:LADD<10 S LADD=$C($A("a")+LADD-10)
|
|---|
| 150 | Q LADH
|
|---|
| 151 | ERR(ERTYPE) ;
|
|---|
| 152 | N LL
|
|---|
| 153 | F LL=CNT-LAIN:1:CNT D
|
|---|
| 154 | .S ^TMP("LA",ERTYPE_" ERR",$J,LL)=^LA(TSK,"I",LL)
|
|---|
| 155 | S ^TMP("VITEK",LL)=LAHEX_U_LASUM_U_^LA(TSK,"I",LL)
|
|---|
| 156 | S ERR=1
|
|---|
| 157 | Q
|
|---|
| 158 | BLANKS(XX) ;
|
|---|
| 159 | N I,J
|
|---|
| 160 | F I=$L(XX):-1:1 Q:$E(XX,I)'=" "
|
|---|
| 161 | F J=1:1:$L(XX) Q:$E(XX,J)'=" "
|
|---|
| 162 | Q $E(XX,J,I)
|
|---|
