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

ROREXT01.m

Go to the documentation of this file. 
  1. ROREXT01 ;HCIOFO/SG - EXTRACTION & TRANSMISSION PROCESS ;1/22/06 12:40pm
  1.  ;;1.5;CLINICAL CASE REGISTRIES;**10,21,28**;Feb 17, 2006;Build 66
  1.  ;
  1.  ; This routine uses the following IAs:
  1.  ;
  1.  ; #10063  $$S^%ZTLOAD (supported)
  1.  ; #10103  $$FMDIFF^XLFDT (supported)
  1.  ; #10103  $$NOW^XLFDT (supported)
  1.  ;
  1.  ;******************************************************************************
  1.  ;******************************************************************************
  1.  ;                 --- ROUTINE MODIFICATION LOG ---
  1.  ;        
  1.  ;PKG/PATCH    DATE        DEVELOPER    MODIFICATION
  1.  ;-----------  ----------  -----------  ----------------------------------------
  1.  ;ROR*1.5*21   NOV 2013    T KOPP       Output # of reports run for all local
  1.  ;                                      registries
  1.  ;ROR*1.5*28   APR  2016   T KOPP       Kill flag for one time extract to
  1.  ;                                      retrieve problem list entries missed
  1.  ;                                      from 2009-2011 for HIV/HEPC registries
  1.  ;******************************************************************************
  1.  ;******************************************************************************
  1.  Q
  1.  ;
  1.  ;***** INTERNAL ENTRY POINT FOR DATA EXTRACTION
  1.  ;
  1.  ; .REGLST       Reference to a local array containing registry
  1.  ;               names as subscripts and registry IENs as values
  1.  ;
  1.  ; [RORTASK]     Task Number (if the data extraction is performed
  1.  ;               by a separate process)
  1.  ;
  1.  ; Return Values:
  1.  ;       <0  Error code (see MSGLIST^RORERR20)
  1.  ;        0  Ok
  1.  ;
  1.  ; NOTE: The ROREXT and RORPARM local arrays must be properly
  1.  ;       initialized before calling this function.
  1.  ;
  1. INTEXT(REGLST,RORTASK) ;
  1.  N RORHL         ; HL7 variables
  1.  N RORLOG        ; Log subsystem constants & variables
  1.  N RORLRC        ; List of codes of Lab results to be extracted
  1.  ;
  1.  N COUNTERS,DXBEG,DXEND,HDTIEN,MID,RC,TMP
  1.  D INIT^RORUTL01("ROREXT")
  1.  S DXBEG=$G(ROREXT("DXBEG")),DXEND="",HDTIEN=0
  1.  K ^TMP("RORPTF",$J)
  1.  ;--- Open a new log
  1.  S TMP=$$SETUP^RORLOG(.REGLST)
  1.  S TMP=$S($G(RORTASK)'="":" TASK #"_RORTASK,1:"")
  1.  S TMP=$$OPEN^RORLOG(.REGLST,2,"DATA EXTRACTION"_TMP_" STARTED")
  1.  D
  1.  . ;--- Check the list of registries
  1.  . I $D(REGLST)<10  D  Q
  1.  . . S RC=$$ERROR^RORERR(-28,,,,"extract data")
  1.  . ;--- Lock parameters of the registries being processed
  1.  . S RC=$$LOCKREG^RORUTL02(.REGLST,1,,"DATA EXTRACTION")  Q:RC<0
  1.  . I 'RC  D  Q
  1.  . . S RC=$$ERROR^RORERR(-11,,,,"registries being processed")
  1.  . ;--- Check for pending historical data extraction
  1.  . I DXBEG'>0  D  I HDTIEN<0  S RC=+HDTIEN  Q
  1.  . . S HDTIEN=$$FIND^RORHDT06(.REGLST,.DXBEG,.DXEND)
  1.  . ;--- Load and process data extraction rules
  1.  . S RC=$$PREPARE^ROREXPR(.REGLST,DXBEG,DXEND)
  1.  . I RC<0  S RC=$$ERROR^RORERR(-22)  Q
  1.  . ;--- Load and process the historical data extraction parameters
  1.  . I HDTIEN>0  D  Q:RC<0
  1.  . . S RC=$$PREPARE^RORHDT06(HDTIEN)
  1.  . ;--- Reference the historical data extraction definition
  1.  . S RC=$$REGREF^RORHDT06(.REGLST,HDTIEN)  Q:RC<0
  1.  . ;--- Display the debug information
  1.  . D:$G(RORPARM("DEBUG"))>1 DEBUG^ROREXTUT
  1.  . ;--- Extract and send the data
  1.  . S RC=$$PROCESS(.REGLST)  Q:RC<0
  1.  . S COUNTERS=RC,RC=0
  1.  . ;--- Update registry parameters
  1.  . S TMP=$$TMSTMP^ROREXTUT(.REGLST)
  1.  ;--- Unlock parameters of processed registries
  1.  S TMP=$$LOCKREG^RORUTL02(.REGLST,0)
  1.  ;
  1.  ;--- Statistics & Cleanup
  1.  S TMP="DATA EXTRACTION "_$S(RC<0:"ABORTED",1:"COMPLETED")
  1.  I RC'<0,$D(^XTMP("ROR_ONETIME_PROBLEM_LIST_EXTRACT")) K ^XTMP("ROR_ONETIME_PROBLEM_LIST_EXTRACT")
  1.  D CLOSE^RORLOG(TMP,$G(COUNTERS))
  1.  D:'$G(RORPARM("DEBUG")) INIT^RORUTL01("ROREXT")
  1.  K ^TMP("RORPTF",$J)
  1.  ;---
  1.  Q $S($G(RC)<0:RC,1:0)
  1.  ;
  1.  ;***** RETURNS THE NEXT PATIENT FOR DATA EXTRACTION
  1.  ;
  1.  ; PTIEN         Patient IEN (DFN in file #2)
  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,STATUS
  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.  . . ;With patch 10, status is irrelevant
  1.  . . ;I '$$ACTIVE^RORDD(IEN,,.STATUS)  Q:STATUS'=5
  1.  . . ;--- Skip a record tagged as "DON'T SEND" or if test patient
  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.  ;***** SCANS THE REGISTRY AND EXTRACTS THE DATA
  1.  ;
  1.  ; .REGLST       Reference to a local array containing registry
  1.  ;               names as subscripts and registry IENs as values
  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.  ; In normal mode this function processes all patients and returns
  1.  ; total number of patients and number of patients processed with
  1.  ; errors.
  1.  ;
  1.  ; However, in debug mode 3 the function stops after the first
  1.  ; patient processed with error and returns an error code.
  1.  ;
  1. PROCESS(REGLST) ;
  1.  N CNT,DTNEXT,ECNT,PTIEN,RC,REGIEN,REGNAME,RGIENLST,RORBUF,RORMSG,TH,TMP
  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.  ;--- Initialize environment variables
  1.  S RC=$$INIT^RORHL7()  Q:RC<0 RC
  1.  ;
  1.  ;--- Generate the registry state message
  1.  S RC=$$CREATE^RORHL7()  Q:RC<0 RC
  1.  S REGIEN=0
  1.  F  S REGIEN=$O(RGIENLST(REGIEN))  Q:REGIEN'>0  D  Q:RC<0
  1.  . S RC=$$REGSTATE^ROREXT03(REGIEN)
  1.  Q:RC<0 RC
  1.  ;
  1.  ;Output # of reports run for all local registries
  1.  S REGIEN=0
  1.  F  S REGIEN=$O(^ROR(798.1,REGIEN))  Q:REGIEN'>0  D  Q:RC<0
  1.  . I '$D(RGIENLST(REGIEN)) S RC=$$REGSTATE^ROREXT03(REGIEN)
  1.  Q:RC<0 RC
  1.  ;
  1.  ;--- Loop through the patients of the registries
  1.  S (CNT,ECNT,PTIEN,RC)=0
  1.  F  S PTIEN=$$NEXTPAT(PTIEN,.RGIENLST)  Q:PTIEN'>0  D  Q:RC
  1.  . ;--- For a queued task only
  1.  . I $D(ZTQUEUED)  S RC=0  D  Q:RC<0
  1.  . . ;--- Check if task stop has been requested
  1.  . . I $$S^%ZTLOAD  S RC=$$ERROR^RORERR(-42)  Q
  1.  . . ;--- Check if the task should be suspended
  1.  . . Q:'$G(ROREXT("SUSPEND"))
  1.  . . Q:$$NOW^XLFDT<$G(DTNEXT)
  1.  . . Q:'$$SUSPEND(.DTNEXT)
  1.  . . ;--- Suspend the task during the peak hours
  1.  . . F  D  Q:'TH!(RC<0)
  1.  . . . S TH=$$FMDIFF^XLFDT(DTNEXT,$$NOW^XLFDT,2)
  1.  . . . I TH<60  S TH=0  Q       ; Do not HANG for less than a
  1.  . . . H $S(TH>3600:3600,1:TH)  ; minute and more than an hour
  1.  . . . ;--- Check if task stop has been requested
  1.  . . . S:$$S^%ZTLOAD RC=$$ERROR^RORERR(-42)
  1.  . ;--- Process the patient's records
  1.  . S CNT=CNT+1
  1.  . I $G(RORPARM("DEBUG"))>1  W:$E($G(IOST),1,2)="C-" *13,CNT
  1.  . S RC=$$PROCPAT(PTIEN,.RGIENLST)
  1.  . ;--- Process the error (if any)
  1.  . I RC<0  D  S:$G(RORPARM("DEBUG"))<3 RC=0  Q
  1.  . . S ECNT=ECNT+1,RC=$$ERROR^RORERR(-15,,,$G(PTIEN))
  1.  . ;--- Send the batch HL7 message when the maximum size is reached
  1.  . S:$$ISMAXSZ^RORHL7() RC=$$SEND^ROREXT03(.RGIENLST)
  1.  Q:RC<0 RC
  1.  ;
  1.  ;--- Send the remaining data (flush the buffer)
  1.  S RC=$$SEND^ROREXT03(.RGIENLST)  Q:RC<0 RC
  1.  ;
  1.  ;--- Return number of processed patients and number of errors
  1.  Q CNT_U_ECNT
  1.  ;
  1.  ;***** PROCESS THE PATIENT'S REGISTRY RECORDS
  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. PROCPAT(PTIEN,RGIENLST) ;
  1.  N RORERRDL      ; Default error location
  1.  ;
  1.  N BATCHID,CNT,DXDTS,IEN,MSHPTR,RC,REGIEN,RORMSH,TMP
  1.  D CLEAR^RORERR("PROCPAT^ROREXT01")
  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.  ;--- Do not change state of the record(s) during the
  1.  ;--- historical data extraction
  1.  I $G(ROREXT("HDTIEN"))'>0  D  Q:RC<0 RC
  1.  . S TMP=$S('RC:$P(RORMSH,$E(RORMSH,4),10),1:"")
  1.  . S RC=$$UPDRECS^ROREXT03(PTIEN,.RGIENLST,TMP,$P(DXDTS,U,2))
  1.  ;---
  1.  Q 0
  1.  ;
  1.  ;***** CHECKS IF THE TASK SHOULD BE SUSPENDED
  1.  ;
  1.  ; .DTNEXT       Date/Time of the next event (suspend/resume)
  1.  ;               is returned via this parameter
  1.  ;
  1.  ; Return Values:
  1.  ;        0  Continue/Resume
  1.  ;        1  Suspend
  1.  ;
  1. SUSPEND(DTNEXT) ;
  1.  N DATE,NOW,SUSPEND,TIME,TS,TR
  1.  S TS=$P(ROREXT("SUSPEND"),U,1)
  1.  S TR=$P(ROREXT("SUSPEND"),U,2)
  1.  S NOW=$$NOW^XLFDT,DATE=NOW\1
  1.  ;--- A work day
  1.  I $$WDCHK^RORUTL01(DATE)  D  Q SUSPEND
  1.  . S TIME=NOW-DATE,SUSPEND=0
  1.  . I TIME<TS   S DTNEXT=DATE+TS  Q
  1.  . I TIME'<TR  S DTNEXT=$$WDNEXT^RORUTL01(DATE)+TS  Q
  1.  . S DTNEXT=DATE+TR,SUSPEND=1
  1.  ;--- Saturday, Sunday or Holiday
  1.  S DTNEXT=$$WDNEXT^RORUTL01(DATE)+TS
  1.  Q 0