source: FOIAVistA/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORUPD04.m

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

initial load of FOIAVistA 6/30/08 version

File size: 5.8 KB
Line 
1RORUPD04 ;HCIOFO/SG - PROCESSING OF THE LAB DATA ; 12/8/05 8:20am
2 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
3 ;
4 Q
5 ;
6 ;***** CHECKS AN INDICATOR CONDITION
7 ;
8 ; LSI Indicator (internal value)
9 ; VAL Indicated value
10 ; .RESULT( Result value
11 ; "RH") Reference high
12 ; "RL") Reference low
13 ;
14 ; Return Values:
15 ; 0 False
16 ; >0 True
17 ;
18CHKIND(LSI,VAL,RESULT) ;
19 S RESULT=$$UP^XLFSTR(RESULT)
20 ;--- Reference Range
21 I LSI=1 D Q LSI
22 . I $G(RESULT("RL"))'="" Q:RESULT<RESULT("RL")
23 . I $G(RESULT("RH"))'="" Q:RESULT>RESULT("RH")
24 . S LSI=0
25 ;--- Positive Result
26 I LSI=6 S VAL=0 D Q VAL
27 . I (RESULT="P")!(RESULT="R") S VAL=1 Q
28 . I RESULT'["POS",RESULT'["REA",RESULT'["DETEC" Q
29 . I RESULT'["NEG",RESULT'["NO",RESULT'["IND" S VAL=1
30 ;--- Compare to the value
31 Q:VAL="" 0
32 I LSI=3 Q (RESULT>VAL)
33 I LSI=4 Q (RESULT<VAL)
34 S VAL=$$UP^XLFSTR(VAL)
35 I LSI=2 Q (RESULT[VAL)
36 I LSI=5 Q (RESULT=VAL)
37 Q 0
38 ;
39 ;***** PROCESSING OF THE 'LAB DATA' FILE
40 ;
41 ; UPDSTART Date of the earliest update (DO NOT pass by
42 ; reference)
43 ; PATIEN Patient IEN
44 ;
45 ; Return values:
46 ; <0 Error code
47 ; 0 Continue processing of the current patient
48 ; 1 Stop processing
49 ;
50LAB(UPDSTART,PATIEN) ;
51 N RORFILE ; File number
52 ;
53 N DM,DSEND,LABIENS,RC,RORLAB,TMP
54 S RORFILE=63,DSEND=RORUPD("DSEND")
55 K RORVALS("LS")
56 ;--- If the start date is more than 60 days in the past, results
57 ; should be loaded using collection dates. Otherwise, dates of
58 ;--- the results are used).
59 S DM=$S($$FMDIFF^XLFDT(DT,UPDSTART)>60:"^CD",1:"^RAD")
60 ;--- Check the event references if the events are enabled
61 I $G(RORUPD("FLAGS"))["E" D Q:RC'>0 RC
62 . S RC=$$GET^RORUPP02(PATIEN,1,.UPDSTART,.DSEND)
63 . ;--- If dates have been modified according to the event references,
64 . ;--- they are the collection dates/times.
65 . S:RC>1 UPDSTART=UPDSTART\1,DSEND=$$FMADD^XLFDT(DSEND\1,1),DM="^CD"
66 ;---
67 S TMP=$$LABREF^RORUTL18(PATIEN) Q:TMP'>0 TMP
68 S LABIENS=TMP_",",RC=0
69 ;
70 S RORLAB=$$ALLOC^RORTMP() D D FREE^RORTMP(RORLAB)
71 . ;--- Load the Lab results
72 . S RC=$$LABRSLTS^RORUTL02(PATIEN,UPDSTART_DM,DSEND_DM,RORLAB)
73 . I RC<0 D INCEC^RORUPDUT(.RC) Q
74 . ;--- Process the results
75 . Q:$$RESULTS(PATIEN,RORLAB)<0
76 . ;--- Load necessary data elements
77 . I $D(RORUPD("SR",RORFILE,"F"))>1 D I TMP<0 D INCEC^RORUPDUT() Q
78 . . S TMP=$$LOAD(LABIENS)
79 . ;--- Apply "before" rules
80 . S RC=$$APLRULES^RORUPDUT(RORFILE,LABIENS,"B")
81 . I RC D INCEC^RORUPDUT(.RC) Q
82 . ;--- Apply "after" rules
83 . S RC=$$APLRULES^RORUPDUT(RORFILE,LABIENS,"A")
84 . I RC D INCEC^RORUPDUT(.RC) Q
85 ;
86 D CLRDES^RORUPDUT(RORFILE)
87 Q RC
88 ;
89 ;***** LOAD DATA ELEMENTS
90 ;
91 ; IENS IENS of the current record
92 ;
93 ; Return values:
94 ; <0 Error code
95 ; 0 Ok
96 ;
97LOAD(IENS) ;
98 N RC S RC=0
99 ;--- API #1
100 I $D(RORUPD("SR",RORFILE,"F",1)) D Q:RC<0 RC
101 . S RC=$$LOADFLDS^RORUPDUT(RORFILE,IENS)
102 ;--- API #2
103 Q 0
104 ;
105 ;***** EXTRACTS PROPER RESULT CODE FROM THE OBSERVATION ID
106 ;
107 ; OID Observation ID in HL7 format
108 ; CS HL7 component separator
109 ;
110 ; Return values:
111 ; Lab result code (see the LA7SC parameter of
112 ; the GCPR^LA7QRY entry point)
113 ; ^1: Result code
114 ; ^2: Coding system ("LN" or "NLT")
115 ; Or an empty string if coding system is unknown or there
116 ; are no active search indicators exist for this code.
117 ;
118RESCODE(OID,CS) ;
119 N CODE,I,RESCODE,TYPE
120 S RESCODE=""
121 F I=1,4 D Q:RESCODE'=""
122 . S CODE=$P(OID,CS,I),TYPE=$P(OID,CS,I+2) Q:CODE=""
123 . S TYPE=$S(TYPE="LN":"LN",TYPE="99VA64":"NLT",1:"") Q:TYPE=""
124 . ;--- Check if the search indicators exist for this code
125 . S RESCODE=CODE_U_TYPE
126 . S:$D(@RORUPDPI@("LS",RESCODE))<10 RESCODE=""
127 Q RESCODE
128 ;
129 ;***** LOADS AND PROCESSES RESULTS OF THE TESTS
130 ;
131 ; PATIEN Patient IEN
132 ; ROR8LAB Closed root of the HL7 message created by GCPR^LA7QRY
133 ;
134 ; Return values:
135 ; <0 Error code
136 ; 0 Ok
137 ;
138RESULTS(PATIEN,ROR8LAB) ;
139 N CS,DATE,FS,I,ISEG,LOCATION,LSIEN,LSNODE,RC,RESCODE,RESVAL,RORHL,SEG,SEGTYPE,TMP
140 S ISEG="",RC=0
141 F S ISEG=$O(@ROR8LAB@(ISEG)) Q:ISEG="" D Q:RC<0
142 . S SEG=$G(@ROR8LAB@(ISEG))
143 . ;--- Extract separators from the MSH segment
144 . I $E(SEG,1,3)="MSH" D Q
145 . . S (RORHL("FS"),FS)=$E(SEG,4),TMP=$P(SEG,FS,2)
146 . . S CS=$E(TMP,1)
147 . ;--- Skip all segments except OBX
148 . S SEGTYPE=$P(SEG,FS)
149 . Q:SEGTYPE'="OBX"
150 . ;--- Get lab result code
151 . S RESCODE=$$RESCODE($P(SEG,FS,4),CS) Q:RESCODE=""
152 . ;--- Load the full segment
153 . D LOADSEG^RORHL7A(.SEG,$NA(@ROR8LAB@(ISEG)))
154 . ;--- Get the result data
155 . S RESVAL=$G(SEG(5)),TMP=$G(SEG(7))
156 . S RESVAL("RL")=$P(TMP,"-",1) ; Reference Low
157 . S RESVAL("RH")=$P(TMP,"-",2) ; Reference High
158 . S DATE=$$HL7TFM^XLFDT($G(SEG(14)),"L")\1
159 . ;--- Analyze the result
160 . K LOCATION
161 . S LSNODE=$NA(@RORUPDPI@("LS",RESCODE))
162 . S LSIEN=""
163 . F S LSIEN=$O(@LSNODE@(LSIEN)) Q:LSIEN="" D Q:RC<0
164 . . S I="",RC=0
165 . . F S I=$O(@LSNODE@(LSIEN,I)) Q:I="" D Q:RC
166 . . . S TMP=$G(@LSNODE@(LSIEN,I))
167 . . . S RC=$$CHKIND(+TMP,$P(TMP,U,2),.RESVAL)
168 . . Q:RC'>0
169 . . S TMP=+$G(RORVALS("LS",LSIEN))
170 . . I TMP Q:(DATE'>0)!(DATE'<TMP)
171 . . S:'$D(LOCATION) LOCATION=$$IEN^XUAF4($P($G(SEG(15)),CS))
172 . . S RORVALS("LS",LSIEN)=DATE_U_LOCATION
173 ;---
174 Q $S(RC<0:RC,1:0)
175 ;
176 ;***** IMPLEMENTATION OF THE SELECTION RULE
177 ;
178 ; LSIEN Lab Search IEN
179 ;
180 ; Return values:
181 ; 0 Skip the patient
182 ; 1 Add the patient
183 ;
184RULE(LSIEN) ;
185 Q:'$D(RORVALS("LS",LSIEN)) 0
186 N DATE,LOC,SRDT
187 S DATE=+$G(RORVALS("LS",LSIEN))
188 D:DATE>0
189 . S LOC=$P($G(RORVALS("LS",LSIEN)),U,2)
190 . S SRDT=$$GETVAL^RORUPDUT("ROR SRDT")
191 . I (DATE<SRDT)!(SRDT'>0) D Q
192 . . S RORVALS("SV","ROR SRDT")=DATE
193 . . S RORVALS("SV","ROR SRLOC")=LOC
194 . I DATE=SRDT D:$$GETVAL^RORUPDUT("ROR SRLOC")="" Q
195 . . S RORVALS("SV","ROR SRLOC")=LOC
196 Q 1
Note: See TracBrowser for help on using the repository browser.