| [1586] | 1 | LA7QRY2 ;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
|
|---|
| [1544] | 3 | ; JMC - mods to check for IHS V LAB file
|
|---|
| 4 | ;
|
|---|
| [1586] | 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 | ;
|
|---|
| [1544] | 21 | Q
|
|---|
| 22 | ;
|
|---|
| 23 | PATID ; 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 | ;
|
|---|
| 49 | BCD ; 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 | ;
|
|---|
| 68 | BRAD ; 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 | ;
|
|---|
| 102 | SEARCH ; 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 | ;
|
|---|
| 130 | CHSS ; 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 | ;
|
|---|
| 144 | MISS ; 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 | ;
|
|---|
| 156 | APSS ; 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 | ;
|
|---|
| 168 | BBSS ; Search BB subscript for matching codes
|
|---|
| 169 | ; *** This subscript currently not supported ***
|
|---|
| 170 | Q
|
|---|
| 171 | ;
|
|---|
| 172 | ;
|
|---|
| 173 | CHECK ; 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 | ;
|
|---|
| 191 | STORE ; Store entry for building in HL7 message
|
|---|
| 192 | ;
|
|---|
| 193 | S ^TMP("LA7-QRY",$J,LRDFN,LRIDT,LRSS,LA7CODE,LRSB)=""
|
|---|
| 194 | Q
|
|---|
| 195 | ;
|
|---|
| 196 | ;
|
|---|
| 197 | SETDFN(LA7X) ; Setup DFN and other lab variables.
|
|---|
| 198 | ;
|
|---|
| 199 | S DFN=LA7X,LRDFN=$P($G(^DPT(DFN,"LR")),"^")
|
|---|
| 200 | Q
|
|---|
