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

ROREXTUT.m

Go to the documentation of this file. 
  1. ROREXTUT ;HCIOFO/SG - DATA EXTRACT UTILITIES  ; 11/25/05 3:57pm
  1.  ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
  1.  ;
  1.  Q
  1.  ;
  1.  ;***** PRINT SOME DEBUG INFORMATION
  1. DEBUG ;
  1.  D ZW^RORUTL01("ROREXT","Control Data")
  1.  D ZW^RORUTL01("RORLRC","Lab Results to extract")
  1.  W !,"Job number: ",$J,!
  1.  Q
  1.  ;
  1.  ;***** ADDS THE TIME FRAME TO THE LIST
  1.  ;
  1.  ; .DXDTS        Reference to a local variable where the
  1.  ;               data extraction time frames are stored.
  1.  ;
  1.  ; STDT          Start date (FileMan)
  1.  ; ENDT          End Date   (FileMan)
  1.  ;
  1.  ; DTAR          Data area code (see the ROR DATA AREA file #799.33)
  1.  ;
  1.  ; [MAIN]        If this parameter defined and not zero, the time
  1.  ;               frame is considered the main one.
  1.  ;
  1.  ; Variants of positional relationship of the existing time frames
  1.  ; and the one that is being added to the list (STDT-ENDT):
  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. DXADD(DXDTS,STDT,ENDT,DTAR,MAIN) ;
  1.  Q:STDT>ENDT
  1.  N DATE,EXIT,TMP
  1.  ;--- Update the main time frame
  1.  I $G(MAIN)  D  S DTAR=0
  1.  . S TMP=+$P(DXDTS,U)
  1.  . S:(TMP'>0)!(STDT<TMP) $P(DXDTS,U,1)=STDT
  1.  . S:ENDT>$P(DXDTS,U,2) $P(DXDTS,U,2)=ENDT
  1.  ;--- Merge the time frames if possible
  1.  S DATE=$O(DXDTS(DTAR,ENDT)),EXIT=0
  1.  F  S DATE=$O(DXDTS(DTAR,DATE),-1)  Q:DATE=""  D  Q:EXIT
  1.  . S TMP=$P(DXDTS(DTAR,DATE),U,2)
  1.  . I TMP<STDT  S EXIT=1  Q          ; (1)
  1.  . S:TMP>ENDT ENDT=TMP              ; (2)
  1.  . S TMP=$P(DXDTS(DTAR,DATE),U)
  1.  . S:TMP<STDT STDT=TMP              ; (3)
  1.  . K DXDTS(DTAR,DATE)
  1.  ;--- Store the new time frame
  1.  S DXDTS(DTAR,STDT)=STDT_U_ENDT
  1.  Q
  1.  ;
  1.  ;***** CALCULATES THE MAIN DATA EXTRACTION TIME FRAME
  1.  ;
  1.  ; .DXDTS        Reference to a local variable where the
  1.  ;               data extraction time frames are stored.
  1.  ;
  1.  ; IEN           IEN of the patient's record in the registry
  1.  ;
  1.  ; Return Values:
  1.  ;        <0  Error Code
  1.  ;         0  Ok
  1.  ;        >0  Skip the patient
  1.  ;
  1.  ; If the special extraction start date for all patients is defined
  1.  ; then it is as the start date of the main time frame. Usually,
  1.  ; this mode is not used. ;-)
  1.  ;
  1.  ; If the field #9.1 of the patient record in the registry (#798)
  1.  ; has a value then this value is used as the start date of the
  1.  ; main time frame (data have already been extracted until that
  1.  ; date). This field is empty for new patients.
  1.  ;
  1.  ; The function tries to get the earliest date when a selection rule
  1.  ; has been triggered for the newly added patient. If the patient has
  1.  ; been added manually and there are no selection rules in the
  1.  ; SELECTION RULE multiple of the registry record then a date when
  1.  ; the patient was added to the registry is used.
  1.  ;
  1.  ; After that, extract period for new patients (value of the field
  1.  ; #7 of the file #798.1) is subtracted from the date and the result
  1.  ; is used as the start date. If the extract period is not set for
  1.  ; the registry then a default value (365) is used.
  1.  ;
  1. DXMAIN(DXDTS,IEN) ;
  1.  N ENDT,IENS,LCH,RC,RORBUF,RORMSG,STDT,TMP
  1.  S (ENDT,STDT)="",IENS=IEN_",",LCH=0
  1.  ;--- Get the registry record data
  1.  D GETS^DIQ(798,IENS,"1;3;3.2;4;5;9.1","I","RORBUF","RORMSG")
  1.  Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,,798,IENS)
  1.  S ENDT=$$FMADD^XLFDT(ROREXT("DXEND"),-$G(ROREXT("LD",1)))
  1.  F TMP=4,5  S:$G(RORBUF(798,IENS,TMP,"I")) LCH=1
  1.  ;--- Empty time frame for patients who are marked for deletion
  1.  I $G(RORBUF(798,IENS,3,"I"))=5  D  Q 0
  1.  . D DXADD(.DXDTS,ENDT,ENDT,0,1)
  1.  ;--- Special start date for ALL patients (if defined)
  1.  S STDT=$G(ROREXT("DXBEG"))
  1.  I STDT'>0  D
  1.  . ;--- Start date from the patient's registry record
  1.  . ;--- (value of the DATA ACKNOWLEDGED UNTIL field)
  1.  . S STDT=$G(RORBUF(798,IENS,9.1,"I"))\1  Q:STDT>0
  1.  . ;--- If value of the DATA ACKNOWLEDGED UNTIL field is missing or
  1.  . ;    not greater than 0, then the patient is considered new and
  1.  . ;    the start date is calculated as date of earliest selection
  1.  . ;    rule minus maximum value of the EXTRACT PERIOD FOR NEW
  1.  . ;--- PATIENT field for all processed registries.
  1.  . S STDT=$G(RORBUF(798,IENS,3.2,"I"))  Q:STDT'>0
  1.  . S TMP=+$G(ROREXT("EXTRDAYS"))
  1.  . S STDT=$$FMADD^XLFDT(STDT,-$S(TMP>0:TMP,1:365))\1
  1.  ;--- Check the dates and add the time frame to the list
  1.  I (STDT'>0)!(ENDT'>0)  D  Q RC
  1.  . S TMP=$$GET1^DIQ(798,IENS,.01,"I",,"RORMSG")
  1.  . S RC=$$ERROR^RORERR(-32,,,TMP,STDT,ENDT)
  1.  S RC=0
  1.  I STDT'<ENDT  S RC=1  S:LCH STDT=ENDT,RC=0
  1.  D:'RC DXADD(.DXDTS,STDT,ENDT,0,1)
  1.  Q RC
  1.  ;
  1.  ;***** MERGES SPECIAL TIME FRAMES INTO THE 'DATA-SPECIFIC' LISTS
  1.  ;
  1.  ; .DXDTS        Reference to a local variable where the
  1.  ;               data extraction time frames are stored.
  1.  ;
  1. DXMERGE(DXDTS) ;
  1.  N DTAR,TMP
  1.  S DTAR=0
  1.  F  S DTAR=$O(ROREXT("DTAR",DTAR))  Q:DTAR'>0  D
  1.  . ;--- Main time frame
  1.  . D DXADD(.DXDTS,$P(DXDTS,U),$P(DXDTS,U,2),DTAR)
  1.  . ;--- Data-specific time frame
  1.  . S TMP=$G(ROREXT("DTAR",DTAR))
  1.  . D:TMP>0 DXADD(.DXDTS,$P(TMP,U),$P(TMP,U,2),DTAR)
  1.  Q
  1.  ;
  1.  ;***** ADDS DATA EXTRACTION PERIODS FOR THE PATIENT TO THE LIST
  1.  ;
  1.  ; .DXDTS        Reference to a local variable that the data
  1.  ;               extraction time frames are added to. The
  1.  ;               main time frame is returned in the root node:
  1.  ;
  1.  ;  DXDTS(         MainStartDate^MainEndDate  (FileMan)
  1.  ;    DataArea,
  1.  ;      i)         StartDate^EndDate          (FileMan)
  1.  ;
  1.  ; IEN           IEN of the patient record in the registry
  1.  ;
  1.  ; PATIEN        Patient IEN
  1.  ;
  1.  ; Return Values:
  1.  ;        <0  Error Code
  1.  ;         0  Ok
  1.  ;        >0  Skip the patient
  1.  ;
  1. DXPERIOD(DXDTS,IEN,PATIEN) ;
  1.  N AREA,ENDT,EVTDT,EVTIEN,NODE,RC,STDT,TMP
  1.  S DXDTS=$G(DXDTS)
  1.  ;
  1.  ;=== Main data extraction time frame
  1.  S RC=$$DXMAIN(.DXDTS,IEN)  Q:RC RC
  1.  ;
  1.  ;=== Data-specific protocols (only Inpatient at present)
  1.  ; The Inpatient protocol is not used anymore because now the
  1.  ; data search is performed on the PTF CLOSE OUT file instead
  1.  ; of the PTF file (after patch ROR*1*8).
  1.  ;S NODE=$NA(^RORDATA(798.3,+PATIEN,2))
  1.  ;F AREA=3  D
  1.  ;. ;--- Browse the events in the main time frame
  1.  ;. S EVTDT=$O(@NODE@("AT",AREA,+DXDTS),-1)
  1.  ;. S ENDT=+$P(DXDTS,U,2)
  1.  ;. F  S EVTDT=$O(@NODE@("AT",AREA,EVTDT))  Q:'EVTDT!(EVTDT'<ENDT)  D
  1.  ;. . S EVTIEN=""
  1.  ;. . F  S EVTIEN=$O(@NODE@("AT",AREA,EVTDT,EVTIEN))  Q:EVTIEN=""  D
  1.  ;. . . S TMP=$P($G(@NODE@(EVTIEN,0)),U,3)\1
  1.  ;. . . D:TMP>0 DXADD(.DXDTS,TMP,$$FMADD^XLFDT(TMP,1),AREA)
  1.  ;
  1.  ;=== Data-specific 'sliding windows'
  1.  D:$G(ROREXT("HDTIEN"))'>0
  1.  . S STDT=$$FMADD^XLFDT($P(DXDTS,U,1),-60)
  1.  . S ENDT=$$FMADD^XLFDT($P(DXDTS,U,2),-60)
  1.  . D DXADD(.DXDTS,STDT,ENDT,7)  ; Autopsy
  1.  ;
  1.  ;=== Merge the main time frame into the data-specific ones
  1.  D DXMERGE(.DXDTS)
  1.  Q 0
  1.  ;
  1.  ;***** UPDATES DATA EXTRACTION PARAMETERS OF THE REGISTRY
  1.  ;
  1.  ; .REGLST       Reference to a local array containing registry names
  1.  ;               as subscripts and optional registry IENs as values
  1.  ;
  1.  ; Return values:
  1.  ;       <0  Error code
  1.  ;        0  Ok
  1.  ;
  1. TMSTMP(REGLST) ;
  1.  N DATE,RC,REGIEN,REGIENS,REGNAME,RORFDA,RORMSG
  1.  S RC=0,DATE=ROREXT("DXEND")\1
  1.  ;---
  1.  S REGNAME=""
  1.  F  S REGNAME=$O(REGLST(REGNAME))  Q:REGNAME=""  D  Q:RC<0
  1.  . ;--- Get the registry IEN
  1.  . S REGIEN=+$G(REGLST(REGNAME))
  1.  . I REGIEN'>0  D  I REGIEN'>0  S RC=+REGIEN  Q
  1.  . . S REGIEN=$$REGIEN^RORUTL02(REGNAME)
  1.  . S REGIENS=REGIEN_","
  1.  . ;--- Do not update timestamp after historical data extractions
  1.  . I $G(ROREXT("HDTIEN"))'>0  D  Q:RC<0
  1.  . . ;--- Check if the new date until that data has been extracted
  1.  . . ;    is greater than that stored in the registry parameters
  1.  . . S TMP=$$GET1^DIQ(798.1,REGIENS,2,"I",,"RORMSG")
  1.  . . I $G(DIERR)  D  Q
  1.  . . . S RC=$$DBS^RORERR("RORMSG",-9,,,798.1,REGIENS)
  1.  . . S:DATE>TMP RORFDA(798.1,REGIENS,2)=DATE
  1.  . ;--- Increment the number of attempts
  1.  . D:$G(ROREXT("NBM"))>0
  1.  . . S TMP=$$GET1^DIQ(798.1,REGIENS,19.3,"I",,"RORMSG")
  1.  . . S RORFDA(798.1,REGIENS,19.3)=TMP+1
  1.  . ;--- Update registry parameters
  1.  . Q:$D(RORFDA)<10
  1.  . D FILE^DIE("K","RORFDA","RORMSG")
  1.  . I $G(DIERR)  D  Q
  1.  . . S RC=$$DBS^RORERR("RORMSG",-9,,,798.1,REGIENS)
  1.  . ;--- Reset all report stats
  1.  . D CLEAR^RORTSK12(REGIEN)
  1.  ;---
  1.  Q $S(RC<0:RC,1:0)