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