source: ccr/trunk/p/C0CQRY2.m@ 1800

Last change on this file since 1800 was 1586, checked in by Sam Habiel, 12 years ago

Changed license to AGPL. Some clean-up for XINDEX
  • Property svn:mergeinfo set to (toggle deleted branches)
    /ccr/branches/ohum/o-old/p/C0CQRY2.m1290
    /ccr/branches/ohum/p/C0CQRY2.m1291-1543
    /ccr/branches/ohum/p/p/C0CQRY2.m1287-1289
File size: 5.5 KB
Line 
1LA7QRY2 ;DALOI/JMC - Lab HL7 Query Utility ; 04/13/09 ; 10/30/12 10:16am
2 ;;1.2;CCD/CCR GENERATION UTILITIES;;Oct 30, 2012;Build 50
3 ; JMC - mods to check for IHS V LAB file
4 ;
5 ; (C) John McCormack 2009
6 ;
7 ; This program is free software: you can redistribute it and/or modify
8 ; it under the terms of the GNU Affero General Public License as
9 ; published by the Free Software Foundation, either version 3 of the
10 ; License, or (at your option) any later version.
11 ;
12 ; This program is distributed in the hope that it will be useful,
13 ; but WITHOUT ANY WARRANTY; without even the implied warranty of
14 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 ; GNU Affero General Public License for more details.
16 ;
17 ; You should have received a copy of the GNU Affero General Public License
18 ; along with this program. If not, see <http://www.gnu.org/licenses/>.
19 ;
20 ;
21 Q
22 ;
23PATID ; Resolve patient id and establish patient environment
24 ;
25 N LA7X
26 ;
27 S (DFN,LRDFN)="",LA7PTYP=0
28 ;
29 ; SSN passed as patient identifier
30 I LA7PTID?9N.1A D
31 . S LA7PTYP=1
32 . S LA7X=$O(^DPT("SSN",LA7PTID,0))
33 . I LA7X>0 D SETDFN(LA7X)
34 ;
35 ; MPI/ICN (integration control number) passed as patient identifier
36 I LA7PTID?10N1"V"6N D
37 . S LA7PTYP=2
38 . S LA7X=$$GETDFN^MPIF001($P(LA7PTID,"V"))
39 . I LA7X>0 D SETDFN(LA7X)
40 ;
41 ; If no patient identified/no laboratory record - return exception message
42 I 'LA7PTYP S LA7ERR(1)="Invalid patient identifier passed"
43 I 'DFN S LA7ERR(2)="No patient found with requested identifier"
44 I DFN,'LRDFN S LA7ERR(3)="No laboratory record for requested patient"
45 I LRDFN,'$D(^LR(LRDFN)) S LA7ERR(4)="Database error - missing laboratory record for requested patient"
46 Q
47 ;
48 ;
49BCD ; Search by specimen collection date.
50 ;
51 N LA763,LA7QUIT
52 ;
53 S (LA7SDT(0),LA7EDT(0))=0
54 I LA7SDT S LA7SDT(0)=9999999-LA7SDT
55 I LA7EDT S LA7EDT(0)=9999999-LA7EDT
56 ;
57 F LRSS="CH","MI","SP" D
58 . S (LA7QUIT,LRIDT)=0
59 . I LA7EDT(0) S LRIDT=$O(^LR(LRDFN,LRSS,LA7EDT(0)),-1)
60 . F S LRIDT=$O(^LR(LRDFN,LRSS,LRIDT)) Q:LA7QUIT D
61 . . ; Quit if reached end of data or outside date criteria
62 . . I 'LRIDT!(LRIDT>LA7SDT(0)) S LA7QUIT=1 Q
63 . . D SEARCH
64 ;
65 Q
66 ;
67 ;
68BRAD ; Search by results available date (completion date).
69 ; Assumes cross-references still exist for dates in LRO(69) global.
70 ; Collects specimen date/time values for a given LRDFN and completion date.
71 ; Cross-reference is by date only, time stripped from start date.
72 ; Uses cross-reference ^LRO(69,DT,1,"AN",'LOCATION',LRDFN,LRIDT)=""
73 ;
74 N LA763,LA7DT,LA7ROOT,LA7SRC,X
75 ;
76 ; Check if orders still exist Iin file #69 for search range
77 S LA7SDT(1)=(LA7SDT\1)-.0000000001,LA7EDT(1)=(LA7EDT\1)+.24,LA7SRC=0
78 S X=$O(^LRO(69,LA7SDT(1)))
79 I X,X<LA7EDT(1) S LA7SRC=1
80 ;
81 ; Search "AN" cross-reference in file #69.
82 I LA7SRC D
83 . S LA7DT=LA7SDT(1)
84 . F S LA7DT=$O(^LRO(69,LA7DT)) Q:'LA7DT!(LA7DT>LA7EDT(1)) D
85 . . S LA7ROOT="^LRO(69,LA7DT,1,""AN"")"
86 . . F S LA7ROOT=$Q(@LA7ROOT) Q:LA7ROOT=""!($QS(LA7ROOT,2)'=LA7DT)!($QS(LA7ROOT,4)'="AN") D
87 . . . I $QS(LA7ROOT,6)'=LRDFN Q
88 . . . S LRIDT=$QS(LA7ROOT,7)
89 . . . F LRSS="CH","MI","SP" D SEARCH
90 ;
91 ; If no orders in #69 then do long search through file #63.
92 I 'LA7SRC D
93 . F LRSS="CH","MI","SP" D
94 . . S LRIDT=0
95 . . F S LRIDT=$O(^LR(LRDFN,LRSS,LRIDT)) Q:'LRIDT D
96 . . . S LA763(0)=$G(^LR(LRDFN,LRSS,LRIDT,0))
97 . . . I $P(LA763(0),"^",3)>LA7SDT(1),$P(LA763(0),"^",3)<LA7EDT(1) D SEARCH
98 ;
99 Q
100 ;
101 ;
102SEARCH ; Search subscript for a specific collection date/time
103 ;
104 K LA763
105 S LA763(0)=$G(^LR(LRDFN,LRSS,LRIDT,0))
106 ;
107 ; Only CH, MI, and BB subscripts store pointer to file #61 in 5th piece of zeroth node.
108 ; Quit if specific specimen codes and they do not match
109 I "CHMIBB"[LRSS S LA761=+$P(LA763(0),"^",5)
110 E S LA761=0
111 I LA761,$D(^TMP("LA7-61",$J)),'$D(^TMP("LA7-61",$J,LA761)) Q
112 ;
113 ; --- Chemistry
114 I LRSS="CH" D CHSS Q
115 ; --- Microbiology
116 I LRSS="MI" D MISS Q
117 ; --- Surgical pathology
118 I LRSS="SP" D APSS Q
119 ; --- Cytology
120 I LRSS="CY" D APSS Q
121 ; --- Electron Micrscopsy
122 I LRSS="EM" D APSS Q
123 ; --- Autopsy
124 I LRSS="AU" D APSS Q
125 ; --- Blood Bank
126 I LRSS="BB" D BBSS Q
127 Q
128 ;
129 ;
130CHSS ; Search "CH" datanames for matching codes
131 ;
132 N LA7X,LRSB
133 ;
134 S LRSB=1
135 F S LRSB=$O(^LR(LRDFN,LRSS,LRIDT,LRSB)) Q:'LRSB D
136 . S LA7X=$G(^LR(LRDFN,LRSS,LRIDT,LRSB))
137 . I $D(^AUPNVLAB) D LNCHK^C0CLA7Q ; WV check for IHS.
138 . S LA7CODE=$$DEFCODE^LA7VHLU5(LRSS,LRSB,$P(LA7X,"^",3),LA761)
139 . D CHECK
140 ;
141 Q
142 ;
143 ;
144MISS ; Search "MI" subscripts for matching codes
145 ;
146 N LA7ND,LRSB
147 ;
148 S LA7ND=0
149 F LA7ND=1,5,8,11,16 I $D(^LR(LRDFN,LRSS,LRIDT,LA7ND)) D
150 . S LRSB=$S(LA7ND=1:11,LA7ND=5:14,LA7ND=8:18,LA7ND=11:22,LA7ND=16:33,1:11)
151 . S LA7CODE=$$DEFCODE^LA7VHLU5(LRSS,LRSB,"",LA761)
152 . D CHECK
153 Q
154 ;
155 ;
156APSS ; Search AP subscripts for matching codes
157 ; AP results are currently not coded - use defaults
158 ;
159 N LA7CODE,LRSB
160 ;
161 S LRSB=.012
162 S LA7CODE=$$DEFCODE^LA7VHLU5(LRSS,LRSB,"","")
163 D CHECK
164 ;
165 Q
166 ;
167 ;
168BBSS ; Search BB subscript for matching codes
169 ; *** This subscript currently not supported ***
170 Q
171 ;
172 ;
173CHECK ; Check NLT order/result and LOINC codes.
174 ;
175 N LA7QUIT
176 ;
177 ; If wildcard then store
178 ; Otherwise check for specific NLT order/result and LOINC codes
179 I LA7SC="*" D STORE Q
180 S LA7QUIT=0
181 F I=1:1:3 D Q:LA7QUIT
182 . ; If no test code then skip
183 . I '$L($P(LA7CODE,"!",I)) Q
184 . ; If test code does not match a search code then quit
185 . I '$D(^TMP($S(I=3:"LA7-LN",1:"LA7-NLT"),$J,$P(LA7CODE,"!",I))) Q
186 . D STORE S LA7QUIT=1
187 ;
188 Q
189 ;
190 ;
191STORE ; Store entry for building in HL7 message
192 ;
193 S ^TMP("LA7-QRY",$J,LRDFN,LRIDT,LRSS,LA7CODE,LRSB)=""
194 Q
195 ;
196 ;
197SETDFN(LA7X) ; Setup DFN and other lab variables.
198 ;
199 S DFN=LA7X,LRDFN=$P($G(^DPT(DFN,"LR")),"^")
200 Q
Note: See TracBrowser for help on using the repository browser.