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

RORHL11.m

Go to the documentation of this file. 
  1. RORHL11 ;HOIFO/BH,SG - HL7 CYTOPATHOLOGY 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.  ; #4344         $$CYPATH^LA7UTL02 (controlled)
  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 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.  S IDT=$O(^LR(LRDFN,"CY",STDT))
  1.  F  S IDT=$O(^LR(LRDFN,"CY",IDT),-1)  Q:'IDT!(IDT'>ENDT)  D
  1.  . S:$$OBROBX(IDT) ERRCNT=ERRCNT+1
  1.  Q ERRCNT
  1.  ;
  1.  ;***** SEARCHES FOR CYTOPATHOLOGY 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,RORPTR,RORFILE,HLFS,HLECH) ;
  1.  N ERRCNT,IDX,LRDFN,RC,RORENDT,RORIEN,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(10,IDX))  Q:IDX'>0  D  Q:RC<0
  1.  . S RORSTDT=$P(DXDTS(10,IDX),U),RORENDT=$P(DXDTS(10,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.  ;*****
  1. ICD(RPS) ;
  1.  Q:$D(@RORTMP@("ICD9"))<10
  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.  ;***** CREATES OBR AND OBX SEGMENTS
  1. OBROBX(RORIDT) ;
  1.  N ERRCNT,RC,RORMSG,RORTMP,TMP
  1.  S (ERRCNT,RC)=0
  1.  S RORTMP=$$ALLOC^RORTMP()
  1.  ;---
  1.  I $$CYPATH^LA7UTL02(LRDFN,RORIDT,RORTMP,"RORMSG")  D
  1.  . S RC=$$OBR(RORTMP,RORIDT)
  1.  . I RC  S ERRCNT=ERRCNT+1  Q:RC<0
  1.  . ;---
  1.  . S RC=$$OBX(RORTMP)
  1.  . I RC  S ERRCNT=ERRCNT+1  Q:RC<0
  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,"$$CYPATH^LA7UTL02")
  1.  ;---
  1.  D FREE^RORTMP(RORTMP)
  1.  Q $S(RC<0:RC,1:ERRCNT)
  1.  ;
  1.  ;***** CYTOPATHOLOGY OBR SEGMENT BUILDER
  1.  ;
  1.  ; RORTMP        Closed root of the array holding lab data
  1.  ; RORIEN        IEN of Cyto Visit
  1.  ;
  1.  ; Return Values:
  1.  ;       <0  Error code
  1.  ;        0  Ok
  1.  ;       >0  Non-fatal error(s)
  1.  ;
  1. OBR(RORTMP,RORIEN) ;
  1.  N CS,CPA,ERRCNT,RC,RORSEG,TMP
  1.  S (ERRCNT,RC)=0
  1.  D ECH^RORHL7(.CS)
  1.  ;
  1.  ;--- Initialize the segment
  1.  S RORSEG(0)="OBR"
  1.  ;
  1.  ;--- OBR-3 - Cyto Path Acc #
  1.  S CPA=$P($G(@RORTMP@("DEMO",RORIEN)),U,2)  Q:CPA="" 0
  1.  S RORSEG(3)=CPA
  1.  ;
  1.  ;--- OBR-4
  1.  S RORSEG(4)="88108"_CS_"CYTOPATHOLOGY, CONCENT"_CS_"C4"
  1.  ;
  1.  ;--- OBR-7 - Date/Time Specimen Taken
  1.  S TMP=$$FMTHL7^XLFDT($P(@RORTMP@("DEMO",RORIEN),U))
  1.  I TMP'>0  D  Q RC
  1.  . S RC=$$ERROR^RORERR(-100,,,,"No specimen date","$$CYPATH^LA7UTL02")
  1.  S RORSEG(7)=TMP
  1.  ;
  1.  ;--- OBR-24 - Service Section ID
  1.  S RORSEG(24)="CP"
  1.  ;
  1.  ;--- OBR-44 - Divsion
  1.  S RORSEG(44)=$$SITE^RORUTL03(CS)
  1.  ;
  1.  ;--- Store the segment
  1.  D ADDSEG^RORHL7(.RORSEG)
  1.  Q ERRCNT
  1.  ;
  1.  ;***** CYTOPATHOLOGY OBX SEGMENT BUILDER
  1.  ;
  1.  ; RORTMP        Closed root of the array holding lab data
  1.  ;
  1.  ; Return Values:
  1.  ;       <0  Error code
  1.  ;        0  Ok
  1.  ;       >0  Non-fatal error(s)
  1.  ;
  1. OBX(RORTMP) ;
  1.  N CS,ERRCNT,RC,RPS,TMP
  1.  S (ERRCNT,RC)=0
  1.  D ECH^RORHL7(.CS,,.RPS)
  1.  ;
  1.  D:$D(@RORTMP@("SPEC")) 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.  D SETOBXWP($$SEGID("POPDIAG","Postoperative Diagnosis",CS),"POSTDX")
  1.  D SETOBXWP($$SEGID("MICRO","Microscopic Examination",CS),"MICRO")
  1.  D SETOBXWP($$SEGID("CDIAG","Cytopathology Diagnosis",CS),"CYTODX")
  1.  D ICD(RPS)
  1.  ;
  1.  Q $S(RC<0:RC,1:ERRCNT)
  1.  ;
  1.  ;***** SEARCHES BY COMPLETION (RESULT) DATE
  1. RAD() ;
  1.  N ERRCNT,IDT,RCDT
  1.  S (ERRCNT,IDT)=0
  1.  F  S IDT=$O(^LR(LRDFN,"CY",IDT))  Q:'IDT  D
  1.  . S RCDT=$P($G(^LR(LRDFN,"CY",IDT,0)),U,3)
  1.  . I RCDT'<RORSTDT,RCDT<RORENDT  S:$$OBROBX(IDT) ERRCNT=ERRCNT+1
  1.  Q ERRCNT
  1.  ;
  1.  ;***** CONSTRUCTS SEGMENT IDENTIFIER
  1. SEGID(PONE,PTWO,CS) ; Create segment identifier
  1.  Q PONE_CS_PTWO_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
  1.  S RORSEG(2)="FT"
  1.  ;--- OBX-3
  1.  S RORSEG(3)=OBX3
  1.  ;--- OBX-5
  1.  S RORSEG(5)=$$ESCAPE^RORHL7(OBX5)
  1.  ;--- OBX-11
  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
  1.  ;
  1.  ;***** MAKES SPECIMEN OBX
  1. SPECIMEN ;
  1.  N INDEX,RORSPEC,SPECID
  1.  S SPECID=$$SEGID("SPEC","Specimen",CS)
  1.  S INDEX=""
  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