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