RORHL10 ;HOIFO/BH - HL7 SURGICAL PATHOLOGY DATA: OBR,OBX ;3/13/06 9:24am
;;1.5;CLINICAL CASE REGISTRIES;**1,19**;Feb 17, 2006;Build 43
;
; This routine uses the following IAs:
;
; #525 Read access to the multiple #63.08 (controlled)
; #4343 $$SPATH^LA7UTL03 (controlled)
; #10040 ^SC("B" (supported)
;
;******************************************************************************
;******************************************************************************
; --- ROUTINE MODIFICATION LOG ---
;
;PKG/PATCH DATE DEVELOPER MODIFICATION
;----------- ---------- ----------- ----------------------------------------
;ROR*1.5*19 MAY 2012 K GUPTA Support for ICD-10 Coding System.
;
;******************************************************************************
;******************************************************************************
Q
;
;***** SEARCHES FOR SURGICAL PATHOLOGY DATA
;
; RORDFN IEN of the patient in the PATIENT file (#2)
;
; .DXDTS Reference to a local variable where the
; data extraction time frames are stored.
;
; [CDSMODE] Search the data by:
; 0 completion/result date (default)
; 1 specimen collection date
;
; Return Values:
; <0 Error code
; 0 Ok
; >0 Non-fatal error(s)
;
EN1(RORDFN,DXDTS,CDSMODE) ;
N ERRCNT,IDX,LRDFN,RC,RORENDT,RORSTDT
S (ERRCNT,RC)=0
;
S LRDFN=+$$LABREF^RORUTL18(RORDFN) Q:LRDFN'>0 0
;
S IDX=0
F S IDX=$O(DXDTS(9,IDX)) Q:IDX'>0 D Q:RC<0
. S RORSTDT=$P(DXDTS(9,IDX),U),RORENDT=$P(DXDTS(9,IDX),U,2)
. ;---
. S RC=$S($G(CDSMODE):$$CD(),1:$$RAD())
. S:RC>0 ERRCNT=ERRCNT+RC
;
Q $S(RC<0:RC,1:ERRCNT)
;
;***** SEARCHES BY SPECIMEN COLLECTION DATE
CD() ;
N ENDT,ERRCNT,IDT,STDT
S ERRCNT=0
S STDT=9999999-RORSTDT
S ENDT=9999999-RORENDT
;---
S IDT=$O(^LR(LRDFN,"SP",STDT))
F S IDT=$O(^LR(LRDFN,"SP",IDT),-1) Q:'IDT!(IDT'>ENDT) D
. S:$$OBROBX(IDT,LRDFN) ERRCNT=ERRCNT+1
Q ERRCNT
;
;***** SEARCHES BY COMPLETION (RESULT) DATE
RAD() ;
N ERRCNT,IDT,RCDT
S ERRCNT=0
;---
S IDT=0
F S IDT=$O(^LR(LRDFN,"SP",IDT)) Q:IDT'>0 D
. S RCDT=$P($G(^LR(LRDFN,"SP",IDT,0)),U,3)
. I RCDT'<RORSTDT,RCDT<RORENDT S:$$OBROBX(IDT,LRDFN) ERRCNT=ERRCNT+1
Q ERRCNT
;
;***** CREATES OBR AND OBX SEGMENTS
OBROBX(RORIDT,LRDFN) ;
N ERRCNT,RC
S ERRCNT=0
;---
S RC=$$OBR(RORIDT_","_LRDFN_",")
I RC S ERRCNT=ERRCNT+1 Q:RC<0 RC
;---
S RC=$$OBX(LRDFN,RORIDT)
I RC S ERRCNT=ERRCNT+1 Q:RC<0 RC
;---
Q ERRCNT
;
;***** OBR SEGMENT BUILDER
;
; RORIENS IENS of SP Entry
;
; Return Values:
; <0 Error code
; 0 Ok
; >0 Non-fatal error(s)
;
OBR(RORIENS) ;
N CS,ERRCNT,FLDS,IEN,RC,RORMSG,ROROUT,RORSEG,TMP
S (ERRCNT,RC)=0
D ECH^RORHL7(.CS)
;--- Check the parameters
S:$E(RORIENS,$L(RORIENS))'="," RORIENS=RORIENS_","
;
;--- Load the data (with a temporary fix for invalid
;--- output transform of the .01 field - ROR*1*8)
D GETS^DIQ(63.08,RORIENS,".01","I","ROROUT","RORMSG")
I $G(DIERR) D S ERRCNT=ERRCNT+1
. D DBS^RORERR("RORMSG",-9,,,63.08,RORIENS)
D GETS^DIQ(63.08,RORIENS,".03;.06;.07;.08","IE","ROROUT","RORMSG")
I $G(DIERR) D S ERRCNT=ERRCNT+1
. D DBS^RORERR("RORMSG",-9,,,63.08,RORIENS)
;
;--- Initialize the segment
S RORSEG(0)="OBR"
;
;--- OBR-3 - Surgical Pathology Acc #
I $G(ROROUT(63.08,RORIENS,.06,"E"))="" D Q RC
. S RC=$$ERROR^RORERR(-95,,,,63.08,RORIENS,.06)
S RORSEG(3)=ROROUT(63.08,RORIENS,.06,"E")
;
;--- OBR-4 - SP CPT Code
S RORSEG(4)="88300"_CS_"LEVEL I - SURGICAL PAT"_CS_"C4"
;
;--- OBR-7 - Date/Time Specimen Taken
S TMP=$$FMTHL7^XLFDT($G(ROROUT(63.08,RORIENS,.01,"I")))
Q:TMP'>0 $$ERROR^RORERR(-95,,,,63.08,RORIENS,.01)
S RORSEG(7)=TMP
;
;--- OBR-8 - Date Report Completed
S TMP=$G(ROROUT(63.08,RORIENS,.03,"I"))
S RORSEG(8)=$$FM2HL^RORHL7(TMP)
;
;--- OBR-16 - Surgeon/Physican
S RORSEG(16)=$G(ROROUT(63.08,RORIENS,.07,"I"))
;
;--- OBR-24 - Service Section ID
S RORSEG(24)="SP"
;
; OBR-44 - Divsion
S TMP=$G(ROROUT(63.08,RORIENS,.08,"I"))
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
;
;***** OBX SEGMENT BUILDER
;
; LRDFN Patient Lab DFN
; RORIENS IENS of SP Entry
;
; Return Values:
; <0 Error code
; 0 Ok
; >0 Non-fatal error(s)
;
OBX(LRDFN,RORIENS) ;
N CS,ERRCNT,RC,RORMSG,ROROUT,RORSEG,RORTMP,RPS,TMP
S (ERRCNT,RC)=0
D ECH^RORHL7(.CS,,.RPS)
S RORTMP=$$ALLOC^RORTMP()
;---
I $$SPATH^LA7UTL03(LRDFN,RORIENS,RORTMP,"RORMSG") D
. D SPECIMEN
. D SETOBXWP($$SEGID("BCH","Brief clinical History",CS),"CHIS")
. D SETOBXWP($$SEGID("PDIAG","Preoperative Diagnosis",CS),"PREDX")
. D SETOBXWP($$SEGID("OF","Operative Findings",CS),"OPERDX")
. S TMP=$$SEGID("POPDIAG","Postoperative Diagnosis",CS)
. D SETOBXWP(TMP,"POSTDX")
. D SETOBXWP($$SEGID("GDESC","Gross Decription",CS),"GROSSD")
. D SETOBXWP($$SEGID("MDESC","Microscopic Description",CS),"MICROD")
. S TMP=$$SEGID("SPDIAG","Surgical Pathology Diagnosis",CS)
. D SETOBXWP(TMP,"SURGP")
. D ICD(RPS)
E D:$D(RORMSG)>1
. N I,INFO S TMP=""
. F I=1:1 S TMP=$O(RORMSG(TMP)) Q:TMP="" S INFO(I)=RORMSG(TMP)
. S RC=$$ERROR^RORERR(-56,,.INFO,,0,"$$SPATH^LA7UTL03")
;---
D FREE^RORTMP(RORTMP)
Q $S(RC<0:RC,1:ERRCNT)
;
;***** MAKES SPECIMEN OBX
SPECIMEN ;
N INDEX,RORSPEC,SPECID
S INDEX="",SPECID=$$SEGID("SPEC","Specimen",CS)
F S INDEX=$O(@RORTMP@("SPEC",INDEX)) Q:INDEX="" D
. S RORSPEC=$G(@RORTMP@("SPEC",INDEX))
. D:RORSPEC'="" SETOBX(SPECID,RORSPEC)
Q
;
;***** ICD Codes
ICD(RPS) ;
N CNT,ICDID,INDEX,RORICD,TMP,RORICDSNAM
S ICDID=$$SEGID("ICD","ICD",CS)
S (INDEX,RORICD,RORICDSNAM)="",CNT=0
F S INDEX=$O(@RORTMP@("ICD9",INDEX)) Q:INDEX="" D
. S TMP=$G(@RORTMP@("ICD9",INDEX)) Q:TMP=""
. S CNT=CNT+1,$P(RORICD,RPS,CNT)=TMP
. S:RORICDSNAM="" RORICDSNAM=$$CSNAME^RORHLUT1(80,INDEX)
D:RORICD'="" SETOBX(ICDID,RORICDSNAM_":"_RORICD)
Q
;
;***** CONSTRUCTS SEGMENT IDENTIFIER
SEGID(CODE,NAME,CS) ;
Q CODE_CS_NAME_CS_"VA080"
;
;***** CREATE AND STORE THE OBX SEGMENTS
SETOBX(OBX3,OBX5) ;
N RORSEG
;--- Initialize the segment
S RORSEG(0)="OBX"
;--- OBX-2 - Value Type
S RORSEG(2)="FT"
;--- OBX-3 - Observation Identifier
S RORSEG(3)=OBX3
;--- 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
;
SETOBXWP(OBX3,SUBS) ;
N BR,CNT,I,I1,RORSEG,TMP
S BR=$E(HLECH,3)_".br"_$E(HLECH,3)
Q:$D(@RORTMP@(SUBS))<10
;--- Initialize the segment
S RORSEG(0)="OBX"
;--- OBX-2 - Value Type
S RORSEG(2)="FT"
;--- OBX-3 - Observation Identifier
S RORSEG(3)=OBX3
;--- OBX-5 - Observation Value
S I=$O(@RORTMP@(SUBS,"")),CNT=0
F Q:I="" S I1=$O(@RORTMP@(SUBS,I)) D S I=I1
. S TMP=$$ESCAPE^RORHL7(@RORTMP@(SUBS,I))
. S CNT=CNT+1,RORSEG(5,CNT)=$S(I1'="":TMP_BR,1:TMP)
;--- OBX-11 - Observation Result Status
S RORSEG(11)="F"
;--- Store the segment
D:$D(RORSEG(5)) ADDSEG^RORHL7(.RORSEG)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORHL10 7344 printed Apr 09, 2024@20:49:07 Page 2
RORHL10 ;HOIFO/BH - HL7 SURGICAL PATHOLOGY DATA: OBR,OBX ;3/13/06 9:24am
+1 ;;1.5;CLINICAL CASE REGISTRIES;**1,19**;Feb 17, 2006;Build 43
+2 ;
+3 ; This routine uses the following IAs:
+4 ;
+5 ; #525 Read access to the multiple #63.08 (controlled)
+6 ; #4343 $$SPATH^LA7UTL03 (controlled)
+7 ; #10040 ^SC("B" (supported)
+8 ;
+9 ;******************************************************************************
+10 ;******************************************************************************
+11 ; --- ROUTINE MODIFICATION LOG ---
+12 ;
+13 ;PKG/PATCH DATE DEVELOPER MODIFICATION
+14 ;----------- ---------- ----------- ----------------------------------------
+15 ;ROR*1.5*19 MAY 2012 K GUPTA Support for ICD-10 Coding System.
+16 ;
+17 ;******************************************************************************
+18 ;******************************************************************************
+19 QUIT
+20 ;
+21 ;***** SEARCHES FOR SURGICAL PATHOLOGY DATA
+22 ;
+23 ; RORDFN IEN of the patient in the PATIENT file (#2)
+24 ;
+25 ; .DXDTS Reference to a local variable where the
+26 ; data extraction time frames are stored.
+27 ;
+28 ; [CDSMODE] Search the data by:
+29 ; 0 completion/result date (default)
+30 ; 1 specimen collection date
+31 ;
+32 ; Return Values:
+33 ; <0 Error code
+34 ; 0 Ok
+35 ; >0 Non-fatal error(s)
+36 ;
EN1(RORDFN,DXDTS,CDSMODE) ;
+1 NEW ERRCNT,IDX,LRDFN,RC,RORENDT,RORSTDT
+2 SET (ERRCNT,RC)=0
+3 ;
+4 SET LRDFN=+$$LABREF^RORUTL18(RORDFN)
if LRDFN'>0
QUIT 0
+5 ;
+6 SET IDX=0
+7 FOR
SET IDX=$ORDER(DXDTS(9,IDX))
if IDX'>0
QUIT
Begin DoDot:1
+8 SET RORSTDT=$PIECE(DXDTS(9,IDX),U)
SET RORENDT=$PIECE(DXDTS(9,IDX),U,2)
+9 ;---
+10 SET RC=$SELECT($GET(CDSMODE):$$CD(),1:$$RAD())
+11 if RC>0
SET ERRCNT=ERRCNT+RC
End DoDot:1
if RC<0
QUIT
+12 ;
+13 QUIT $SELECT(RC<0:RC,1:ERRCNT)
+14 ;
+15 ;***** SEARCHES BY SPECIMEN COLLECTION DATE
CD() ;
+1 NEW ENDT,ERRCNT,IDT,STDT
+2 SET ERRCNT=0
+3 SET STDT=9999999-RORSTDT
+4 SET ENDT=9999999-RORENDT
+5 ;---
+6 SET IDT=$ORDER(^LR(LRDFN,"SP",STDT))
+7 FOR
SET IDT=$ORDER(^LR(LRDFN,"SP",IDT),-1)
if 'IDT!(IDT'>ENDT)
QUIT
Begin DoDot:1
+8 if $$OBROBX(IDT,LRDFN)
SET ERRCNT=ERRCNT+1
End DoDot:1
+9 QUIT ERRCNT
+10 ;
+11 ;***** SEARCHES BY COMPLETION (RESULT) DATE
RAD() ;
+1 NEW ERRCNT,IDT,RCDT
+2 SET ERRCNT=0
+3 ;---
+4 SET IDT=0
+5 FOR
SET IDT=$ORDER(^LR(LRDFN,"SP",IDT))
if IDT'>0
QUIT
Begin DoDot:1
+6 SET RCDT=$PIECE($GET(^LR(LRDFN,"SP",IDT,0)),U,3)
+7 IF RCDT'<RORSTDT
IF RCDT<RORENDT
if $$OBROBX(IDT,LRDFN)
SET ERRCNT=ERRCNT+1
End DoDot:1
+8 QUIT ERRCNT
+9 ;
+10 ;***** CREATES OBR AND OBX SEGMENTS
OBROBX(RORIDT,LRDFN) ;
+1 NEW ERRCNT,RC
+2 SET ERRCNT=0
+3 ;---
+4 SET RC=$$OBR(RORIDT_","_LRDFN_",")
+5 IF RC
SET ERRCNT=ERRCNT+1
if RC<0
QUIT RC
+6 ;---
+7 SET RC=$$OBX(LRDFN,RORIDT)
+8 IF RC
SET ERRCNT=ERRCNT+1
if RC<0
QUIT RC
+9 ;---
+10 QUIT ERRCNT
+11 ;
+12 ;***** OBR SEGMENT BUILDER
+13 ;
+14 ; RORIENS IENS of SP Entry
+15 ;
+16 ; Return Values:
+17 ; <0 Error code
+18 ; 0 Ok
+19 ; >0 Non-fatal error(s)
+20 ;
OBR(RORIENS) ;
+1 NEW CS,ERRCNT,FLDS,IEN,RC,RORMSG,ROROUT,RORSEG,TMP
+2 SET (ERRCNT,RC)=0
+3 DO ECH^RORHL7(.CS)
+4 ;--- Check the parameters
+5 if $EXTRACT(RORIENS,$LENGTH(RORIENS))'=","
SET RORIENS=RORIENS_","
+6 ;
+7 ;--- Load the data (with a temporary fix for invalid
+8 ;--- output transform of the .01 field - ROR*1*8)
+9 DO GETS^DIQ(63.08,RORIENS,".01","I","ROROUT","RORMSG")
+10 IF $GET(DIERR)
Begin DoDot:1
+11 DO DBS^RORERR("RORMSG",-9,,,63.08,RORIENS)
End DoDot:1
SET ERRCNT=ERRCNT+1
+12 DO GETS^DIQ(63.08,RORIENS,".03;.06;.07;.08","IE","ROROUT","RORMSG")
+13 IF $GET(DIERR)
Begin DoDot:1
+14 DO DBS^RORERR("RORMSG",-9,,,63.08,RORIENS)
End DoDot:1
SET ERRCNT=ERRCNT+1
+15 ;
+16 ;--- Initialize the segment
+17 SET RORSEG(0)="OBR"
+18 ;
+19 ;--- OBR-3 - Surgical Pathology Acc #
+20 IF $GET(ROROUT(63.08,RORIENS,.06,"E"))=""
Begin DoDot:1
+21 SET RC=$$ERROR^RORERR(-95,,,,63.08,RORIENS,.06)
End DoDot:1
QUIT RC
+22 SET RORSEG(3)=ROROUT(63.08,RORIENS,.06,"E")
+23 ;
+24 ;--- OBR-4 - SP CPT Code
+25 SET RORSEG(4)="88300"_CS_"LEVEL I - SURGICAL PAT"_CS_"C4"
+26 ;
+27 ;--- OBR-7 - Date/Time Specimen Taken
+28 SET TMP=$$FMTHL7^XLFDT($GET(ROROUT(63.08,RORIENS,.01,"I")))
+29 if TMP'>0
QUIT $$ERROR^RORERR(-95,,,,63.08,RORIENS,.01)
+30 SET RORSEG(7)=TMP
+31 ;
+32 ;--- OBR-8 - Date Report Completed
+33 SET TMP=$GET(ROROUT(63.08,RORIENS,.03,"I"))
+34 SET RORSEG(8)=$$FM2HL^RORHL7(TMP)
+35 ;
+36 ;--- OBR-16 - Surgeon/Physican
+37 SET RORSEG(16)=$GET(ROROUT(63.08,RORIENS,.07,"I"))
+38 ;
+39 ;--- OBR-24 - Service Section ID
+40 SET RORSEG(24)="SP"
+41 ;
+42 ; OBR-44 - Divsion
+43 SET TMP=$GET(ROROUT(63.08,RORIENS,.08,"I"))
+44 SET IEN=$SELECT(TMP'="":+$ORDER(^SC("B",TMP,0)),1:0)
+45 SET RORSEG(44)=$$DIV44^RORHLUT1(IEN,CS)
+46 ;
+47 ;--- Store the segment
+48 DO ADDSEG^RORHL7(.RORSEG)
+49 QUIT ERRCNT
+50 ;
+51 ;***** OBX SEGMENT BUILDER
+52 ;
+53 ; LRDFN Patient Lab DFN
+54 ; RORIENS IENS of SP Entry
+55 ;
+56 ; Return Values:
+57 ; <0 Error code
+58 ; 0 Ok
+59 ; >0 Non-fatal error(s)
+60 ;
OBX(LRDFN,RORIENS) ;
+1 NEW CS,ERRCNT,RC,RORMSG,ROROUT,RORSEG,RORTMP,RPS,TMP
+2 SET (ERRCNT,RC)=0
+3 DO ECH^RORHL7(.CS,,.RPS)
+4 SET RORTMP=$$ALLOC^RORTMP()
+5 ;---
+6 IF $$SPATH^LA7UTL03(LRDFN,RORIENS,RORTMP,"RORMSG")
Begin DoDot:1
+7 DO SPECIMEN
+8 DO SETOBXWP($$SEGID("BCH","Brief clinical History",CS),"CHIS")
+9 DO SETOBXWP($$SEGID("PDIAG","Preoperative Diagnosis",CS),"PREDX")
+10 DO SETOBXWP($$SEGID("OF","Operative Findings",CS),"OPERDX")
+11 SET TMP=$$SEGID("POPDIAG","Postoperative Diagnosis",CS)
+12 DO SETOBXWP(TMP,"POSTDX")
+13 DO SETOBXWP($$SEGID("GDESC","Gross Decription",CS),"GROSSD")
+14 DO SETOBXWP($$SEGID("MDESC","Microscopic Description",CS),"MICROD")
+15 SET TMP=$$SEGID("SPDIAG","Surgical Pathology Diagnosis",CS)
+16 DO SETOBXWP(TMP,"SURGP")
+17 DO ICD(RPS)
End DoDot:1
+18 IF '$TEST
if $DATA(RORMSG)>1
Begin DoDot:1
+19 NEW I,INFO
SET TMP=""
+20 FOR I=1:1
SET TMP=$ORDER(RORMSG(TMP))
if TMP=""
QUIT
SET INFO(I)=RORMSG(TMP)
+21 SET RC=$$ERROR^RORERR(-56,,.INFO,,0,"$$SPATH^LA7UTL03")
End DoDot:1
+22 ;---
+23 DO FREE^RORTMP(RORTMP)
+24 QUIT $SELECT(RC<0:RC,1:ERRCNT)
+25 ;
+26 ;***** MAKES SPECIMEN OBX
SPECIMEN ;
+1 NEW INDEX,RORSPEC,SPECID
+2 SET INDEX=""
SET SPECID=$$SEGID("SPEC","Specimen",CS)
+3 FOR
SET INDEX=$ORDER(@RORTMP@("SPEC",INDEX))
if INDEX=""
QUIT
Begin DoDot:1
+4 SET RORSPEC=$GET(@RORTMP@("SPEC",INDEX))
+5 if RORSPEC'=""
DO SETOBX(SPECID,RORSPEC)
End DoDot:1
+6 QUIT
+7 ;
+8 ;***** ICD Codes
ICD(RPS) ;
+1 NEW CNT,ICDID,INDEX,RORICD,TMP,RORICDSNAM
+2 SET ICDID=$$SEGID("ICD","ICD",CS)
+3 SET (INDEX,RORICD,RORICDSNAM)=""
SET CNT=0
+4 FOR
SET INDEX=$ORDER(@RORTMP@("ICD9",INDEX))
if INDEX=""
QUIT
Begin DoDot:1
+5 SET TMP=$GET(@RORTMP@("ICD9",INDEX))
if TMP=""
QUIT
+6 SET CNT=CNT+1
SET $PIECE(RORICD,RPS,CNT)=TMP
+7 if RORICDSNAM=""
SET RORICDSNAM=$$CSNAME^RORHLUT1(80,INDEX)
End DoDot:1
+8 if RORICD'=""
DO SETOBX(ICDID,RORICDSNAM_":"_RORICD)
+9 QUIT
+10 ;
+11 ;***** CONSTRUCTS SEGMENT IDENTIFIER
SEGID(CODE,NAME,CS) ;
+1 QUIT CODE_CS_NAME_CS_"VA080"
+2 ;
+3 ;***** CREATE AND STORE THE OBX SEGMENTS
SETOBX(OBX3,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 Identifier
+7 SET RORSEG(3)=OBX3
+8 ;--- OBX-5 - Observation Value
+9 SET RORSEG(5)=$$ESCAPE^RORHL7(OBX5)
+10 ;--- OBX-11 - Observation Result Status
+11 SET RORSEG(11)="F"
+12 ;--- Store the segment
+13 DO ADDSEG^RORHL7(.RORSEG)
+14 QUIT
+15 ;
SETOBXWP(OBX3,SUBS) ;
+1 NEW BR,CNT,I,I1,RORSEG,TMP
+2 SET BR=$EXTRACT(HLECH,3)_".br"_$EXTRACT(HLECH,3)
+3 if $DATA(@RORTMP@(SUBS))<10
QUIT
+4 ;--- Initialize the segment
+5 SET RORSEG(0)="OBX"
+6 ;--- OBX-2 - Value Type
+7 SET RORSEG(2)="FT"
+8 ;--- OBX-3 - Observation Identifier
+9 SET RORSEG(3)=OBX3
+10 ;--- OBX-5 - Observation Value
+11 SET I=$ORDER(@RORTMP@(SUBS,""))
SET CNT=0
+12 FOR
if I=""
QUIT
SET I1=$ORDER(@RORTMP@(SUBS,I))
Begin DoDot:1
+13 SET TMP=$$ESCAPE^RORHL7(@RORTMP@(SUBS,I))
+14 SET CNT=CNT+1
SET RORSEG(5,CNT)=$SELECT(I1'="":TMP_BR,1:TMP)
End DoDot:1
SET I=I1
+15 ;--- OBX-11 - Observation Result Status
+16 SET RORSEG(11)="F"
+17 ;--- Store the segment
+18 if $DATA(RORSEG(5))
DO ADDSEG^RORHL7(.RORSEG)
+19 QUIT
