source: FOIAVistA/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORHL13.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 4.3 KB
Line 
1RORHL13 ;HOIFO/BH,SG - HL7 MEDICAL PROCEDURES (EKG): OBR,OBX ; 8/25/05 11:32am
2 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
3 ;
4 ; This routine uses the following IAs:
5 ;
6 ; #3780 GET^MCARAPI (private)
7 ; #3854 GET^MDAPI1 (private)
8 ;
9 Q
10 ;
11 ;***** CONVERTS THE DATE FROM EXTERNAL TO HL7 FORMAT
12DATE(DATE) ;
13 N RES
14 D DT^DILF(,$P(DATE,"@"),.RES)
15 Q $$FM2HL^RORHL7($G(RES))
16 ;
17 ;***** SEARCHES FOR MEDICAL PROCEDURES (EKG)
18 ;
19 ; RORDFN IEN of the patient in the PATIENT file (#2)
20 ;
21 ; .DXDTS Reference to a local variable where the
22 ; data extraction time frames are stored.
23 ;
24 ; Return Values:
25 ; <0 Error code
26 ; 0 Ok
27 ; >0 Non-fatal error(s)
28 ;
29EN1(RORDFN,DXDTS) ;
30 N ERRCNT,IDX,RC,RORENDT,RORESULT,RORIENS,RORSTDT,SF,TMP
31 S (ERRCNT,RC)=0
32 S RORESULT=$$ALLOC^RORTMP()
33 ;
34 S IDX=0
35 F S IDX=$O(DXDTS(12,IDX)) Q:IDX'>0 D Q:RC<0
36 . S RORSTDT=$P(DXDTS(12,IDX),U),RORENDT=$P(DXDTS(12,IDX),U,2)
37 . K @RORESULT
38 . ;
39 . ;--- Check if Clinical Procedures patch has been installed,
40 . ;--- if not call the API associated with the Medicine Patch.
41 . S TMP=".01;.02;11;14;20;21;18"
42 . I $D(ROREXT("PATCH","MD*1.0*1")) D
43 . . D GET^MDAPI1(RORESULT,RORDFN,RORSTDT,RORENDT,TMP)
44 . E I $D(ROREXT("PATCH","MC*2.3*34")) D
45 . . D GET^MCARAPI(RORESULT,RORDFN,RORSTDT,RORENDT,TMP)
46 . E S ERRCNT=ERRCNT+1 Q
47 . ;
48 . ;--- Build the index
49 . F SF=691.54 S TMP="" D
50 . . F S TMP=$O(@RORESULT@(SF,TMP)) Q:TMP="" D
51 . . . S @RORESULT@("A",SF,$P(TMP,",",2)_",",TMP)=""
52 . ;
53 . ;--- Process the data
54 . S RORIENS=""
55 . F S RORIENS=$O(@RORESULT@(691.5,RORIENS)) Q:RORIENS="" D
56 . . S TMP=$$OBR(RORIENS)
57 . . I TMP Q:TMP<0 S ERRCNT=ERRCNT+TMP
58 . . S TMP=$$OBX(RORIENS)
59 . . I TMP Q:TMP<0 S ERRCNT=ERRCNT+TMP
60 ;
61 D FREE^RORTMP(RORESULT)
62 Q $S(RC<0:RC,1:ERRCNT)
63 ;
64 ;***** MEDICAL PROCEDURE (EKG) OBR SEGMENT BUILDER
65 ;
66 ; RORIENS Medical Procedure Record IENS
67 ;
68 ; Return Values:
69 ; <0 Error code
70 ; 0 Ok
71 ; >0 Non-fatal error(s)
72 ;
73OBR(RORIENS) ;
74 N CS,ERRCNT,IEN,RC,ROROUT,RORSEG,TMP
75 S (ERRCNT,RC)=0
76 D ECH^RORHL7(.CS)
77 ;
78 ;--- Initialize the segment
79 S RORSEG(0)="OBR"
80 ;
81 ;--- OBR-3 - IEN in the ELECTROCARDIOGRAM (EKG) file #691.5
82 S RORSEG(3)=$TR(RORIENS,",")
83 ;
84 ;--- OBR-4 - Universal Service ID
85 S RORSEG(4)="93000"_CS_"ELECTROCARDIOGRAM"_CS_"C4"
86 ;
87 ;--- OBR-6 - Requested Date/time (date of the EKG)
88 S TMP=$$DATE($G(@RORESULT@(691.5,RORIENS,.01,"E")))
89 Q:TMP'>0 $$ERROR^RORERR(-95,,,,691.5,RORIENS,.01)
90 S RORSEG(6)=TMP
91 ;
92 ;--- OBR-7 - Observation Date/Time (when received from an instrument)
93 S RORSEG(7)=$$DATE($G(@RORESULT@(691.5,RORIENS,21,"E")))
94 ;
95 ;--- OBR-24 - Diagnostic Service ID
96 S RORSEG(24)="EC"
97 ;
98 ;--- OBR-25 - Confirmation Status
99 S TMP=$G(@RORESULT@(691.5,RORIENS,11,"E"))
100 I TMP'="" D S RORSEG(25)=TMP
101 . S TMP=$S(TMP="CONFIRMED":"F",TMP="UNCONFIRMED":"R",1:"")
102 ;
103 ;--- OBR-44 - Division
104 S TMP=$G(@RORESULT@(691.5,RORIENS,18,"E"))
105 S IEN=$S(TMP'="":+$O(^SC("B",TMP,0)),1:0)
106 S RORSEG(44)=$$DIV44^RORHLUT1(IEN,CS)
107 ;
108 ;--- Store the segment
109 D ADDSEG^RORHL7(.RORSEG)
110 Q ERRCNT
111 ;
112 ;***** MEDICAL PROCEDURE (EKG) OBX SEGMENT(S) BUILDER
113 ;
114 ; RORIENS Medical Procedure Record IENS
115 ;
116 ; Return Values:
117 ; <0 Error code
118 ; 0 Ok
119 ; >0 Non-fatal error(s)
120 ;
121OBX(RORIENS) ;
122 N CS,ERRCNT,RC,RORID,RORINT,RORKEY,RORMOD,RORSEG,TMP
123 S (ERRCNT,RC)=0
124 D ECH^RORHL7(.CS)
125 ;
126 ;--- Process any interpretation data
127 S RORID="INT"_CS_"Interpretation"_CS_"VA080"
128 S RORKEY=""
129 F S RORKEY=$O(@RORESULT@("A",691.54,RORIENS,RORKEY)) Q:RORKEY="" D
130 . S RORINT=$G(@RORESULT@(691.54,RORKEY,.01,"E"))
131 . Q:RORINT=""
132 . S RORMOD=$G(@RORESULT@(691.54,RORKEY,1,"E"))
133 . D SETOBX(RORID,RORMOD,RORINT)
134 ;
135 ;--- Process auto instrument data
136 S RORID="AUTO"_CS_"Auto Instrument"_CS_"VA080"
137 D SETOBXWP^RORHLUT1($NA(@RORESULT@(691.5,RORIENS,20)),RORID)
138 ;
139 Q $S(RC<0:RC,1:ERRCNT)
140 ;
141 ;***** CREATES AND STORES THE OBX SEGMENT
142SETOBX(OBX3,OBX4,OBX5) ;
143 N RORSEG
144 ;--- Initialize the segment
145 S RORSEG(0)="OBX"
146 ;--- OBX-2 - Value Type
147 S RORSEG(2)="FT"
148 ;--- OBX-3 - Observation Identiifer
149 S RORSEG(3)=OBX3
150 ;--- OBX-4 - Observation Sub-ID (Interpretation Code Modifier)
151 S:$G(OBX4)'="" RORSEG(4)=OBX4
152 ;--- OBX-5 - Observation Value
153 S RORSEG(5)=$$ESCAPE^RORHL7(OBX5)
154 ;--- OBX-11 - Observation Result Status
155 S RORSEG(11)="F"
156 ;--- Store the segment
157 D ADDSEG^RORHL7(.RORSEG)
158 Q
Note: See TracBrowser for help on using the repository browser.