source: FOIAVistA/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/ROREXPR.m

Last change on this file was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 5.1 KB
Line 
1ROREXPR ;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 ;
37PREPARE(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
Note: See TracBrowser for help on using the repository browser.