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