source: FOIAVistA/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORHL081.m@ 649

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

initial load of FOIAVistA 6/30/08 version
File size: 6.7 KB
Line 
1RORHL081 ;HOIFO/BH - HL7 INPATIENT DATA: OBX ; 10/27/05 12:32pm
2 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
3 ;
4 ; This routine uses the following IAs:
5 ;
6 ; #92 Read access to the PTF file (Controlled)
7 ;
8 Q
9 ;
10 ;***** BED SECTION
11BEDSEC(RORIEN) ;
12 N DATE,ERRCNT,FLD,ICDFLST,IEN4502,IENS,IFL,NODE,OID,RORBS,RORBSED,RORBSSD,RORBUF,RORCODE,RORMSG,TMP
13 S ERRCNT=0,ICDFLST="5;6;7;8;9;11;12;13;14;15"
14 S OID="INBED"_RORCS_"Bedsection Diagnosis"_RORCS_"VA080"
15 S NODE=$$ROOT^DILFD(45.02,","_RORIEN_",",1)
16 ;---
17 S DATE=$$GET1^DIQ(45,RORIEN_",",2,"I",,"RORMSG")
18 I $G(DIERR) D S ERRCNT=ERRCNT+1
19 . D DBS^RORERR("RORMSG",-99,,RORDFN,45,RORIEN_",")
20 S (RORBSSD,RORBSED)=$$FM2HL^RORHL7(DATE)
21 ;
22 S DATE=""
23 F S DATE=$O(@NODE@("AM",DATE)) Q:DATE="" D
24 . S IEN4502=0
25 . F S IEN4502=$O(@NODE@("AM",DATE,IEN4502)) Q:IEN4502'>0 D
26 . . S RORBSSD=RORBSED K RORBUF
27 . . S IENS=IEN4502_","_RORIEN_","
28 . . ;--- Load the data
29 . . D GETS^DIQ(45.02,IENS,"2;10;"_ICDFLST,"EI","RORBUF","RORMSG")
30 . . I $G(DIERR) D S ERRCNT=ERRCNT+1
31 . . . D DBS^RORERR("RORMSG",-99,,RORDFN,45.02,IENS)
32 . . ;--- Name of the bed section
33 . . S RORBS=$$ESCAPE^RORHL7($G(RORBUF(45.02,IENS,2,"E")))
34 . . ;--- End date
35 . . S RORBSED=$$FM2HL^RORHL7($G(RORBUF(45.02,IENS,10,"I")))
36 . . ;--- ICD-9 codes
37 . . S RORCODE=""
38 . . F IFL=1:1 S FLD=+$P(ICDFLST,";",IFL) Q:'FLD D
39 . . . S TMP=$G(RORBUF(45.02,IENS,FLD,"E"))
40 . . . S:TMP'="" $P(RORCODE,RORRS,IFL)=TMP
41 . . ;--- Store the segment (if there is at least one ICD-9 code)
42 . . D:RORCODE'="" SETOBX(OID,RORCODE,RORBS,RORBSED,RORBSSD)
43 ;
44 Q ERRCNT
45 ;
46 ;***** DISCHARGE DIAGNOSIS CODES
47DDIAG(RORIEN) ;
48 N ERRCNT,FLD,ICDFLST,IENS,IFL,OID,RORBUF,RORDDIAG,TMP
49 S ERRCNT=0,OID="INDIS"_RORCS_"Discharge Diagnosis"_RORCS_"VA080"
50 S ICDFLST="79.16;79.17;79.18;79.19;79.201;79.21;79.22;79.23;79.24"
51 ;--- Load the data
52 S IENS=RORIEN_","
53 D GETS^DIQ(45,IENS,ICDFLST,"E","RORBUF","RORMSG")
54 I $G(DIERR) D S ERRCNT=ERRCNT+1
55 . D DBS^RORERR("RORMSG",-99,,RORDFN,45,IENS)
56 ;--- ICD-9 codes
57 S RORDDIAG=""
58 F IFL=1:1 S FLD=+$P(ICDFLST,";",IFL) Q:'FLD D
59 . S TMP=$G(RORBUF(45,IENS,FLD,"E"))
60 . S:TMP'="" $P(RORDDIAG,RORRS,IFL)=TMP
61 ;--- Store the segment (if there is at least one ICD-9 code)
62 D:RORDDIAG'="" SETOBX(OID,RORDDIAG)
63 Q ERRCNT
64 ;
65 ;***** OBX SEGMENT(S) BUILDER (INPATIENT)
66 ;
67 ; RORIEN IEN of file #45
68 ; RORDFN DFN of Patient Record in File #2
69 ;
70 ; Return Values:
71 ; <0 Error Code
72 ; 0 Ok
73 ; >0 Non-fatal error(s)
74 ;
75OBX(RORIEN,RORDFN) ;
76 N ERRCNT,RC,RORCS,RORLST,RORMSG,RORRS,TMP
77 S (ERRCNT,RC)=0
78 D ECH^RORHL7(.RORCS,,.RORRS)
79 ;
80 ;--- Principal diagnosis
81 S RC=$$PRIN(RORIEN)
82 I RC S ERRCNT=ERRCNT+1 Q:RC<0 RC
83 ;--- Primary discharge diagnosis
84 S RC=$$PDISCH(RORIEN)
85 I RC S ERRCNT=ERRCNT+1 Q:RC<0 RC
86 ;--- Discharge diagnosis codes
87 S RC=$$DDIAG(RORIEN)
88 I RC S ERRCNT=ERRCNT+1 Q:RC<0 RC
89 ;--- Bed section
90 S RC=$$BEDSEC(RORIEN)
91 I RC S ERRCNT=ERRCNT+1 Q:RC<0 RC
92 ;--- Surgical procedures
93 S RC=$$SURGPRO(RORIEN)
94 I RC S ERRCNT=ERRCNT+1 Q:RC<0 RC
95 ;--- Other diagnoses
96 S RC=$$OTRPROC(RORIEN)
97 I RC S ERRCNT=ERRCNT+1 Q:RC<0 RC
98 ;
99 Q ERRCNT
100 ;
101 ;***** OTHER DIAGNOSES
102OTRPROC(RORIEN) ;
103 N ERRCNT,FLD,ICDFLST,IEN4505,IENS,IFL,NODE,OID,RORBUF,RORMSG,ROROPBS,ROROPCD,ROROPDTE,TMP
104 S ERRCNT=0,ICDFLST="4;5;6;7;8"
105 S OID="INOTR"_RORCS_"Other Diagnosis"_RORCS_"VA080"
106 S NODE=$$ROOT^DILFD(45.05,","_RORIEN_",",1)
107 ;
108 S IEN4505=0
109 F S IEN4505=$O(@NODE@(IEN4505)) Q:IEN4505'>0 D
110 . S IENS=IEN4505_","_RORIEN_"," K RORBUF
111 . ;--- Load the data
112 . D GETS^DIQ(45.05,IENS,".01;1;"_ICDFLST,"EI","RORBUF","RORMSG")
113 . I $G(DIERR) D S ERRCNT=ERRCNT+1
114 . . D DBS^RORERR("RORMSG",-99,,RORDFN,45.05,IENS)
115 . ;--- Name of the facility
116 . S ROROPBS=$$ESCAPE^RORHL7($G(RORBUF(45.05,IENS,1,"E")))
117 . ;--- Date of the procedure
118 . S ROROPDTE=$$FM2HL^RORHL7($G(RORBUF(45.05,IENS,.01,"I")))
119 . ;--- ICD-9 codes
120 . S ROROPCD=""
121 . F IFL=1:1 S FLD=+$P(ICDFLST,";",IFL) Q:'FLD D
122 . . S TMP=$G(RORBUF(45.05,IENS,FLD,"E"))
123 . . S:TMP'="" $P(ROROPCD,RORRS,IFL)=TMP
124 . ;--- Store the segment (if there is at least one ICD-9 code)
125 . D:ROROPCD'="" SETOBX(OID,ROROPCD,ROROPBS,,ROROPDTE)
126 ;
127 Q ERRCNT
128 ;
129 ;***** PRIMARY DISCHARGE DIAGNOSIS
130PDISCH(IEN) ;
131 N ERRCNT,OID,RORDD,RORMSG,TMP
132 S ERRCNT=0,OID="INPRI"_RORCS_"Primary Dis. Diagnosis"_RORCS_"VA080"
133 ;--- Load the data
134 S RORDD=$$GET1^DIQ(45,IEN_",",79,"E",,"RORMSG")
135 I $G(DIERR) D S ERRCNT=ERRCNT+1
136 . D DBS^RORERR("RORMSG",-99,,RORDFN,45,IEN_",")
137 ;--- Store the segment
138 D:RORDD'="" SETOBX(OID,RORDD)
139 Q ERRCNT
140 ;
141 ;***** PRINCIPAL DIAGNOSIS
142PRIN(IEN) ;
143 N ERRCNT,OID,RORMSG,RORPDIAG,TMP
144 S ERRCNT=0,OID="INAD"_RORCS_"Admitting Diagnosis"_RORCS_"VA080"
145 ;--- Load the data
146 S RORPDIAG=$$GET1^DIQ(45,IEN_",",80,"E",,"RORMSG")
147 I $G(DIERR) D S ERRCNT=ERRCNT+1
148 . D DBS^RORERR("RORMSG",-99,,RORDFN,45,IEN_",")
149 ;--- Store the segment
150 D:RORPDIAG'="" SETOBX(OID,RORPDIAG)
151 Q ERRCNT
152 ;
153 ;***** LOW-LEVEL SEGMENT BUILDER
154 ;
155 ; OBX3 Observation Identifier
156 ;
157 ; OBX5 Observation Value
158 ;
159 ; [OBX6] Bed Section
160 ;
161 ; [OBX12] Bed Section End Date/Time
162 ;
163 ; [OBX14] Bed Section Start Date, if OBX3 contains
164 ; "INBED^Bedsection Diagnosis";
165 ; Surgical Procedure Date, if OBX3 contains
166 ; "INSURG^Surgical Procedures";
167 ; Other Procedure Date, if OBX3 contains
168 ; "INOTR^Other Diagnosis".
169 ;
170SETOBX(OBX3,OBX5,OBX6,OBX12,OBX14) ;
171 N RORSEG
172 S RORSEG(0)="OBX"
173 ;--- OBX-2 Value Type
174 S RORSEG(2)="FT"
175 ;--- OBX-3 Observation Identifier
176 S RORSEG(3)=OBX3
177 ;--- OBX-5 Observation Value
178 S RORSEG(5)=OBX5
179 ;--- OBX-6 Bed Section
180 S:$G(OBX6)'="" RORSEG(6)=OBX6
181 ;--- OBX-11 Observation Result Status
182 S RORSEG(11)="F"
183 ;--- OBX-12 Bed Section End Date/Time
184 S:$G(OBX12)'="" RORSEG(12)=OBX12
185 ;--- OBX-14 Bed Section Start Date/Time or Procedure Date
186 S:$G(OBX14)'="" RORSEG(14)=OBX14
187 ;--- Store the segment
188 D ADDSEG^RORHL7(.RORSEG)
189 Q
190 ;
191 ;***** SURGICAL PROCEDURES
192SURGPRO(RORIEN) ;
193 N ERRCNT,FLD,IEN4501,IENS,IFL,NODE,OID,RORBUF,RORMSG,SDTE,SPCD,SPFLST,TMP
194 S ERRCNT=0,SPFLST="8;9;10;11;12"
195 S OID="INSURG"_RORCS_"Surgical Procedures"_RORCS_"VA080"
196 S NODE=$$ROOT^DILFD(45.01,","_RORIEN_",",1)
197 ;
198 S IEN4501=0
199 F S IEN4501=$O(@NODE@(IEN4501)) Q:IEN4501'>0 D
200 . S IENS=IEN4501_","_RORIEN_"," K RORBUF
201 . ;--- Load the data
202 . D GETS^DIQ(45.01,IENS,".01;"_SPFLST,"EI","RORBUF","RORMSG")
203 . I $G(DIERR) D S ERRCNT=ERRCNT+1
204 . . D DBS^RORERR("RORMSG",-99,,RORDFN,45.01,IENS)
205 . ;--- Date of the procedure
206 . S SDTE=$$FM2HL^RORHL7($G(RORBUF(45.01,IENS,.01,"I")))
207 . ;--- Procedure codes
208 . S SPCD=""
209 . F IFL=1:1 S FLD=+$P(SPFLST,";",IFL) Q:'FLD D
210 . . S TMP=$G(RORBUF(45.01,IENS,FLD,"E"))
211 . . S:TMP'="" $P(SPCD,RORRS,IFL)=TMP
212 . ;--- Store the segment (if there is at least one code)
213 . D:SPCD'="" SETOBX(OID,SPCD,,,SDTE)
214 ;
215 Q ERRCNT
Note: See TracBrowser for help on using the repository browser.