RORHL04 ;HOIFO/CRT,SG - HL7 RADIOLOGY: OBR,OBX ; 4/26/07 12:53pm
;;1.5;CLINICAL CASE REGISTRIES;**3**;Feb 17, 2006;Build 7
;
; This routine uses the following IAs:
;
; #65 Read access to file #70 (controlled)
; #118-B Read access to file #71 (controlled)
; #118-D Read access to file #72 (controlled)
; #1995 $$CPT^ICPTCOD (supported)
; #2043 EN1^RAO7PC1 (supported)
; #2265 EN3^RAO7PC1 (supported)
; #10060 Read access to the file #200 (supported)
; #10090 Read access to the file #4 (supported)
;
; #15-C Read access to file #74 (Private)
;
Q
;
;***** SEARCHES RADIOLOGY FOR 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.
;
; Return Values:
; <0 Error code
; 0 Ok
; >0 Non-fatal error(s)
;
; The ^TMP($J,"RAE1") and ^TMP($J,"RAE2") global nodes are used by
; this function.
;
EN1(RORDFN,DXDTS) ;
N CNI,DTI,ERRCNT,EXAMID,IDX,IENS,IENS74,RACN0,RC,RORENDT,RORSTDT,STR1,TMP
S (ERRCNT,RC)=0
;
S IDX=0
F S IDX=$O(DXDTS(4,IDX)) Q:IDX'>0 D Q:RC<0
. S RORSTDT=$P(DXDTS(4,IDX),U),RORENDT=$P(DXDTS(4,IDX),U,2)
. ;--- Get radiology data
. K ^TMP($J,"RAE1")
. D EN1^RAO7PC1(RORDFN,RORSTDT,RORENDT,999999999)
. ;--- Process the data
. S EXAMID=""
. F S EXAMID=$O(^TMP($J,"RAE1",RORDFN,EXAMID)) Q:EXAMID="" D
. . S DTI=$P(EXAMID,"-"),CNI=$P(EXAMID,"-",2)
. . S IENS=CNI_","_DTI_","_RORDFN_","
. . S STR=^TMP($J,"RAE1",RORDFN,EXAMID)
. . S RACN0=$P(STR,"^",2),IENS74=$P(STR,"^",5)
. . S TMP=$$OBR(IENS,RACN0)
. . I TMP Q:TMP<0 S ERRCNT=ERRCNT+TMP
. . Q:TMP="S"
. . S TMP=$$OBX(IENS,IENS74)
. . I TMP Q:TMP<0 S ERRCNT=ERRCNT+TMP
;
K ^TMP($J,"RAE1")
Q $S(RC<0:RC,1:ERRCNT)
;
;*****
LOOP(ROR8NODE,OID,PREFIX) ;
N BR,CNT,I,I1,TMP
S BR=$E(HLECH,3)_".br"_$E(HLECH,3)
S RORSEG(3)=OID
K RORSEG(5)
;---
S I=$O(@ROR8NODE@("")),CNT=0
D:$G(PREFIX)'=""
. S CNT=CNT+1
. S RORSEG(5,CNT)=$$ESCAPE^RORHL7(PREFIX)_$S(I'="":BR,1:"")
;---
F Q:I="" S I1=$O(@ROR8NODE@(I)) D S I=I1
. S TMP=$$ESCAPE^RORHL7(@ROR8NODE@(I))
. S CNT=CNT+1,RORSEG(5,CNT)=$S(I1'="":TMP_BR,1:TMP)
;---
D:$D(RORSEG(5)) ADDSEG^RORHL7(.RORSEG)
Q
;
;***** GENERATES THE RADIOLOGY OBR SEGMENT
;
; RORIENS IENS of the radiology record in the file #70.03
;
; Return Values:
; <0 Error code
; 0 Ok
; >0 Non-fatal error(s)
; "S" Skip the record
;
OBR(RORIENS,RACN0) ;
N BUF,CPTIEN,CS,ERRCNT,IENS,IENS7002,RADTE,RC,RORMSG,ROROUT,RORSEG,TMP
S (ERRCNT,RC)=0
D ECH^RORHL7(.CS)
;--- Check the parameters
S:$E(RORIENS,$L(RORIENS))'="," RORIENS=RORIENS_","
;
D GETS^DIQ(70.03,RORIENS,"2;14","IE","ROROUT","RORMSG")
Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,,70.03,RORIENS)
S IENS7002=$P(RORIENS,",",2,3)_","
D GETS^DIQ(70.02,IENS7002,".01;3","EI","ROROUT","RORMSG")
Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,,70.02,IENS7002)
;
;--- Initialize the segment
S RORSEG(0)="OBR"
;
;--- OBR-3 - Unique Accession #
S BUF=$P(RORIENS,",",2)_"-"_$P(RORIENS,",")
S RADTE=$G(ROROUT(70.02,IENS7002,.01,"I"))\1
S $P(BUF,CS,2)=$E(RADTE,4,7)_$E(RADTE,2,3)_"-"_+RACN0
S RORSEG(3)=BUF
;
;--- OBR-4 - Procedure & CPT Code
S IENS=+$G(ROROUT(70.03,RORIENS,2,"I"))_","
Q:IENS'>0 $$ERROR^RORERR(-95,,,,70.03,RORIENS,2)
S CPTIEN=+$$GET1^DIQ(71,IENS,9,"I",,"RORMSG")
Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,,71,IENS)
;--- Some procedures never have a CPT code. Record a warning
;--- (only in debug mode) and skip the record.
I CPTIEN'>0 D:$G(RORPARM("DEBUG")) Q "S"
. D ERROR^RORERR(-95,,,,71,IENS,9)
;---
S TMP=$$CPT^ICPTCOD(CPTIEN)
Q:TMP<0 $$ERROR^RORERR(-56,,$P(TMP,U,2),,+TMP,"$$CPT^ICPTCOD")
S BUF=$P(TMP,U,2)_CS_$$ESCAPE^RORHL7($P(TMP,U,3))_CS_"C4"
;---
S $P(BUF,CS,4)=$G(ROROUT(70.03,RORIENS,2,"I"))
S $P(BUF,CS,5)=$$ESCAPE^RORHL7($G(ROROUT(70.03,RORIENS,2,"E")))
S $P(BUF,CS,6)="99RAP"
S RORSEG(4)=BUF
;
;--- OBR-7 - Exam Date/Time
S TMP=$$FMTHL7^XLFDT($G(ROROUT(70.02,IENS7002,.01,"I")))
Q:TMP'>0 $$ERROR^RORERR(-95,,,,70.02,IENS7002,.01)
S RORSEG(7)=TMP
;
;--- OBR-16 - Requesting Physician
S BUF=+$G(ROROUT(70.03,RORIENS,14,"I"))
I BUF>0 D
. S $P(BUF,CS,13)=$$GET1^DIQ(200,+BUF_",",53.5,"E",,"RORMSG")
. I $G(DIERR) D DBS^RORERR("RORMSG",-99,,,200,+BUF_",") Q
. S RORSEG(16)=BUF
;
;--- OBR-24 - Service Section ID
S RORSEG(24)="RAD"
;
;--- OBR-44 - Division
S RORSEG(44)=$$SITE^RORUTL03(CS)
S IENS=+$G(ROROUT(70.02,IENS7002,3,"I"))_","
I IENS>0 D
. S BUF=$$GET1^DIQ(4,IENS,99,"I",,"RORMSG")
. I $G(DIERR) D DBS^RORERR("RORMSG",-99,,,4,IENS) Q
. Q:BUF=""
. S $P(BUF,CS,2)=$$ESCAPE^RORHL7($G(ROROUT(70.02,IENS7002,3,"E")))
. S $P(BUF,CS,3)="99VA4"
. S RORSEG(44)=BUF
;
;--- Store the segment
D ADDSEG^RORHL7(.RORSEG)
Q ERRCNT
;
;***** GENERATES THE RADIOLOGY OBX SEGMENT
;
; RORIENS IENS of the radiology record in the file #70.03
;
; Return Values:
; <0 Error code
; 0 Ok
; >0 Non-fatal error(s)
;
OBX(RORIENS,IENS74) ;
N CASEIEN,RAENODE,ERRCNT,PTIEN,RC,RFS,RORBUF,RORSEG,RORTXT,TMP
S (ERRCNT,RC)=0
D ECH^RORHL7(.CS)
;--- Check the parameters
S:$E(RORIENS,$L(RORIENS))'="," RORIENS=RORIENS_","
;
;--- Load the data into the ^TMP($J,"RAE2")
S CASEIEN=$P(IENS,","),PTIEN=$P(IENS,",",3)
D EN3^RAO7PC1(PTIEN_U_$P(IENS,",",2)_U_CASEIEN)
S TMP=$O(^TMP($J,"RAE2",PTIEN,CASEIEN,""))
Q:TMP="" $$ERROR^RORERR(-100,,,PTIEN,"Nothing","EN3^RAO7PC1")
S RAENODE=$NA(^TMP($J,"RAE2",PTIEN,CASEIEN,TMP))
;
;--- Initialize the segment
S RORSEG(0)="OBX"
;
;--- OBX-2
S RORSEG(2)="FT"
;
;--- OBX-11
S RORSEG(11)="F"
;
;-- Get the Report Text
S TMP=$NA(@RAENODE@("R"))
D:$D(@TMP)>1 LOOP(TMP,"RT"_CS_"Report Text"_CS_"VA080")
;
;--- Get the Impression Report
S TMP=$NA(@RAENODE@("I"))
D:$D(@TMP)>1 LOOP(TMP,"IT"_CS_"Impression Text"_CS_"VA080")
;
;--- Get the Reason for Study and Clinical History
S TMP=$NA(@RAENODE@("H")),RFS=$G(@RAENODE@("RFS"))
D:($D(@TMP)>1)!(RFS'="")
. S:RFS'="" RFS="Reason for Study: "_RFS
. D LOOP(TMP,"CH"_CS_"Clinical History"_CS_"VA080",RFS)
;
;--- Get the Reason for Study (alternative approach)
;S RORBUF(1)=$G(@RAENODE@("RFS"))
;D:RORBUF(1)'="" LOOP("RORBUF","RS"_CS_"Reason for Study"_CS_"VA080")
;
Q ERRCNT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORHL04 6542 printed Dec 13, 2024@01:41:47 Page 2
RORHL04 ;HOIFO/CRT,SG - HL7 RADIOLOGY: OBR,OBX ; 4/26/07 12:53pm
+1 ;;1.5;CLINICAL CASE REGISTRIES;**3**;Feb 17, 2006;Build 7
+2 ;
+3 ; This routine uses the following IAs:
+4 ;
+5 ; #65 Read access to file #70 (controlled)
+6 ; #118-B Read access to file #71 (controlled)
+7 ; #118-D Read access to file #72 (controlled)
+8 ; #1995 $$CPT^ICPTCOD (supported)
+9 ; #2043 EN1^RAO7PC1 (supported)
+10 ; #2265 EN3^RAO7PC1 (supported)
+11 ; #10060 Read access to the file #200 (supported)
+12 ; #10090 Read access to the file #4 (supported)
+13 ;
+14 ; #15-C Read access to file #74 (Private)
+15 ;
+16 QUIT
+17 ;
+18 ;***** SEARCHES RADIOLOGY FOR DATA
+19 ;
+20 ; RORDFN IEN of the patient in the PATIENT file (#2)
+21 ;
+22 ; .DXDTS Reference to a local variable where the
+23 ; data extraction time frames are stored.
+24 ;
+25 ; Return Values:
+26 ; <0 Error code
+27 ; 0 Ok
+28 ; >0 Non-fatal error(s)
+29 ;
+30 ; The ^TMP($J,"RAE1") and ^TMP($J,"RAE2") global nodes are used by
+31 ; this function.
+32 ;
EN1(RORDFN,DXDTS) ;
+1 NEW CNI,DTI,ERRCNT,EXAMID,IDX,IENS,IENS74,RACN0,RC,RORENDT,RORSTDT,STR1,TMP
+2 SET (ERRCNT,RC)=0
+3 ;
+4 SET IDX=0
+5 FOR
SET IDX=$ORDER(DXDTS(4,IDX))
if IDX'>0
QUIT
Begin DoDot:1
+6 SET RORSTDT=$PIECE(DXDTS(4,IDX),U)
SET RORENDT=$PIECE(DXDTS(4,IDX),U,2)
+7 ;--- Get radiology data
+8 KILL ^TMP($JOB,"RAE1")
+9 DO EN1^RAO7PC1(RORDFN,RORSTDT,RORENDT,999999999)
+10 ;--- Process the data
+11 SET EXAMID=""
+12 FOR
SET EXAMID=$ORDER(^TMP($JOB,"RAE1",RORDFN,EXAMID))
if EXAMID=""
QUIT
Begin DoDot:2
+13 SET DTI=$PIECE(EXAMID,"-")
SET CNI=$PIECE(EXAMID,"-",2)
+14 SET IENS=CNI_","_DTI_","_RORDFN_","
+15 SET STR=^TMP($JOB,"RAE1",RORDFN,EXAMID)
+16 SET RACN0=$PIECE(STR,"^",2)
SET IENS74=$PIECE(STR,"^",5)
+17 SET TMP=$$OBR(IENS,RACN0)
+18 IF TMP
if TMP<0
QUIT
SET ERRCNT=ERRCNT+TMP
+19 if TMP="S"
QUIT
+20 SET TMP=$$OBX(IENS,IENS74)
+21 IF TMP
if TMP<0
QUIT
SET ERRCNT=ERRCNT+TMP
End DoDot:2
End DoDot:1
if RC<0
QUIT
+22 ;
+23 KILL ^TMP($JOB,"RAE1")
+24 QUIT $SELECT(RC<0:RC,1:ERRCNT)
+25 ;
+26 ;*****
LOOP(ROR8NODE,OID,PREFIX) ;
+1 NEW BR,CNT,I,I1,TMP
+2 SET BR=$EXTRACT(HLECH,3)_".br"_$EXTRACT(HLECH,3)
+3 SET RORSEG(3)=OID
+4 KILL RORSEG(5)
+5 ;---
+6 SET I=$ORDER(@ROR8NODE@(""))
SET CNT=0
+7 if $GET(PREFIX)'=""
Begin DoDot:1
+8 SET CNT=CNT+1
+9 SET RORSEG(5,CNT)=$$ESCAPE^RORHL7(PREFIX)_$SELECT(I'="":BR,1:"")
End DoDot:1
+10 ;---
+11 FOR
if I=""
QUIT
SET I1=$ORDER(@ROR8NODE@(I))
Begin DoDot:1
+12 SET TMP=$$ESCAPE^RORHL7(@ROR8NODE@(I))
+13 SET CNT=CNT+1
SET RORSEG(5,CNT)=$SELECT(I1'="":TMP_BR,1:TMP)
End DoDot:1
SET I=I1
+14 ;---
+15 if $DATA(RORSEG(5))
DO ADDSEG^RORHL7(.RORSEG)
+16 QUIT
+17 ;
+18 ;***** GENERATES THE RADIOLOGY OBR SEGMENT
+19 ;
+20 ; RORIENS IENS of the radiology record in the file #70.03
+21 ;
+22 ; Return Values:
+23 ; <0 Error code
+24 ; 0 Ok
+25 ; >0 Non-fatal error(s)
+26 ; "S" Skip the record
+27 ;
OBR(RORIENS,RACN0) ;
+1 NEW BUF,CPTIEN,CS,ERRCNT,IENS,IENS7002,RADTE,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 DO GETS^DIQ(70.03,RORIENS,"2;14","IE","ROROUT","RORMSG")
+8 if $GET(DIERR)
QUIT $$DBS^RORERR("RORMSG",-9,,,70.03,RORIENS)
+9 SET IENS7002=$PIECE(RORIENS,",",2,3)_","
+10 DO GETS^DIQ(70.02,IENS7002,".01;3","EI","ROROUT","RORMSG")
+11 if $GET(DIERR)
QUIT $$DBS^RORERR("RORMSG",-9,,,70.02,IENS7002)
+12 ;
+13 ;--- Initialize the segment
+14 SET RORSEG(0)="OBR"
+15 ;
+16 ;--- OBR-3 - Unique Accession #
+17 SET BUF=$PIECE(RORIENS,",",2)_"-"_$PIECE(RORIENS,",")
+18 SET RADTE=$GET(ROROUT(70.02,IENS7002,.01,"I"))\1
+19 SET $PIECE(BUF,CS,2)=$EXTRACT(RADTE,4,7)_$EXTRACT(RADTE,2,3)_"-"_+RACN0
+20 SET RORSEG(3)=BUF
+21 ;
+22 ;--- OBR-4 - Procedure & CPT Code
+23 SET IENS=+$GET(ROROUT(70.03,RORIENS,2,"I"))_","
+24 if IENS'>0
QUIT $$ERROR^RORERR(-95,,,,70.03,RORIENS,2)
+25 SET CPTIEN=+$$GET1^DIQ(71,IENS,9,"I",,"RORMSG")
+26 if $GET(DIERR)
QUIT $$DBS^RORERR("RORMSG",-9,,,71,IENS)
+27 ;--- Some procedures never have a CPT code. Record a warning
+28 ;--- (only in debug mode) and skip the record.
+29 IF CPTIEN'>0
if $GET(RORPARM("DEBUG"))
Begin DoDot:1
+30 DO ERROR^RORERR(-95,,,,71,IENS,9)
End DoDot:1
QUIT "S"
+31 ;---
+32 SET TMP=$$CPT^ICPTCOD(CPTIEN)
+33 if TMP<0
QUIT $$ERROR^RORERR(-56,,$PIECE(TMP,U,2),,+TMP,"$$CPT^ICPTCOD")
+34 SET BUF=$PIECE(TMP,U,2)_CS_$$ESCAPE^RORHL7($PIECE(TMP,U,3))_CS_"C4"
+35 ;---
+36 SET $PIECE(BUF,CS,4)=$GET(ROROUT(70.03,RORIENS,2,"I"))
+37 SET $PIECE(BUF,CS,5)=$$ESCAPE^RORHL7($GET(ROROUT(70.03,RORIENS,2,"E")))
+38 SET $PIECE(BUF,CS,6)="99RAP"
+39 SET RORSEG(4)=BUF
+40 ;
+41 ;--- OBR-7 - Exam Date/Time
+42 SET TMP=$$FMTHL7^XLFDT($GET(ROROUT(70.02,IENS7002,.01,"I")))
+43 if TMP'>0
QUIT $$ERROR^RORERR(-95,,,,70.02,IENS7002,.01)
+44 SET RORSEG(7)=TMP
+45 ;
+46 ;--- OBR-16 - Requesting Physician
+47 SET BUF=+$GET(ROROUT(70.03,RORIENS,14,"I"))
+48 IF BUF>0
Begin DoDot:1
+49 SET $PIECE(BUF,CS,13)=$$GET1^DIQ(200,+BUF_",",53.5,"E",,"RORMSG")
+50 IF $GET(DIERR)
DO DBS^RORERR("RORMSG",-99,,,200,+BUF_",")
QUIT
+51 SET RORSEG(16)=BUF
End DoDot:1
+52 ;
+53 ;--- OBR-24 - Service Section ID
+54 SET RORSEG(24)="RAD"
+55 ;
+56 ;--- OBR-44 - Division
+57 SET RORSEG(44)=$$SITE^RORUTL03(CS)
+58 SET IENS=+$GET(ROROUT(70.02,IENS7002,3,"I"))_","
+59 IF IENS>0
Begin DoDot:1
+60 SET BUF=$$GET1^DIQ(4,IENS,99,"I",,"RORMSG")
+61 IF $GET(DIERR)
DO DBS^RORERR("RORMSG",-99,,,4,IENS)
QUIT
+62 if BUF=""
QUIT
+63 SET $PIECE(BUF,CS,2)=$$ESCAPE^RORHL7($GET(ROROUT(70.02,IENS7002,3,"E")))
+64 SET $PIECE(BUF,CS,3)="99VA4"
+65 SET RORSEG(44)=BUF
End DoDot:1
+66 ;
+67 ;--- Store the segment
+68 DO ADDSEG^RORHL7(.RORSEG)
+69 QUIT ERRCNT
+70 ;
+71 ;***** GENERATES THE RADIOLOGY OBX SEGMENT
+72 ;
+73 ; RORIENS IENS of the radiology record in the file #70.03
+74 ;
+75 ; Return Values:
+76 ; <0 Error code
+77 ; 0 Ok
+78 ; >0 Non-fatal error(s)
+79 ;
OBX(RORIENS,IENS74) ;
+1 NEW CASEIEN,RAENODE,ERRCNT,PTIEN,RC,RFS,RORBUF,RORSEG,RORTXT,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 into the ^TMP($J,"RAE2")
+8 SET CASEIEN=$PIECE(IENS,",")
SET PTIEN=$PIECE(IENS,",",3)
+9 DO EN3^RAO7PC1(PTIEN_U_$PIECE(IENS,",",2)_U_CASEIEN)
+10 SET TMP=$ORDER(^TMP($JOB,"RAE2",PTIEN,CASEIEN,""))
+11 if TMP=""
QUIT $$ERROR^RORERR(-100,,,PTIEN,"Nothing","EN3^RAO7PC1")
+12 SET RAENODE=$NAME(^TMP($JOB,"RAE2",PTIEN,CASEIEN,TMP))
+13 ;
+14 ;--- Initialize the segment
+15 SET RORSEG(0)="OBX"
+16 ;
+17 ;--- OBX-2
+18 SET RORSEG(2)="FT"
+19 ;
+20 ;--- OBX-11
+21 SET RORSEG(11)="F"
+22 ;
+23 ;-- Get the Report Text
+24 SET TMP=$NAME(@RAENODE@("R"))
+25 if $DATA(@TMP)>1
DO LOOP(TMP,"RT"_CS_"Report Text"_CS_"VA080")
+26 ;
+27 ;--- Get the Impression Report
+28 SET TMP=$NAME(@RAENODE@("I"))
+29 if $DATA(@TMP)>1
DO LOOP(TMP,"IT"_CS_"Impression Text"_CS_"VA080")
+30 ;
+31 ;--- Get the Reason for Study and Clinical History
+32 SET TMP=$NAME(@RAENODE@("H"))
SET RFS=$GET(@RAENODE@("RFS"))
+33 if ($DATA(@TMP)>1)!(RFS'="")
Begin DoDot:1
+34 if RFS'=""
SET RFS="Reason for Study: "_RFS
+35 DO LOOP(TMP,"CH"_CS_"Clinical History"_CS_"VA080",RFS)
End DoDot:1
+36 ;
+37 ;--- Get the Reason for Study (alternative approach)
+38 ;S RORBUF(1)=$G(@RAENODE@("RFS"))
+39 ;D:RORBUF(1)'="" LOOP("RORBUF","RS"_CS_"Reason for Study"_CS_"VA080")
+40 ;
+41 QUIT ERRCNT
