Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RORHL13

RORHL13.m

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