RORHDT05 ;HCIOFO/SG - HISTORICAL DATA EXTRACTION FUNCTIONS ; 1/22/06 12:01pm
;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
;
Q
;
;***** ADDS A RECORD TO THE 'ERROR' MULTIPLE OF THE TASK RECORD
;
; HDEIEN Data Extract IEN
; TASKIEN Task IEN
; PTIEN Patient IEN
;
; Return Values:
; <0 Error code
; 0 Ok
;
ADDERR(HDEIEN,TASKIEN,PTIEN) ;
N IENS,RC,RORFDA,RORIEN,RORMSG
S IENS="+1,"_(+TASKIEN)_","_(+HDEIEN)_",",RORIEN(1)=+PTIEN
S RORFDA(799.641,IENS,.01)=+PTIEN
D UPDATE^DIE(,"RORFDA","RORIEN","RORMSG")
Q $$DBS^RORERR("RORMSG",-9,,,799.641,IENS)
;
;***** DELETES RECORDS FROM THE 'ERROR' MULTIPLE OF THE TASK RECORD
;
; HDEIEN Data Extract IEN
; TASKIEN Task IEN
;
; This functions deletes all erroneous records from the ERROR
; multiple of the task record that have been re-extracted without
; errors. So, there is no reason to keep them anymore.
;
; Return Values:
; <0 Error code
; 0 Ok
;
CLRERRS(HDEIEN,TASKIEN) ;
N I,IEN,RC,RORFDA,RORMSG,SFI
S SFI=","_(+TASKIEN)_","_(+HDEIEN)_",",RC=0
S IEN=""
F D Q:(RC<0)!(IEN="")
. F I=1:1:10 S IEN=$O(^TMP("RORHDT",$J,"PR",IEN)) Q:IEN="" D
. . S:^TMP("RORHDT",$J,"PR",IEN)'<0 RORFDA(799.641,IEN_SFI,.01)="@"
. Q:$D(RORFDA)<10
. D FILE^DIE(,"RORFDA","RORMSG")
. S:$G(DIERR) RC=$$DBS^RORERR("RORMSG",-9,,,799.641)
Q $S(RC<0:RC,1:0)
;
;***** COMMITS HL7 DATA TO THE OUTPUT FILE
;
; OUTDIR Output directory
; FILE Output file name
;
; Return Values:
; <0 Error code
; 0 Ok
;
COMMIT(OUTDIR,FILE) ;
N CR,I,J,POP,RC
Q:$D(^TMP("HLS",$J))<10 0
S CR=$C(13),RC=0
;--- Create the file and write the BHS segment (if necessary)
I $G(RORHDT("BHS")) D Q:RC<0 RC K RORHDT("BHS")
. D OPEN^%ZISH("HL7FILE",OUTDIR,FILE,"WB")
. I $G(POP) S RC=$$ERROR^RORERR(-34,,OUTDIR_FILE) Q
. S I=$G(ROREXT("HL7DT")) U IO
. W $$BHS^RORHL7A($G(ROREXT("HL7MID")),I,"HISTORICAL DATA"),$C(13)
;--- Write the segments
S I=0
F S I=$O(^TMP("HLS",$J,I)) Q:I="" D
. W ^TMP("HLS",$J,I) S J=""
. F S J=$O(^TMP("HLS",$J,I,J)) Q:J="" W ^(J)
. W CR
Q 0
;
;***** DELETES THE OLD OUTPUT HOST FILE(S)
;
; OUTDIR Output directory
; FILE Output file name
;
; Return Values:
; <0 Error code
; 0 Ok
;
DELFILES(OUTDIR,FILE) ;
N RC,RORDST,RORSRC Q:FILE="" 0
S RORSRC(FILE_"*")=""
Q:'$$LIST^%ZISH(OUTDIR,"RORSRC","RORDST") 0
I '$$DEL^%ZISH(OUTDIR,"RORDST") D Q RC
. S RC=$$ERROR^RORERR(-56,,,,0,"$$DEL^%ZISH")
Q 0
;
;***** LOADS DATA EXTRACTION PARAMETERS
;
; HDEIEN Data Extract IEN
;
; [.BDT] Start date of the data extract
; [.EDT] End date of the data extract
; [.OUTDIR] Output directory
;
; Return Values:
; <0 Error code
; 0 Ok
;
HDEPARM(HDEIEN,BDT,EDT,OUTDIR) ;
N IENS,RC,RORBUF,RORMSG,TMP
S IENS=(+HDEIEN)_","
;--- Get data from the registry descriptor
D GETS^DIQ(799.6,IENS,".03;.04;2","I","RORBUF","RORMSG")
Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,,798.1,IENS)
S BDT=$G(RORBUF(799.6,IENS,.03,"I"))
S EDT=$G(RORBUF(799.6,IENS,.04,"I"))
S OUTDIR=$G(RORBUF(799.6,IENS,2,"I"))
I (BDT'>0)!(EDT'>0)!(BDT>EDT) D Q RC
. S RC=$$ERROR^RORERR(-32,,,,BDT,EDT)
Q 0
;
;***** LOADS TASK PARAMETERS
;
; HDEIEN Data Extract IEN
; TASKIEN Task IEN
;
; [.RBIEN] Start record IEN
; [.REIEN] End record IEN
; [.FILE] File name
;
; Return Values:
; <0 Error code
; 0 Ok
;
TASKPARM(HDEIEN,TASKIEN,RBIEN,REIEN,FILE) ;
N IENS,RC,ROOT,RORBUF,RORMSG,TMP
;--- Load data from the task record
S IENS=(+TASKIEN)_","_(+HDEIEN)_","
D GETS^DIQ(799.64,IENS,".01;.04;.05","I","RORBUF","RORMSG")
Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,,799.64,IENS)
S RBIEN=$G(RORBUF(799.64,IENS,.01,"I"))
S FILE=$G(RORBUF(799.64,IENS,.05,"I"))
;--- Get the end record IEN from the next task record
S ROOT=$$ROOT^DILFD(799.64,","_(+HDEIEN)_",",1)
S REIEN=$O(@ROOT@("B",RBIEN))
;--- If an IEN of the record is available from the previous run,
; use it as start record IEN
S TMP=$G(RORBUF(799.64,IENS,.04,"I"))
S:TMP>0 RBIEN=TMP
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORHDT05 4286 printed Apr 09, 2024@20:49:46 Page 2
RORHDT05 ;HCIOFO/SG - HISTORICAL DATA EXTRACTION FUNCTIONS ; 1/22/06 12:01pm
+1 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
+2 ;
+3 QUIT
+4 ;
+5 ;***** ADDS A RECORD TO THE 'ERROR' MULTIPLE OF THE TASK RECORD
+6 ;
+7 ; HDEIEN Data Extract IEN
+8 ; TASKIEN Task IEN
+9 ; PTIEN Patient IEN
+10 ;
+11 ; Return Values:
+12 ; <0 Error code
+13 ; 0 Ok
+14 ;
ADDERR(HDEIEN,TASKIEN,PTIEN) ;
+1 NEW IENS,RC,RORFDA,RORIEN,RORMSG
+2 SET IENS="+1,"_(+TASKIEN)_","_(+HDEIEN)_","
SET RORIEN(1)=+PTIEN
+3 SET RORFDA(799.641,IENS,.01)=+PTIEN
+4 DO UPDATE^DIE(,"RORFDA","RORIEN","RORMSG")
+5 QUIT $$DBS^RORERR("RORMSG",-9,,,799.641,IENS)
+6 ;
+7 ;***** DELETES RECORDS FROM THE 'ERROR' MULTIPLE OF THE TASK RECORD
+8 ;
+9 ; HDEIEN Data Extract IEN
+10 ; TASKIEN Task IEN
+11 ;
+12 ; This functions deletes all erroneous records from the ERROR
+13 ; multiple of the task record that have been re-extracted without
+14 ; errors. So, there is no reason to keep them anymore.
+15 ;
+16 ; Return Values:
+17 ; <0 Error code
+18 ; 0 Ok
+19 ;
CLRERRS(HDEIEN,TASKIEN) ;
+1 NEW I,IEN,RC,RORFDA,RORMSG,SFI
+2 SET SFI=","_(+TASKIEN)_","_(+HDEIEN)_","
SET RC=0
+3 SET IEN=""
+4 FOR
Begin DoDot:1
+5 FOR I=1:1:10
SET IEN=$ORDER(^TMP("RORHDT",$JOB,"PR",IEN))
if IEN=""
QUIT
Begin DoDot:2
+6 if ^TMP("RORHDT",$JOB,"PR",IEN)'<0
SET RORFDA(799.641,IEN_SFI,.01)="@"
End DoDot:2
+7 if $DATA(RORFDA)<10
QUIT
+8 DO FILE^DIE(,"RORFDA","RORMSG")
+9 if $GET(DIERR)
SET RC=$$DBS^RORERR("RORMSG",-9,,,799.641)
End DoDot:1
if (RC<0)!(IEN="")
QUIT
+10 QUIT $SELECT(RC<0:RC,1:0)
+11 ;
+12 ;***** COMMITS HL7 DATA TO THE OUTPUT FILE
+13 ;
+14 ; OUTDIR Output directory
+15 ; FILE Output file name
+16 ;
+17 ; Return Values:
+18 ; <0 Error code
+19 ; 0 Ok
+20 ;
COMMIT(OUTDIR,FILE) ;
+1 NEW CR,I,J,POP,RC
+2 if $DATA(^TMP("HLS",$JOB))<10
QUIT 0
+3 SET CR=$CHAR(13)
SET RC=0
+4 ;--- Create the file and write the BHS segment (if necessary)
+5 IF $GET(RORHDT("BHS"))
Begin DoDot:1
+6 DO OPEN^%ZISH("HL7FILE",OUTDIR,FILE,"WB")
+7 IF $GET(POP)
SET RC=$$ERROR^RORERR(-34,,OUTDIR_FILE)
QUIT
+8 SET I=$GET(ROREXT("HL7DT"))
USE IO
+9 WRITE $$BHS^RORHL7A($GET(ROREXT("HL7MID")),I,"HISTORICAL DATA"),$CHAR(13)
End DoDot:1
if RC<0
QUIT RC
KILL RORHDT("BHS")
+10 ;--- Write the segments
+11 SET I=0
+12 FOR
SET I=$ORDER(^TMP("HLS",$JOB,I))
if I=""
QUIT
Begin DoDot:1
+13 WRITE ^TMP("HLS",$JOB,I)
SET J=""
+14 FOR
SET J=$ORDER(^TMP("HLS",$JOB,I,J))
if J=""
QUIT
WRITE ^(J)
+15 WRITE CR
End DoDot:1
+16 QUIT 0
+17 ;
+18 ;***** DELETES THE OLD OUTPUT HOST FILE(S)
+19 ;
+20 ; OUTDIR Output directory
+21 ; FILE Output file name
+22 ;
+23 ; Return Values:
+24 ; <0 Error code
+25 ; 0 Ok
+26 ;
DELFILES(OUTDIR,FILE) ;
+1 NEW RC,RORDST,RORSRC
if FILE=""
QUIT 0
+2 SET RORSRC(FILE_"*")=""
+3 if '$$LIST^%ZISH(OUTDIR,"RORSRC","RORDST")
QUIT 0
+4 IF '$$DEL^%ZISH(OUTDIR,"RORDST")
Begin DoDot:1
+5 SET RC=$$ERROR^RORERR(-56,,,,0,"$$DEL^%ZISH")
End DoDot:1
QUIT RC
+6 QUIT 0
+7 ;
+8 ;***** LOADS DATA EXTRACTION PARAMETERS
+9 ;
+10 ; HDEIEN Data Extract IEN
+11 ;
+12 ; [.BDT] Start date of the data extract
+13 ; [.EDT] End date of the data extract
+14 ; [.OUTDIR] Output directory
+15 ;
+16 ; Return Values:
+17 ; <0 Error code
+18 ; 0 Ok
+19 ;
HDEPARM(HDEIEN,BDT,EDT,OUTDIR) ;
+1 NEW IENS,RC,RORBUF,RORMSG,TMP
+2 SET IENS=(+HDEIEN)_","
+3 ;--- Get data from the registry descriptor
+4 DO GETS^DIQ(799.6,IENS,".03;.04;2","I","RORBUF","RORMSG")
+5 if $GET(DIERR)
QUIT $$DBS^RORERR("RORMSG",-9,,,798.1,IENS)
+6 SET BDT=$GET(RORBUF(799.6,IENS,.03,"I"))
+7 SET EDT=$GET(RORBUF(799.6,IENS,.04,"I"))
+8 SET OUTDIR=$GET(RORBUF(799.6,IENS,2,"I"))
+9 IF (BDT'>0)!(EDT'>0)!(BDT>EDT)
Begin DoDot:1
+10 SET RC=$$ERROR^RORERR(-32,,,,BDT,EDT)
End DoDot:1
QUIT RC
+11 QUIT 0
+12 ;
+13 ;***** LOADS TASK PARAMETERS
+14 ;
+15 ; HDEIEN Data Extract IEN
+16 ; TASKIEN Task IEN
+17 ;
+18 ; [.RBIEN] Start record IEN
+19 ; [.REIEN] End record IEN
+20 ; [.FILE] File name
+21 ;
+22 ; Return Values:
+23 ; <0 Error code
+24 ; 0 Ok
+25 ;
TASKPARM(HDEIEN,TASKIEN,RBIEN,REIEN,FILE) ;
+1 NEW IENS,RC,ROOT,RORBUF,RORMSG,TMP
+2 ;--- Load data from the task record
+3 SET IENS=(+TASKIEN)_","_(+HDEIEN)_","
+4 DO GETS^DIQ(799.64,IENS,".01;.04;.05","I","RORBUF","RORMSG")
+5 if $GET(DIERR)
QUIT $$DBS^RORERR("RORMSG",-9,,,799.64,IENS)
+6 SET RBIEN=$GET(RORBUF(799.64,IENS,.01,"I"))
+7 SET FILE=$GET(RORBUF(799.64,IENS,.05,"I"))
+8 ;--- Get the end record IEN from the next task record
+9 SET ROOT=$$ROOT^DILFD(799.64,","_(+HDEIEN)_",",1)
+10 SET REIEN=$ORDER(@ROOT@("B",RBIEN))
+11 ;--- If an IEN of the record is available from the previous run,
+12 ; use it as start record IEN
+13 SET TMP=$GET(RORBUF(799.64,IENS,.04,"I"))
+14 if TMP>0
SET RBIEN=TMP
+15 QUIT 0
