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

RORHL08.m

Go to the documentation of this file. 
  1. RORHL08 ;HOIFO/BH - HL7 INPATIENT DATA: PV1,OBR ; 3/13/06 9:24am
  1.  ;;1.5;CLINICAL CASE REGISTRIES;**1**;Feb 17, 2006;Build 24
  1.  ;
  1.  ; This routine uses the following IAs:
  1.  ;
  1.  ; #92           Read access to the PTF file (controlled)
  1.  ; #994          Read access to the PTF CLOSE OUT file (controlled)
  1.  ;
  1.  Q
  1.  ;
  1.  ;***** INPATIENT DATA SEGMENT BUILDER
  1.  ;
  1.  ; RORDFN        DFN of Patient Record in File #2
  1.  ;
  1.  ; .DXDTS        Reference to a local variable where the
  1.  ;               data extraction time frames are stored.
  1.  ;
  1.  ; RORTY         Set to either "PV1" or "OBR"
  1.  ;
  1.  ; The ^TMP("RORHL08",$J) global node is used by this function.
  1.  ;
  1.  ; Return Values:
  1.  ;       <0  Error Code
  1.  ;        0  Ok
  1.  ;       >0  Non-fatal error(s)
  1.  ;
  1. EN1(RORDFN,DXDTS,RORTY) ;
  1.  N ERRCNT,IENS,INIEN,PV1CNT,RC,RORMSG,TMP
  1.  S (ERRCNT,RC)=0
  1.  ;
  1.  ;--- PV1 Segments
  1.  I RORTY="PV1"  K ^TMP("RORHL08",$J)  D
  1.  . N DATE,ENDT,IDX,STDT,TYPE,XREF
  1.  . S XREF=$NA(^TMP("RORPTF",$J,"PDI",RORDFN))
  1.  . S (IDX,PV1CNT)=0
  1.  . F  S IDX=$O(DXDTS(3,IDX))  Q:IDX'>0  D  Q:RC<0
  1.  . . S STDT=$P(DXDTS(3,IDX),U),ENDT=$P(DXDTS(3,IDX),U,2)
  1.  . . ;---
  1.  . . S TMP=$$UPDNDX(STDT,ENDT)
  1.  . . I TMP  Q:TMP<0  S ERRCNT=ERRCNT+TMP
  1.  . . ;---
  1.  . . S DATE=$O(@XREF@(STDT),-1)
  1.  . . F  S DATE=$O(@XREF@(DATE))  Q:'DATE!(DATE'<ENDT)  D
  1.  . . . S INIEN=""
  1.  . . . F  S INIEN=$O(@XREF@(DATE,INIEN))  Q:'INIEN  D
  1.  . . . . S IENS=INIEN_","
  1.  . . . . ;--- Skip non-PTF records
  1.  . . . . S TYPE=$$GET1^DIQ(45,IENS,11,"I",,"RORMSG")
  1.  . . . . I $G(DIERR)  D  S ERRCNT=ERRCNT+1  Q
  1.  . . . . . D DBS^RORERR("RORMSG",-9,,RORDFN,45,IENS)
  1.  . . . . Q:TYPE'="1"
  1.  . . . . ;--- Generate the PV1 segment
  1.  . . . . S TMP=$$PV1(INIEN,RORDFN)
  1.  . . . . I TMP  Q:TMP<0  S ERRCNT=ERRCNT+TMP
  1.  . . . . ;--- Reference for the corresponding OBR and OBX segments
  1.  . . . . S:TMP'="S" PV1CNT=PV1CNT+1,^TMP("RORHL08",$J,PV1CNT)=INIEN
  1.  ;
  1.  ;--- OBR and OBX Segments
  1.  I RORTY="OBR"  D  K ^TMP("RORHL08",$J)
  1.  . S PV1CNT=0
  1.  . F  S PV1CNT=$O(^TMP("RORHL08",$J,PV1CNT))  Q:PV1CNT'>0  D
  1.  . . S INIEN=+$G(^TMP("RORHL08",$J,PV1CNT))  Q:INIEN'>0
  1.  . . ;---
  1.  . . S TMP=$$OBR(INIEN,RORDFN)
  1.  . . I TMP  Q:TMP<0  S ERRCNT=ERRCNT+TMP
  1.  . . ;---
  1.  . . S TMP=$$OBX^RORHL081(INIEN,RORDFN)
  1.  . . I TMP  Q:TMP<0  S ERRCNT=ERRCNT+TMP
  1.  ;
  1.  ;--- Check for errors
  1.  Q $S(RC<0:RC,1:ERRCNT)
  1.  ;
  1.  ;***** MERGES THE TIME FRAME INTO THE LIST
  1.  ;
  1.  ; .DXDTS        Reference to a local array where the time frames
  1.  ;               are returned: DXDTS(StartDT)=StartDT^EndDT.
  1.  ;
  1.  ; STDT          Start date
  1.  ; ENDT          End date
  1.  ;
  1.  ; This procedure merges the provided time frame [STDT,ENDT[ into
  1.  ; the list stored in the ^TMP("RORPTF",$J,"DTF") global node and
  1.  ; returns a list of time frames that should be updated into a
  1.  ; local array defined by the DXDTS parameter.
  1.  ;
  1.  ; Variants of positional relationship of the existing time frames
  1.  ; and the one that is being added to the list:
  1.  ;
  1.  ; (1)  +--------TMP                      +----------+
  1.  ;                     STDT--------ENDT
  1.  ;
  1.  ; (2)           +--------TMP
  1.  ;      STDT--------ENDT
  1.  ;
  1.  ; (3)  TMP--------+
  1.  ;           STDT--------ENDT
  1.  ;
  1.  ; (4)         +--------+
  1.  ;      STDT------------------ENDT
  1.  ;
  1. MERGEDTF(DXDTS,STDT,ENDT) ;
  1.  N DATE,DXE,DXS,ENDT0,EXIT,STDT0,TMP  K DXDTS
  1.  Q:STDT>ENDT
  1.  S STDT0=STDT,(DXE,ENDT0)=ENDT
  1.  ;--- Merge time frames if possible
  1.  S DATE=$O(^TMP("RORPTF",$J,"DTF",ENDT)),EXIT=0
  1.  F  S DATE=$O(^TMP("RORPTF",$J,"DTF",DATE),-1)  Q:DATE=""  D  Q:EXIT
  1.  . S DXS=$P(^TMP("RORPTF",$J,"DTF",DATE),U,2)
  1.  . I DXS<STDT  S EXIT=1  Q         ; (1)
  1.  . S:DXS>ENDT ENDT=DXS,DFLT=0      ; (2)
  1.  . S:DXS<DXE DXDTS(DXS)=DXS_U_DXE
  1.  . S DXE=$P(^TMP("RORPTF",$J,"DTF",DATE),U)
  1.  . S:DXE<STDT STDT=DXE,DFLT=0      ; (3)
  1.  . K ^TMP("RORPTF",$J,"DTF",DATE)
  1.  S:DXE>STDT0 DXDTS(STDT0)=STDT0_U_DXE
  1.  ;--- Store the new time frame
  1.  S ^TMP("RORPTF",$J,"DTF",STDT)=STDT_U_ENDT
  1.  Q
  1.  ;
  1.  ;***** OBR SEGMENT BUILDER (INPATIENT)
  1.  ;
  1.  ; RORIEN        IEN of file #45
  1.  ;
  1.  ; RORDFN        DFN of Patient Record in File #2
  1.  ;
  1.  ; Return Values:
  1.  ;       <0  Error Code
  1.  ;        0  Ok
  1.  ;       >0  Non-fatal error(s)
  1.  ;
  1. OBR(RORIEN,RORDFN) ;
  1.  N CS,ERRCNT,IENS,OBDT,RC,RORMSG,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 - Order Number (IEN in the PTF file #45)
  1.  S RORSEG(3)=RORIEN
  1.  ;
  1.  ;--- OBR-4 - Universal Service ID
  1.  S RORSEG(4)="IP"_CS_"Inpatient"_CS_"C4"
  1.  ;
  1.  ;--- OBR-7 -Observation Date/Time (Admission Date/Time) *KEY*
  1.  S IENS=RORIEN_","
  1.  S OBDT=$$GET1^DIQ(45,IENS,2,"I",,"RORMSG")
  1.  Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,RORDFN,45,IENS)
  1.  ;---
  1.  S OBDT=$$FMTHL7^XLFDT(OBDT)
  1.  Q:OBDT'>0 $$ERROR^RORERR(-95,,,RORDFN,45,IENS,2)
  1.  S RORSEG(7)=OBDT
  1.  ;
  1.  ;--- OBR-24 - Diagnostic Service ID
  1.  S RORSEG(24)="PHY"
  1.  ;
  1.  ;--- OBR-44 - Division
  1.  S RORSEG(44)=$$SITE^RORUTL03(CS)
  1.  ;
  1.  ;--- Store the segment
  1.  D ADDSEG^RORHL7(.RORSEG)
  1.  Q ERRCNT
  1.  ;
  1.  ;***** PV1 SEGMENT BUILDER (INPATIENT)
  1.  ;
  1.  ; RORIEN        IEN of file #45
  1.  ;
  1.  ; RORDFN        DFN of Patient Record in File #2
  1.  ;
  1.  ; Return Values:
  1.  ;       <0  Error Code
  1.  ;        0  Ok
  1.  ;      "S"  No inpatient data
  1.  ;       >0  Non-fatal error(s)
  1.  ;
  1. PV1(RORIEN,RORDFN) ;
  1.  N BUF,CS,ERRCNT,IENS,RC,RORBUF,RORMSG,RORSEG,TMP
  1.  S (ERRCNT,RC)=0
  1.  D ECH^RORHL7(.CS)
  1.  ;
  1.  ;--- Load the data
  1.  S IENS=RORIEN_","
  1.  D GETS^DIQ(45,IENS,"2;70;71;72","I","RORBUF","RORMSG")
  1.  I $G(DIERR)  D  S ERRCNT=ERRCNT+1
  1.  . D DBS^RORERR("RORMSG",-9,,RORDFN,45,IENS)
  1.  ;
  1.  ;--- Initialize the segment
  1.  S RORSEG(0)="PV1"
  1.  ;
  1.  ;--- PV1-2 - Patient Class
  1.  S RORSEG(2)="I"  ; I - Inpatient
  1.  ;
  1.  ;--- PV1-3 - Assigned Patient Location (Station Number)
  1.  S TMP=$E($P($$SITE^VASITE,U,3),1,3)  ; Strip the suffix
  1.  Q:TMP'>0 $$ERROR^RORERR(-100,,,,"No station number","$$SITE^VASITE")
  1.  S RORSEG(3)=TMP
  1.  ;
  1.  ;--- PV1-6 - Prior Patient Location (Bed Section at Discharge)
  1.  I $G(RORBUF(45,IENS,71,"I"))>0  D
  1.  . S BUF=""
  1.  . S $P(BUF,CS,3)=RORBUF(45,IENS,71,"I")  ; Bed Section IEN
  1.  . S TMP=$$EXTERNAL^DILFD(45,71,,$P(BUF,CS,3),"RORMSG")
  1.  . I $G(DIERR)  D  S ERRCNT=ERRCNT+1  Q
  1.  . . D DBS^RORERR("RORMSG",-99,,RORDFN,45,IENS)
  1.  . S $P(BUF,CS,9)=$$ESCAPE^RORHL7(TMP)    ; Bed Section Name
  1.  . S RORSEG(6)=BUF
  1.  ;
  1.  ;--- PV1-19 - Visit Number (IEN in the PTF file #45) *KEY*
  1.  S RORSEG(19)=RORIEN
  1.  ;
  1.  ;--- PV1-36 - Discharge Disposition
  1.  S RORSEG(36)=$G(RORBUF(45,IENS,72,"I"))
  1.  ;
  1.  ;--- PV1-44 - Admit Date/Time *KEY*
  1.  S TMP=$$FMTHL7^XLFDT($G(RORBUF(45,IENS,2,"I")))
  1.  Q:TMP'>0 $$ERROR^RORERR(-95,,,RORDFN,45,IENS,2)
  1.  S RORSEG(44)=TMP
  1.  ;
  1.  ;--- PV1-45 - Discharge Date/Time
  1.  S RORSEG(45)=$$FM2HL^RORHL7($G(RORBUF(45,IENS,70,"I")))
  1.  ;
  1.  ;--- Store the segment
  1.  D ADDSEG^RORHL7(.RORSEG)
  1.  Q ERRCNT
  1.  ;
  1.  ;***** UPDATES TEMPORARY PTF INDEX
  1.  ;
  1.  ; STDT          Start date
  1.  ; ENDT          End date
  1.  ;
  1.  ; This function updates the temporary PTF index with records
  1.  ; closed in the provided time frame.
  1.  ;
  1.  ; Return Values:
  1.  ;       <0  Error Code
  1.  ;        0  Ok
  1.  ;
  1. UPDNDX(STDT,ENDT) ;
  1.  N DATE,DXDTS,IDX,IEN,PATIEN,RC,RORMSG,TMP
  1.  ;--- Get time frames that should be processed
  1.  D MERGEDTF(.DXDTS,STDT,ENDT)  Q:$D(DXDTS)<10 0
  1.  ;--- Update the index
  1.  S IDX=0
  1.  F  S IDX=$O(DXDTS(IDX))  Q:IDX'>0  D
  1.  . S STDT=$P(DXDTS(IDX),U),ENDT=$P(DXDTS(IDX),U,2)
  1.  . S DATE=$O(^DGP(45.84,"AC",STDT),-1)
  1.  . F  S DATE=$O(^DGP(45.84,"AC",DATE))  Q:'DATE!(DATE'<ENDT)  D
  1.  . . S IEN=0
  1.  . . F  S IEN=$O(^DGP(45.84,"AC",DATE,IEN))  Q:IEN'>0  D
  1.  . . . ;--- Patient IEN (entries of file #45.84 are DINUM'ed)
  1.  . . . S PATIEN=$$GET1^DIQ(45,IEN,.01,"I",,"RORMSG")
  1.  . . . I $G(DIERR)  D DBS^RORERR("RORMSG",-99,,,45,IEN)  Q
  1.  . . . ;--- Create index entry
  1.  . . . S:PATIEN>0 ^TMP("RORPTF",$J,"PDI",PATIEN,DATE,IEN)=""
  1.  ;---
  1.  Q 0