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

LAMIVTLC.m

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