| [613] | 1 | ROREXPR ;HCIOFO/SG - PREPARATION FOR DATA EXTRACTION ; 11/2/05 8:56am
|
|---|
| 2 | ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
|
|---|
| 3 | ;
|
|---|
| 4 | Q
|
|---|
| 5 | ;
|
|---|
| 6 | ;***** PREPARES VARIABLES FOR DATA EXTRACTION
|
|---|
| 7 | ;
|
|---|
| 8 | ; .REGLST Reference to a local array containing registry
|
|---|
| 9 | ; names as subscripts and registry IENs as values
|
|---|
| 10 | ;
|
|---|
| 11 | ; [DXBEG] Data extraction start date (individual start
|
|---|
| 12 | ; date for each patient by default).
|
|---|
| 13 | ; Time part of the parameter value is ignored.
|
|---|
| 14 | ;
|
|---|
| 15 | ; [DXEND] Data extraction end date (TODAY by default)
|
|---|
| 16 | ; Time part of the parameter value is ignored.
|
|---|
| 17 | ;
|
|---|
| 18 | ; DXBEG and DXEND parameters may be used only for historical data
|
|---|
| 19 | ; extraction. Use of these parameters for regular data extraction
|
|---|
| 20 | ; process will negatively affect the package!
|
|---|
| 21 | ;
|
|---|
| 22 | ; This function does not kill the ROREXT("DTAR") node! It just adds
|
|---|
| 23 | ; missing data areas to those that are already present in the list.
|
|---|
| 24 | ;
|
|---|
| 25 | ; Data extraction parameters are aggregated from individual
|
|---|
| 26 | ; registry parameters as follow:
|
|---|
| 27 | ;
|
|---|
| 28 | ; EXTRACT PERIOD FOR NEW PATIENT Maximum
|
|---|
| 29 | ; LAG DAYS Maximum
|
|---|
| 30 | ; EXTRACTED RESULT Union
|
|---|
| 31 | ; MAXIMUM MESSAGE SIZE Minimum
|
|---|
| 32 | ;
|
|---|
| 33 | ; Return Values:
|
|---|
| 34 | ; 0 Ok
|
|---|
| 35 | ; <0 Error code
|
|---|
| 36 | ;
|
|---|
| 37 | PREPARE(REGLST,DXBEG,DXEND) ;
|
|---|
| 38 | N I,IL,IR,LOINC,NODE,RC,REGIEN,REGNAME,RORBUF,RORMSG,TMP,VAL
|
|---|
| 39 | K RORLRC
|
|---|
| 40 | F TMP="DXBEG","HDTIEN","LD","MAXHL7SIZE","PATCH" K ROREXT(TMP)
|
|---|
| 41 | S DXBEG=$G(DXBEG)\1,DXEND=$G(DXEND)\1
|
|---|
| 42 | ;
|
|---|
| 43 | ;=== Data areas
|
|---|
| 44 | S NODE=$$ROOT^DILFD(799.33,,1)
|
|---|
| 45 | ;--- Validate the existing list
|
|---|
| 46 | S IR=0
|
|---|
| 47 | F S IR=$O(ROREXT("DTAR",IR)) Q:IR'>0 D
|
|---|
| 48 | . I '$D(@NODE@(IR)) K ROREXT("DTAR",IR) Q
|
|---|
| 49 | . S TMP=$G(ROREXT("DTAR",IR))
|
|---|
| 50 | . S:TMP>0 ROREXT("DTAR",IR)=($P(TMP,U)\1)_U_($P(TMP,U,2)\1)
|
|---|
| 51 | ;--- Add remaining data areas
|
|---|
| 52 | S IR=0
|
|---|
| 53 | F S IR=$O(@NODE@(IR)) Q:IR'>0 D:'$D(ROREXT("DTAR",IR))
|
|---|
| 54 | . S ROREXT("DTAR",IR)=""
|
|---|
| 55 | ;
|
|---|
| 56 | ;=== Main data extraction time frame
|
|---|
| 57 | S ROREXT("DXEND")=$S(DXEND>0:DXEND,1:$$DT^XLFDT)
|
|---|
| 58 | I DXBEG>0 S RC=0 D Q:RC<0 RC
|
|---|
| 59 | . S ROREXT("DXBEG")=DXBEG Q:DXBEG'>ROREXT("DXEND")
|
|---|
| 60 | . S RC=$$ERROR^RORERR(-32,,,,DXBEG,ROREXT("DXEND"))
|
|---|
| 61 | ;
|
|---|
| 62 | ;=== Check if the critical patches are installed
|
|---|
| 63 | F TMP="MD*1.0*1","MC*2.3*34","GMPL*2*30" D
|
|---|
| 64 | . S:$$PATCH^XPDUTL(TMP) ROREXT("PATCH",TMP)=""
|
|---|
| 65 | ;
|
|---|
| 66 | ;=== Get the package version and the latest patch info
|
|---|
| 67 | S TMP="CLINICAL CASE REGISTRIES"
|
|---|
| 68 | S ROREXT("VERSION")=$$VERSION^XPDUTL(TMP)
|
|---|
| 69 | S TMP=$$LAST^XPDUTL(TMP) D:TMP>0
|
|---|
| 70 | . S $P(ROREXT("VERSION"),U,2)=+TMP
|
|---|
| 71 | . S $P(ROREXT("VERSION"),U,3)=$P(TMP,U,2)
|
|---|
| 72 | ;
|
|---|
| 73 | ;=== Aggregate registry parameters
|
|---|
| 74 | S REGNAME="",RC=0
|
|---|
| 75 | F S REGNAME=$O(REGLST(REGNAME)) Q:REGNAME="" D Q:RC<0
|
|---|
| 76 | . ;--- Get the registry IEN and parameters
|
|---|
| 77 | . S REGIEN=$$REGIEN^RORUTL02(REGNAME,"7;10;13;13.1;15.1",.RORBUF)
|
|---|
| 78 | . I REGIEN<0 S RC=REGIEN Q
|
|---|
| 79 | . ;--- Extract Period for New Patient
|
|---|
| 80 | . S VAL=+$G(RORBUF("DILIST","ID",1,7))
|
|---|
| 81 | . S:VAL>$G(ROREXT("EXTRDAYS")) ROREXT("EXTRDAYS")=VAL
|
|---|
| 82 | . ;--- Setup the message builder call-back entry point
|
|---|
| 83 | . S VAL=$$TRIM^XLFSTR($G(RORBUF("DILIST","ID",1,10)))
|
|---|
| 84 | . I VAL'="" D Q:RC<0
|
|---|
| 85 | . . S RC=$$VERIFYEP^RORUTL01(VAL)
|
|---|
| 86 | . . I RC<0 D ERROR^RORERR(-44,,REGNAME,,VAL) Q
|
|---|
| 87 | . . S ROREXT("MSGBLD",REGIEN)=VAL
|
|---|
| 88 | . ;--- Use the first available HL7 event protocol if it has not
|
|---|
| 89 | . ;--- been defined before calling the $$PREPARE^ROREXPR
|
|---|
| 90 | . D:$G(ROREXT("HL7PROT"))=""
|
|---|
| 91 | . . S ROREXT("HL7PROT")=$G(RORBUF("DILIST","ID",1,13))
|
|---|
| 92 | . ;--- Load maximum message size and convert it into bytes
|
|---|
| 93 | . ;--- (1 Megabyte = 1024 Kb = 1024 * 1024 = 1048576 bytes)
|
|---|
| 94 | . S VAL=($G(RORBUF("DILIST","ID",1,13.1))*1048576)\1
|
|---|
| 95 | . I VAL>0 D S:(TMP'>0)!(VAL<TMP) ROREXT("MAXHL7SIZE")=VAL
|
|---|
| 96 | . . S TMP=+$G(ROREXT("MAXHL7SIZE"))
|
|---|
| 97 | . ;--- Setup the lag interval (for regular data extraction only)
|
|---|
| 98 | . D:'$G(ROREXT("DXBEG"))
|
|---|
| 99 | . . S VAL=+$G(RORBUF("DILIST","ID",1,15.1))
|
|---|
| 100 | . . S:VAL>$G(ROREXT("LD",1)) ROREXT("LD",1)=VAL
|
|---|
| 101 | . ;--- Load list of codes of extracted Lab results
|
|---|
| 102 | . I $G(RORLRC)'="*" D Q:RC<0
|
|---|
| 103 | . . S TMP=","_REGIEN_","
|
|---|
| 104 | . . D LIST^DIC(798.112,TMP,"@;.01;.02;.03","U",,,,"B",,,,"RORMSG")
|
|---|
| 105 | . . I $G(DIERR) S RC=$$DBS^RORERR("RORMSG",-9,,,798.112,TMP) Q
|
|---|
| 106 | . . Q:$G(^TMP("DILIST",$J,0))'>0
|
|---|
| 107 | . . S (IL,IR,RC)=0
|
|---|
| 108 | . . F S IR=$O(^TMP("DILIST",$J,"ID",IR)) Q:IR="" D Q:RC
|
|---|
| 109 | . . . S LOINC=$G(^TMP("DILIST",$J,"ID",IR,.01))
|
|---|
| 110 | . . . ;--- All results or list of subscripts
|
|---|
| 111 | . . . I LOINC="*" D S RC=1 Q
|
|---|
| 112 | . . . . S VAL=$G(^TMP("DILIST",$J,"ID",IR,.03))
|
|---|
| 113 | . . . . I VAL="" K RORLRC S RORLRC="*" Q
|
|---|
| 114 | . . . . I $G(RORLRC)="" K RORLRC S RORLRC=VAL Q
|
|---|
| 115 | . . . . F I=1:1 S TMP=$P(RORLRC,",",I) Q:(TMP="")!(TMP=VAL)
|
|---|
| 116 | . . . . S:TMP="" RORLRC=RORLRC_","_VAL
|
|---|
| 117 | . . . ;--- Ignore individual codes if any subscripts
|
|---|
| 118 | . . . ;--- (CH, MI, etc.) have been requested already
|
|---|
| 119 | . . . Q:$G(RORLRC)'=""
|
|---|
| 120 | . . . ;--- LOINC
|
|---|
| 121 | . . . I LOINC>0 D Q:RC<0 S IL=IL+1,RORLRC(IL)=TMP_"^LN"
|
|---|
| 122 | . . . . S TMP=$$LNCODE^RORUTL02(LOINC) S:TMP<0 RC=TMP
|
|---|
| 123 | . . . ;--- NLT
|
|---|
| 124 | . . . S TMP=$G(^TMP("DILIST",$J,"ID",IR,.02))
|
|---|
| 125 | . . . S:TMP>0 IL=IL+1,RORLRC(IL)=TMP_"^NLT"
|
|---|
| 126 | D CLEAN^DILF
|
|---|
| 127 | K ^TMP("DILIST",$J)
|
|---|
| 128 | Q:RC<0 RC
|
|---|
| 129 | ;
|
|---|
| 130 | ;=== Validate parameters
|
|---|
| 131 | I '$G(ROREXT("DXBEG")) S:$G(ROREXT("LD",1))'>0 ROREXT("LD",1)=1
|
|---|
| 132 | ;
|
|---|
| 133 | ;=== Check the HL7 parameters
|
|---|
| 134 | I $G(ROREXT("HL7PROT"))'="" D Q:RC<0 RC
|
|---|
| 135 | . S RC=$$INIT^RORHL7()
|
|---|
| 136 | ;
|
|---|
| 137 | ;=== Success
|
|---|
| 138 | Q 0
|
|---|
