source: FOIAVistA/trunk/r/AUTOMATED_LAB_INSTRUMENTS-LA/LAMIVTLC.m@ 811

Last change on this file since 811 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 5.5 KB
Line 
1LAMIVTLC ;DALISC/DRH - MICRO VITEK LITERAL DATA MANAGER ; 1/8/96
2 ;;5.2;AUTOMATED LAB INSTRUMENTS;**12,30,37**;Sep 27,1994
3EN ;
4 ;
5 D ^LAMIVTLW
6 ;
7 S LRCMNT=$G(LART("o5",1))
8 S LRBACT=$G(LART("t4",1))
9 N LACCN,LASSN ;,J,JJ,JJJ,LADATA
10 S DBATA=""
11 I $G(CI)="" Q
12 I $G(LACI(CI))="" Q
13 I $G(LAPD(PI))="" Q
14 Q:'$D(LART(LABGNODE))
15 ;Q:'$D(LART(LANTIB))
16 S LACCN=LACI(CI) ;,ISQN=LACCN
17 S LASSN=LAPD(PI)
18 S LADATA="",(J,JJ,JJJ)=0
19 F S J=$O(LART(LABGNODE,J)) Q:'J D
20 . F S JJ=$O(LART(RT,JJ)) Q:'JJ D
21 .. I '$D(LART(LANTIB)) S LADATA(LART("t1",J)_LART(LABGNODE,J),LART(RT,JJ))="" QUIT
22 .. F S JJJ=$O(LART(LANTIB,JJJ)) Q:'JJJ D
23 ... 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")
24 D SETMIC(LAPD(PI)_U_LACI(CI)) K LADATA
25 D NA^LAMIVTLW
26 Q
27 ;;5.2;AUTOMATED LAB INSTRUMENTS;**12,30**;Sep 27,1994
28 ; VLIST:
29 ;----------------------------------------------------------
30 ;LRA1=Antibody, LRVAB=Drug Node, LRORGNSM=ORGANISM, LRA3=MIC
31 ;LRID=SSN^ACCN
32 ;-----------------------------------------------------------
33SETMIC(LRIDX) ;This function resolves the vitek fields
34 ; resolved fields go to Alternative Interpretation (AI) written by FHS
35 ; DATA is the array..DATA(ORG,AB)=MIC
36 ; ID is ssn^accn (two pieces)
37 ;S TSK=3 D LA1+3^LASET ;--> left in for debugging
38LA3 ;X LAGEN ;set auto inst variables ;--> left in for debugging
39 ;----------------------------------------------------------------------
40 ; This block grabs the accn area, accn date and specimen
41 ; LRAA=ACCN AREA, LRAD=ACCN DATE, ID=SSN^ACCN NUMBER(comming from vitek)
42 ; LRSP=SPECIMEN --> TAKEN FROM PREVIOUS ENCODED VITEK RTNS.
43ID S SSN=+LRIDX
44 ;D NA^LAMIVTLW
45 S LRID=$P(LRIDX,U,2)
46 S LRA=$P(^LAH(LWL,1,ISQN,0),U,3,5)
47 S LRAA=+LRA ;Accn area
48 S LRAD=$P(LRA,U,2) ;Accn date
49 K LRSP
50 S LRAN=ID
51 ;
52 Q:'$G(LRAN)!('$G(LRAD))!('$G(LRAA))
53 Q:'$D(^LRO(68,LRAA,1,LRAD,1,LRAN,0))
54 ;
55 S LRSNORK=0
56 F S LRSNORK=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,5,LRSNORK)) Q:LRSNORK="" D
57 . Q:$D(^LRO(68,LRA,1,LRAD,1,LRAN,5,LRSNORK))
58 . I LRAA,LRAD,LRSNORK S LRSP=+^LRO(68,LRAA,1,LRAD,1,LRAN,5,LRSNORK,0)
59 . E S LRSP=$O(^LAB(61,"B","UNKNOWN",0))
60 ;_________________________________________________________________
61UNPACK ; Here is where we unpack the bug,drug and min inhib conc (MIC)
62 ; LRORGNSM,CARD,LRA1 and LRA3
63 ; Multiple drugs and MIC vales per data set.
64 S LRTIC=0
65 S LRORGNZM=""
66 K LRISOFLG
67 F S LRORGNZM=$O(LADATA(LRORGNZM)) Q:LRORGNZM="" D
68 . S CARD=""
69 . F S CARD=$O(LADATA(LRORGNZM,CARD)) Q:CARD="" D
70 .. I '$D(LART(LANTIB)) D ALTSET QUIT
71 .. S LRA1=""
72 .. F S LRA1=$O(LADATA(LRORGNZM,CARD,LRA1)) Q:LRA1="" D
73 ... S LRA3=LADATA(LRORGNZM,CARD,LRA1)
74 ... D CALL
75 Q
76ALTSET ;
77 S ISOLATE=+LRORGNZM,LRORGNSM=$P(LRORGNZM,ISOLATE,2)
78 ;If an isolate is not marked on vitek it = zero
79 ;So ^LAH does not get set with a "0" the following is used
80 ;---------------------------------------------------------
81 I ISOLATE=0 SET LRISOFLG=1
82 I $G(LRISOFLG) S ISOLATE=ISOLATE+1
83 ;----------------------------------------------------------
84 S ISOL=$O(^LAB(61.39,1,1,"B",LRORGNSM,0))
85 S ISOL=^LAB(61.39,1,1,ISOL,1) ; IEN ETIOLOGY FIELD
86 S LRORGNSM=ISOL
87 S ^LAH(LWL,1,ISQN,2,2)="CARD^"_CARD
88 S ^LAH(LWL,1,ISQN,3,ISOLATE,0)=ISOL_"^^"_CARD
89 Q
90CALL ;
91 ;This is where we call the LIC file containing the translation
92 ; for drugs and bugs comming from the instrument.
93 ;I '$D(LRORGNSM) W !!!!,"NO ORG XMITTED"
94 ;_________________________________________________________________
95 ;Q:'$Q(^LAB(61.39,1,2,"B",LRA1))
96 S TMPAB=LRA1
97 S ISOLATE=+LRORGNZM,LRORGNSM=$P(LRORGNZM,ISOLATE,2)
98 ;If an isolate is not marked on vitek it = zero
99 ;So ^LAH does not get set with a "0" the following is used
100 ;---------------------------------------------------------
101 ;I ISOLATE=0 SET LRISOFLG=1
102 ;I $G(LRISOFLG) S ISOLATE=ISOLATE+1
103 ;S ISOLATE=ISOLATE+1
104 ;----------------------------------------------------------
105 S ISOL=$O(^LAB(61.39,1,1,"B",LRORGNSM,0))
106 S ISOL=^LAB(61.39,1,1,ISOL,1) ; IEN ETIOLOGY FIELD
107 S LRORGNSM=ISOL
108 ;S ISOL=$P(^LAB(61.2,ISOL,0),U) ; Pull out name from etiology
109 S LAVAB2=$O(^LAB(61.39,1,2,"B",LRA1,""))
110 S LAVAB1=^LAB(61.39,1,2,LAVAB2,1) ; IEN ANTIMICROBIAL SUSCEP
111 S LAVAB=$P(^LAB(62.06,LAVAB1,0),U,2) ; Pull out drug node (n.xxxx)
112 Q:'$G(LAVAB)
113 ;-----------------------------------------------------------------
114 S K1=LRA3
115 S MIC(ISOL,LAVAB)=LRA3
116 S ORG(ISOL)=ISOL
117 ;S ^LAH(LWL,1,ISQN,3,ISOL,0)=ISOL
118 S ^LAH(LWL,1,ISQN,2,2)="CARD^"_CARD
119 S ^LAH(LWL,"ISO",LACCN,ISOLATE)=ISQN
120 S ^LAH(LWL,1,ISQN,3,ISOLATE,1,0)=LRCMNT_U_LRBACT
121 S ^LAH(LWL,1,ISQN,3,ISOLATE,0)=ORG(ISOL)_"^^"_CARD
122 ;S ^TMPDRH(LACCN,LRORGNSM,CARD,TMPAB)=LRA3
123LA4 ;This is where I call FHS interp. program
124 ;------------------------------------------------------------------
125 S J=0
126 F S J=$O(MIC(ISOL,J)) Q:J<1 D
127 . S K=MIC(ISOL,J)_"^"
128 . D INTRP^LAMIVTE6 D QUIT
129 .. ;S ^LAH(LWL,1,ISQN,3,ISOLATE,J)=K_$G(S) ; looking for AI
130 .. ;K ^LAH(LWL,1,ISQN,3,ISOL)
131 .. S ^LAH(LWL,1,ISQN,3,ISOLATE,J)=MIC(ISOL,J)_"^"_$P($G(S),U,2)
132END ;
133 ;K LRORGNSM,LRA1
134 K MIC,LRVAB,LRA3,LRID ; <--- COMMENT OUT FOR TESTING
135 Q
136 ;___________________________________________________________________
137 ; For debugging purposes only
138DEBUG ;
139 K ZLACI,ZLART,ZLAPD,ZLASI
140 S LACOUNT=LACOUNT+1
141 S %X="LACI(",%Y="ZLACI(" D %XY^%RCR
142 S %Y="^TMP(""LA"",LACOUNT,""LACI""," D %XY^%RCR
143 S %X="LART(",%Y="ZLART(" D %XY^%RCR
144 S %Y="^TMP(""LA"",LACOUNT,""LART""," D %XY^%RCR
145 S %X="LAPD(",%Y="ZLAPD(" D %XY^%RCR
146 S %Y="^TMP(""LA"",LACOUNT,""LAPD""," D %XY^%RCR
147 S %X="LASI(",%Y="ZLASI(" D %XY^%RCR
148 S %Y="^TMP(""LA"",LACOUNT,""LASI""," D %XY^%RCR
149 Q
Note: See TracBrowser for help on using the repository browser.