source: FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LRSRVR2.m@ 636

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

initial load of FOIAVistA 6/30/08 version
File size: 6.8 KB
Line 
1LRSRVR2 ;DALIO/FHS - LAB DATA SERVER CONT'D RELMA EXTRACT ; Jan 9, 2006
2 ;;5.2;LAB SERVICE;**303,346**;Sep 27, 1994;Build 10
3 ; Produces LOINC RELMA extract - via LRLABSERVER or option
4 ;
5EN ; Called by option [LR LOINC EXTRACT RELMA FORMAT]
6 ; Entry point for the option - user must capture output
7 N DIR,DIRUT,LREND,LRCNT,LRSUB,LRVAL,LRST,LRSTN,LRTXT,X,Y
8 S DIR(0)="Y",DIR("A")="Ready to Capture",DIR("B")="Yes"
9 D ^DIR
10 I $D(DIRUT) Q
11 D WAIT^DICD
12 S LRSUB="RELMA",LRTXT=1
13 D BUILD
14 W !
15 S LRL=0
16 F S LRL=$O(^TMP($J,"LRDATA",LRL)) Q:LRL<1 W !,^(LRL)
17 D CLEAN^LRSRVR2A
18 Q
19 ;
20 ;
21SERVER ; Server entry Point
22 N I,LRCNT,LREND,LRL,LRMSUBJ,LRTXT,LRX,LRY
23 S LRTXT=0
24 D BUILD
25 S LRMSUBJ=LRST_" "_LRSTN_" RELMA EXTRACT "_$$HTE^XLFDT($H,"1M")
26 D MAILSEND^LRSRVR6(LRMSUBJ)
27 D CLEAN^LRSRVR2A
28 Q
29 ;
30 ;
31BUILD ; Build extract
32 N I,LR6206,LR64,LRCNT,LRCRLF,LRLEN,LRQUIT,LRROOT,LRSTNOTE,LRSS,LRSTR,LRSTUB,LRVAL
33 S LRVAL=$$SITE^VASITE,LRST=$P(LRVAL,"^",3),LRSTN=$P(LRVAL,"^",2)
34 I LRST="" S LRST="???"
35 K ^TMP($J,"LRDATA"),^TMP($J,"LR60")
36 S LRCNT=0,LRCRLF=$C(13,10),LRSTR=""
37 F I=0,1,2,3 S LRCNT(I)=0
38 D HDR^LRSRVR2A
39 ;
40 ; Step down the B X-ref - exclude synomyms
41 S LRROOT="^LAB(60,""B"")"
42 F S LRROOT=$Q(@LRROOT) Q:LRROOT="" Q:$QS(LRROOT,2)'="B" D
43 . Q:$G(@LRROOT)
44 . D TEST
45 ;
46 ; Process microbiology antibiotics
47 S LR6206=0,LRSS="MI"
48 F S LR6206=$O(^LAB(62.06,LR6206)) Q:'LR6206 D
49 . S LR64=$$GET1^DIQ(62.06,LR6206_",",64,"I")
50 . S LRX=$$MICRO^LRSRVR3(LR64)
51 . S LRSTUB=$P(LRX,"|",5)_"||||"_$P(LRX,"|",3)_"|"_$P(LRX,"|",1)_"|||"_$P(LRX,"|",20)_"|"_$P(LRX,"|",19)_"|||||||||||"
52 . I LR64 S LRSTUB=LRSTUB_$$GET1^DIQ(64,LR64_",",25)
53 . S LRSTUB=LRSTUB_"|1.1|" ; Set extract version number
54 . S LRSTR=LRSTR_LRST_"-"_LR64_"-"_"AB"_LR6206_"|"_LRSTUB
55 . I 'LRTXT S LRSTR=LRSTR_LRCRLF
56 . D SETDATA S LRCNT=LRCNT+1,LRCNT(3)=LRCNT(3)+1
57 ;
58 ; Set the final info into the ^TMP message global
59 I 'LRTXT D
60 . S LRNODE=$O(^TMP($J,"LRDATA",""),-1)
61 . I LRSTR'="" S LRNODE=LRNODE+1,^TMP($J,"LRDATA",LRNODE)=$$UUEN^LRSRVR4(LRSTR)
62 . S ^TMP($J,"LRDATA",LRNODE+1)=" "
63 . S ^TMP($J,"LRDATA",LRNODE+2)="end"
64 ;
65 S ^TMP($J,"LRDATA",6)="Total number of records: "_$J(LRCNT,5)
66 S ^TMP($J,"LRDATA",7)="Total number of tests..: "_$J(LRCNT(0),5)
67 S ^TMP($J,"LRDATA",8)="Tests with LOINC code..: "_$J(LRCNT(1),5)
68 S ^TMP($J,"LRDATA",9)="Tests with NLT code....: "_$J(LRCNT(2),5)
69 S ^TMP($J,"LRDATA",10)="Antimicrobials.........: "_$J(LRCNT(3),5)
70 ;
71 Q
72 ;
73 ;
74TEST ; Pull out test info
75 N LA7TREE,LR60,LRBATTY,LRBATTYN,LRTSTTYP
76 K LROUT,LRSPEC,ERR
77 S LR60NM=$QS(LRROOT,3),LR60IEN=$QS(LRROOT,4)
78 S LR60NM=$$TRIM^XLFSTR(LR60NM,"RL"," ")
79 S LRTSTTYP=$P(^LAB(60,LR60IEN,0),"^",3)
80 ;
81 ; Bypass "neither" type tests.
82 I LRTSTTYP="N" Q
83 ; Bypass "workload" type tests.
84 I $P(^LAB(60,LR60IEN,0),"^",4)="WK" Q
85 ;
86 S LRBATTY=LRST_"-"_LR60IEN,LRBATTYN=LR60NM
87 S LRBATTY=$$TRIM^XLFSTR(LRBATTY,"RL"," ")
88 ; Panel test
89 ; Bypass "output panel" type tests - usually used for display only.
90 I $O(^LAB(60,LR60IEN,2,0)) D Q
91 . I $P(^LAB(60,LR60IEN,0),"^",3)="O" Q
92 . D UNWIND^LA7ADL1(LR60IEN,9,0)
93 . S LR60=0
94 . F S LR60=$O(LA7TREE(LR60)) Q:'LR60 D
95 . . I $D(^TMP($J,"LR60",LR60)) Q
96 . . S LR60IEN=LR60,LR60NM=$P(^LAB(60,LR60IEN,0),"^")
97 . . S LRTSTTYP=$P(^LAB(60,LR60IEN,0),"^",3)
98 . . ; Bypass "neither" type tests.
99 . . I LRTSTTYP="N" Q
100 . . ; Bypass "workload" type tests.
101 . . I $P(^LAB(60,LR60IEN,0),"^",4)="WK" Q
102 . . S LRR64=+$P($G(^LAB(60,+LR60IEN,64)),U,2)
103 . . D SPEC
104 ;
105 I $D(^TMP($J,"LR60",LR60IEN)) Q
106 ; Not a panel test
107 ; Get result NLT code
108 S LRR64=+$P($G(^LAB(60,+LR60IEN,64)),U,2)
109 D SPEC
110 Q
111 ;
112 ;
113SPEC ; Check each specimen for this test
114 K LRSPEC,LROUT
115 S (LRCDEF,LRSPEC,LRSPECN,LRLNC,LRLNCN,LRLNCX,LRLNC80,LRUNIT,Y)=""
116 D SITENOTE^LRSRVR2A
117 D SYNNOTE^LRSRVR2A
118 S LRSPEC60=0
119 F S LRSPEC60=$O(^LAB(60,+LR60IEN,1,LRSPEC60)) Q:'LRSPEC60 D
120 . Q:'($D(^LAB(60,+LR60IEN,1,LRSPEC60,0))#2)
121 . S LRUNIT=$P(^LAB(60,+LR60IEN,1,LRSPEC60,0),U,7)
122 . S X=$G(^LAB(61,LRSPEC60,0))
123 . S LRSPECN=$P(X,"^"),LRSPECTA=$P(X,"^",10)
124 . S LRSPEC(LRSPEC60_"-0")=LRSPEC60_U_LRSPECN_U_LRSPECTA_U_LRUNIT_U_LRR64
125 . I LRR64,$P($$GET1^DIQ(64,LRR64_",",1,"E"),".",2)="0000" D SUFFIX^LRSRVR2A
126 D SPECLOOP
127 Q
128 ;
129 ;
130SPECLOOP ; Check to see if specimen has been linked to LOINC
131 ;
132 N LR64,LR6421,LRINDX,LRLNTA,LRRNLT,LRTA,LRX,X
133 S LRINDX=0
134 F S LRINDX=$O(LRSPEC(LRINDX)) Q:'LRINDX D
135 . S X=LRSPEC(LRINDX)
136 . S LRSPEC=$P(X,U),LRSPECN=$P(X,U,2),LRLNTA=$P(X,U,3),LR64=$P(X,U,5),LRUNIT=$$TRIM^XLFSTR($P(X,U,4),"RL"," ")
137 . S (LR6421,LRLNC,LRRNLT,LRTA)=""
138 . I LR64 D
139 . . S LRRNLT=$$GET1^DIQ(64,LR64_",",1,"E")
140 . . S LR6421=$$GET1^DIQ(64,LR64_",",13,"I")
141 . . S LRX=""
142 . . I LRSPEC,LRLNTA S LRX=$P($G(^LAM(LR64,5,LRSPEC,1,LRLNTA,1)),"^")
143 . . I LRX="",LRSPEC D
144 . . . S X=$O(^LAM(LR64,5,LRSPEC,1,0))
145 . . . I X S LRLNTA=X,LRX=$P($G(^LAM(LR64,5,LRSPEC,1,X,1)),"^")
146 . . I LRX'="" S LRLNC=$$GET1^DIQ(95.3,LRX_",",.01,"E")
147 . . I LRLNTA S LRTA=$$GET1^DIQ(64.061,LRLNTA_",",.01,"E")
148 . D WRT
149 Q
150 ;
151 ;
152WRT ; Set ^TMP( with extracted data
153 N LRJ,LREN,LRQUIT,LRSS,X,Y
154 ;
155 ; Set flag that this file #60 test has been processed - avoid duplicate
156 ; processing as component of panel and individual test
157 S ^TMP($J,"LR60",LR60IEN)=""
158 ;
159 S LRSTR=LRSTR_LRST_"-"_LR60IEN_"-"_LRINDX
160 S LRSTR=LRSTR_"|"_LR60NM_"|"_LRSPECN_"|"_LRTA_"|"_LRUNIT_"|"_LRLNC_"|"_LRRNLT_"|"_LRBATTY_"|"_LRBATTYN_"|"
161 ;
162 ; Lab section specified for this NLT code.
163 S LRSTR=LRSTR_$S($G(LR6421)>0:$$GET1^DIQ(64.21,LR6421_",",1),1:"")_"|"
164 ;
165 ; Subscript
166 S LRSS=$$GET1^DIQ(60,LR60IEN_",",4,"I")
167 S LRSTR=LRSTR_LRSS_"|"
168 ; Test info - data type, help prompt
169 I LRSS'="CH" S LRSTR=LRSTR_"||"
170 I LRSS="CH" S X=$$TSTTYP^LRSRVR3($$GET1^DIQ(60,LR60IEN_",",13)) S LRSTR=LRSTR_$P(X,"|")_"|"_$P(X,"|",2)_"|"
171 ;
172 ; Test reference low|reference high|therapeutic low|therapeutic high|
173 S X=$G(^LAB(60,LR60IEN,1,LRSPEC,0))
174 S Y=$P(X,"^",2)_"|"_$P(X,"^",3)_"|"_$P(X,"^",11)_"|"_$P(X,"^",12)
175 S LRSTR=LRSTR_$TR(Y,$C(34),"")
176 ; Use for reference lab testing
177 S X=$G(^LAB(60,LR60IEN,1,LRSPEC,.1))
178 S LRSTR=LRSTR_"|"_$S($P(X,"^")=1:"YES",1:"NO")_"|"
179 ;
180 ; Send site's test notes on first record for this test.
181 I LRSTNOTE D
182 . D SETDATA
183 . S LRJ="LRSTNOTE"
184 . F S LRJ=$Q(@LRJ) Q:LRJ="" D
185 . . S X=@LRJ I X["|" S X=$TR(X,"|","~")
186 . . S LRSTR=LRSTR_X D SETDATA
187 . S LRSTNOTE=0
188 S LRSTR=LRSTR_"|"
189 ;
190 ; Send site's test synonym's on first record for this test.
191 I LRSTSYN D
192 . D SETDATA
193 . S LRJ="LRSTSYN"
194 . F S LRJ=$Q(@LRJ) Q:LRJ="" S LRSTR=LRSTR_@LRJ_"^" D SETDATA
195 . S LRSTSYN=0
196 ;
197 ; Send file #60 test type
198 S LRSTR=LRSTR_"|"_LRTSTTYP_"|"
199 ;
200 ; Send default LOINC code
201 I LR64 S LRSTR=LRSTR_$$GET1^DIQ(64,LR64_",",25)
202 ;
203 ; Set extract version number
204 S LRSTR=LRSTR_"|1.1|"
205 ;
206 I 'LRTXT S LRSTR=LRSTR_LRCRLF
207 D SETDATA
208 ;
209 S LRCNT=LRCNT+1,LRCNT(0)=LRCNT(0)+1
210 I LRLNC'="" S LRCNT(1)=LRCNT(1)+1
211 I LR64 S LRCNT(2)=LRCNT(2)+1
212 Q
213 ;
214 ;
215SETDATA ; Set data into report structure
216 S LRNODE=$O(^TMP($J,"LRDATA",""),-1)
217 I LRTXT S LRNODE=LRNODE+1,^TMP($J,"LRDATA",LRNODE)=LRSTR,LRSTR="" Q
218 I 'LRTXT D ENCODE^LRSRVR4(.LRSTR)
219 Q
Note: See TracBrowser for help on using the repository browser.