Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RORHDT04

RORHDT04.m

Go to the documentation of this file. 
  1. RORHDT04 ;HCIOFO/SG - HISTORICAL DATA EXTRACTION PROCESS ;1/22/06 8:18pm
  1.  ;;1.5;CLINICAL CASE REGISTRIES;**10**;Feb 17, 2006;Build 32
  1.  ;
  1.  ; This routine uses the following IAs:
  1.  ;
  1.  ; #2320  CLOSE^ZISH (supported)
  1.  ; #2053  FILE^DIE (supported)
  1.  ; #2055  $$ROOT^DILFD (supported)
  1.  Q
  1.  ;
  1.  ;***** DATA EXTRACTION PROCESS
  1.  ;
  1.  ; .REGLST       Reference to a local array containing registry
  1.  ;               names as subscripts and registry IENs as values
  1.  ;
  1.  ; HDEIEN        Data Extract IEN
  1.  ; TASKIEN       Task IEN
  1.  ;
  1.  ; FAM           File Access Mode
  1.  ;
  1.  ; Return Values:
  1.  ;       <0  Error code
  1.  ;      >=0  Statistics
  1.  ;             ^1: Total number of processed patients
  1.  ;             ^2: Number of patients processed with errors
  1.  ;
  1. EXTRACT(REGLST,HDEIEN,TASKIEN,FAM) ;
  1.  N ROREXT        ; Data extraction descriptor
  1.  N RORHL         ; HL7 variables
  1.  N RORLRC        ; List of codes of Lab results to be extracted
  1.  ;
  1.  N CNT           ; Number of processed registry records
  1.  N ECNT          ; Number of records processed with errors
  1.  N FILE          ; Name of the output file
  1.  N OUTDIR        ; Name of the output directory
  1.  ;
  1.  N BDT,EDT,NEXT,POP,RC,REGIEN,REGNAME,RGIENLST,RRBIEN,RREIEN,STOP,TMP
  1.  K ^TMP("RORHDT",$J,"PR"),^TMP("HLS",$J),^TMP("RORPTF",$J)
  1.  S (CNT,ECNT,STOP)=0,RORHDT("BHS")=1
  1.  ;--- Prepare the list of registry IENs
  1.  S REGNAME="",REGIEN=0
  1.  F  S REGNAME=$O(REGLST(REGNAME))  Q:REGNAME=""  D  Q:REGIEN<0
  1.  . S REGIEN=+REGLST(REGNAME)
  1.  . S:REGIEN'>0 REGIEN=$$REGIEN^RORUTL02(REGNAME)
  1.  . S:REGIEN>0 RGIENLST(REGIEN)=""
  1.  Q:REGIEN<0 REGIEN
  1.  ;
  1.  ;=== Load parameters
  1.  S RC=$$HDEPARM^RORHDT05(HDEIEN,.BDT,.EDT,.OUTDIR)
  1.  Q:RC<0 RC
  1.  S RC=$$TASKPARM^RORHDT05(HDEIEN,TASKIEN,.RRBIEN,.RREIEN,.FILE)
  1.  Q:RC<0 RC
  1.  ;
  1.  ;=== Prepare data extraction rules
  1.  S RC=$$PREPARE^ROREXPR(.REGLST,BDT,EDT)
  1.  Q:RC<0 $$ERROR^RORERR(-22)
  1.  ;--- Load and process historical data extraction parameters
  1.  S RC=$$PREPARE^RORHDT06(HDEIEN)  Q:RC<0 RC
  1.  K ROREXT("MAXHL7SIZE")  ; Do not limit the size
  1.  ;
  1.  ;=== Initialize the HL7 environment
  1.  S RC=$$INIT^RORHL7()  Q:RC<0 RC
  1.  ;
  1.  ;=== Delete the old output host file(s)
  1.  S TMP=$$DELFILES^RORHDT05(OUTDIR,FILE)
  1.  ;
  1.  D
  1.  . N COMMIT,IENS,NODE,NRTC,PTIEN
  1.  . S NRTC=100 ; Number of records to commit
  1.  . ;
  1.  . ;=== Try to re-extract the erroneous records
  1.  . S NODE=$$ROOT^DILFD(799.641,","_(+TASKIEN)_","_(+HDEIEN)_",",1)
  1.  . S NODE=$NA(@NODE@("B"))
  1.  . S PTIEN=0,RC=0
  1.  . F  D  Q:RC!STOP!(PTIEN'>0)
  1.  . . K ^TMP("HLS",$J)
  1.  . . F  S PTIEN=$O(@NODE@(PTIEN))  Q:PTIEN'>0  D  Q:RC!'((CNT-ECNT)#NRTC)
  1.  . . . S RC=$$LOOP^RORTSK01()
  1.  . . . I RC<0  S:RC=-42 STOP=1  Q
  1.  . . . S RC=$$PROCREC(PTIEN,.RGIENLST),CNT=CNT+1
  1.  . . . S ^TMP("RORHDT",$J,"PR",PTIEN)=RC
  1.  . . . I RC'<0  S RC=0  Q
  1.  . . . ;--- Process the error
  1.  . . . S RC=$$ERROR^RORERR(-15,,,PTIEN),ECNT=ECNT+1
  1.  . . . S:$G(RORPARM("DEBUG"))<3 RC=0
  1.  . . I RC<0  Q:'STOP
  1.  . . ;--- Commit the data
  1.  . . S TMP=$$COMMIT^RORHDT05(OUTDIR,FILE)
  1.  . . S:TMP<0 RC=TMP
  1.  . Q:STOP!(RC=-34)
  1.  . ;
  1.  . ;=== Extract the remaining registry data
  1.  . S PTIEN=$S(RRBIEN>0:+$O(^RORDATA(798,"KEY",RRBIEN),-1),1:0)
  1.  . S RC=0
  1.  . F  D  Q:RC!STOP!(PTIEN'>0)
  1.  . . K ^TMP("HLS",$J)  S COMMIT=0
  1.  . . F  S PTIEN=$$NEXTPAT(PTIEN,.RGIENLST)  Q:PTIEN'>0  D  Q:RC!COMMIT
  1.  . . . S RC=$$LOOP^RORTSK01()
  1.  . . . I RC<0  S:RC=-42 STOP=1  Q
  1.  . . . I RREIEN>0,PTIEN'<RREIEN  S PTIEN="",RC=1  Q
  1.  . . . Q:$D(^TMP("RORHDT",$J,"PR",PTIEN))
  1.  . . . S RC=$$PROCREC(PTIEN,.RGIENLST),CNT=CNT+1
  1.  . . . I RC'<0  S COMMIT='((CNT-ECNT)#NRTC),RC=0  Q
  1.  . . . ;--- Process the error
  1.  . . . S RC=$$ERROR^RORERR(-15,,,PTIEN),ECNT=ECNT+1
  1.  . . . S:$G(RORPARM("DEBUG"))<3 RC=0
  1.  . . . S TMP=$$ADDERR^RORHDT05(HDEIEN,TASKIEN,PTIEN)
  1.  . . . S:TMP<0 RC=TMP
  1.  . . I RC<0  Q:'STOP
  1.  . . ;--- Commit the data
  1.  . . S NEXT=$S(COMMIT:$$NEXTPAT(PTIEN,.RGIENLST),1:PTIEN)
  1.  . . S TMP=$$COMMIT^RORHDT05(OUTDIR,FILE)
  1.  . . S:TMP<0 RC=TMP
  1.  ;
  1.  ;--- The $$COMMIT^RORHDT05 returns -34 if it was not able to create
  1.  ;--- the output file (wrong directory name, protection error, etc.).
  1.  D:RC'=-34
  1.  . N NODE,RORFDA,RORMSG
  1.  . ;
  1.  . ;=== Write the batch trailer segment and close the file if
  1.  . ;=== the batch is not empty. Otherwise, record a warning.
  1.  . I '$G(RORHDT("BHS"))  D
  1.  . . S TMP=$S(ECNT!(RC<0):"Completed with errors",STOP:"Stopped",1:"")
  1.  . . U IO  W $$BTS^RORHL7A($$MSGCNT^RORHL7,TMP),$C(13)
  1.  . . D CLOSE^%ZISH("HL7FILE")
  1.  . E  D ERROR^RORERR(-89)
  1.  . ;
  1.  . ;=== Update the NEXT RECORD IEN field in the task record
  1.  . I $D(NEXT)  D:NEXT'>0
  1.  . . ;--- If the task completed successfully, the NEXT RECORD IEN
  1.  . . ;    field is set to an empty string. If the task is restarted
  1.  . . ;--- afterwards, it will re-extract all data again.
  1.  . . I 'ECNT  S NEXT=""  Q
  1.  . . ;--- If completed with errors, use IEN of the last record
  1.  . . ;--- processed by the task incremented by 1.
  1.  . . I RREIEN>0  S NEXT=RREIEN+1  Q
  1.  . . ;--- Or the IEN of the last patient record incremented by 1
  1.  . . ;--- (in case of the last/single task).
  1.  . . S NEXT=$O(^RORDATA(798,"KEY",""),-1)+1
  1.  . . ;--- When the task is restarted, it will try to re-extract only
  1.  . . ;    erroneous records and will not process already extracted
  1.  . . ;    data (the PTIEN will not be less than the RREIEN or the
  1.  . . ;--- $ORDER function will not return a value greater than zero).
  1.  . E  Q:(RC<0)!ECNT!STOP  S NEXT=""
  1.  . ;
  1.  . ;=== Update the task record
  1.  . S IENS=(+TASKIEN)_","_(+HDEIEN)_","
  1.  . S RORFDA(799.64,IENS,.04)=NEXT
  1.  . D FILE^DIE("K","RORFDA","RORMSG")
  1.  . S TMP=$$DBS^RORERR("RORMSG",-9,,,799.64,IENS)
  1.  ;
  1.  ;=== Cleanup
  1.  K ^TMP("RORPTF",$J)
  1.  S:RC'<0 RC=$$CLRERRS^RORHDT05(HDEIEN,TASKIEN)
  1.  Q $S(RC<0:RC,1:CNT_U_ECNT)
  1.  ;
  1.  ;***** RETURNS THE NEXT PATIENT FOR DATA EXTRACTION
  1.  ;
  1.  ; PTIEN         Patient IEN (DFN)
  1.  ;
  1.  ; .RGIENLST     Reference to a local array containing registry
  1.  ;               IENs as subscripts. The IENs of the corresponding
  1.  ;               patient's registry records are returned as values.
  1.  ;
  1.  ; Return Values:
  1.  ;        0  No more patients
  1.  ;       >0  IEN (DFN) of the next patient who belongs to at least
  1.  ;           one of the registries defined by the RGIENLST parameter.
  1.  ;
  1. NEXTPAT(PTIEN,RGIENLST) ;
  1.  N CNT,IEN,REGIEN
  1.  S CNT=0
  1.  F  S PTIEN=$O(^RORDATA(798,"KEY",PTIEN))  Q:PTIEN'>0  D  Q:CNT
  1.  . S REGIEN=0
  1.  . F  S REGIEN=$O(RGIENLST(REGIEN))  Q:REGIEN'>0  D
  1.  . . S RGIENLST(REGIEN)=0
  1.  . . S IEN=+$O(^RORDATA(798,"KEY",PTIEN,REGIEN,""))
  1.  . . Q:IEN'>0
  1.  . . ;************************************************************
  1.  . . ; Patch 10: also include pending patients
  1.  . . ;--- Skip inactive records (pending and marked for deletion)
  1.  . . ;Q:'$$ACTIVE^RORDD(IEN)
  1.  . . ;************************************************************
  1.  . . ;--- skip patients marked for deletion
  1.  . . I $$DEL^RORDD(IEN) Q
  1.  . . ;--- Skip records tagged as "DON'T SEND" and skip test patients
  1.  . . I (($P($G(^RORDATA(798,IEN,2)),U,4))!($$TESTPAT^RORUTL01(PTIEN))) Q
  1.  . . ;--- Consider the record
  1.  . . S RGIENLST(REGIEN)=IEN,CNT=CNT+1
  1.  Q $S(PTIEN>0:PTIEN,1:0)
  1.  ;
  1.  ;***** PROCESSES A RECORD IN THE REGISTRY
  1.  ;
  1.  ; PTIEN         Patient IEN (DFN)
  1.  ;
  1.  ; .RGIENLST     Reference to a local array containing registry
  1.  ;               IENs as subscripts and IENs of the corresponding
  1.  ;               patient's registry records as values.
  1.  ;
  1.  ; Return Values:
  1.  ;       <0  Error code
  1.  ;        0  Ok
  1.  ;        1  Nothing has been extracted
  1.  ;
  1. PROCREC(PTIEN,RGIENLST) ;
  1.  N RORERRDL      ; Default error location
  1.  ;
  1.  N BATCHID,CNT,DXDTS,IEN,MSHPTR,RC,REGIEN,RORMSH,TMP
  1.  D CLEAR^RORERR("PROCREC^RORHDT04")
  1.  ;
  1.  ;--- Compile the data extraction time frames
  1.  S (CNT,RC,REGIEN)=0
  1.  F  S REGIEN=$O(RGIENLST(REGIEN))  Q:REGIEN'>0  D  Q:RC<0
  1.  . S IEN=+RGIENLST(REGIEN)  Q:IEN'>0
  1.  . S RC=$$DXPERIOD^ROREXTUT(.DXDTS,IEN,PTIEN)
  1.  . S:'RC CNT=CNT+1
  1.  . S:RC>0 RGIENLST(REGIEN)=0
  1.  Q:RC<0 RC
  1.  ;--- If the patient should be skipped in all registries
  1.  ;    that are being processed, then do not perform the data
  1.  ;--- extraction for this patient at all.
  1.  I 'CNT  D:$G(RORPARM("DEBUG"))  Q 0
  1.  . D LOG^RORLOG(4,"There is no data to extract.",PTIEN)
  1.  ;
  1.  ;--- Create an HL7 message for the patient
  1.  S MSHPTR=$$CREATE^RORHL7(.RORMSH)  Q:MSHPTR<0 MSHPTR
  1.  S RC=$$MESSAGE^ROREXT02(PTIEN,.RGIENLST,.DXDTS,$G(ROREXT("HDTIEN")))
  1.  ;
  1.  ;--- Delete the unfinished message from the ^TMP("HLS",$J)
  1.  ;    if there is no data to send (RC>0) or there was an error
  1.  ;    during the data extraction (RC<0). Return the error code
  1.  ;--- in the latter case.
  1.  I RC!($O(^TMP("HLS",$J,""),-1)=MSHPTR)  D  Q:RC<0 RC
  1.  . D ROLLBACK^RORHL7(MSHPTR)  S:'RC RC=1
  1.  ;---
  1.  Q RC