LAMIVTLC ;VA/DALISC/DRH - MICRO VITEK LITERAL DATA MANAGER ; 1/8/96
;;5.2;AUTOMATED LAB INSTRUMENTS;**1030**;NOV 01, 1997
;;5.2;AUTOMATED LAB INSTRUMENTS;**12,30,37**;Sep 27,1994;Build 7
EN ;
;
D ^LAMIVTLW
;
S LRCMNT=$G(LART("o5",1))
S LRBACT=$G(LART("t4",1))
N LACCN,LASSN ;,J,JJ,JJJ,LADATA
S DBATA=""
I $G(CI)="" Q
I $G(LACI(CI))="" Q
I $G(LAPD(PI))="" Q
Q:'$D(LART(LABGNODE))
;Q:'$D(LART(LANTIB))
S LACCN=LACI(CI) ;,ISQN=LACCN
S LASSN=LAPD(PI)
S LADATA="",(J,JJ,JJJ)=0
F S J=$O(LART(LABGNODE,J)) Q:'J D
. F S JJ=$O(LART(RT,JJ)) Q:'JJ D
.. I '$D(LART(LANTIB)) S LADATA(LART("t1",J)_LART(LABGNODE,J),LART(RT,JJ))="" QUIT
.. F S JJJ=$O(LART(LANTIB,JJJ)) Q:'JJJ D
... S LADATA(LART("t1",J)_LART(LABGNODE,J),LART(RT,JJ),LART(LANTIB,JJJ))=$S($G(LART(LAMIC,JJJ))'="":LART(LAMIC,JJJ),1:" ")_U_$S(LART(A4,JJJ)'="":LART(A4,JJJ),1:"NA")
D SETMIC(LAPD(PI)_U_LACI(CI)) K LADATA
D NA^LAMIVTLW
Q
;;5.2;AUTOMATED LAB INSTRUMENTS;**12,30**;Sep 27,1994
; VLIST:
;----------------------------------------------------------
;LRA1=Antibody, LRVAB=Drug Node, LRORGNSM=ORGANISM, LRA3=MIC
;LRID=SSN^ACCN
;-----------------------------------------------------------
SETMIC(LRIDX) ;This function resolves the vitek fields
; resolved fields go to Alternative Interpretation (AI) written by FHS
; DATA is the array..DATA(ORG,AB)=MIC
; ID is ssn^accn (two pieces)
;S TSK=3 D LA1+3^LASET ;--> left in for debugging
LA3 ;X LAGEN ;set auto inst variables ;--> left in for debugging
;----------------------------------------------------------------------
; This block grabs the accn area, accn date and specimen
; LRAA=ACCN AREA, LRAD=ACCN DATE, ID=SSN^ACCN NUMBER(comming from vitek)
; LRSP=SPECIMEN --> TAKEN FROM PREVIOUS ENCODED VITEK RTNS.
ID S SSN=+LRIDX
;D NA^LAMIVTLW
S LRID=$P(LRIDX,U,2)
S LRA=$P(^LAH(LWL,1,ISQN,0),U,3,5)
S LRAA=+LRA ;Accn area
S LRAD=$P(LRA,U,2) ;Accn date
K LRSP
S LRAN=ID
;
Q:'$G(LRAN)!('$G(LRAD))!('$G(LRAA))
Q:'$D(^LRO(68,LRAA,1,LRAD,1,LRAN,0))
;
S LRSNORK=0
F S LRSNORK=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,5,LRSNORK)) Q:LRSNORK="" D
. Q:$D(^LRO(68,LRA,1,LRAD,1,LRAN,5,LRSNORK))
. I LRAA,LRAD,LRSNORK S LRSP=+^LRO(68,LRAA,1,LRAD,1,LRAN,5,LRSNORK,0)
. E S LRSP=$O(^LAB(61,"B","UNKNOWN",0))
;_________________________________________________________________
UNPACK ; Here is where we unpack the bug,drug and min inhib conc (MIC)
; LRORGNSM,CARD,LRA1 and LRA3
; Multiple drugs and MIC vales per data set.
S LRTIC=0
S LRORGNZM=""
K LRISOFLG
F S LRORGNZM=$O(LADATA(LRORGNZM)) Q:LRORGNZM="" D
. S CARD=""
. F S CARD=$O(LADATA(LRORGNZM,CARD)) Q:CARD="" D
.. I '$D(LART(LANTIB)) D ALTSET QUIT
.. S LRA1=""
.. F S LRA1=$O(LADATA(LRORGNZM,CARD,LRA1)) Q:LRA1="" D
... S LRA3=LADATA(LRORGNZM,CARD,LRA1)
... D CALL
Q
ALTSET ;
S ISOLATE=+LRORGNZM,LRORGNSM=$P(LRORGNZM,ISOLATE,2)
;If an isolate is not marked on vitek it = zero
;So ^LAH does not get set with a "0" the following is used
;---------------------------------------------------------
I ISOLATE=0 SET LRISOFLG=1
I $G(LRISOFLG) S ISOLATE=ISOLATE+1
;----------------------------------------------------------
S ISOL=$O(^LAB(61.39,1,1,"B",LRORGNSM,0))
S ISOL=^LAB(61.39,1,1,ISOL,1) ; IEN ETIOLOGY FIELD
S LRORGNSM=ISOL
S ^LAH(LWL,1,ISQN,2,2)="CARD^"_CARD
S ^LAH(LWL,1,ISQN,3,ISOLATE,0)=ISOL_"^^"_CARD
Q
CALL ;
;This is where we call the LIC file containing the translation
; for drugs and bugs comming from the instrument.
;I '$D(LRORGNSM) W !!!!,"NO ORG XMITTED"
;_________________________________________________________________
;Q:'$Q(^LAB(61.39,1,2,"B",LRA1))
S TMPAB=LRA1
S ISOLATE=+LRORGNZM,LRORGNSM=$P(LRORGNZM,ISOLATE,2)
;If an isolate is not marked on vitek it = zero
;So ^LAH does not get set with a "0" the following is used
;---------------------------------------------------------
;I ISOLATE=0 SET LRISOFLG=1
;I $G(LRISOFLG) S ISOLATE=ISOLATE+1
;S ISOLATE=ISOLATE+1
;----------------------------------------------------------
S ISOL=$O(^LAB(61.39,1,1,"B",LRORGNSM,0))
S ISOL=^LAB(61.39,1,1,ISOL,1) ; IEN ETIOLOGY FIELD
S LRORGNSM=ISOL
;S ISOL=$P(^LAB(61.2,ISOL,0),U) ; Pull out name from etiology
S LAVAB2=$O(^LAB(61.39,1,2,"B",LRA1,""))
S LAVAB1=^LAB(61.39,1,2,LAVAB2,1) ; IEN ANTIMICROBIAL SUSCEP
S LAVAB=$P(^LAB(62.06,LAVAB1,0),U,2) ; Pull out drug node (n.xxxx)
Q:'$G(LAVAB)
;-----------------------------------------------------------------
S K1=LRA3
S MIC(ISOL,LAVAB)=LRA3
S ORG(ISOL)=ISOL
;S ^LAH(LWL,1,ISQN,3,ISOL,0)=ISOL
S ^LAH(LWL,1,ISQN,2,2)="CARD^"_CARD
S ^LAH(LWL,"ISO",LACCN,ISOLATE)=ISQN
S ^LAH(LWL,1,ISQN,3,ISOLATE,1,0)=LRCMNT_U_LRBACT
S ^LAH(LWL,1,ISQN,3,ISOLATE,0)=ORG(ISOL)_"^^"_CARD
;S ^TMPDRH(LACCN,LRORGNSM,CARD,TMPAB)=LRA3
LA4 ;This is where I call FHS interp. program
;------------------------------------------------------------------
S J=0
F S J=$O(MIC(ISOL,J)) Q:J<1 D
. S K=MIC(ISOL,J)_"^"
. D INTRP^LAMIVTE6 D QUIT
.. ;S ^LAH(LWL,1,ISQN,3,ISOLATE,J)=K_$G(S) ; looking for AI
.. ;K ^LAH(LWL,1,ISQN,3,ISOL)
.. S ^LAH(LWL,1,ISQN,3,ISOLATE,J)=MIC(ISOL,J)_"^"_$P($G(S),U,2)
END ;
;K LRORGNSM,LRA1
K MIC,LRVAB,LRA3,LRID ; <--- COMMENT OUT FOR TESTING
Q
;___________________________________________________________________
; For debugging purposes only
DEBUG ;
K ZLACI,ZLART,ZLAPD,ZLASI
S LACOUNT=LACOUNT+1
S %X="LACI(",%Y="ZLACI(" D %XY^%RCR
S %Y="^TMP(""LA"",LACOUNT,""LACI""," D %XY^%RCR
S %X="LART(",%Y="ZLART(" D %XY^%RCR
S %Y="^TMP(""LA"",LACOUNT,""LART""," D %XY^%RCR
S %X="LAPD(",%Y="ZLAPD(" D %XY^%RCR
S %Y="^TMP(""LA"",LACOUNT,""LAPD""," D %XY^%RCR
S %X="LASI(",%Y="ZLASI(" D %XY^%RCR
S %Y="^TMP(""LA"",LACOUNT,""LASI""," D %XY^%RCR
Q
LAMIVTLC ;VA/DALISC/DRH - MICRO VITEK LITERAL DATA MANAGER ; 1/8/96
+1 ;;5.2;AUTOMATED LAB INSTRUMENTS;**1030**;NOV 01, 1997
+2 ;;5.2;AUTOMATED LAB INSTRUMENTS;**12,30,37**;Sep 27,1994;Build 7
EN ;
+1 ;
+2 DO ^LAMIVTLW
+3 ;
+4 SET LRCMNT=$GET(LART("o5",1))
+5 SET LRBACT=$GET(LART("t4",1))
+6 ;,J,JJ,JJJ,LADATA
NEW LACCN,LASSN
+7 SET DBATA=""
+8 IF $GET(CI)=""
QUIT
+9 IF $GET(LACI(CI))=""
QUIT
+10 IF $GET(LAPD(PI))=""
QUIT
+11 IF '$DATA(LART(LABGNODE))
QUIT
+12 ;Q:'$D(LART(LANTIB))
+13 ;,ISQN=LACCN
SET LACCN=LACI(CI)
+14 SET LASSN=LAPD(PI)
+15 SET LADATA=""
SET (J,JJ,JJJ)=0
+16 FOR
SET J=$ORDER(LART(LABGNODE,J))
IF 'J
QUIT
Begin DoDot:1
+17 FOR
SET JJ=$ORDER(LART(RT,JJ))
IF 'JJ
QUIT
Begin DoDot:2
+18 IF '$DATA(LART(LANTIB))
SET LADATA(LART("t1",J)_LART(LABGNODE,J),LART(RT,JJ))=""
QUIT
+19 FOR
SET JJJ=$ORDER(LART(LANTIB,JJJ))
IF 'JJJ
QUIT
Begin DoDot:3
+20 SET LADATA(LART("t1",J)_LART(LABGNODE,J),LART(RT,JJ),LART(LANTIB,JJJ))=$SELECT($GET(LART(LAMIC,JJJ))'="":LART(LAMIC,JJJ),1:" ")_U_$SELECT(LART(A4,JJJ)'="":LART(A4,JJJ),1:"NA")
End DoDot:3
End DoDot:2
End DoDot:1
+21 DO SETMIC(LAPD(PI)_U_LACI(CI))
KILL LADATA
+22 DO NA^LAMIVTLW
+23 QUIT
+24 ;;5.2;AUTOMATED LAB INSTRUMENTS;**12,30**;Sep 27,1994
+25 ; VLIST:
+26 ;----------------------------------------------------------
+27 ;LRA1=Antibody, LRVAB=Drug Node, LRORGNSM=ORGANISM, LRA3=MIC
+28 ;LRID=SSN^ACCN
+29 ;-----------------------------------------------------------
SETMIC(LRIDX) ;This function resolves the vitek fields
+1 ; resolved fields go to Alternative Interpretation (AI) written by FHS
+2 ; DATA is the array..DATA(ORG,AB)=MIC
+3 ; ID is ssn^accn (two pieces)
+4 ;S TSK=3 D LA1+3^LASET ;--> left in for debugging
LA3 ;X LAGEN ;set auto inst variables ;--> left in for debugging
+1 ;----------------------------------------------------------------------
+2 ; This block grabs the accn area, accn date and specimen
+3 ; LRAA=ACCN AREA, LRAD=ACCN DATE, ID=SSN^ACCN NUMBER(comming from vitek)
+4 ; LRSP=SPECIMEN --> TAKEN FROM PREVIOUS ENCODED VITEK RTNS.
ID SET SSN=+LRIDX
+1 ;D NA^LAMIVTLW
+2 SET LRID=$PIECE(LRIDX,U,2)
+3 SET LRA=$PIECE(^LAH(LWL,1,ISQN,0),U,3,5)
+4 ;Accn area
SET LRAA=+LRA
+5 ;Accn date
SET LRAD=$PIECE(LRA,U,2)
+6 KILL LRSP
+7 SET LRAN=ID
+8 ;
+9 IF '$GET(LRAN)!('$GET(LRAD))!('$GET(LRAA))
QUIT
+10 IF '$DATA(^LRO(68,LRAA,1,LRAD,1,LRAN,0))
QUIT
+11 ;
+12 SET LRSNORK=0
+13 FOR
SET LRSNORK=$ORDER(^LRO(68,LRAA,1,LRAD,1,LRAN,5,LRSNORK))
IF LRSNORK=""
QUIT
Begin DoDot:1
+14 IF $DATA(^LRO(68,LRA,1,LRAD,1,LRAN,5,LRSNORK))
QUIT
+15 IF LRAA
IF LRAD
IF LRSNORK
SET LRSP=+^LRO(68,LRAA,1,LRAD,1,LRAN,5,LRSNORK,0)
+16 IF '$TEST
SET LRSP=$ORDER(^LAB(61,"B","UNKNOWN",0))
End DoDot:1
+17 ;_________________________________________________________________
UNPACK ; Here is where we unpack the bug,drug and min inhib conc (MIC)
+1 ; LRORGNSM,CARD,LRA1 and LRA3
+2 ; Multiple drugs and MIC vales per data set.
+3 SET LRTIC=0
+4 SET LRORGNZM=""
+5 KILL LRISOFLG
+6 FOR
SET LRORGNZM=$ORDER(LADATA(LRORGNZM))
IF LRORGNZM=""
QUIT
Begin DoDot:1
+7 SET CARD=""
+8 FOR
SET CARD=$ORDER(LADATA(LRORGNZM,CARD))
IF CARD=""
QUIT
Begin DoDot:2
+9 IF '$DATA(LART(LANTIB))
DO ALTSET
QUIT
+10 SET LRA1=""
+11 FOR
SET LRA1=$ORDER(LADATA(LRORGNZM,CARD,LRA1))
IF LRA1=""
QUIT
Begin DoDot:3
+12 SET LRA3=LADATA(LRORGNZM,CARD,LRA1)
+13 DO CALL
End DoDot:3
End DoDot:2
End DoDot:1
+14 QUIT
ALTSET ;
+1 SET ISOLATE=+LRORGNZM
SET LRORGNSM=$PIECE(LRORGNZM,ISOLATE,2)
+2 ;If an isolate is not marked on vitek it = zero
+3 ;So ^LAH does not get set with a "0" the following is used
+4 ;---------------------------------------------------------
+5 IF ISOLATE=0
SET LRISOFLG=1
+6 IF $GET(LRISOFLG)
SET ISOLATE=ISOLATE+1
+7 ;----------------------------------------------------------
+8 SET ISOL=$ORDER(^LAB(61.39,1,1,"B",LRORGNSM,0))
+9 ; IEN ETIOLOGY FIELD
SET ISOL=^LAB(61.39,1,1,ISOL,1)
+10 SET LRORGNSM=ISOL
+11 SET ^LAH(LWL,1,ISQN,2,2)="CARD^"_CARD
+12 SET ^LAH(LWL,1,ISQN,3,ISOLATE,0)=ISOL_"^^"_CARD
+13 QUIT
CALL ;
+1 ;This is where we call the LIC file containing the translation
+2 ; for drugs and bugs comming from the instrument.
+3 ;I '$D(LRORGNSM) W !!!!,"NO ORG XMITTED"
+4 ;_________________________________________________________________
+5 ;Q:'$Q(^LAB(61.39,1,2,"B",LRA1))
+6 SET TMPAB=LRA1
+7 SET ISOLATE=+LRORGNZM
SET LRORGNSM=$PIECE(LRORGNZM,ISOLATE,2)
+8 ;If an isolate is not marked on vitek it = zero
+9 ;So ^LAH does not get set with a "0" the following is used
+10 ;---------------------------------------------------------
+11 ;I ISOLATE=0 SET LRISOFLG=1
+12 ;I $G(LRISOFLG) S ISOLATE=ISOLATE+1
+13 ;S ISOLATE=ISOLATE+1
+14 ;----------------------------------------------------------
+15 SET ISOL=$ORDER(^LAB(61.39,1,1,"B",LRORGNSM,0))
+16 ; IEN ETIOLOGY FIELD
SET ISOL=^LAB(61.39,1,1,ISOL,1)
+17 SET LRORGNSM=ISOL
+18 ;S ISOL=$P(^LAB(61.2,ISOL,0),U) ; Pull out name from etiology
+19 SET LAVAB2=$ORDER(^LAB(61.39,1,2,"B",LRA1,""))
+20 ; IEN ANTIMICROBIAL SUSCEP
SET LAVAB1=^LAB(61.39,1,2,LAVAB2,1)
+21 ; Pull out drug node (n.xxxx)
SET LAVAB=$PIECE(^LAB(62.06,LAVAB1,0),U,2)
+22 IF '$GET(LAVAB)
QUIT
+23 ;-----------------------------------------------------------------
+24 SET K1=LRA3
+25 SET MIC(ISOL,LAVAB)=LRA3
+26 SET ORG(ISOL)=ISOL
+27 ;S ^LAH(LWL,1,ISQN,3,ISOL,0)=ISOL
+28 SET ^LAH(LWL,1,ISQN,2,2)="CARD^"_CARD
+29 SET ^LAH(LWL,"ISO",LACCN,ISOLATE)=ISQN
+30 SET ^LAH(LWL,1,ISQN,3,ISOLATE,1,0)=LRCMNT_U_LRBACT
+31 SET ^LAH(LWL,1,ISQN,3,ISOLATE,0)=ORG(ISOL)_"^^"_CARD
+32 ;S ^TMPDRH(LACCN,LRORGNSM,CARD,TMPAB)=LRA3
LA4 ;This is where I call FHS interp. program
+1 ;------------------------------------------------------------------
+2 SET J=0
+3 FOR
SET J=$ORDER(MIC(ISOL,J))
IF J<1
QUIT
Begin DoDot:1
+4 SET K=MIC(ISOL,J)_"^"
+5 DO INTRP^LAMIVTE6
Begin DoDot:2
+6 ;S ^LAH(LWL,1,ISQN,3,ISOLATE,J)=K_$G(S) ; looking for AI
+7 ;K ^LAH(LWL,1,ISQN,3,ISOL)
+8 SET ^LAH(LWL,1,ISQN,3,ISOLATE,J)=MIC(ISOL,J)_"^"_$PIECE($GET(S),U,2)
End DoDot:2
QUIT
End DoDot:1
END ;
+1 ;K LRORGNSM,LRA1
+2 ; <--- COMMENT OUT FOR TESTING
KILL MIC,LRVAB,LRA3,LRID
+3 QUIT
+4 ;___________________________________________________________________
+5 ; For debugging purposes only
DEBUG ;
+1 KILL ZLACI,ZLART,ZLAPD,ZLASI
+2 SET LACOUNT=LACOUNT+1
+3 SET %X="LACI("
SET %Y="ZLACI("
DO %XY^%RCR
+4 SET %Y="^TMP(""LA"",LACOUNT,""LACI"","
DO %XY^%RCR
+5 SET %X="LART("
SET %Y="ZLART("
DO %XY^%RCR
+6 SET %Y="^TMP(""LA"",LACOUNT,""LART"","
DO %XY^%RCR
+7 SET %X="LAPD("
SET %Y="ZLAPD("
DO %XY^%RCR
+8 SET %Y="^TMP(""LA"",LACOUNT,""LAPD"","
DO %XY^%RCR
+9 SET %X="LASI("
SET %Y="ZLASI("
DO %XY^%RCR
+10 SET %Y="^TMP(""LA"",LACOUNT,""LASI"","
DO %XY^%RCR
+11 QUIT
