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

RORHL04.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ; This routine uses the following IAs:
  1. ;
  1. ; #65 Read access to file #70 (controlled)
  1. ; #118-B Read access to file #71 (controlled)
  1. ; #118-D Read access to file #72 (controlled)
  1. ; #1995 $$CPT^ICPTCOD (supported)
  1. ; #2043 EN1^RAO7PC1 (supported)
  1. ; #2265 EN3^RAO7PC1 (supported)
  1. ; #10060 Read access to the file #200 (supported)
  1. ; #10090 Read access to the file #4 (supported)
  1. ;
  1. ; #15-C Read access to file #74 (Private)
  1. ;
  1. Q
  1. ;
  1. ;***** SEARCHES RADIOLOGY FOR DATA
  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. ; The ^TMP($J,"RAE1") and ^TMP($J,"RAE2") global nodes are used by
  1. ; this function.
  1. ;
  1. EN1(RORDFN,DXDTS) ;
  1. N CNI,DTI,ERRCNT,EXAMID,IDX,IENS,IENS74,RACN0,RC,RORENDT,RORSTDT,STR1,TMP
  1. S (ERRCNT,RC)=0
  1. ;
  1. S IDX=0
  1. F S IDX=$O(DXDTS(4,IDX)) Q:IDX'>0 D Q:RC<0
  1. . S RORSTDT=$P(DXDTS(4,IDX),U),RORENDT=$P(DXDTS(4,IDX),U,2)
  1. . ;--- Get radiology data
  1. . K ^TMP($J,"RAE1")
  1. . D EN1^RAO7PC1(RORDFN,RORSTDT,RORENDT,999999999)
  1. . ;--- Process the data
  1. . S EXAMID=""
  1. . F S EXAMID=$O(^TMP($J,"RAE1",RORDFN,EXAMID)) Q:EXAMID="" D
  1. . . S DTI=$P(EXAMID,"-"),CNI=$P(EXAMID,"-",2)
  1. . . S IENS=CNI_","_DTI_","_RORDFN_","
  1. . . S STR=^TMP($J,"RAE1",RORDFN,EXAMID)
  1. . . S RACN0=$P(STR,"^",2),IENS74=$P(STR,"^",5)
  1. . . S TMP=$$OBR(IENS,RACN0)
  1. . . I TMP Q:TMP<0 S ERRCNT=ERRCNT+TMP
  1. . . Q:TMP="S"
  1. . . S TMP=$$OBX(IENS,IENS74)
  1. . . I TMP Q:TMP<0 S ERRCNT=ERRCNT+TMP
  1. ;
  1. K ^TMP($J,"RAE1")
  1. Q $S(RC<0:RC,1:ERRCNT)
  1. ;
  1. ;*****
  1. LOOP(ROR8NODE,OID,PREFIX) ;
  1. N BR,CNT,I,I1,TMP
  1. S BR=$E(HLECH,3)_".br"_$E(HLECH,3)
  1. S RORSEG(3)=OID
  1. K RORSEG(5)
  1. ;---
  1. S I=$O(@ROR8NODE@("")),CNT=0
  1. D:$G(PREFIX)'=""
  1. . S CNT=CNT+1
  1. . S RORSEG(5,CNT)=$$ESCAPE^RORHL7(PREFIX)_$S(I'="":BR,1:"")
  1. ;---
  1. F Q:I="" S I1=$O(@ROR8NODE@(I)) D S I=I1
  1. . S TMP=$$ESCAPE^RORHL7(@ROR8NODE@(I))
  1. . S CNT=CNT+1,RORSEG(5,CNT)=$S(I1'="":TMP_BR,1:TMP)
  1. ;---
  1. D:$D(RORSEG(5)) ADDSEG^RORHL7(.RORSEG)
  1. Q
  1. ;
  1. ;***** GENERATES THE RADIOLOGY OBR SEGMENT
  1. ;
  1. ; RORIENS IENS of the radiology record in the file #70.03
  1. ;
  1. ; Return Values:
  1. ; <0 Error code
  1. ; 0 Ok
  1. ; >0 Non-fatal error(s)
  1. ; "S" Skip the record
  1. ;
  1. OBR(RORIENS,RACN0) ;
  1. N BUF,CPTIEN,CS,ERRCNT,IENS,IENS7002,RADTE,RC,RORMSG,ROROUT,RORSEG,TMP
  1. S (ERRCNT,RC)=0
  1. D ECH^RORHL7(.CS)
  1. ;--- Check the parameters
  1. S:$E(RORIENS,$L(RORIENS))'="," RORIENS=RORIENS_","
  1. ;
  1. D GETS^DIQ(70.03,RORIENS,"2;14","IE","ROROUT","RORMSG")
  1. Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,,70.03,RORIENS)
  1. S IENS7002=$P(RORIENS,",",2,3)_","
  1. D GETS^DIQ(70.02,IENS7002,".01;3","EI","ROROUT","RORMSG")
  1. Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,,70.02,IENS7002)
  1. ;
  1. ;--- Initialize the segment
  1. S RORSEG(0)="OBR"
  1. ;
  1. ;--- OBR-3 - Unique Accession #
  1. S BUF=$P(RORIENS,",",2)_"-"_$P(RORIENS,",")
  1. S RADTE=$G(ROROUT(70.02,IENS7002,.01,"I"))\1
  1. S $P(BUF,CS,2)=$E(RADTE,4,7)_$E(RADTE,2,3)_"-"_+RACN0
  1. S RORSEG(3)=BUF
  1. ;
  1. ;--- OBR-4 - Procedure & CPT Code
  1. S IENS=+$G(ROROUT(70.03,RORIENS,2,"I"))_","
  1. Q:IENS'>0 $$ERROR^RORERR(-95,,,,70.03,RORIENS,2)
  1. S CPTIEN=+$$GET1^DIQ(71,IENS,9,"I",,"RORMSG")
  1. Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,,71,IENS)
  1. ;--- Some procedures never have a CPT code. Record a warning
  1. ;--- (only in debug mode) and skip the record.
  1. I CPTIEN'>0 D:$G(RORPARM("DEBUG")) Q "S"
  1. . D ERROR^RORERR(-95,,,,71,IENS,9)
  1. ;---
  1. S TMP=$$CPT^ICPTCOD(CPTIEN)
  1. Q:TMP<0 $$ERROR^RORERR(-56,,$P(TMP,U,2),,+TMP,"$$CPT^ICPTCOD")
  1. S BUF=$P(TMP,U,2)_CS_$$ESCAPE^RORHL7($P(TMP,U,3))_CS_"C4"
  1. ;---
  1. S $P(BUF,CS,4)=$G(ROROUT(70.03,RORIENS,2,"I"))
  1. S $P(BUF,CS,5)=$$ESCAPE^RORHL7($G(ROROUT(70.03,RORIENS,2,"E")))
  1. S $P(BUF,CS,6)="99RAP"
  1. S RORSEG(4)=BUF
  1. ;
  1. ;--- OBR-7 - Exam Date/Time
  1. S TMP=$$FMTHL7^XLFDT($G(ROROUT(70.02,IENS7002,.01,"I")))
  1. Q:TMP'>0 $$ERROR^RORERR(-95,,,,70.02,IENS7002,.01)
  1. S RORSEG(7)=TMP
  1. ;
  1. ;--- OBR-16 - Requesting Physician
  1. S BUF=+$G(ROROUT(70.03,RORIENS,14,"I"))
  1. I BUF>0 D
  1. . S $P(BUF,CS,13)=$$GET1^DIQ(200,+BUF_",",53.5,"E",,"RORMSG")
  1. . I $G(DIERR) D DBS^RORERR("RORMSG",-99,,,200,+BUF_",") Q
  1. . S RORSEG(16)=BUF
  1. ;
  1. ;--- OBR-24 - Service Section ID
  1. S RORSEG(24)="RAD"
  1. ;
  1. ;--- OBR-44 - Division
  1. S RORSEG(44)=$$SITE^RORUTL03(CS)
  1. S IENS=+$G(ROROUT(70.02,IENS7002,3,"I"))_","
  1. I IENS>0 D
  1. . S BUF=$$GET1^DIQ(4,IENS,99,"I",,"RORMSG")
  1. . I $G(DIERR) D DBS^RORERR("RORMSG",-99,,,4,IENS) Q
  1. . Q:BUF=""
  1. . S $P(BUF,CS,2)=$$ESCAPE^RORHL7($G(ROROUT(70.02,IENS7002,3,"E")))
  1. . S $P(BUF,CS,3)="99VA4"
  1. . S RORSEG(44)=BUF
  1. ;
  1. ;--- Store the segment
  1. D ADDSEG^RORHL7(.RORSEG)
  1. Q ERRCNT
  1. ;
  1. ;***** GENERATES THE RADIOLOGY OBX SEGMENT
  1. ;
  1. ; RORIENS IENS of the radiology record in the file #70.03
  1. ;
  1. ; Return Values:
  1. ; <0 Error code
  1. ; 0 Ok
  1. ; >0 Non-fatal error(s)
  1. ;
  1. OBX(RORIENS,IENS74) ;
  1. N CASEIEN,RAENODE,ERRCNT,PTIEN,RC,RFS,RORBUF,RORSEG,RORTXT,TMP
  1. S (ERRCNT,RC)=0
  1. D ECH^RORHL7(.CS)
  1. ;--- Check the parameters
  1. S:$E(RORIENS,$L(RORIENS))'="," RORIENS=RORIENS_","
  1. ;
  1. ;--- Load the data into the ^TMP($J,"RAE2")
  1. S CASEIEN=$P(IENS,","),PTIEN=$P(IENS,",",3)
  1. D EN3^RAO7PC1(PTIEN_U_$P(IENS,",",2)_U_CASEIEN)
  1. S TMP=$O(^TMP($J,"RAE2",PTIEN,CASEIEN,""))
  1. Q:TMP="" $$ERROR^RORERR(-100,,,PTIEN,"Nothing","EN3^RAO7PC1")
  1. S RAENODE=$NA(^TMP($J,"RAE2",PTIEN,CASEIEN,TMP))
  1. ;
  1. ;--- Initialize the segment
  1. S RORSEG(0)="OBX"
  1. ;
  1. ;--- OBX-2
  1. S RORSEG(2)="FT"
  1. ;
  1. ;--- OBX-11
  1. S RORSEG(11)="F"
  1. ;
  1. ;-- Get the Report Text
  1. S TMP=$NA(@RAENODE@("R"))
  1. D:$D(@TMP)>1 LOOP(TMP,"RT"_CS_"Report Text"_CS_"VA080")
  1. ;
  1. ;--- Get the Impression Report
  1. S TMP=$NA(@RAENODE@("I"))
  1. D:$D(@TMP)>1 LOOP(TMP,"IT"_CS_"Impression Text"_CS_"VA080")
  1. ;
  1. ;--- Get the Reason for Study and Clinical History
  1. S TMP=$NA(@RAENODE@("H")),RFS=$G(@RAENODE@("RFS"))
  1. D:($D(@TMP)>1)!(RFS'="")
  1. . S:RFS'="" RFS="Reason for Study: "_RFS
  1. . D LOOP(TMP,"CH"_CS_"Clinical History"_CS_"VA080",RFS)
  1. ;
  1. ;--- Get the Reason for Study (alternative approach)
  1. ;S RORBUF(1)=$G(@RAENODE@("RFS"))
  1. ;D:RORBUF(1)'="" LOOP("RORBUF","RS"_CS_"Reason for Study"_CS_"VA080")
  1. ;
  1. Q ERRCNT