source: WorldVistAEHR/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORHL04.m@ 1710

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

initial load of WorldVistAEHR

File size: 5.8 KB
Line 
1RORHL04 ;HOIFO/CRT,SG - HL7 RADIOLOGY: OBR,OBX ; 10/27/05 11:19am
2 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
3 ;
4 ; This routine uses the following IAs:
5 ;
6 ; #65 Read access to file #70 (controlled)
7 ; #118-B Read access to file #71 (controlled)
8 ; #118-D Read access to file #72 (controlled)
9 ; #1995 $$CPT^ICPTCOD (supported)
10 ; #2043 EN1^RAO7PC1 (supported)
11 ; #10060 Read access to the file #200 (supported)
12 ; #10090 Read access to the file #4 (supported)
13 ;
14 ; #15-C Read access to file #74 (Private)
15 ;
16 Q
17 ;
18 ;***** SEARCHES RADIOLOGY FOR DATA
19 ;
20 ; RORDFN IEN of the patient in the PATIENT file (#2)
21 ;
22 ; .DXDTS Reference to a local variable where the
23 ; data extraction time frames are stored.
24 ;
25 ; Return Values:
26 ; <0 Error code
27 ; 0 Ok
28 ; >0 Non-fatal error(s)
29 ;
30 ; The ^TMP($J,"RAE1") global node is used by the function.
31 ;
32EN1(RORDFN,DXDTS) ;
33 N CNI,DTI,ERRCNT,EXAMID,IDX,IENS,IENS74,RACN0,RC,RORENDT,RORSTDT,STR1,TMP
34 S (ERRCNT,RC)=0
35 ;
36 S IDX=0
37 F S IDX=$O(DXDTS(4,IDX)) Q:IDX'>0 D Q:RC<0
38 . S RORSTDT=$P(DXDTS(4,IDX),U),RORENDT=$P(DXDTS(4,IDX),U,2)
39 . ;--- Get radiology data
40 . K ^TMP($J,"RAE1")
41 . D EN1^RAO7PC1(RORDFN,RORSTDT,RORENDT,999999999)
42 . ;--- Process the data
43 . S EXAMID=""
44 . F S EXAMID=$O(^TMP($J,"RAE1",RORDFN,EXAMID)) Q:EXAMID="" D
45 . . S DTI=$P(EXAMID,"-"),CNI=$P(EXAMID,"-",2)
46 . . S IENS=CNI_","_DTI_","_RORDFN_","
47 . . S STR=^TMP($J,"RAE1",RORDFN,EXAMID)
48 . . S RACN0=$P(STR,"^",2),IENS74=$P(STR,"^",5)
49 . . S TMP=$$OBR(IENS,RACN0)
50 . . I TMP Q:TMP<0 S ERRCNT=ERRCNT+TMP
51 . . Q:TMP="S"
52 . . S TMP=$$OBX(IENS,IENS74)
53 . . I TMP Q:TMP<0 S ERRCNT=ERRCNT+TMP
54 ;
55 K ^TMP($J,"RAE1")
56 Q $S(RC<0:RC,1:ERRCNT)
57 ;
58 ;*****
59LOOP(TEXT,OID) ;
60 N BR,CNT,I,I1,TMP
61 S BR=$E(HLECH,3)_".br"_$E(HLECH,3)
62 S RORSEG(3)=OID
63 K RORSEG(5)
64 ;---
65 S I=$O(TEXT("")),CNT=0
66 F Q:I="" S I1=$O(TEXT(I)) D S I=I1
67 . S TMP=$$ESCAPE^RORHL7(TEXT(I))
68 . S CNT=CNT+1,RORSEG(5,CNT)=$S(I1'="":TMP_BR,1:TMP)
69 ;---
70 D:$D(RORSEG(5)) ADDSEG^RORHL7(.RORSEG)
71 Q
72 ;
73 ;***** GENERATES THE RADIOLOGY OBR SEGMENT
74 ;
75 ; RORIENS IENS of the radiology record in the file #70.03
76 ;
77 ; Return Values:
78 ; <0 Error code
79 ; 0 Ok
80 ; >0 Non-fatal error(s)
81 ; "S" Skip the record
82 ;
83OBR(RORIENS,RACN0) ;
84 N BUF,CPTIEN,CS,ERRCNT,IENS,IENS7002,RADTE,RC,RORMSG,ROROUT,RORSEG,TMP
85 S (ERRCNT,RC)=0
86 D ECH^RORHL7(.CS)
87 ;--- Check the parameters
88 S:$E(RORIENS,$L(RORIENS))'="," RORIENS=RORIENS_","
89 ;
90 D GETS^DIQ(70.03,RORIENS,"2;14","IE","ROROUT","RORMSG")
91 Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,,70.03,RORIENS)
92 S IENS7002=$P(RORIENS,",",2,3)_","
93 D GETS^DIQ(70.02,IENS7002,".01;3","EI","ROROUT","RORMSG")
94 Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,,70.02,IENS7002)
95 ;
96 ;--- Initialize the segment
97 S RORSEG(0)="OBR"
98 ;
99 ;--- OBR-3 - Unique Accession #
100 S BUF=$P(RORIENS,",",2)_"-"_$P(RORIENS,",")
101 S RADTE=$G(ROROUT(70.02,IENS7002,.01,"I"))\1
102 S $P(BUF,CS,2)=$E(RADTE,4,7)_$E(RADTE,2,3)_"-"_+RACN0
103 S RORSEG(3)=BUF
104 ;
105 ;--- OBR-4 - Procedure & CPT Code
106 S IENS=+$G(ROROUT(70.03,RORIENS,2,"I"))_","
107 Q:IENS'>0 $$ERROR^RORERR(-95,,,,70.03,RORIENS,2)
108 S CPTIEN=+$$GET1^DIQ(71,IENS,9,"I",,"RORMSG")
109 Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,,71,IENS)
110 ;--- Some procedures never have a CPT code. Record a warning
111 ;--- (only in debug mode) and skip the record.
112 I CPTIEN'>0 D:$G(RORPARM("DEBUG")) Q "S"
113 . D ERROR^RORERR(-95,,,,71,IENS,9)
114 ;---
115 S TMP=$$CPT^ICPTCOD(CPTIEN)
116 Q:TMP<0 $$ERROR^RORERR(-56,,$P(TMP,U,2),,+TMP,"$$CPT^ICPTCOD")
117 S BUF=$P(TMP,U,2)_CS_$$ESCAPE^RORHL7($P(TMP,U,3))_CS_"C4"
118 ;---
119 S $P(BUF,CS,4)=$G(ROROUT(70.03,RORIENS,2,"I"))
120 S $P(BUF,CS,5)=$$ESCAPE^RORHL7($G(ROROUT(70.03,RORIENS,2,"E")))
121 S $P(BUF,CS,6)="99RAP"
122 S RORSEG(4)=BUF
123 ;
124 ;--- OBR-7 - Exam Date/Time
125 S TMP=$$FMTHL7^XLFDT($G(ROROUT(70.02,IENS7002,.01,"I")))
126 Q:TMP'>0 $$ERROR^RORERR(-95,,,,70.02,IENS7002,.01)
127 S RORSEG(7)=TMP
128 ;
129 ;--- OBR-16 - Requesting Physician
130 S BUF=+$G(ROROUT(70.03,RORIENS,14,"I"))
131 I BUF>0 D
132 . S $P(BUF,CS,13)=$$GET1^DIQ(200,+BUF_",",53.5,"E",,"RORMSG")
133 . I $G(DIERR) D DBS^RORERR("RORMSG",-99,,,200,+BUF_",") Q
134 . S RORSEG(16)=BUF
135 ;
136 ;--- OBR-24 - Service Section ID
137 S RORSEG(24)="RAD"
138 ;
139 ;--- OBR-44 - Division
140 S RORSEG(44)=$$SITE^RORUTL03(CS)
141 S IENS=+$G(ROROUT(70.02,IENS7002,3,"I"))_","
142 I IENS>0 D
143 . S BUF=$$GET1^DIQ(4,IENS,99,"I",,"RORMSG")
144 . I $G(DIERR) D DBS^RORERR("RORMSG",-99,,,4,IENS) Q
145 . Q:BUF=""
146 . S $P(BUF,CS,2)=$$ESCAPE^RORHL7($G(ROROUT(70.02,IENS7002,3,"E")))
147 . S $P(BUF,CS,3)="99VA4"
148 . S RORSEG(44)=BUF
149 ;
150 ;--- Store the segment
151 D ADDSEG^RORHL7(.RORSEG)
152 Q ERRCNT
153 ;
154 ;***** GENERATES THE RADIOLOGY OBX SEGMENT
155 ;
156 ; RORIENS IENS of the radiology record in the file #70.03
157 ;
158 ; Return Values:
159 ; <0 Error code
160 ; 0 Ok
161 ; >0 Non-fatal error(s)
162 ;
163OBX(RORIENS,IENS74) ;
164 N ERRCNT,RC,RORMSG,ROROUT,RORSEG,RORTXT,TMP
165 S (ERRCNT,RC)=0
166 D ECH^RORHL7(.CS)
167 ;--- Check the parameters
168 S:$E(RORIENS,$L(RORIENS))'="," RORIENS=RORIENS_","
169 ;
170 ;--- Initialize the segment
171 S RORSEG(0)="OBX"
172 ;
173 ;--- OBX-2
174 S RORSEG(2)="FT"
175 ;
176 ;--- OBX-11
177 S RORSEG(11)="F"
178 ;
179 ;-- Get the Report Text
180 S TMP=$$GET1^DIQ(74,IENS74,200,,"RORTXT","RORMSG")
181 I $G(DIERR) D S ERRCNT=ERRCNT+1
182 . D DBS^RORERR("RORMSG",-99,,,74,IENS74)
183 I $D(RORTXT)>1 D K RORTXT
184 . D LOOP(.RORTXT,"RT"_CS_"Report Text"_CS_"VA080")
185 ;
186 ;--- Get the Impression Report
187 S TMP=$$GET1^DIQ(74,IENS74,300,,"RORTXT","RORMSG")
188 I $G(DIERR) D S ERRCNT=ERRCNT+1
189 . D DBS^RORERR("RORMSG",-99,,,74,IENS74)
190 I $D(RORTXT)>1 D K RORTXT
191 . D LOOP(.RORTXT,"IT"_CS_"Impression Text"_CS_"VA080")
192 ;
193 ;--- Get the Clinical History
194 S TMP=$$GET1^DIQ(70.03,RORIENS,400,,"RORTXT","RORMSG")
195 I $G(DIERR) D S ERRCNT=ERRCNT+1
196 . D DBS^RORERR("RORMSG",-99,,,70.03,RORIENS)
197 I $D(RORTXT)>1 D K RORTXT
198 . D LOOP(.RORTXT,"CH"_CS_"Clinical History"_CS_"VA080")
199 ;
200 Q ERRCNT
Note: See TracBrowser for help on using the repository browser.