RORHL13 ;HOIFO/BH,SG - HL7 MEDICAL PROCEDURES (EKG): OBR,OBX ; 8/25/05 11:32am
;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
;
; This routine uses the following IAs:
;
; #3780 GET^MCARAPI (private)
; #3854 GET^MDAPI1 (private)
;
Q
;
;***** CONVERTS THE DATE FROM EXTERNAL TO HL7 FORMAT
DATE(DATE) ;
N RES
D DT^DILF(,$P(DATE,"@"),.RES)
Q $$FM2HL^RORHL7($G(RES))
;
;***** SEARCHES FOR MEDICAL PROCEDURES (EKG)
;
; RORDFN IEN of the patient in the PATIENT file (#2)
;
; .DXDTS Reference to a local variable where the
; data extraction time frames are stored.
;
; Return Values:
; <0 Error code
; 0 Ok
; >0 Non-fatal error(s)
;
EN1(RORDFN,DXDTS) ;
N ERRCNT,IDX,RC,RORENDT,RORESULT,RORIENS,RORSTDT,SF,TMP
S (ERRCNT,RC)=0
S RORESULT=$$ALLOC^RORTMP()
;
S IDX=0
F S IDX=$O(DXDTS(12,IDX)) Q:IDX'>0 D Q:RC<0
. S RORSTDT=$P(DXDTS(12,IDX),U),RORENDT=$P(DXDTS(12,IDX),U,2)
. K @RORESULT
. ;
. ;--- Check if Clinical Procedures patch has been installed,
. ;--- if not call the API associated with the Medicine Patch.
. S TMP=".01;.02;11;14;20;21;18"
. I $D(ROREXT("PATCH","MD*1.0*1")) D
. . D GET^MDAPI1(RORESULT,RORDFN,RORSTDT,RORENDT,TMP)
. E I $D(ROREXT("PATCH","MC*2.3*34")) D
. . D GET^MCARAPI(RORESULT,RORDFN,RORSTDT,RORENDT,TMP)
. E S ERRCNT=ERRCNT+1 Q
. ;
. ;--- Build the index
. F SF=691.54 S TMP="" D
. . F S TMP=$O(@RORESULT@(SF,TMP)) Q:TMP="" D
. . . S @RORESULT@("A",SF,$P(TMP,",",2)_",",TMP)=""
. ;
. ;--- Process the data
. S RORIENS=""
. F S RORIENS=$O(@RORESULT@(691.5,RORIENS)) Q:RORIENS="" D
. . S TMP=$$OBR(RORIENS)
. . I TMP Q:TMP<0 S ERRCNT=ERRCNT+TMP
. . S TMP=$$OBX(RORIENS)
. . I TMP Q:TMP<0 S ERRCNT=ERRCNT+TMP
;
D FREE^RORTMP(RORESULT)
Q $S(RC<0:RC,1:ERRCNT)
;
;***** MEDICAL PROCEDURE (EKG) OBR SEGMENT BUILDER
;
; RORIENS Medical Procedure Record IENS
;
; Return Values:
; <0 Error code
; 0 Ok
; >0 Non-fatal error(s)
;
OBR(RORIENS) ;
N CS,ERRCNT,IEN,RC,ROROUT,RORSEG,TMP
S (ERRCNT,RC)=0
D ECH^RORHL7(.CS)
;
;--- Initialize the segment
S RORSEG(0)="OBR"
;
;--- OBR-3 - IEN in the ELECTROCARDIOGRAM (EKG) file #691.5
S RORSEG(3)=$TR(RORIENS,",")
;
;--- OBR-4 - Universal Service ID
S RORSEG(4)="93000"_CS_"ELECTROCARDIOGRAM"_CS_"C4"
;
;--- OBR-6 - Requested Date/time (date of the EKG)
S TMP=$$DATE($G(@RORESULT@(691.5,RORIENS,.01,"E")))
Q:TMP'>0 $$ERROR^RORERR(-95,,,,691.5,RORIENS,.01)
S RORSEG(6)=TMP
;
;--- OBR-7 - Observation Date/Time (when received from an instrument)
S RORSEG(7)=$$DATE($G(@RORESULT@(691.5,RORIENS,21,"E")))
;
;--- OBR-24 - Diagnostic Service ID
S RORSEG(24)="EC"
;
;--- OBR-25 - Confirmation Status
S TMP=$G(@RORESULT@(691.5,RORIENS,11,"E"))
I TMP'="" D S RORSEG(25)=TMP
. S TMP=$S(TMP="CONFIRMED":"F",TMP="UNCONFIRMED":"R",1:"")
;
;--- OBR-44 - Division
S TMP=$G(@RORESULT@(691.5,RORIENS,18,"E"))
S IEN=$S(TMP'="":+$O(^SC("B",TMP,0)),1:0)
S RORSEG(44)=$$DIV44^RORHLUT1(IEN,CS)
;
;--- Store the segment
D ADDSEG^RORHL7(.RORSEG)
Q ERRCNT
;
;***** MEDICAL PROCEDURE (EKG) OBX SEGMENT(S) BUILDER
;
; RORIENS Medical Procedure Record IENS
;
; Return Values:
; <0 Error code
; 0 Ok
; >0 Non-fatal error(s)
;
OBX(RORIENS) ;
N CS,ERRCNT,RC,RORID,RORINT,RORKEY,RORMOD,RORSEG,TMP
S (ERRCNT,RC)=0
D ECH^RORHL7(.CS)
;
;--- Process any interpretation data
S RORID="INT"_CS_"Interpretation"_CS_"VA080"
S RORKEY=""
F S RORKEY=$O(@RORESULT@("A",691.54,RORIENS,RORKEY)) Q:RORKEY="" D
. S RORINT=$G(@RORESULT@(691.54,RORKEY,.01,"E"))
. Q:RORINT=""
. S RORMOD=$G(@RORESULT@(691.54,RORKEY,1,"E"))
. D SETOBX(RORID,RORMOD,RORINT)
;
;--- Process auto instrument data
S RORID="AUTO"_CS_"Auto Instrument"_CS_"VA080"
D SETOBXWP^RORHLUT1($NA(@RORESULT@(691.5,RORIENS,20)),RORID)
;
Q $S(RC<0:RC,1:ERRCNT)
;
;***** CREATES AND STORES THE OBX SEGMENT
SETOBX(OBX3,OBX4,OBX5) ;
N RORSEG
;--- Initialize the segment
S RORSEG(0)="OBX"
;--- OBX-2 - Value Type
S RORSEG(2)="FT"
;--- OBX-3 - Observation Identiifer
S RORSEG(3)=OBX3
;--- OBX-4 - Observation Sub-ID (Interpretation Code Modifier)
S:$G(OBX4)'="" RORSEG(4)=OBX4
;--- OBX-5 - Observation Value
S RORSEG(5)=$$ESCAPE^RORHL7(OBX5)
;--- OBX-11 - Observation Result Status
S RORSEG(11)="F"
;--- Store the segment
D ADDSEG^RORHL7(.RORSEG)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORHL13 4560 printed Apr 09, 2024@20:46:43 Page 2
RORHL13 ;HOIFO/BH,SG - HL7 MEDICAL PROCEDURES (EKG): OBR,OBX ; 8/25/05 11:32am
+1 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
+2 ;
+3 ; This routine uses the following IAs:
+4 ;
+5 ; #3780 GET^MCARAPI (private)
+6 ; #3854 GET^MDAPI1 (private)
+7 ;
+8 QUIT
+9 ;
+10 ;***** CONVERTS THE DATE FROM EXTERNAL TO HL7 FORMAT
DATE(DATE) ;
+1 NEW RES
+2 DO DT^DILF(,$PIECE(DATE,"@"),.RES)
+3 QUIT $$FM2HL^RORHL7($GET(RES))
+4 ;
+5 ;***** SEARCHES FOR MEDICAL PROCEDURES (EKG)
+6 ;
+7 ; RORDFN IEN of the patient in the PATIENT file (#2)
+8 ;
+9 ; .DXDTS Reference to a local variable where the
+10 ; data extraction time frames are stored.
+11 ;
+12 ; Return Values:
+13 ; <0 Error code
+14 ; 0 Ok
+15 ; >0 Non-fatal error(s)
+16 ;
EN1(RORDFN,DXDTS) ;
+1 NEW ERRCNT,IDX,RC,RORENDT,RORESULT,RORIENS,RORSTDT,SF,TMP
+2 SET (ERRCNT,RC)=0
+3 SET RORESULT=$$ALLOC^RORTMP()
+4 ;
+5 SET IDX=0
+6 FOR
SET IDX=$ORDER(DXDTS(12,IDX))
if IDX'>0
QUIT
Begin DoDot:1
+7 SET RORSTDT=$PIECE(DXDTS(12,IDX),U)
SET RORENDT=$PIECE(DXDTS(12,IDX),U,2)
+8 KILL @RORESULT
+9 ;
+10 ;--- Check if Clinical Procedures patch has been installed,
+11 ;--- if not call the API associated with the Medicine Patch.
+12 SET TMP=".01;.02;11;14;20;21;18"
+13 IF $DATA(ROREXT("PATCH","MD*1.0*1"))
Begin DoDot:2
+14 DO GET^MDAPI1(RORESULT,RORDFN,RORSTDT,RORENDT,TMP)
End DoDot:2
+15 IF '$TEST
IF $DATA(ROREXT("PATCH","MC*2.3*34"))
Begin DoDot:2
+16 DO GET^MCARAPI(RORESULT,RORDFN,RORSTDT,RORENDT,TMP)
End DoDot:2
+17 IF '$TEST
SET ERRCNT=ERRCNT+1
QUIT
+18 ;
+19 ;--- Build the index
+20 FOR SF=691.54
SET TMP=""
Begin DoDot:2
+21 FOR
SET TMP=$ORDER(@RORESULT@(SF,TMP))
if TMP=""
QUIT
Begin DoDot:3
+22 SET @RORESULT@("A",SF,$PIECE(TMP,",",2)_",",TMP)=""
End DoDot:3
End DoDot:2
+23 ;
+24 ;--- Process the data
+25 SET RORIENS=""
+26 FOR
SET RORIENS=$ORDER(@RORESULT@(691.5,RORIENS))
if RORIENS=""
QUIT
Begin DoDot:2
+27 SET TMP=$$OBR(RORIENS)
+28 IF TMP
if TMP<0
QUIT
SET ERRCNT=ERRCNT+TMP
+29 SET TMP=$$OBX(RORIENS)
+30 IF TMP
if TMP<0
QUIT
SET ERRCNT=ERRCNT+TMP
End DoDot:2
End DoDot:1
if RC<0
QUIT
+31 ;
+32 DO FREE^RORTMP(RORESULT)
+33 QUIT $SELECT(RC<0:RC,1:ERRCNT)
+34 ;
+35 ;***** MEDICAL PROCEDURE (EKG) OBR SEGMENT BUILDER
+36 ;
+37 ; RORIENS Medical Procedure Record IENS
+38 ;
+39 ; Return Values:
+40 ; <0 Error code
+41 ; 0 Ok
+42 ; >0 Non-fatal error(s)
+43 ;
OBR(RORIENS) ;
+1 NEW CS,ERRCNT,IEN,RC,ROROUT,RORSEG,TMP
+2 SET (ERRCNT,RC)=0
+3 DO ECH^RORHL7(.CS)
+4 ;
+5 ;--- Initialize the segment
+6 SET RORSEG(0)="OBR"
+7 ;
+8 ;--- OBR-3 - IEN in the ELECTROCARDIOGRAM (EKG) file #691.5
+9 SET RORSEG(3)=$TRANSLATE(RORIENS,",")
+10 ;
+11 ;--- OBR-4 - Universal Service ID
+12 SET RORSEG(4)="93000"_CS_"ELECTROCARDIOGRAM"_CS_"C4"
+13 ;
+14 ;--- OBR-6 - Requested Date/time (date of the EKG)
+15 SET TMP=$$DATE($GET(@RORESULT@(691.5,RORIENS,.01,"E")))
+16 if TMP'>0
QUIT $$ERROR^RORERR(-95,,,,691.5,RORIENS,.01)
+17 SET RORSEG(6)=TMP
+18 ;
+19 ;--- OBR-7 - Observation Date/Time (when received from an instrument)
+20 SET RORSEG(7)=$$DATE($GET(@RORESULT@(691.5,RORIENS,21,"E")))
+21 ;
+22 ;--- OBR-24 - Diagnostic Service ID
+23 SET RORSEG(24)="EC"
+24 ;
+25 ;--- OBR-25 - Confirmation Status
+26 SET TMP=$GET(@RORESULT@(691.5,RORIENS,11,"E"))
+27 IF TMP'=""
Begin DoDot:1
+28 SET TMP=$SELECT(TMP="CONFIRMED":"F",TMP="UNCONFIRMED":"R",1:"")
End DoDot:1
SET RORSEG(25)=TMP
+29 ;
+30 ;--- OBR-44 - Division
+31 SET TMP=$GET(@RORESULT@(691.5,RORIENS,18,"E"))
+32 SET IEN=$SELECT(TMP'="":+$ORDER(^SC("B",TMP,0)),1:0)
+33 SET RORSEG(44)=$$DIV44^RORHLUT1(IEN,CS)
+34 ;
+35 ;--- Store the segment
+36 DO ADDSEG^RORHL7(.RORSEG)
+37 QUIT ERRCNT
+38 ;
+39 ;***** MEDICAL PROCEDURE (EKG) OBX SEGMENT(S) BUILDER
+40 ;
+41 ; RORIENS Medical Procedure Record IENS
+42 ;
+43 ; Return Values:
+44 ; <0 Error code
+45 ; 0 Ok
+46 ; >0 Non-fatal error(s)
+47 ;
OBX(RORIENS) ;
+1 NEW CS,ERRCNT,RC,RORID,RORINT,RORKEY,RORMOD,RORSEG,TMP
+2 SET (ERRCNT,RC)=0
+3 DO ECH^RORHL7(.CS)
+4 ;
+5 ;--- Process any interpretation data
+6 SET RORID="INT"_CS_"Interpretation"_CS_"VA080"
+7 SET RORKEY=""
+8 FOR
SET RORKEY=$ORDER(@RORESULT@("A",691.54,RORIENS,RORKEY))
if RORKEY=""
QUIT
Begin DoDot:1
+9 SET RORINT=$GET(@RORESULT@(691.54,RORKEY,.01,"E"))
+10 if RORINT=""
QUIT
+11 SET RORMOD=$GET(@RORESULT@(691.54,RORKEY,1,"E"))
+12 DO SETOBX(RORID,RORMOD,RORINT)
End DoDot:1
+13 ;
+14 ;--- Process auto instrument data
+15 SET RORID="AUTO"_CS_"Auto Instrument"_CS_"VA080"
+16 DO SETOBXWP^RORHLUT1($NAME(@RORESULT@(691.5,RORIENS,20)),RORID)
+17 ;
+18 QUIT $SELECT(RC<0:RC,1:ERRCNT)
+19 ;
+20 ;***** CREATES AND STORES THE OBX SEGMENT
SETOBX(OBX3,OBX4,OBX5) ;
+1 NEW RORSEG
+2 ;--- Initialize the segment
+3 SET RORSEG(0)="OBX"
+4 ;--- OBX-2 - Value Type
+5 SET RORSEG(2)="FT"
+6 ;--- OBX-3 - Observation Identiifer
+7 SET RORSEG(3)=OBX3
+8 ;--- OBX-4 - Observation Sub-ID (Interpretation Code Modifier)
+9 if $GET(OBX4)'=""
SET RORSEG(4)=OBX4
+10 ;--- OBX-5 - Observation Value
+11 SET RORSEG(5)=$$ESCAPE^RORHL7(OBX5)
+12 ;--- OBX-11 - Observation Result Status
+13 SET RORSEG(11)="F"
+14 ;--- Store the segment
+15 DO ADDSEG^RORHL7(.RORSEG)
+16 QUIT
