RORHL12 ;HOIFO/BH,SG - HL7 MICROBIOLOGY DATA: OBR ;3/13/06 9:24am
;;1.5;CLINICAL CASE REGISTRIES;**1,10**;Feb 17, 2006;Build 32
;
; This routine uses the following IAs:
;
; #4335 $$GETDATA^LA7UTL1A (controlled)
; #10000 C^%DTC (supported)
; #10103 FMTHL7^XLFDT (supported)
; #2056 GET1^DIQ (supported)
;
Q
;
;***** SEARCH FOR MICROBIOLOGY 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.
;
; RORMODE The type of extract to be performed:
; 0 Nightly extract
; 1 Historical extract
;
; Return Values:
; <0 Error code
; 0 Ok
; >0 Non-fatal error(s)
;
;-----------------------------------------------------------------------------
; NIGHTLY EXTRACT FOR A PATIENT THAT HAS NOT BEEN INCLUDED IN A PREVIOUS
; EXTRACT:
; This will consist of 1 call to the Lab API to retrieve all micro data
; collected during the extraction date range.
;
; st end
; |----------------------------------------|
; <========================================> collection date
;
;-----------------------------------------------------------------------------
; NIGHTLY EXTRACT FOR A PATIENT THAT HAS BEEN INCLUDED IN A PREVIOUS EXTRACT:
; This will consist of 3 calls to the Lab API. It will pull micro data with
; a completion date in the date range, and it also pulls micro data that was
; collected exactly 60 days before the start date but has no completion date.
;
; 1. Call using a COMPLETION date in the original date range, but only
; include records in the extract from this call that have a collection date
; on or after the start date minus 60 days.
;
; st-60 days st end
; |--------------------|----|
; <=========================> collection date
; <====> completion date
;
; 2. Call using a COMPLETION date range of 60 days prior to the extraction
; start date through the original end date. Records returned from this call
; are completed, and will be compared to the records returned in the next call.
;
; 3. Call again to get all records COLLECTED exactly 60 days from the
; extraction date range. Only send the records from call #3 that were NOT
; returned from call #2. This sends all records that were collected at
; exactly 60 days before the extraction date range, but have not yet been
; completed.
;
; st-60 end-60 st end
; |-----------|--------|----|
; ============== collection date 60 days prior to date range
; no completion date
;
;-----------------------------------------------------------------------------
; HISTORICAL EXTRACT:
; This will consist of 1 call to the Lab API to retrieve all micro data
; collected during the extraction date range.
;
; st end
; |----------------------------------------|
; <========================================> collection date
;
;-----------------------------------------------------------------------------
EN1(RORDFN,DXDTS,RORMODE) ;
N ERRCNT,IDX,LRDFN,RC,RCL,RORENDT,RORMIIEN,RORREF,RORSTDT,RORTMP,TMP
S (ERRCNT,RC)=0
;--- Which is being requested - historical or nightly extract?
S RORMODE=$S($G(RORMODE):"HIST",1:"NIGHT")
;
S LRDFN=+$$LABREF^RORUTL18(RORDFN) Q:LRDFN'>0 0
S RORTMP=$$ALLOC^RORTMP()
;
S IDX=0
F S IDX=$O(DXDTS(11,IDX)) Q:IDX'>0 D Q:RC<0
. S RORSTDT=$P(DXDTS(11,IDX),U),RORENDT=$P(DXDTS(11,IDX),U,2)
. K @RORTMP
. ;---NIGHTLY EXTRACTION---
. I RORMODE="NIGHT" D
.. ;get 798 IEN (ROR REGISTRY RECORD)
.. N ROR798 S ROR798=$O(^RORDATA(798,"B",RORDFN,0))
.. Q:'$G(ROR798)
.. ;get DATA ACKNOWLEDGED UNTIL field (#9.1) in 798
.. N RORACK K RORMSG S RORACK=$$GET1^DIQ(798,ROR798_",",9.1,,,"RORMSG")
.. Q:$D(RORMSG("DIERR"))
.. ;--------------------------------------------------------------------------
.. I $G(RORACK)="" D Q ;patient has not been included in a previous extract
... ;call lab api using 'collection date' mode
... S RCL=$$GETDATA^LA7UTL1A(LRDFN,RORSTDT,RORENDT,"CD",RORTMP)
... I RCL<0 D Q
.... S TMP="$$GETDATA^LA7UTL1A"
.... S RC=$$ERROR^RORERR(-56,,$P(RCL,U,2),RORDFN,+RCL,TMP)
... ;--- Process the returned data and build the message segments
... S RORMIIEN="" F S RORMIIEN=$O(@RORTMP@(LRDFN,RORMIIEN)) Q:RORMIIEN="" D
.... S RORREF=$NA(@RORTMP@(LRDFN,RORMIIEN))
.... S TMP=$$OBR(RORREF)
.... I TMP Q:TMP<0 S ERRCNT=ERRCNT+TMP
.... S TMP=$$OBX^RORHL121(RORREF)
.... I TMP Q:TMP<0 S ERRCNT=ERRCNT+TMP
.... Q
... Q
.. ;--------------------------------------------------------------------------
.. I $L(RORACK)>0 D Q ;patient has been included in a previous extract
... N X,X1,X2,RORST60
... ;subtract 60 from start date
... S X1=RORSTDT,X2=-60 D C^%DTC S RORST60=X K X,X1,X2
... ;subtract 60 from end date
... N X,X1,X2,ROREND60
... S X1=RORENDT,X2=-60 D C^%DTC S ROREND60=X K X,X1,X2
... K @RORTMP
... ;CALL #1 using 'completion date' mode
... S RCL=$$GETDATA^LA7UTL1A(LRDFN,RORSTDT,RORENDT,"RAD",RORTMP)
... I RCL<0 D Q
.... S TMP="$$GETDATA^LA7UTL1A"
.... S RC=$$ERROR^RORERR(-56,,$P(RCL,U,2),RORDFN,+RCL,TMP)
... ;--- Process the returned data and get the collection date
... S RORMIIEN=""
... F S RORMIIEN=$O(@RORTMP@(LRDFN,RORMIIEN)) Q:RORMIIEN="" D
.... S RORREF=$NA(@RORTMP@(LRDFN,RORMIIEN))
.... N RORCOLLDT S RORCOLLDT=$G(@RORREF@(0,.01,"I")) ;collection date
.... Q:$G(RORCOLLDT)'>0 ;quit if collection date is null
.... ;If the collection date was in the 60 days prior to the extraction start
.... ;date, build the segments.
.... I RORCOLLDT'<RORST60 D Q
..... S TMP=$$OBR(RORREF)
..... I TMP Q:TMP<0 S ERRCNT=ERRCNT+TMP
..... S TMP=$$OBX^RORHL121(RORREF)
..... I TMP Q:TMP<0 S ERRCNT=ERRCNT+TMP
..... Q
.... Q
... N RORTMP2,RCL2
... S RORTMP2=$$ALLOC^RORTMP() K @RORTMP2
... ;CALL #2 using 'completion date' mode. Will be used further down.
... S RCL2=$$GETDATA^LA7UTL1A(LRDFN,RORST60,RORENDT,"RAD",RORTMP2)
... I RCL2<0 D Q
.... S TMP="$$GETDATA^LA7UTL1A"
.... S RC=$$ERROR^RORERR(-56,,$P(RCL2,U,2),RORDFN,+RCL2,TMP)
... N RORTMP3,RCL3
... S RORTMP3=$$ALLOC^RORTMP() K @RORTMP3
... ;CALL #3 using 'collection date' mode - 60 days prior to range
... S RCL3=$$GETDATA^LA7UTL1A(LRDFN,RORST60,ROREND60,"CD",RORTMP3)
... I RCL3<0 D Q
.... S TMP="$$GETDATA^LA7UTL1A"
.... S RC=$$ERROR^RORERR(-56,,$P(RCL2,U,2),RORDFN,+RCL2,TMP)
... ;--- Process the returned records from call #3 and compare them
... ;to the records returned from call #2
... S RORMIIEN=""
... F S RORMIIEN=$O(@RORTMP3@(LRDFN,RORMIIEN)) Q:RORMIIEN="" D
.... S RORREF=$NA(@RORTMP3@(LRDFN,RORMIIEN))
.... N RORCOLLDT
.... S RORCOLLDT=$G(@RORREF@(0,.01,"I")) ;collection date
.... ;quit if the record is on the "completed" output from call #2
.... Q:$D(@RORTMP2@(LRDFN,RORMIIEN))
.... ;otherwise, build message segments
.... S TMP=$$OBR(RORREF)
.... I TMP Q:TMP<0 S ERRCNT=ERRCNT+TMP
.... S TMP=$$OBX^RORHL121(RORREF)
.... I TMP Q:TMP<0 S ERRCNT=ERRCNT+TMP
.... D FREE^RORTMP(RORTMP2)
.... D FREE^RORTMP(RORTMP3)
... Q
. ;--------------------------------------------------------------------------
. I RORMODE="HIST" D ;historical extract
.. ;call lab api using 'collection date' mode
.. S RCL=$$GETDATA^LA7UTL1A(LRDFN,RORSTDT,RORENDT,"CD",RORTMP)
.. ;--- Process the returned data and build the message segments
.. S RORMIIEN=""
.. F S RORMIIEN=$O(@RORTMP@(LRDFN,RORMIIEN)) Q:RORMIIEN="" D
... S RORREF=$NA(@RORTMP@(LRDFN,RORMIIEN))
... S TMP=$$OBR(RORREF) ;build OBR segment
... I TMP Q:TMP<0 S ERRCNT=ERRCNT+TMP
... S TMP=$$OBX^RORHL121(RORREF) ;build OBX segment
... I TMP Q:TMP<0 S ERRCNT=ERRCNT+TMP
.. Q
. Q
;
D FREE^RORTMP(RORTMP)
Q $S(RC<0:RC,1:ERRCNT)
;
;***** MICROBIOLOGY OBR SEGMENT BUILDER
;
; RORREF Global reference for MI entry
;
; Return Values:
; <0 Error code
; 0 Ok
; >0 Non-fatal error(s)
;
OBR(RORREF) ;
N CS,ERRCNT,RC,RORSEG
S (ERRCNT,RC)=0
D ECH^RORHL7(.CS)
;
;--- Initialize the segment
S RORSEG(0)="OBR"
;
;--- OBR-3 - Accession Number
S TMP=$G(@RORREF@(0,.06,"I"))
I TMP="" D Q RC
. S RC=$$ERROR^RORERR(-100,,,,"No accession #","$$GETDATA^LA7UTL1A")
S RORSEG(3)=TMP
;
;--- OBR-4 - Universal Service ID
S RORSEG(4)="87999"_CS_"MICROBIOLOGY"_CS_"C4"
;
;--- OBR-7 - Accession Date
S TMP=$$FMTHL7^XLFDT($G(@RORREF@(0,.01,"I")))
I TMP'>0 D Q RC
. S RC=$$ERROR^RORERR(-100,,,,"No accession date","$$GETDATA^LA7UTL1A")
S RORSEG(7)=TMP
;
;--- OBR-11 - Urine Screen
S RORSEG(11)=$G(@RORREF@(0,11.57,"I"))
;
;--- OBR-13 - Site/Specimen
S RORSEG(13)=$$ESCAPE^RORHL7($G(@RORREF@(0,.05,"E")))
;
;--- OBR-20 - Collection Sample
S RORSEG(20)=$$ESCAPE^RORHL7($G(@RORREF@(0,.055,"E")))
;
;--- OBR-21 - Sputum Screen
S RORSEG(21)=$$ESCAPE^RORHL7($G(@RORREF@(0,11.58,"E")))
;
;--- OBR-24 - Diagnostic Service ID
S RORSEG(24)="MB"
;
;--- OBR-25 - Sterility Control
S TMP=$G(@RORREF@(0,11.51,"I"))
S RORSEG(25)=$S(TMP="P":"F",TMP="N":"R",1:"")
;
;--- OBR-44 - Division
S RORSEG(44)=$$SITE^RORUTL03(CS)
;
;--- Store the segment
D ADDSEG^RORHL7(.RORSEG)
Q ERRCNT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORHL12 9686 printed Dec 13, 2024@01:41:57 Page 2
RORHL12 ;HOIFO/BH,SG - HL7 MICROBIOLOGY DATA: OBR ;3/13/06 9:24am
+1 ;;1.5;CLINICAL CASE REGISTRIES;**1,10**;Feb 17, 2006;Build 32
+2 ;
+3 ; This routine uses the following IAs:
+4 ;
+5 ; #4335 $$GETDATA^LA7UTL1A (controlled)
+6 ; #10000 C^%DTC (supported)
+7 ; #10103 FMTHL7^XLFDT (supported)
+8 ; #2056 GET1^DIQ (supported)
+9 ;
+10 QUIT
+11 ;
+12 ;***** SEARCH FOR MICROBIOLOGY DATA
+13 ;
+14 ; RORDFN IEN of the patient in the PATIENT file (#2)
+15 ;
+16 ; .DXDTS Reference to a local variable where the
+17 ; data extraction time frames are stored.
+18 ;
+19 ; RORMODE The type of extract to be performed:
+20 ; 0 Nightly extract
+21 ; 1 Historical extract
+22 ;
+23 ; Return Values:
+24 ; <0 Error code
+25 ; 0 Ok
+26 ; >0 Non-fatal error(s)
+27 ;
+28 ;-----------------------------------------------------------------------------
+29 ; NIGHTLY EXTRACT FOR A PATIENT THAT HAS NOT BEEN INCLUDED IN A PREVIOUS
+30 ; EXTRACT:
+31 ; This will consist of 1 call to the Lab API to retrieve all micro data
+32 ; collected during the extraction date range.
+33 ;
+34 ; st end
+35 ; |----------------------------------------|
+36 ; <========================================> collection date
+37 ;
+38 ;-----------------------------------------------------------------------------
+39 ; NIGHTLY EXTRACT FOR A PATIENT THAT HAS BEEN INCLUDED IN A PREVIOUS EXTRACT:
+40 ; This will consist of 3 calls to the Lab API. It will pull micro data with
+41 ; a completion date in the date range, and it also pulls micro data that was
+42 ; collected exactly 60 days before the start date but has no completion date.
+43 ;
+44 ; 1. Call using a COMPLETION date in the original date range, but only
+45 ; include records in the extract from this call that have a collection date
+46 ; on or after the start date minus 60 days.
+47 ;
+48 ; st-60 days st end
+49 ; |--------------------|----|
+50 ; <=========================> collection date
+51 ; <====> completion date
+52 ;
+53 ; 2. Call using a COMPLETION date range of 60 days prior to the extraction
+54 ; start date through the original end date. Records returned from this call
+55 ; are completed, and will be compared to the records returned in the next call.
+56 ;
+57 ; 3. Call again to get all records COLLECTED exactly 60 days from the
+58 ; extraction date range. Only send the records from call #3 that were NOT
+59 ; returned from call #2. This sends all records that were collected at
+60 ; exactly 60 days before the extraction date range, but have not yet been
+61 ; completed.
+62 ;
+63 ; st-60 end-60 st end
+64 ; |-----------|--------|----|
+65 ; ============== collection date 60 days prior to date range
+66 ; no completion date
+67 ;
+68 ;-----------------------------------------------------------------------------
+69 ; HISTORICAL EXTRACT:
+70 ; This will consist of 1 call to the Lab API to retrieve all micro data
+71 ; collected during the extraction date range.
+72 ;
+73 ; st end
+74 ; |----------------------------------------|
+75 ; <========================================> collection date
+76 ;
+77 ;-----------------------------------------------------------------------------
EN1(RORDFN,DXDTS,RORMODE) ;
+1 NEW ERRCNT,IDX,LRDFN,RC,RCL,RORENDT,RORMIIEN,RORREF,RORSTDT,RORTMP,TMP
+2 SET (ERRCNT,RC)=0
+3 ;--- Which is being requested - historical or nightly extract?
+4 SET RORMODE=$SELECT($GET(RORMODE):"HIST",1:"NIGHT")
+5 ;
+6 SET LRDFN=+$$LABREF^RORUTL18(RORDFN)
if LRDFN'>0
QUIT 0
+7 SET RORTMP=$$ALLOC^RORTMP()
+8 ;
+9 SET IDX=0
+10 FOR
SET IDX=$ORDER(DXDTS(11,IDX))
if IDX'>0
QUIT
Begin DoDot:1
+11 SET RORSTDT=$PIECE(DXDTS(11,IDX),U)
SET RORENDT=$PIECE(DXDTS(11,IDX),U,2)
+12 KILL @RORTMP
+13 ;---NIGHTLY EXTRACTION---
+14 IF RORMODE="NIGHT"
Begin DoDot:2
+15 ;get 798 IEN (ROR REGISTRY RECORD)
+16 NEW ROR798
SET ROR798=$ORDER(^RORDATA(798,"B",RORDFN,0))
+17 if '$GET(ROR798)
QUIT
+18 ;get DATA ACKNOWLEDGED UNTIL field (#9.1) in 798
+19 NEW RORACK
KILL RORMSG
SET RORACK=$$GET1^DIQ(798,ROR798_",",9.1,,,"RORMSG")
+20 if $DATA(RORMSG("DIERR"))
QUIT
+21 ;--------------------------------------------------------------------------
+22 ;patient has not been included in a previous extract
IF $GET(RORACK)=""
Begin DoDot:3
+23 ;call lab api using 'collection date' mode
+24 SET RCL=$$GETDATA^LA7UTL1A(LRDFN,RORSTDT,RORENDT,"CD",RORTMP)
+25 IF RCL<0
Begin DoDot:4
+26 SET TMP="$$GETDATA^LA7UTL1A"
+27 SET RC=$$ERROR^RORERR(-56,,$PIECE(RCL,U,2),RORDFN,+RCL,TMP)
End DoDot:4
QUIT
+28 ;--- Process the returned data and build the message segments
+29 SET RORMIIEN=""
FOR
SET RORMIIEN=$ORDER(@RORTMP@(LRDFN,RORMIIEN))
if RORMIIEN=""
QUIT
Begin DoDot:4
+30 SET RORREF=$NAME(@RORTMP@(LRDFN,RORMIIEN))
+31 SET TMP=$$OBR(RORREF)
+32 IF TMP
if TMP<0
QUIT
SET ERRCNT=ERRCNT+TMP
+33 SET TMP=$$OBX^RORHL121(RORREF)
+34 IF TMP
if TMP<0
QUIT
SET ERRCNT=ERRCNT+TMP
+35 QUIT
End DoDot:4
+36 QUIT
End DoDot:3
QUIT
+37 ;--------------------------------------------------------------------------
+38 ;patient has been included in a previous extract
IF $LENGTH(RORACK)>0
Begin DoDot:3
+39 NEW X,X1,X2,RORST60
+40 ;subtract 60 from start date
+41 SET X1=RORSTDT
SET X2=-60
DO C^%DTC
SET RORST60=X
KILL X,X1,X2
+42 ;subtract 60 from end date
+43 NEW X,X1,X2,ROREND60
+44 SET X1=RORENDT
SET X2=-60
DO C^%DTC
SET ROREND60=X
KILL X,X1,X2
+45 KILL @RORTMP
+46 ;CALL #1 using 'completion date' mode
+47 SET RCL=$$GETDATA^LA7UTL1A(LRDFN,RORSTDT,RORENDT,"RAD",RORTMP)
+48 IF RCL<0
Begin DoDot:4
+49 SET TMP="$$GETDATA^LA7UTL1A"
+50 SET RC=$$ERROR^RORERR(-56,,$PIECE(RCL,U,2),RORDFN,+RCL,TMP)
End DoDot:4
QUIT
+51 ;--- Process the returned data and get the collection date
+52 SET RORMIIEN=""
+53 FOR
SET RORMIIEN=$ORDER(@RORTMP@(LRDFN,RORMIIEN))
if RORMIIEN=""
QUIT
Begin DoDot:4
+54 SET RORREF=$NAME(@RORTMP@(LRDFN,RORMIIEN))
+55 ;collection date
NEW RORCOLLDT
SET RORCOLLDT=$GET(@RORREF@(0,.01,"I"))
+56 ;quit if collection date is null
if $GET(RORCOLLDT)'>0
QUIT
+57 ;If the collection date was in the 60 days prior to the extraction start
+58 ;date, build the segments.
+59 IF RORCOLLDT'<RORST60
Begin DoDot:5
+60 SET TMP=$$OBR(RORREF)
+61 IF TMP
if TMP<0
QUIT
SET ERRCNT=ERRCNT+TMP
+62 SET TMP=$$OBX^RORHL121(RORREF)
+63 IF TMP
if TMP<0
QUIT
SET ERRCNT=ERRCNT+TMP
+64 QUIT
End DoDot:5
QUIT
+65 QUIT
End DoDot:4
+66 NEW RORTMP2,RCL2
+67 SET RORTMP2=$$ALLOC^RORTMP()
KILL @RORTMP2
+68 ;CALL #2 using 'completion date' mode. Will be used further down.
+69 SET RCL2=$$GETDATA^LA7UTL1A(LRDFN,RORST60,RORENDT,"RAD",RORTMP2)
+70 IF RCL2<0
Begin DoDot:4
+71 SET TMP="$$GETDATA^LA7UTL1A"
+72 SET RC=$$ERROR^RORERR(-56,,$PIECE(RCL2,U,2),RORDFN,+RCL2,TMP)
End DoDot:4
QUIT
+73 NEW RORTMP3,RCL3
+74 SET RORTMP3=$$ALLOC^RORTMP()
KILL @RORTMP3
+75 ;CALL #3 using 'collection date' mode - 60 days prior to range
+76 SET RCL3=$$GETDATA^LA7UTL1A(LRDFN,RORST60,ROREND60,"CD",RORTMP3)
+77 IF RCL3<0
Begin DoDot:4
+78 SET TMP="$$GETDATA^LA7UTL1A"
+79 SET RC=$$ERROR^RORERR(-56,,$PIECE(RCL2,U,2),RORDFN,+RCL2,TMP)
End DoDot:4
QUIT
+80 ;--- Process the returned records from call #3 and compare them
+81 ;to the records returned from call #2
+82 SET RORMIIEN=""
+83 FOR
SET RORMIIEN=$ORDER(@RORTMP3@(LRDFN,RORMIIEN))
if RORMIIEN=""
QUIT
Begin DoDot:4
+84 SET RORREF=$NAME(@RORTMP3@(LRDFN,RORMIIEN))
+85 NEW RORCOLLDT
+86 ;collection date
SET RORCOLLDT=$GET(@RORREF@(0,.01,"I"))
+87 ;quit if the record is on the "completed" output from call #2
+88 if $DATA(@RORTMP2@(LRDFN,RORMIIEN))
QUIT
+89 ;otherwise, build message segments
+90 SET TMP=$$OBR(RORREF)
+91 IF TMP
if TMP<0
QUIT
SET ERRCNT=ERRCNT+TMP
+92 SET TMP=$$OBX^RORHL121(RORREF)
+93 IF TMP
if TMP<0
QUIT
SET ERRCNT=ERRCNT+TMP
+94 DO FREE^RORTMP(RORTMP2)
+95 DO FREE^RORTMP(RORTMP3)
End DoDot:4
+96 QUIT
End DoDot:3
QUIT
End DoDot:2
+97 ;--------------------------------------------------------------------------
+98 ;historical extract
IF RORMODE="HIST"
Begin DoDot:2
+99 ;call lab api using 'collection date' mode
+100 SET RCL=$$GETDATA^LA7UTL1A(LRDFN,RORSTDT,RORENDT,"CD",RORTMP)
+101 ;--- Process the returned data and build the message segments
+102 SET RORMIIEN=""
+103 FOR
SET RORMIIEN=$ORDER(@RORTMP@(LRDFN,RORMIIEN))
if RORMIIEN=""
QUIT
Begin DoDot:3
+104 SET RORREF=$NAME(@RORTMP@(LRDFN,RORMIIEN))
+105 ;build OBR segment
SET TMP=$$OBR(RORREF)
+106 IF TMP
if TMP<0
QUIT
SET ERRCNT=ERRCNT+TMP
+107 ;build OBX segment
SET TMP=$$OBX^RORHL121(RORREF)
+108 IF TMP
if TMP<0
QUIT
SET ERRCNT=ERRCNT+TMP
End DoDot:3
+109 QUIT
End DoDot:2
+110 QUIT
End DoDot:1
if RC<0
QUIT
+111 ;
+112 DO FREE^RORTMP(RORTMP)
+113 QUIT $SELECT(RC<0:RC,1:ERRCNT)
+114 ;
+115 ;***** MICROBIOLOGY OBR SEGMENT BUILDER
+116 ;
+117 ; RORREF Global reference for MI entry
+118 ;
+119 ; Return Values:
+120 ; <0 Error code
+121 ; 0 Ok
+122 ; >0 Non-fatal error(s)
+123 ;
OBR(RORREF) ;
+1 NEW CS,ERRCNT,RC,RORSEG
+2 SET (ERRCNT,RC)=0
+3 DO ECH^RORHL7(.CS)
+4 ;
+5 ;--- Initialize the segment
+6 SET RORSEG(0)="OBR"
+7 ;
+8 ;--- OBR-3 - Accession Number
+9 SET TMP=$GET(@RORREF@(0,.06,"I"))
+10 IF TMP=""
Begin DoDot:1
+11 SET RC=$$ERROR^RORERR(-100,,,,"No accession #","$$GETDATA^LA7UTL1A")
End DoDot:1
QUIT RC
+12 SET RORSEG(3)=TMP
+13 ;
+14 ;--- OBR-4 - Universal Service ID
+15 SET RORSEG(4)="87999"_CS_"MICROBIOLOGY"_CS_"C4"
+16 ;
+17 ;--- OBR-7 - Accession Date
+18 SET TMP=$$FMTHL7^XLFDT($GET(@RORREF@(0,.01,"I")))
+19 IF TMP'>0
Begin DoDot:1
+20 SET RC=$$ERROR^RORERR(-100,,,,"No accession date","$$GETDATA^LA7UTL1A")
End DoDot:1
QUIT RC
+21 SET RORSEG(7)=TMP
+22 ;
+23 ;--- OBR-11 - Urine Screen
+24 SET RORSEG(11)=$GET(@RORREF@(0,11.57,"I"))
+25 ;
+26 ;--- OBR-13 - Site/Specimen
+27 SET RORSEG(13)=$$ESCAPE^RORHL7($GET(@RORREF@(0,.05,"E")))
+28 ;
+29 ;--- OBR-20 - Collection Sample
+30 SET RORSEG(20)=$$ESCAPE^RORHL7($GET(@RORREF@(0,.055,"E")))
+31 ;
+32 ;--- OBR-21 - Sputum Screen
+33 SET RORSEG(21)=$$ESCAPE^RORHL7($GET(@RORREF@(0,11.58,"E")))
+34 ;
+35 ;--- OBR-24 - Diagnostic Service ID
+36 SET RORSEG(24)="MB"
+37 ;
+38 ;--- OBR-25 - Sterility Control
+39 SET TMP=$GET(@RORREF@(0,11.51,"I"))
+40 SET RORSEG(25)=$SELECT(TMP="P":"F",TMP="N":"R",1:"")
+41 ;
+42 ;--- OBR-44 - Division
+43 SET RORSEG(44)=$$SITE^RORUTL03(CS)
+44 ;
+45 ;--- Store the segment
+46 DO ADDSEG^RORHL7(.RORSEG)
+47 QUIT ERRCNT
