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