source: FOIAVistA/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORHDTUT.m@ 1535

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

initial load of FOIAVistA 6/30/08 version
File size: 8.7 KB
Line 
1RORHDTUT ;HCIOFO/SG - HISTORICAL DATA EXTRACTION UTILITIES ; 1/23/06 8:16am
2 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
3 ;
4 Q
5 ;
6 ;***** RETURNS THE DATA EXTRACTION TIME FRAME(S)
7 ;
8 ; HDEIEN Data Extract IEN
9 ;
10 ; .DXDTF Reference to a local array where the time frame(s)
11 ; will be returned to.
12 ;
13 ; DXTDF( A single time frame if no specific parameters are
14 ; defined for the data area(s)
15 ; ^01: Start Date
16 ; ^02: End Date
17 ; DataArea) Time frame for the data area:
18 ; ^01: Start Date
19 ; ^02: End Date
20 ;
21 ; Return Values:
22 ; <0 Error code
23 ; 0 Ok
24 ;
25DXDTF(HDEIEN,DXDTF) ;
26 N BUF,DAC,ENDT,IENS,RORBUF,RORMSG,STDT,TMP
27 K DXDTF
28 ;--- Load the time frame(s) from the data extract definition
29 S IENS=(+HDEIEN)_","
30 D GETS^DIQ(799.6,IENS,".03;.04;1*","I","RORBUF","RORMSG")
31 Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,,799.6,IENS)
32 ;--- Get the main time frame (if defined)
33 S STDT=$G(RORBUF(799.6,IENS,.03,"I"))\1 ; Start Date
34 S ENDT=$G(RORBUF(799.6,IENS,.04,"I"))\1 ; End Date
35 ;--- Check for data area time frames
36 S IENS=""
37 F S IENS=$O(RORBUF(799.61,IENS)) Q:IENS="" D
38 . S DAC=+$G(RORBUF(799.61,IENS,.01,"I")) Q:DAC'>0
39 . S BUF=""
40 . ;--- Start Date
41 . S TMP=$G(RORBUF(799.61,IENS,.02,"I"))\1
42 . I TMP'>0 S TMP=STDT Q:TMP'>0
43 . S $P(BUF,U,1)=TMP
44 . ;--- End Date
45 . S TMP=$G(RORBUF(799.61,IENS,.03,"I"))\1
46 . I TMP'>0 S TMP=ENDT Q:TMP'>0
47 . S $P(BUF,U,2)=TMP
48 . ;--- Store the time frame
49 . S DXDTF(DAC)=BUF
50 ;--- Otherwise, return the main time frame
51 S:$D(DXDTF)<10 DXDTF=STDT_U_ENDT
52 ;--- Success
53 Q 0
54 ;
55 ;***** GENERATES A NEW UNUSED FILE NAME FOR THE TASK
56 ;
57 ; HDEIEN Data Extract IEN
58 ; TASKIEN Task IEN
59 ; [.FILE] New name is returned via this parameter
60 ; [GNONLY] Only generate a new name but do not store it into
61 ; task record
62 ;
63 ; Return Values:
64 ; <0 Error code
65 ; 0 Ok
66 ;
67NEWFILE(HDEIEN,TASKIEN,FILE,GNONLY) ;
68 N BASE,EXT,FN,IENS,NAME,OUTDIR,RC,RORBUF,RORLST,RORMSG,TMP
69 S RC=$$TASKFILE(HDEIEN,TASKIEN,.OUTDIR,.FILE) Q:RC<0 RC
70 S BASE=$P($P(FILE,"."),"-",1,3),EXT=$P($P(FILE,".",2),";")
71 ;--- Get a list of files in the output directory
72 S RORBUF(BASE_"*."_EXT)=""
73 Q:'$$LIST^%ZISH(OUTDIR,"RORBUF","RORLST") 0
74 Q:$D(RORLST)<10 0
75 K RORBUF
76 ;--- Generate a new name
77 S NAME="",FN=0
78 F S NAME=$O(RORLST(NAME)) Q:NAME="" D
79 . S TMP=+$P(NAME,"-",4) S:TMP>FN FN=TMP
80 S FILE=BASE,$P(FILE,"-",4)=$TR($J(FN+1,2)," ","0")
81 S FILE=FILE_"."_EXT
82 Q:$G(GNONLY) 0
83 K RORLST
84 ;--- Store it to the task record
85 S IENS=(+TASKIEN)_","_(+HDEIEN)_","
86 S RORBUF(799.64,IENS,.05)=FILE
87 D FILE^DIE(,"RORBUF","RORMSG")
88 Q $$DBS^RORERR("RORMSG",-9,,,799.64,IENS)
89 ;
90 ;***** PAUSES THE OUTPUT AT PAGE END
91 ;
92 ; Return values:
93 ; -2 Timeout
94 ; -1 User entered a '^'
95 ; 0 Continue
96 ;
97PAGE() ;
98 I $G(IOST)'["C-" S $Y=0 Q:$QUIT 0 Q
99 N DA,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
100 S DIR(0)="E" D ^DIR S $Y=0
101 Q:$QUIT $S($D(DUOUT):-1,$D(DTOUT):-2,1:0)
102 Q
103 ;
104 ;***** SELECTS/ADDS A HISTORICAL DATA EXTRACTION DEFINITION
105 ;
106 ; [FLAGS] Flags that control the processing
107 ; "A" Allow addition of new entries
108 ;
109 ; [.NAME] Data extract name is returned via this parameter
110 ;
111 ; [.NATIONAL] This parameter is set to 1 if a national data
112 ; extraction is selected
113 ;
114 ; Return Values:
115 ; <0 Error code
116 ; "" "^" has been entered or timeout
117 ; 0 Nothing has been selected
118 ; >0 IEN of the selected definition (file #799.6)
119 ;
120SELHDE(FLAGS,NAME,NATIONAL) ;
121 N DA,DIC,DLAYGO,DTOUT,DUOUT,X,Y
122 S NAME="",NATIONAL=0,FLAGS=$G(FLAGS)
123 S DIC=799.6,DIC(0)="AENQZ"
124 I FLAGS["A" D S DIC(0)=DIC(0)_"L",DLAYGO=DIC
125 . S DIC("DR")="[RORHDT EDIT EXTRACTION]"
126 S DIC("A")="Select a Data Extraction: "
127 S DIC("S")="I $P($G(^(0)),U,2)=2" ; Only "Manual" type
128 W ! D ^DIC Q:$D(DTOUT)!$D(DUOUT) ""
129 I Y>0 S NAME=Y(0,0),NATIONAL=+$P(Y(0),U,9) Q +Y
130 Q 0
131 ;
132 ;***** SELECTS A DATA EXTRACTION TASK
133 ;
134 ; RORHDIEN Data Extraction Definition IEN
135 ;
136 ; Return Values:
137 ; <0 Error code
138 ; "" "^" has been entered or timeout
139 ; 0 Nothing has been selected
140 ; >0 IEN of the selected task (multiple #4 of file #799.6)
141 ;
142SELTASK(RORHDIEN) ;
143 N DA,DIR,DTOUT,DUOUT,IENS,RC,ROROOT,X,Y
144 ;--- Display status of the data extraction
145 S RC=$$STATUS^RORHDT01(RORHDIEN) Q:RC<0 RC
146 ;--- Select a task
147 S ROROOT=$$ROOT^DILFD(799.64,","_RORHDIEN_",",1)
148 S TMP=+$O(@ROROOT@(" "),-1)
149 S DIR(0)="NO^1:"_TMP_":0^K:'$D(@ROROOT@(X,0)) X"
150 S DIR("A")="Task ID"
151 S DIR("?")="^I $$TASKLIST^RORHDTUT(RORHDIEN)"
152 W ! D ^DIR
153 Q $S($D(DTOUT)!$D(DUOUT):"",Y>0:+Y,1:0)
154 ;
155 ;***** GETS THE NAME OF THE TASK OUTPUT FILE
156 ;
157 ; HDEIEN Data Extract IEN
158 ; TASKIEN Task IEN
159 ; .OUTDIR Output directory is returned via this parameter
160 ; .FILE File name is returned via the parameter
161 ;
162 ; Return Values:
163 ; <0 Error code
164 ; 0 Ok
165 ;
166TASKFILE(HDEIEN,TASKIEN,OUTDIR,FILE) ;
167 N IENS,RC,RORMSG
168 S (OUTDIR,FILE)=""
169 ;--- Get the output directory
170 S IENS=(+HDEIEN)_","
171 S OUTDIR=$$GET1^DIQ(799.6,IENS,2,,,"RORMSG")
172 Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,,799.6,IENS)
173 ;--- Get the file name
174 S IENS=(+TASKIEN)_","_(+HDEIEN)_","
175 S FILE=$$GET1^DIQ(799.64,IENS,.05,,,"RORMSG")
176 Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,,799.6,IENS)
177 ;--- Success
178 Q 0
179 ;
180 ;***** DISPLAYS THE TASK LIST
181 ;
182 ; HDEIEN Data Extract IEN
183 ;
184 ; Return Values:
185 ; <0 Error code
186 ; 0 Ok
187 ;
188TASKLIST(HDEIEN) ;
189 N IENS,IT,RC,RORBUF,RORMNL,RORMSG,TASKIEN,TS
190 ;--- Get the list of tasks
191 S IENS=","_(+HDEIEN)_",",TMP="@;.01;.02;.05"
192 D LIST^DIC(799.64,IENS,TMP,"Q",,,,"B",,,"RORBUF","RORMSG")
193 Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,,799.64,IENS)
194 I $G(RORBUF("DILIST",0))<1 D Q 0
195 . W !,?10,"No tasks have been defined"
196 ;--- Get status of the tasks
197 S IT=""
198 F S IT=$O(RORBUF("DILIST","ID",IT)) Q:IT="" D
199 . S TASKIEN=+RORBUF("DILIST",2,IT)
200 . S TS=$$TASKSTAT(HDEIEN,TASKIEN)
201 . S RORBUF("DILIST","ID",IT,.03)=$P(TS,U,2)
202 ;--- Display the task table
203 S RORMNL=$S($G(IOSL)>3:IOSL-3,1:20),$Y=0
204 D TASKLP() W !
205 S IT="",RC=0
206 F S IT=$O(RORBUF("DILIST","ID",IT)) Q:IT="" D Q:RC
207 . D TASKLP(IT) S:$Y'<RORMNL RC=$$PAGE()
208 ;--- Success
209 Q 0
210 ;
211 ;***** DISPLAYS A LINE OF THE TASK TABLE
212 ;
213 ; RORBUF Field values from the record of the file #798.5
214 ; returned by LIST^DIC
215 ;
216 ; IT Index in the table
217 ;
218TASKLP(IT) ;
219 ;;!?2^ID^$J($G(RORBUF("DILIST",2,IT)),2)
220 ;;?6^File Name^$G(RORBUF("DILIST","ID",IT,.05))
221 ;;?39^Task^$G(RORBUF("DILIST","ID",IT,.02))
222 ;;?49^Status^$G(RORBUF("DILIST","ID",IT,.03))
223 ;
224 N I,TMP
225 ;--- Display the headers
226 I '$G(IT) D Q
227 . F I=1:1 S TMP=$P($T(TASKLP+I),";;",2,999) Q:TMP="" D
228 . . W @$TR($P(TMP,"^")," "),$P(TMP,"^",2)
229 ;--- Display the values
230 F I=1:1 S TMP=$P($T(TASKLP+I),";;",2,999) Q:TMP="" D
231 . W @$TR($P(TMP,"^")," "),@$P(TMP,"^",3)
232 Q
233 ;
234 ;***** RETURNS THE TASK NUMBER
235 ;
236 ; HDEIEN Data Extract IEN
237 ; TASKIEN Task IEN
238 ;
239 ; Return Values:
240 ; <0 Error code
241 ; 0 No task defined
242 ; >0 Task Number
243 ;
244TASKNUM(HDEIEN,TASKIEN) ;
245 N IENS,RORMSG,TASK
246 S IENS=(+TASKIEN)_","_(+HDEIEN)_","
247 S TASK=+$$GET1^DIQ(799.64,IENS,.02,"I",,"RORMSG")
248 Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,,799.64,IENS)
249 Q TASK
250 ;
251 ;***** RETURNS STATUS OF THE TASK
252 ;
253 ; HDEIEN Data Extract IEN
254 ; TASKIEN Task IEN
255 ; [LTO] LOCK timeout
256 ;
257 ; Return Values:
258 ; <0 Error code
259 ; 0 Unknown Status
260 ; >0 Status (Code^Description)
261 ;
262 ; 1 Active: Pending
263 ; 2 Active: Running
264 ; 3 Inactive: Finished
265 ; 4 Inactive: Available
266 ; 5 Inactive: Interrupted
267 ;
268 ; 100 Inactive: Crashed
269 ; 101 Inactive: Errors
270 ; 102 Active: Suspended
271 ; 103 Active: Stopping
272 ;
273TASKSTAT(HDEIEN,TASKIEN,LTO) ;
274 N IENS,RORBUF,RORFDA,RORMSG,STATUS,TASK,TMP
275 S IENS=(+TASKIEN)_","_(+HDEIEN)_","
276 ;--- Get the task number and its last known status
277 D GETS^DIQ(799.64,IENS,".02;.03","EI","RORBUF","RORMSG")
278 Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,,799.64,IENS)
279 S TASK=$G(RORBUF(799.64,IENS,.02,"I"))
280 Q:TASK="" 0
281 ;--- Try to get status of the task
282 S STATUS=$$STATUS^RORTSK02(TASK,$G(LTO))
283 Q:STATUS<0 STATUS
284 ;--- If the task record exists, then update the task STATUS
285 ;--- field if necessary and return the current task status
286 I STATUS>0 D:+STATUS'=$G(RORBUF(799.64,IENS,.03,"I")) Q STATUS
287 . S RORFDA(799.64,IENS,.03)=+STATUS
288 . D FILE^DIE(,"RORFDA","RORMSG")
289 . D:$G(DIERR) DBS^RORERR("RORMSG",-9,,,799.64,IENS)
290 ;--- Otherwise, return the last known status
291 S STATUS=+$G(RORBUF(799.64,IENS,.03,"I"))
292 Q:STATUS'>0 0
293 S TMP=$TR($G(RORBUF(799.64,IENS,.03,"E")),">",":")
294 Q STATUS_U_TMP
Note: See TracBrowser for help on using the repository browser.