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