| 1 | RORHDTUT ;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 | ;
|
---|
| 25 | DXDTF(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 | ;
|
---|
| 67 | NEWFILE(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 | ;
|
---|
| 97 | PAGE() ;
|
---|
| 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 | ;
|
---|
| 120 | SELHDE(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 | ;
|
---|
| 142 | SELTASK(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 | ;
|
---|
| 166 | TASKFILE(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 | ;
|
---|
| 188 | TASKLIST(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 | ;
|
---|
| 218 | TASKLP(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 | ;
|
---|
| 244 | TASKNUM(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 | ;
|
---|
| 273 | TASKSTAT(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
|
---|