139 lines
5.1 KiB
Mathematica
139 lines
5.1 KiB
Mathematica
|
ROREXPR ;HCIOFO/SG - PREPARATION FOR DATA EXTRACTION ; 11/2/05 8:56am
|
||
|
|
;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
|
||
|
|
;
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
;***** PREPARES VARIABLES FOR DATA EXTRACTION
|
||
|
|
;
|
||
|
|
; .REGLST Reference to a local array containing registry
|
||
|
|
; names as subscripts and registry IENs as values
|
||
|
|
;
|
||
|
|
; [DXBEG] Data extraction start date (individual start
|
||
|
|
; date for each patient by default).
|
||
|
|
; Time part of the parameter value is ignored.
|
||
|
|
;
|
||
|
|
; [DXEND] Data extraction end date (TODAY by default)
|
||
|
|
; Time part of the parameter value is ignored.
|
||
|
|
;
|
||
|
|
; DXBEG and DXEND parameters may be used only for historical data
|
||
|
|
; extraction. Use of these parameters for regular data extraction
|
||
|
|
; process will negatively affect the package!
|
||
|
|
;
|
||
|
|
; This function does not kill the ROREXT("DTAR") node! It just adds
|
||
|
|
; missing data areas to those that are already present in the list.
|
||
|
|
;
|
||
|
|
; Data extraction parameters are aggregated from individual
|
||
|
|
; registry parameters as follow:
|
||
|
|
;
|
||
|
|
; EXTRACT PERIOD FOR NEW PATIENT Maximum
|
||
|
|
; LAG DAYS Maximum
|
||
|
|
; EXTRACTED RESULT Union
|
||
|
|
; MAXIMUM MESSAGE SIZE Minimum
|
||
|
|
;
|
||
|
|
; Return Values:
|
||
|
|
; 0 Ok
|
||
|
|
; <0 Error code
|
||
|
|
;
|
||
|
|
PREPARE(REGLST,DXBEG,DXEND) ;
|
||
|
|
N I,IL,IR,LOINC,NODE,RC,REGIEN,REGNAME,RORBUF,RORMSG,TMP,VAL
|
||
|
|
K RORLRC
|
||
|
|
F TMP="DXBEG","HDTIEN","LD","MAXHL7SIZE","PATCH" K ROREXT(TMP)
|
||
|
|
S DXBEG=$G(DXBEG)\1,DXEND=$G(DXEND)\1
|
||
|
|
;
|
||
|
|
;=== Data areas
|
||
|
|
S NODE=$$ROOT^DILFD(799.33,,1)
|
||
|
|
;--- Validate the existing list
|
||
|
|
S IR=0
|
||
|
|
F S IR=$O(ROREXT("DTAR",IR)) Q:IR'>0 D
|
||
|
|
. I '$D(@NODE@(IR)) K ROREXT("DTAR",IR) Q
|
||
|
|
. S TMP=$G(ROREXT("DTAR",IR))
|
||
|
|
. S:TMP>0 ROREXT("DTAR",IR)=($P(TMP,U)\1)_U_($P(TMP,U,2)\1)
|
||
|
|
;--- Add remaining data areas
|
||
|
|
S IR=0
|
||
|
|
F S IR=$O(@NODE@(IR)) Q:IR'>0 D:'$D(ROREXT("DTAR",IR))
|
||
|
|
. S ROREXT("DTAR",IR)=""
|
||
|
|
;
|
||
|
|
;=== Main data extraction time frame
|
||
|
|
S ROREXT("DXEND")=$S(DXEND>0:DXEND,1:$$DT^XLFDT)
|
||
|
|
I DXBEG>0 S RC=0 D Q:RC<0 RC
|
||
|
|
. S ROREXT("DXBEG")=DXBEG Q:DXBEG'>ROREXT("DXEND")
|
||
|
|
. S RC=$$ERROR^RORERR(-32,,,,DXBEG,ROREXT("DXEND"))
|
||
|
|
;
|
||
|
|
;=== Check if the critical patches are installed
|
||
|
|
F TMP="MD*1.0*1","MC*2.3*34","GMPL*2*30" D
|
||
|
|
. S:$$PATCH^XPDUTL(TMP) ROREXT("PATCH",TMP)=""
|
||
|
|
;
|
||
|
|
;=== Get the package version and the latest patch info
|
||
|
|
S TMP="CLINICAL CASE REGISTRIES"
|
||
|
|
S ROREXT("VERSION")=$$VERSION^XPDUTL(TMP)
|
||
|
|
S TMP=$$LAST^XPDUTL(TMP) D:TMP>0
|
||
|
|
. S $P(ROREXT("VERSION"),U,2)=+TMP
|
||
|
|
. S $P(ROREXT("VERSION"),U,3)=$P(TMP,U,2)
|
||
|
|
;
|
||
|
|
;=== Aggregate registry parameters
|
||
|
|
S REGNAME="",RC=0
|
||
|
|
F S REGNAME=$O(REGLST(REGNAME)) Q:REGNAME="" D Q:RC<0
|
||
|
|
. ;--- Get the registry IEN and parameters
|
||
|
|
. S REGIEN=$$REGIEN^RORUTL02(REGNAME,"7;10;13;13.1;15.1",.RORBUF)
|
||
|
|
. I REGIEN<0 S RC=REGIEN Q
|
||
|
|
. ;--- Extract Period for New Patient
|
||
|
|
. S VAL=+$G(RORBUF("DILIST","ID",1,7))
|
||
|
|
. S:VAL>$G(ROREXT("EXTRDAYS")) ROREXT("EXTRDAYS")=VAL
|
||
|
|
. ;--- Setup the message builder call-back entry point
|
||
|
|
. S VAL=$$TRIM^XLFSTR($G(RORBUF("DILIST","ID",1,10)))
|
||
|
|
. I VAL'="" D Q:RC<0
|
||
|
|
. . S RC=$$VERIFYEP^RORUTL01(VAL)
|
||
|
|
. . I RC<0 D ERROR^RORERR(-44,,REGNAME,,VAL) Q
|
||
|
|
. . S ROREXT("MSGBLD",REGIEN)=VAL
|
||
|
|
. ;--- Use the first available HL7 event protocol if it has not
|
||
|
|
. ;--- been defined before calling the $$PREPARE^ROREXPR
|
||
|
|
. D:$G(ROREXT("HL7PROT"))=""
|
||
|
|
. . S ROREXT("HL7PROT")=$G(RORBUF("DILIST","ID",1,13))
|
||
|
|
. ;--- Load maximum message size and convert it into bytes
|
||
|
|
. ;--- (1 Megabyte = 1024 Kb = 1024 * 1024 = 1048576 bytes)
|
||
|
|
. S VAL=($G(RORBUF("DILIST","ID",1,13.1))*1048576)\1
|
||
|
|
. I VAL>0 D S:(TMP'>0)!(VAL<TMP) ROREXT("MAXHL7SIZE")=VAL
|
||
|
|
. . S TMP=+$G(ROREXT("MAXHL7SIZE"))
|
||
|
|
. ;--- Setup the lag interval (for regular data extraction only)
|
||
|
|
. D:'$G(ROREXT("DXBEG"))
|
||
|
|
. . S VAL=+$G(RORBUF("DILIST","ID",1,15.1))
|
||
|
|
. . S:VAL>$G(ROREXT("LD",1)) ROREXT("LD",1)=VAL
|
||
|
|
. ;--- Load list of codes of extracted Lab results
|
||
|
|
. I $G(RORLRC)'="*" D Q:RC<0
|
||
|
|
. . S TMP=","_REGIEN_","
|
||
|
|
. . D LIST^DIC(798.112,TMP,"@;.01;.02;.03","U",,,,"B",,,,"RORMSG")
|
||
|
|
. . I $G(DIERR) S RC=$$DBS^RORERR("RORMSG",-9,,,798.112,TMP) Q
|
||
|
|
. . Q:$G(^TMP("DILIST",$J,0))'>0
|
||
|
|
. . S (IL,IR,RC)=0
|
||
|
|
. . F S IR=$O(^TMP("DILIST",$J,"ID",IR)) Q:IR="" D Q:RC
|
||
|
|
. . . S LOINC=$G(^TMP("DILIST",$J,"ID",IR,.01))
|
||
|
|
. . . ;--- All results or list of subscripts
|
||
|
|
. . . I LOINC="*" D S RC=1 Q
|
||
|
|
. . . . S VAL=$G(^TMP("DILIST",$J,"ID",IR,.03))
|
||
|
|
. . . . I VAL="" K RORLRC S RORLRC="*" Q
|
||
|
|
. . . . I $G(RORLRC)="" K RORLRC S RORLRC=VAL Q
|
||
|
|
. . . . F I=1:1 S TMP=$P(RORLRC,",",I) Q:(TMP="")!(TMP=VAL)
|
||
|
|
. . . . S:TMP="" RORLRC=RORLRC_","_VAL
|
||
|
|
. . . ;--- Ignore individual codes if any subscripts
|
||
|
|
. . . ;--- (CH, MI, etc.) have been requested already
|
||
|
|
. . . Q:$G(RORLRC)'=""
|
||
|
|
. . . ;--- LOINC
|
||
|
|
. . . I LOINC>0 D Q:RC<0 S IL=IL+1,RORLRC(IL)=TMP_"^LN"
|
||
|
|
. . . . S TMP=$$LNCODE^RORUTL02(LOINC) S:TMP<0 RC=TMP
|
||
|
|
. . . ;--- NLT
|
||
|
|
. . . S TMP=$G(^TMP("DILIST",$J,"ID",IR,.02))
|
||
|
|
. . . S:TMP>0 IL=IL+1,RORLRC(IL)=TMP_"^NLT"
|
||
|
|
D CLEAN^DILF
|
||
|
|
K ^TMP("DILIST",$J)
|
||
|
|
Q:RC<0 RC
|
||
|
|
;
|
||
|
|
;=== Validate parameters
|
||
|
|
I '$G(ROREXT("DXBEG")) S:$G(ROREXT("LD",1))'>0 ROREXT("LD",1)=1
|
||
|
|
;
|
||
|
|
;=== Check the HL7 parameters
|
||
|
|
I $G(ROREXT("HL7PROT"))'="" D Q:RC<0 RC
|
||
|
|
. S RC=$$INIT^RORHL7()
|
||
|
|
;
|
||
|
|
;=== Success
|
||
|
|
Q 0
|