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

RORHL05.m

Go to the documentation of this file.
  1. RORHL05 ;HOIFO/CRT - HL7 AUTOPSY: OBR ; 3/13/06 9:23am
  1. ;;1.5;CLINICAL CASE REGISTRIES;**1**;Feb 17, 2006;Build 24
  1. ;
  1. ; This routine uses the following IAs:
  1. ;
  1. ; #1995 $$CPT^ICPTCOD (supported)
  1. ; #3465 Access to autopsy data (private)
  1. ; #10040 Read the INSTITUTION field of file #44 (supported)
  1. ; #10090 Read access to the file #4 (supported)
  1. ;
  1. Q
  1. ;
  1. ;***** SEARCHES FOR AUTOPSY 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. ; [FORCE] Force the extraction of the autopsy data
  1. ;
  1. ; Return Values:
  1. ; <0 Error code
  1. ; 0 Ok
  1. ; >0 Non-fatal error(s)
  1. ;
  1. EN1(RORDFN,DXDTS,FORCE) ;
  1. N ADATE,ERRCNT,RC,RORLRDFN,RORMSG
  1. S (ERRCNT,RC)=0
  1. ;
  1. ;--- Check if the autopsy has been performed
  1. S RORLRDFN=+$$LABREF^RORUTL18(RORDFN) Q:RORLRDFN'>0 0
  1. S ADATE=$$GET1^DIQ(63,RORLRDFN_",",11,"I",,"RORMSG")
  1. Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,RORDFN,63,RORLRDFN_",")
  1. ;
  1. D:ADATE>0
  1. . ;--- Check if the autopsy data should be sent (autopsy date
  1. . ; falls into one of the data extraction time frames or
  1. . ;--- the extraction if forced by the function parameter).
  1. . I '$G(FORCE) S RC=0 D Q:'RC
  1. . . N D1,D2,IDX
  1. . . S IDX=0
  1. . . F S IDX=$O(DXDTS(7,IDX)) Q:IDX'>0 D Q:RC
  1. . . . S D1=$P(DXDTS(7,IDX),U),D2=$P(DXDTS(7,IDX),U,2)
  1. . . . S:(ADATE'<D1)&(ADATE<D2) RC=1
  1. . .
  1. . ;--- Send the data
  1. . S RC=$$OBR(RORLRDFN)
  1. . I RC Q:RC<0 S ERRCNT=ERRCNT+RC
  1. . S RC=$$OBX(RORLRDFN)
  1. . I RC Q:RC<0 S ERRCNT=ERRCNT+RC
  1. ;
  1. Q $S(RC<0:RC,1:ERRCNT)
  1. ;
  1. ;***** AUTOPSY OBR SEGMENT BUILDER
  1. ;
  1. ; RORLRDFN IEN of Lab Patient Record in File #63
  1. ;
  1. ; Return Values:
  1. ; <0 Error code
  1. ; 0 Ok
  1. ; >0 Non-fatal error(s)
  1. ;
  1. OBR(RORLRDFN) ;
  1. N BUF,CS,ERRCNT,IEN,IENS63,RC,RORMSG,ROROUT,RORSEG,TMP
  1. S (ERRCNT,RC)=0
  1. D ECH^RORHL7(.CS)
  1. ;
  1. S IENS63=+$G(RORLRDFN)_","
  1. D GETS^DIQ(63,IENS63,"11;12.1;13.1;14;14.1;14.5;14.7","IE","ROROUT","RORMSG")
  1. I $G(DIERR) D S ERRCNT=ERRCNT+1
  1. . D DBS^RORERR("RORMSG",-9,,,63,IENS63)
  1. ;
  1. ;--- Initialize the segment
  1. S RORSEG(0)="OBR"
  1. ;
  1. ;--- OBR-3 - Order #
  1. I $G(ROROUT(63,IENS63,14,"E"))="" D Q RC
  1. . S RC=$$ERROR^RORERR(-95,,,,63,IENS63,14)
  1. S RORSEG(3)=ROROUT(63,IENS63,14,"E")
  1. ;
  1. ;--- OBR-4 - CPT Code
  1. S BUF=88099,TMP=$$CPT^ICPTCOD(BUF)
  1. I TMP<0 D S ERRCNT=ERRCNT+1,TMP=""
  1. . D ERROR^RORERR(-57,,$P(TMP,U,2),,+TMP,"$$CPT^ICPTCOD")
  1. S $P(BUF,CS,2)=$$ESCAPE^RORHL7($P(TMP,U,3))
  1. S $P(BUF,CS,3)="C4"
  1. S RORSEG(4)=BUF
  1. ;
  1. ;--- OBR-7 - Autopsy Date/Time
  1. S TMP=$$FMTHL7^XLFDT($G(ROROUT(63,IENS63,11,"I")))
  1. Q:TMP'>0 $$ERROR^RORERR(-95,,,,63,IENS63,11)
  1. S RORSEG(7)=TMP
  1. ;
  1. ;--- OBR-8 - Date of the final autopsy diagnoses
  1. S RORSEG(8)=$$FMTHL7^XLFDT($G(ROROUT(63,IENS63,13.1,"I")))
  1. ;
  1. ;--- OBR-16 - Ordering Provider
  1. S RORSEG(16)=$G(ROROUT(63,IENS63,12.1,"I"))
  1. ;
  1. ;--- OBR-22 - Date/TIme the report is released
  1. S RORSEG(22)=$$FMTHL7^XLFDT($G(ROROUT(63,IENS63,14.7,"I")))
  1. ;
  1. ;--- OBR-24 - Diagnostic Service ID
  1. S RORSEG(24)="SP"
  1. ;
  1. ;--- OBR-44 - Division
  1. S TMP=$G(ROROUT(63,IENS63,14.1,"I"))
  1. S IEN=$S(TMP'="":+$O(^SC("B",TMP,0)),1:0)
  1. S RORSEG(44)=$$DIV44^RORHLUT1(IEN,CS)
  1. ;
  1. ;--- OBR-46 - Service
  1. S BUF=+$G(ROROUT(63,IENS63,14.5,"I"))
  1. D:BUF>0
  1. . S $P(BUF,CS,2)=$G(ROROUT(63,IENS63,14.5,"E"))
  1. . S RORSEG(46)=BUF
  1. ;
  1. ;--- Store the segment
  1. D ADDSEG^RORHL7(.RORSEG)
  1. Q ERRCNT
  1. ;
  1. ;***** AUTOPSY OBX SEGMENT BUILDER
  1. ;
  1. ; RORLRDFN IEN of Lab Patient Record in File #63
  1. ;
  1. ; Return Values:
  1. ; <0 Error code
  1. ; 0 Ok
  1. ; >0 Non-fatal error(s)
  1. ;
  1. OBX(RORLRDFN) ;
  1. ;;32.2;;AUCD^Clinical Diagnosis^VA080
  1. ;;32.3;;AUPD^Pathological Diagnosis^VA080
  1. ;
  1. N BR,BUF,CS,ERRCNT,FLD,I,I1,ICNT,IENS63,IMF,RC,RORMSG,RORSEG,RORTXT,TMP
  1. S (ERRCNT,RC)=0
  1. D ECH^RORHL7(.CS)
  1. S BR=$E(HLECH,3)_".br"_$E(HLECH,3)
  1. ;
  1. ;--- Initialize the segment
  1. S RORSEG(0)="OBX"
  1. ;
  1. ;--- OBX-2 - Value Type
  1. S RORSEG(2)="FT"
  1. ;
  1. ;--- OBX-11 - Observation Result Status
  1. S RORSEG(11)="F"
  1. ;
  1. ;--- Generate the OBX segments
  1. S IENS63=+$G(RORLRDFN)_","
  1. F IMF=1,2 D
  1. . S BUF=$T(OBX+IMF),FLD=$P(BUF,";;",2)
  1. . K RORMSG,RORTXT,RORSEG(5)
  1. . ;--- OBX-3 - Observation Identifier
  1. . S RORSEG(3)=$P(BUF,";;",3)
  1. . ;--- Load the text
  1. . S TMP=$$GET1^DIQ(63,IENS63,FLD,,"RORTXT","RORMSG")
  1. . I $G(DIERR) D S ERRCNT=ERRCNT+1
  1. . . D DBS^RORERR("RORMSG",-9,,,63,IENS63)
  1. . ;--- Process the text
  1. . S I=$O(RORTXT("")),ICNT=0
  1. . F Q:I="" S I1=$O(RORTXT(I)) D S I=I1
  1. . . ;--- OBX-5 - Observation Value
  1. . . S TMP=$$ESCAPE^RORHL7(RORTXT(I))
  1. . . S ICNT=ICNT+1,RORSEG(5,ICNT)=$S(I1'="":TMP_BR,1:TMP)
  1. . ;--- Store the segment
  1. . D:ICNT>0 ADDSEG^RORHL7(.RORSEG)
  1. ;
  1. ;---
  1. Q ERRCNT