source: FOIAVistA/tag/r/CLINICAL_CASE_REGISTRIES-ROR/RORHDT06.m@ 628

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

initial load of FOIAVistA 6/30/08 version
File size: 5.2 KB
Line 
1RORHDT06 ;HCIOFO/SG - HISTORICAL DATA EXTRACTION PARAMETERS ; 11/30/05 10:03am
2 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
3 ;
4 Q
5 ;
6 ;***** UPDATES COMPLETION DATE FOR THE REGISTRY
7 ;
8 ; HDTIEN IEN of the data extraction definition
9 ; REGNAME Registry name
10 ; [DATE] Completion date/time (current, if omitted)
11 ;
12 ; Return Values:
13 ; <0 Error code
14 ; 0 Ok
15 ;
16COMPLETE(HDTIEN,REGNAME,DATE) ;
17 Q:HDTIEN'>0 0
18 Q:$G(^RORDATA(799.6,+HDTIEN,0))="" 0
19 N IEN,IENS,INFO,RORFDA,RORMSG,TMP,TYPE
20 ;--- Search for the registry record in the backpull definition
21 S IENS=","_(+HDTIEN)_","
22 S IEN=$$FIND1^DIC(799.63,IENS,"QX",REGNAME,"B",,"RORMSG")
23 Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,,799.63,IENS)
24 Q:IEN'>0 0
25 ;--- Update the completion date
26 S DATE=$S($G(DATE,-1)<0:$$NOW^XLFDT,'DATE:"",1:DATE)
27 S RORFDA(799.63,IEN_IENS,.02)=DATE
28 D FILE^DIE(,"RORFDA","RORMSG")
29 Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,,799.63,IEN_IENS)
30 ;--- Success
31 S TMP=$$MSG^RORERR20(-109,.TYPE)
32 S INFO(1)=$$GET1^DIQ(799.6,(+HDTIEN)_",",.01,,,"RORMSG")
33 S INFO(2)=REGNAME
34 D LOG^RORLOG(TYPE,TMP,,.INFO)
35 Q 0
36 ;
37 ;***** SEARCHES FOR A PENDING HISTORICAL DATA EXTRACTION
38 ;
39 ; .RORGLST Reference to a local array containing registry names
40 ; as subscripts and optional registry IENs as values.
41 ;
42 ; If a definition of a pending historical data
43 ; extraction is found, then the function removes
44 ; the registries, which are not referenced by the
45 ; definition, from this list.
46 ;
47 ; [.SDT] Reference to a local variable where the start
48 ; date of the main time frame for the historical
49 ; extraction will be returned.
50 ;
51 ; [.EDT] Reference to a local variable where the end
52 ; date of the main time frame for the historical
53 ; extraction will be returned.
54 ;
55 ; Return Values:
56 ; <0 Error code
57 ; 0 There are no pending historical data extractions
58 ; >0 IEN of the data extraction definition
59 ;
60FIND(RORGLST,SDT,EDT) ;
61 N HDTIEN,NODE,REGNAME,RORBUF,RORMSG,SCR,TMP
62 S (EDT,SDT)=""
63 ;--- Search for a pending historical data extraction
64 S TMP="@;.03I;.04I"
65 S SCR="I $P($G(^(0)),U,7)\1'>DT,$$FINDSCR^RORHDT06(Y)"
66 D LIST^DIC(799.6,,TMP,"Q",1,,,"ADNAUTO",SCR,,"RORBUF","RORMSG")
67 Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,,799.6)
68 Q:$G(RORBUF("DILIST",0))'>0 0
69 S HDTIEN=+$G(RORBUF("DILIST",2,1))
70 Q:HDTIEN'>0 0
71 ;--- Keep only the registries referenced by the definition
72 S NODE=$$ROOT^DILFD(799.63,","_HDTIEN_",",1)
73 S REGNAME=""
74 F S REGNAME=$O(RORGLST(REGNAME)) Q:REGNAME="" D
75 . K:'$D(@NODE@("ANC",REGNAME)) RORGLST(REGNAME)
76 ;--- Return the dates and IEN
77 S SDT=$G(RORBUF("DILIST","ID",1,.03))
78 S EDT=$G(RORBUF("DILIST","ID",1,.04))
79 Q HDTIEN
80 ;
81 ;***** CHECKS IF THE BACKPULL SHOULD BE PROCESSED BY THE TASK
82 ;
83 ; HDTIEN IEN of the data extraction definition
84 ;
85 ; Return Values:
86 ; 0 Skip
87 ; 1 Include
88 ;
89FINDSCR(HDTIEN) ;
90 N REGNAME S REGNAME=""
91 F D Q:REGNAME="" Q:$D(RORGLST(REGNAME))
92 . S REGNAME=$O(^RORDATA(799.6,HDTIEN,3,"ANC",REGNAME))
93 Q (REGNAME'="")
94 ;
95 ;***** PREPARES HISTORICAL DATA EXTRACTION PARAMETERS
96 ;
97 ; HDTIEN IEN of the data extraction definition
98 ;
99 ; Return Values:
100 ; 0 Ok
101 ; <0 Error code
102 ;
103PREPARE(HDTIEN) ;
104 N DAC,HDTNAME,IENS,NODE,RC,RORBUF,RORMSG,SCR,SDT,TMP,TYPE
105 I $G(HDTIEN)'>0 D Q 0
106 . K ROREXT("HDTIEN")
107 S ROREXT("HDTIEN")=+HDTIEN,RC=0
108 ;--- Load the parameters
109 S IENS=+HDTIEN_","
110 D GETS^DIQ(799.6,IENS,".01;.06;1*","I","RORBUF","RORMSG")
111 Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,,799.6,IENS)
112 S HDTNAME=$G(RORBUF(799.6,IENS,.01,"I"))
113 ;--- Override the maximum message size (if requested)
114 S TMP=$G(RORBUF(799.6,IENS,.06,"I"))
115 I TMP>0 S ROREXT("MAXHL7SIZE")=(TMP*1048576)\1
116 E K:TMP=0 ROREXT("MAXHL7SIZE")
117 ;--- Override the data areas
118 K ROREXT("DTAR")
119 S NODE=$$ROOT^DILFD(799.33,,1)
120 S IENS=""
121 F S IENS=$O(RORBUF(799.61,IENS)) Q:IENS="" D
122 . S DAC=+$G(RORBUF(799.61,IENS,.01,"I"))
123 . Q:'$D(@NODE@(DAC))
124 . S SDT=+$G(RORBUF(799.61,IENS,.02,"I")) ; Start Date
125 . I SDT'>0 S ROREXT("DTAR",DAC)="" Q
126 . S TMP=+$G(RORBUF(799.61,IENS,.03,"I")) ; End Date
127 . S:TMP>0 ROREXT("DTAR",DAC)=SDT_U_TMP
128 ;--- Ignore the lag days
129 K ROREXT("LD")
130 ;--- Set the special batch message date (BHS-6) to make
131 ; sure that timestamps of historical clinical units are
132 ;--- earlier than those of the regular ones.
133 S ROREXT("HL7DT")=$$FMADD^XLFDT(ROREXT("DXEND")\1,,,1)
134 ;--- Success
135 S TMP=$$MSG^RORERR20(-108,.TYPE)
136 D LOG^RORLOG(TYPE,TMP,,HDTNAME)
137 Q 0
138 ;
139 ;***** STORES THE BACKPULL REFERENCE INTO THE REGISTRY PARAMETERS
140 ;
141 ; .REGLST Reference to a local array containing registry
142 ; names as subscripts and registry IENs as values.
143 ;
144 ; HDTIEN IEN of the data extraction definition
145 ;
146REGREF(REGLST,HDTIEN) ;
147 N RC,REGIEN,REGNAME,RORFDA,RORMSG
148 S REGNAME="",RC=0
149 F S REGNAME=$O(REGLST(REGNAME)) Q:REGNAME="" D Q:RC<0
150 . S REGIEN=+REGLST(REGNAME)
151 . I REGIEN'>0 D I REGIEN'>0 S RC=REGIEN Q
152 . . S REGIEN=$$REGIEN^RORUTL02(REGNAME)
153 . K RORFDA,RORMSG
154 . S RORFDA(798.1,REGIEN_",",21.01)=$S(HDTIEN>0:+HDTIEN,1:"@")
155 . D FILE^DIE(,"RORFDA","RORMSG")
156 . S:$G(DIERR) RC=$$DBS^RORERR("RORMSG",-9,,,798.1,REGIEN_",")
157 ;---
158 Q $S(RC<0:RC,1:0)
Note: See TracBrowser for help on using the repository browser.