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

RORHL10.m

Go to the documentation of this file. 
  1. RORHL10 ;HOIFO/BH - HL7 SURGICAL PATHOLOGY DATA: OBR,OBX ;3/13/06 9:24am
  1.  ;;1.5;CLINICAL CASE REGISTRIES;**1,19**;Feb 17, 2006;Build 43
  1.  ;
  1.  ; This routine uses the following IAs:
  1.  ;
  1.  ; #525          Read access to the multiple #63.08 (controlled)
  1.  ; #4343         $$SPATH^LA7UTL03 (controlled)
  1.  ; #10040        ^SC("B" (supported)
  1.  ;
  1.  ;******************************************************************************
  1.  ;******************************************************************************
  1.  ; --- ROUTINE MODIFICATION LOG ---
  1.  ; 
  1.  ;PKG/PATCH   DATE       DEVELOPER   MODIFICATION
  1.  ;----------- ---------- ----------- ----------------------------------------
  1.  ;ROR*1.5*19  MAY 2012   K GUPTA     Support for ICD-10 Coding System.
  1.  ;
  1.  ;******************************************************************************
  1.  ;******************************************************************************
  1.  Q
  1.  ;
  1.  ;***** SEARCHES FOR SURGICAL PATHOLOGY 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.  ; [CDSMODE]     Search the data by:
  1.  ;                 0  completion/result date (default)
  1.  ;                 1  specimen collection date
  1.  ;
  1.  ; Return Values:
  1.  ;       <0  Error code
  1.  ;        0  Ok
  1.  ;       >0  Non-fatal error(s)
  1.  ;
  1. EN1(RORDFN,DXDTS,CDSMODE) ;
  1.  N ERRCNT,IDX,LRDFN,RC,RORENDT,RORSTDT
  1.  S (ERRCNT,RC)=0
  1.  ;
  1.  S LRDFN=+$$LABREF^RORUTL18(RORDFN)  Q:LRDFN'>0 0
  1.  ;
  1.  S IDX=0
  1.  F  S IDX=$O(DXDTS(9,IDX))  Q:IDX'>0  D  Q:RC<0
  1.  . S RORSTDT=$P(DXDTS(9,IDX),U),RORENDT=$P(DXDTS(9,IDX),U,2)
  1.  . ;---
  1.  . S RC=$S($G(CDSMODE):$$CD(),1:$$RAD())
  1.  . S:RC>0 ERRCNT=ERRCNT+RC
  1.  ;
  1.  Q $S(RC<0:RC,1:ERRCNT)
  1.  ;
  1.  ;***** SEARCHES BY SPECIMEN COLLECTION DATE
  1. CD() ;
  1.  N ENDT,ERRCNT,IDT,STDT
  1.  S ERRCNT=0
  1.  S STDT=9999999-RORSTDT
  1.  S ENDT=9999999-RORENDT
  1.  ;---
  1.  S IDT=$O(^LR(LRDFN,"SP",STDT))
  1.  F  S IDT=$O(^LR(LRDFN,"SP",IDT),-1)  Q:'IDT!(IDT'>ENDT)  D
  1.  . S:$$OBROBX(IDT,LRDFN) ERRCNT=ERRCNT+1
  1.  Q ERRCNT
  1.  ;
  1.  ;***** SEARCHES BY COMPLETION (RESULT) DATE
  1. RAD() ;
  1.  N ERRCNT,IDT,RCDT
  1.  S ERRCNT=0
  1.  ;---
  1.  S IDT=0
  1.  F  S IDT=$O(^LR(LRDFN,"SP",IDT))  Q:IDT'>0  D
  1.  . S RCDT=$P($G(^LR(LRDFN,"SP",IDT,0)),U,3)
  1.  . I RCDT'<RORSTDT,RCDT<RORENDT  S:$$OBROBX(IDT,LRDFN) ERRCNT=ERRCNT+1
  1.  Q ERRCNT
  1.  ; 
  1.  ;***** CREATES OBR AND OBX SEGMENTS
  1. OBROBX(RORIDT,LRDFN) ;
  1.  N ERRCNT,RC
  1.  S ERRCNT=0
  1.  ;---
  1.  S RC=$$OBR(RORIDT_","_LRDFN_",")
  1.  I RC  S ERRCNT=ERRCNT+1  Q:RC<0 RC
  1.  ;---
  1.  S RC=$$OBX(LRDFN,RORIDT)
  1.  I RC  S ERRCNT=ERRCNT+1  Q:RC<0 RC
  1.  ;---
  1.  Q ERRCNT
  1.  ;
  1.  ;***** OBR SEGMENT BUILDER
  1.  ;
  1.  ; RORIENS       IENS of SP Entry
  1.  ;
  1.  ; Return Values:
  1.  ;       <0  Error code
  1.  ;        0  Ok
  1.  ;       >0  Non-fatal error(s)
  1.  ;
  1. OBR(RORIENS) ;
  1.  N CS,ERRCNT,FLDS,IEN,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.  ;--- Load the data (with a temporary fix for invalid
  1.  ;--- output transform of the .01 field - ROR*1*8)
  1.  D GETS^DIQ(63.08,RORIENS,".01","I","ROROUT","RORMSG")
  1.  I $G(DIERR)  D  S ERRCNT=ERRCNT+1
  1.  . D DBS^RORERR("RORMSG",-9,,,63.08,RORIENS)
  1.  D GETS^DIQ(63.08,RORIENS,".03;.06;.07;.08","IE","ROROUT","RORMSG")
  1.  I $G(DIERR)  D  S ERRCNT=ERRCNT+1
  1.  . D DBS^RORERR("RORMSG",-9,,,63.08,RORIENS)
  1.  ;
  1.  ;--- Initialize the segment
  1.  S RORSEG(0)="OBR"
  1.  ;
  1.  ;--- OBR-3 - Surgical Pathology Acc #
  1.  I $G(ROROUT(63.08,RORIENS,.06,"E"))=""  D  Q RC
  1.  . S RC=$$ERROR^RORERR(-95,,,,63.08,RORIENS,.06)
  1.  S RORSEG(3)=ROROUT(63.08,RORIENS,.06,"E")
  1.  ;
  1.  ;--- OBR-4 - SP CPT Code
  1.  S RORSEG(4)="88300"_CS_"LEVEL I - SURGICAL PAT"_CS_"C4"
  1.  ;
  1.  ;--- OBR-7 - Date/Time Specimen Taken
  1.  S TMP=$$FMTHL7^XLFDT($G(ROROUT(63.08,RORIENS,.01,"I")))
  1.  Q:TMP'>0 $$ERROR^RORERR(-95,,,,63.08,RORIENS,.01)
  1.  S RORSEG(7)=TMP
  1.  ;
  1.  ;--- OBR-8 - Date Report Completed
  1.  S TMP=$G(ROROUT(63.08,RORIENS,.03,"I"))
  1.  S RORSEG(8)=$$FM2HL^RORHL7(TMP)
  1.  ;
  1.  ;--- OBR-16 - Surgeon/Physican
  1.  S RORSEG(16)=$G(ROROUT(63.08,RORIENS,.07,"I"))
  1.  ;
  1.  ;--- OBR-24 - Service Section ID
  1.  S RORSEG(24)="SP"
  1.  ;
  1.  ; OBR-44 - Divsion
  1.  S TMP=$G(ROROUT(63.08,RORIENS,.08,"I"))
  1.  S IEN=$S(TMP'="":+$O(^SC("B",TMP,0)),1:0)
  1.  S RORSEG(44)=$$DIV44^RORHLUT1(IEN,CS)
  1.  ;
  1.  ;--- Store the segment
  1.  D ADDSEG^RORHL7(.RORSEG)
  1.  Q ERRCNT
  1.  ;
  1.  ;***** OBX SEGMENT BUILDER
  1.  ;
  1.  ; LRDFN         Patient Lab DFN
  1.  ; RORIENS       IENS of SP Entry
  1.  ;
  1.  ; Return Values:
  1.  ;       <0  Error code
  1.  ;        0  Ok
  1.  ;       >0  Non-fatal error(s)
  1.  ;
  1. OBX(LRDFN,RORIENS) ;
  1.  N CS,ERRCNT,RC,RORMSG,ROROUT,RORSEG,RORTMP,RPS,TMP
  1.  S (ERRCNT,RC)=0
  1.  D ECH^RORHL7(.CS,,.RPS)
  1.  S RORTMP=$$ALLOC^RORTMP()
  1.  ;---
  1.  I $$SPATH^LA7UTL03(LRDFN,RORIENS,RORTMP,"RORMSG")  D
  1.  . D SPECIMEN
  1.  . D SETOBXWP($$SEGID("BCH","Brief clinical History",CS),"CHIS")
  1.  . D SETOBXWP($$SEGID("PDIAG","Preoperative Diagnosis",CS),"PREDX")
  1.  . D SETOBXWP($$SEGID("OF","Operative Findings",CS),"OPERDX")
  1.  . S TMP=$$SEGID("POPDIAG","Postoperative Diagnosis",CS)
  1.  . D SETOBXWP(TMP,"POSTDX")
  1.  . D SETOBXWP($$SEGID("GDESC","Gross Decription",CS),"GROSSD")
  1.  . D SETOBXWP($$SEGID("MDESC","Microscopic Description",CS),"MICROD")
  1.  . S TMP=$$SEGID("SPDIAG","Surgical Pathology Diagnosis",CS)
  1.  . D SETOBXWP(TMP,"SURGP")
  1.  . D ICD(RPS)
  1.  E  D:$D(RORMSG)>1
  1.  . N I,INFO  S TMP=""
  1.  . F I=1:1  S TMP=$O(RORMSG(TMP))  Q:TMP=""  S INFO(I)=RORMSG(TMP)
  1.  . S RC=$$ERROR^RORERR(-56,,.INFO,,0,"$$SPATH^LA7UTL03")
  1.  ;---
  1.  D FREE^RORTMP(RORTMP)
  1.  Q $S(RC<0:RC,1:ERRCNT)
  1.  ;
  1.  ;***** MAKES SPECIMEN OBX
  1. SPECIMEN ;
  1.  N INDEX,RORSPEC,SPECID
  1.  S INDEX="",SPECID=$$SEGID("SPEC","Specimen",CS)
  1.  F  S INDEX=$O(@RORTMP@("SPEC",INDEX))  Q:INDEX=""  D
  1.  . S RORSPEC=$G(@RORTMP@("SPEC",INDEX))
  1.  . D:RORSPEC'="" SETOBX(SPECID,RORSPEC)
  1.  Q
  1.  ;
  1.  ;***** ICD Codes
  1. ICD(RPS) ;
  1.  N CNT,ICDID,INDEX,RORICD,TMP,RORICDSNAM
  1.  S ICDID=$$SEGID("ICD","ICD",CS)
  1.  S (INDEX,RORICD,RORICDSNAM)="",CNT=0
  1.  F  S INDEX=$O(@RORTMP@("ICD9",INDEX))  Q:INDEX=""  D
  1.  . S TMP=$G(@RORTMP@("ICD9",INDEX)) Q:TMP=""
  1.  . S CNT=CNT+1,$P(RORICD,RPS,CNT)=TMP
  1.  . S:RORICDSNAM="" RORICDSNAM=$$CSNAME^RORHLUT1(80,INDEX)
  1.  D:RORICD'="" SETOBX(ICDID,RORICDSNAM_":"_RORICD)
  1.  Q
  1.  ;
  1.  ;***** CONSTRUCTS SEGMENT IDENTIFIER
  1. SEGID(CODE,NAME,CS) ;
  1.  Q CODE_CS_NAME_CS_"VA080"
  1.  ;
  1.  ;***** CREATE AND STORE THE OBX SEGMENTS
  1. SETOBX(OBX3,OBX5) ;
  1.  N RORSEG
  1.  ;--- Initialize the segment
  1.  S RORSEG(0)="OBX"
  1.  ;--- OBX-2 - Value Type
  1.  S RORSEG(2)="FT"
  1.  ;--- OBX-3 - Observation Identifier
  1.  S RORSEG(3)=OBX3
  1.  ;--- OBX-5 - Observation Value
  1.  S RORSEG(5)=$$ESCAPE^RORHL7(OBX5)
  1.  ;--- OBX-11 - Observation Result Status
  1.  S RORSEG(11)="F"
  1.  ;--- Store the segment
  1.  D ADDSEG^RORHL7(.RORSEG)
  1.  Q
  1.  ;
  1. SETOBXWP(OBX3,SUBS) ;
  1.  N BR,CNT,I,I1,RORSEG,TMP
  1.  S BR=$E(HLECH,3)_".br"_$E(HLECH,3)
  1.  Q:$D(@RORTMP@(SUBS))<10
  1.  ;--- Initialize the segment
  1.  S RORSEG(0)="OBX"
  1.  ;--- OBX-2 - Value Type
  1.  S RORSEG(2)="FT"
  1.  ;--- OBX-3 - Observation Identifier
  1.  S RORSEG(3)=OBX3
  1.  ;--- OBX-5 - Observation Value
  1.  S I=$O(@RORTMP@(SUBS,"")),CNT=0
  1.  F  Q:I=""  S I1=$O(@RORTMP@(SUBS,I))  D  S I=I1
  1.  . S TMP=$$ESCAPE^RORHL7(@RORTMP@(SUBS,I))
  1.  . S CNT=CNT+1,RORSEG(5,CNT)=$S(I1'="":TMP_BR,1:TMP)
  1.  ;--- OBX-11 - Observation Result Status
  1.  S RORSEG(11)="F"
  1.  ;--- Store the segment
  1.  D:$D(RORSEG(5)) ADDSEG^RORHL7(.RORSEG)
  1.  Q