295 lines
8.7 KiB
Mathematica
295 lines
8.7 KiB
Mathematica
|
RORHDTUT ;HCIOFO/SG - HISTORICAL DATA EXTRACTION UTILITIES ; 1/23/06 8:16am
|
||
|
|
;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
|
||
|
|
;
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
;***** RETURNS THE DATA EXTRACTION TIME FRAME(S)
|
||
|
|
;
|
||
|
|
; HDEIEN Data Extract IEN
|
||
|
|
;
|
||
|
|
; .DXDTF Reference to a local array where the time frame(s)
|
||
|
|
; will be returned to.
|
||
|
|
;
|
||
|
|
; DXTDF( A single time frame if no specific parameters are
|
||
|
|
; defined for the data area(s)
|
||
|
|
; ^01: Start Date
|
||
|
|
; ^02: End Date
|
||
|
|
; DataArea) Time frame for the data area:
|
||
|
|
; ^01: Start Date
|
||
|
|
; ^02: End Date
|
||
|
|
;
|
||
|
|
; Return Values:
|
||
|
|
; <0 Error code
|
||
|
|
; 0 Ok
|
||
|
|
;
|
||
|
|
DXDTF(HDEIEN,DXDTF) ;
|
||
|
|
N BUF,DAC,ENDT,IENS,RORBUF,RORMSG,STDT,TMP
|
||
|
|
K DXDTF
|
||
|
|
;--- Load the time frame(s) from the data extract definition
|
||
|
|
S IENS=(+HDEIEN)_","
|
||
|
|
D GETS^DIQ(799.6,IENS,".03;.04;1*","I","RORBUF","RORMSG")
|
||
|
|
Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,,799.6,IENS)
|
||
|
|
;--- Get the main time frame (if defined)
|
||
|
|
S STDT=$G(RORBUF(799.6,IENS,.03,"I"))\1 ; Start Date
|
||
|
|
S ENDT=$G(RORBUF(799.6,IENS,.04,"I"))\1 ; End Date
|
||
|
|
;--- Check for data area time frames
|
||
|
|
S IENS=""
|
||
|
|
F S IENS=$O(RORBUF(799.61,IENS)) Q:IENS="" D
|
||
|
|
. S DAC=+$G(RORBUF(799.61,IENS,.01,"I")) Q:DAC'>0
|
||
|
|
. S BUF=""
|
||
|
|
. ;--- Start Date
|
||
|
|
. S TMP=$G(RORBUF(799.61,IENS,.02,"I"))\1
|
||
|
|
. I TMP'>0 S TMP=STDT Q:TMP'>0
|
||
|
|
. S $P(BUF,U,1)=TMP
|
||
|
|
. ;--- End Date
|
||
|
|
. S TMP=$G(RORBUF(799.61,IENS,.03,"I"))\1
|
||
|
|
. I TMP'>0 S TMP=ENDT Q:TMP'>0
|
||
|
|
. S $P(BUF,U,2)=TMP
|
||
|
|
. ;--- Store the time frame
|
||
|
|
. S DXDTF(DAC)=BUF
|
||
|
|
;--- Otherwise, return the main time frame
|
||
|
|
S:$D(DXDTF)<10 DXDTF=STDT_U_ENDT
|
||
|
|
;--- Success
|
||
|
|
Q 0
|
||
|
|
;
|
||
|
|
;***** GENERATES A NEW UNUSED FILE NAME FOR THE TASK
|
||
|
|
;
|
||
|
|
; HDEIEN Data Extract IEN
|
||
|
|
; TASKIEN Task IEN
|
||
|
|
; [.FILE] New name is returned via this parameter
|
||
|
|
; [GNONLY] Only generate a new name but do not store it into
|
||
|
|
; task record
|
||
|
|
;
|
||
|
|
; Return Values:
|
||
|
|
; <0 Error code
|
||
|
|
; 0 Ok
|
||
|
|
;
|
||
|
|
NEWFILE(HDEIEN,TASKIEN,FILE,GNONLY) ;
|
||
|
|
N BASE,EXT,FN,IENS,NAME,OUTDIR,RC,RORBUF,RORLST,RORMSG,TMP
|
||
|
|
S RC=$$TASKFILE(HDEIEN,TASKIEN,.OUTDIR,.FILE) Q:RC<0 RC
|
||
|
|
S BASE=$P($P(FILE,"."),"-",1,3),EXT=$P($P(FILE,".",2),";")
|
||
|
|
;--- Get a list of files in the output directory
|
||
|
|
S RORBUF(BASE_"*."_EXT)=""
|
||
|
|
Q:'$$LIST^%ZISH(OUTDIR,"RORBUF","RORLST") 0
|
||
|
|
Q:$D(RORLST)<10 0
|
||
|
|
K RORBUF
|
||
|
|
;--- Generate a new name
|
||
|
|
S NAME="",FN=0
|
||
|
|
F S NAME=$O(RORLST(NAME)) Q:NAME="" D
|
||
|
|
. S TMP=+$P(NAME,"-",4) S:TMP>FN FN=TMP
|
||
|
|
S FILE=BASE,$P(FILE,"-",4)=$TR($J(FN+1,2)," ","0")
|
||
|
|
S FILE=FILE_"."_EXT
|
||
|
|
Q:$G(GNONLY) 0
|
||
|
|
K RORLST
|
||
|
|
;--- Store it to the task record
|
||
|
|
S IENS=(+TASKIEN)_","_(+HDEIEN)_","
|
||
|
|
S RORBUF(799.64,IENS,.05)=FILE
|
||
|
|
D FILE^DIE(,"RORBUF","RORMSG")
|
||
|
|
Q $$DBS^RORERR("RORMSG",-9,,,799.64,IENS)
|
||
|
|
;
|
||
|
|
;***** PAUSES THE OUTPUT AT PAGE END
|
||
|
|
;
|
||
|
|
; Return values:
|
||
|
|
; -2 Timeout
|
||
|
|
; -1 User entered a '^'
|
||
|
|
; 0 Continue
|
||
|
|
;
|
||
|
|
PAGE() ;
|
||
|
|
I $G(IOST)'["C-" S $Y=0 Q:$QUIT 0 Q
|
||
|
|
N DA,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
|
||
|
|
S DIR(0)="E" D ^DIR S $Y=0
|
||
|
|
Q:$QUIT $S($D(DUOUT):-1,$D(DTOUT):-2,1:0)
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
;***** SELECTS/ADDS A HISTORICAL DATA EXTRACTION DEFINITION
|
||
|
|
;
|
||
|
|
; [FLAGS] Flags that control the processing
|
||
|
|
; "A" Allow addition of new entries
|
||
|
|
;
|
||
|
|
; [.NAME] Data extract name is returned via this parameter
|
||
|
|
;
|
||
|
|
; [.NATIONAL] This parameter is set to 1 if a national data
|
||
|
|
; extraction is selected
|
||
|
|
;
|
||
|
|
; Return Values:
|
||
|
|
; <0 Error code
|
||
|
|
; "" "^" has been entered or timeout
|
||
|
|
; 0 Nothing has been selected
|
||
|
|
; >0 IEN of the selected definition (file #799.6)
|
||
|
|
;
|
||
|
|
SELHDE(FLAGS,NAME,NATIONAL) ;
|
||
|
|
N DA,DIC,DLAYGO,DTOUT,DUOUT,X,Y
|
||
|
|
S NAME="",NATIONAL=0,FLAGS=$G(FLAGS)
|
||
|
|
S DIC=799.6,DIC(0)="AENQZ"
|
||
|
|
I FLAGS["A" D S DIC(0)=DIC(0)_"L",DLAYGO=DIC
|
||
|
|
. S DIC("DR")="[RORHDT EDIT EXTRACTION]"
|
||
|
|
S DIC("A")="Select a Data Extraction: "
|
||
|
|
S DIC("S")="I $P($G(^(0)),U,2)=2" ; Only "Manual" type
|
||
|
|
W ! D ^DIC Q:$D(DTOUT)!$D(DUOUT) ""
|
||
|
|
I Y>0 S NAME=Y(0,0),NATIONAL=+$P(Y(0),U,9) Q +Y
|
||
|
|
Q 0
|
||
|
|
;
|
||
|
|
;***** SELECTS A DATA EXTRACTION TASK
|
||
|
|
;
|
||
|
|
; RORHDIEN Data Extraction Definition IEN
|
||
|
|
;
|
||
|
|
; Return Values:
|
||
|
|
; <0 Error code
|
||
|
|
; "" "^" has been entered or timeout
|
||
|
|
; 0 Nothing has been selected
|
||
|
|
; >0 IEN of the selected task (multiple #4 of file #799.6)
|
||
|
|
;
|
||
|
|
SELTASK(RORHDIEN) ;
|
||
|
|
N DA,DIR,DTOUT,DUOUT,IENS,RC,ROROOT,X,Y
|
||
|
|
;--- Display status of the data extraction
|
||
|
|
S RC=$$STATUS^RORHDT01(RORHDIEN) Q:RC<0 RC
|
||
|
|
;--- Select a task
|
||
|
|
S ROROOT=$$ROOT^DILFD(799.64,","_RORHDIEN_",",1)
|
||
|
|
S TMP=+$O(@ROROOT@(" "),-1)
|
||
|
|
S DIR(0)="NO^1:"_TMP_":0^K:'$D(@ROROOT@(X,0)) X"
|
||
|
|
S DIR("A")="Task ID"
|
||
|
|
S DIR("?")="^I $$TASKLIST^RORHDTUT(RORHDIEN)"
|
||
|
|
W ! D ^DIR
|
||
|
|
Q $S($D(DTOUT)!$D(DUOUT):"",Y>0:+Y,1:0)
|
||
|
|
;
|
||
|
|
;***** GETS THE NAME OF THE TASK OUTPUT FILE
|
||
|
|
;
|
||
|
|
; HDEIEN Data Extract IEN
|
||
|
|
; TASKIEN Task IEN
|
||
|
|
; .OUTDIR Output directory is returned via this parameter
|
||
|
|
; .FILE File name is returned via the parameter
|
||
|
|
;
|
||
|
|
; Return Values:
|
||
|
|
; <0 Error code
|
||
|
|
; 0 Ok
|
||
|
|
;
|
||
|
|
TASKFILE(HDEIEN,TASKIEN,OUTDIR,FILE) ;
|
||
|
|
N IENS,RC,RORMSG
|
||
|
|
S (OUTDIR,FILE)=""
|
||
|
|
;--- Get the output directory
|
||
|
|
S IENS=(+HDEIEN)_","
|
||
|
|
S OUTDIR=$$GET1^DIQ(799.6,IENS,2,,,"RORMSG")
|
||
|
|
Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,,799.6,IENS)
|
||
|
|
;--- Get the file name
|
||
|
|
S IENS=(+TASKIEN)_","_(+HDEIEN)_","
|
||
|
|
S FILE=$$GET1^DIQ(799.64,IENS,.05,,,"RORMSG")
|
||
|
|
Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,,799.6,IENS)
|
||
|
|
;--- Success
|
||
|
|
Q 0
|
||
|
|
;
|
||
|
|
;***** DISPLAYS THE TASK LIST
|
||
|
|
;
|
||
|
|
; HDEIEN Data Extract IEN
|
||
|
|
;
|
||
|
|
; Return Values:
|
||
|
|
; <0 Error code
|
||
|
|
; 0 Ok
|
||
|
|
;
|
||
|
|
TASKLIST(HDEIEN) ;
|
||
|
|
N IENS,IT,RC,RORBUF,RORMNL,RORMSG,TASKIEN,TS
|
||
|
|
;--- Get the list of tasks
|
||
|
|
S IENS=","_(+HDEIEN)_",",TMP="@;.01;.02;.05"
|
||
|
|
D LIST^DIC(799.64,IENS,TMP,"Q",,,,"B",,,"RORBUF","RORMSG")
|
||
|
|
Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,,799.64,IENS)
|
||
|
|
I $G(RORBUF("DILIST",0))<1 D Q 0
|
||
|
|
. W !,?10,"No tasks have been defined"
|
||
|
|
;--- Get status of the tasks
|
||
|
|
S IT=""
|
||
|
|
F S IT=$O(RORBUF("DILIST","ID",IT)) Q:IT="" D
|
||
|
|
. S TASKIEN=+RORBUF("DILIST",2,IT)
|
||
|
|
. S TS=$$TASKSTAT(HDEIEN,TASKIEN)
|
||
|
|
. S RORBUF("DILIST","ID",IT,.03)=$P(TS,U,2)
|
||
|
|
;--- Display the task table
|
||
|
|
S RORMNL=$S($G(IOSL)>3:IOSL-3,1:20),$Y=0
|
||
|
|
D TASKLP() W !
|
||
|
|
S IT="",RC=0
|
||
|
|
F S IT=$O(RORBUF("DILIST","ID",IT)) Q:IT="" D Q:RC
|
||
|
|
. D TASKLP(IT) S:$Y'<RORMNL RC=$$PAGE()
|
||
|
|
;--- Success
|
||
|
|
Q 0
|
||
|
|
;
|
||
|
|
;***** DISPLAYS A LINE OF THE TASK TABLE
|
||
|
|
;
|
||
|
|
; RORBUF Field values from the record of the file #798.5
|
||
|
|
; returned by LIST^DIC
|
||
|
|
;
|
||
|
|
; IT Index in the table
|
||
|
|
;
|
||
|
|
TASKLP(IT) ;
|
||
|
|
;;!?2^ID^$J($G(RORBUF("DILIST",2,IT)),2)
|
||
|
|
;;?6^File Name^$G(RORBUF("DILIST","ID",IT,.05))
|
||
|
|
;;?39^Task^$G(RORBUF("DILIST","ID",IT,.02))
|
||
|
|
;;?49^Status^$G(RORBUF("DILIST","ID",IT,.03))
|
||
|
|
;
|
||
|
|
N I,TMP
|
||
|
|
;--- Display the headers
|
||
|
|
I '$G(IT) D Q
|
||
|
|
. F I=1:1 S TMP=$P($T(TASKLP+I),";;",2,999) Q:TMP="" D
|
||
|
|
. . W @$TR($P(TMP,"^")," "),$P(TMP,"^",2)
|
||
|
|
;--- Display the values
|
||
|
|
F I=1:1 S TMP=$P($T(TASKLP+I),";;",2,999) Q:TMP="" D
|
||
|
|
. W @$TR($P(TMP,"^")," "),@$P(TMP,"^",3)
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
;***** RETURNS THE TASK NUMBER
|
||
|
|
;
|
||
|
|
; HDEIEN Data Extract IEN
|
||
|
|
; TASKIEN Task IEN
|
||
|
|
;
|
||
|
|
; Return Values:
|
||
|
|
; <0 Error code
|
||
|
|
; 0 No task defined
|
||
|
|
; >0 Task Number
|
||
|
|
;
|
||
|
|
TASKNUM(HDEIEN,TASKIEN) ;
|
||
|
|
N IENS,RORMSG,TASK
|
||
|
|
S IENS=(+TASKIEN)_","_(+HDEIEN)_","
|
||
|
|
S TASK=+$$GET1^DIQ(799.64,IENS,.02,"I",,"RORMSG")
|
||
|
|
Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,,799.64,IENS)
|
||
|
|
Q TASK
|
||
|
|
;
|
||
|
|
;***** RETURNS STATUS OF THE TASK
|
||
|
|
;
|
||
|
|
; HDEIEN Data Extract IEN
|
||
|
|
; TASKIEN Task IEN
|
||
|
|
; [LTO] LOCK timeout
|
||
|
|
;
|
||
|
|
; Return Values:
|
||
|
|
; <0 Error code
|
||
|
|
; 0 Unknown Status
|
||
|
|
; >0 Status (Code^Description)
|
||
|
|
;
|
||
|
|
; 1 Active: Pending
|
||
|
|
; 2 Active: Running
|
||
|
|
; 3 Inactive: Finished
|
||
|
|
; 4 Inactive: Available
|
||
|
|
; 5 Inactive: Interrupted
|
||
|
|
;
|
||
|
|
; 100 Inactive: Crashed
|
||
|
|
; 101 Inactive: Errors
|
||
|
|
; 102 Active: Suspended
|
||
|
|
; 103 Active: Stopping
|
||
|
|
;
|
||
|
|
TASKSTAT(HDEIEN,TASKIEN,LTO) ;
|
||
|
|
N IENS,RORBUF,RORFDA,RORMSG,STATUS,TASK,TMP
|
||
|
|
S IENS=(+TASKIEN)_","_(+HDEIEN)_","
|
||
|
|
;--- Get the task number and its last known status
|
||
|
|
D GETS^DIQ(799.64,IENS,".02;.03","EI","RORBUF","RORMSG")
|
||
|
|
Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,,799.64,IENS)
|
||
|
|
S TASK=$G(RORBUF(799.64,IENS,.02,"I"))
|
||
|
|
Q:TASK="" 0
|
||
|
|
;--- Try to get status of the task
|
||
|
|
S STATUS=$$STATUS^RORTSK02(TASK,$G(LTO))
|
||
|
|
Q:STATUS<0 STATUS
|
||
|
|
;--- If the task record exists, then update the task STATUS
|
||
|
|
;--- field if necessary and return the current task status
|
||
|
|
I STATUS>0 D:+STATUS'=$G(RORBUF(799.64,IENS,.03,"I")) Q STATUS
|
||
|
|
. S RORFDA(799.64,IENS,.03)=+STATUS
|
||
|
|
. D FILE^DIE(,"RORFDA","RORMSG")
|
||
|
|
. D:$G(DIERR) DBS^RORERR("RORMSG",-9,,,799.64,IENS)
|
||
|
|
;--- Otherwise, return the last known status
|
||
|
|
S STATUS=+$G(RORBUF(799.64,IENS,.03,"I"))
|
||
|
|
Q:STATUS'>0 0
|
||
|
|
S TMP=$TR($G(RORBUF(799.64,IENS,.03,"E")),">",":")
|
||
|
|
Q STATUS_U_TMP
|