source: WorldVistAEHR/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/ROREXT01.m@ 1464

ROREXT01 ;HCIOFO/SG - EXTRACTION & TRANSMISSION PROCESS ; 1/22/06 12:40pm

 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006

 ;

 Q

 ;

 ;***** INTERNAL ENTRY POINT FOR DATA EXTRACTION

 ;

 ; .REGLST       Reference to a local array containing registry

 ;               names as subscripts and registry IENs as values

 ;

 ; [RORTASK]     Task Number (if the data extraction is performed

 ;               by a separate process)

 ;

 ; Return Values:

 ;       <0  Error code (see MSGLIST^RORERR20)

 ;        0  Ok

 ;

 ; NOTE: The ROREXT and RORPARM local arrays must be properly

 ;       initialized before calling this function.

 ;

INTEXT(REGLST,RORTASK) ;

 N RORHL         ; HL7 variables

 N RORLOG        ; Log subsystem constants & variables

 N RORLRC        ; List of codes of Lab results to be extracted

 ;

 N COUNTERS,DXBEG,DXEND,HDTIEN,MID,RC,TMP

 D INIT^RORUTL01("ROREXT")

 S DXBEG=$G(ROREXT("DXBEG")),DXEND="",HDTIEN=0

 K ^TMP("RORPTF",$J)

 ;--- Open a new log

 S TMP=$$SETUP^RORLOG(.REGLST)

 S TMP=$S($G(RORTASK)'="":" TASK #"_RORTASK,1:"")

 S TMP=$$OPEN^RORLOG(.REGLST,2,"DATA EXTRACTION"_TMP_" STARTED")

 D

 . ;--- Check the list of registries

 . I $D(REGLST)<10  D  Q

 . . S RC=$$ERROR^RORERR(-28,,,,"extract data")

 . ;--- Lock parameters of the registries being processed

 . S RC=$$LOCKREG^RORUTL02(.REGLST,1,,"DATA EXTRACTION")  Q:RC<0

 . I 'RC  D  Q

 . . S RC=$$ERROR^RORERR(-11,,,,"registries being processed")

 . ;--- Check for pending historical data extraction

 . I DXBEG'>0  D  I HDTIEN<0  S RC=+HDTIEN  Q

 . . S HDTIEN=$$FIND^RORHDT06(.REGLST,.DXBEG,.DXEND)

 . ;--- Load and process data extraction rules

 . S RC=$$PREPARE^ROREXPR(.REGLST,DXBEG,DXEND)

 . I RC<0  S RC=$$ERROR^RORERR(-22)  Q

 . ;--- Load and process the historical data extraction parameters

 . I HDTIEN>0  D  Q:RC<0

 . . S RC=$$PREPARE^RORHDT06(HDTIEN)

 . ;--- Reference the historical data extraction definition

 . S RC=$$REGREF^RORHDT06(.REGLST,HDTIEN)  Q:RC<0

 . ;--- Display the debug information

 . D:$G(RORPARM("DEBUG"))>1 DEBUG^ROREXTUT

 . ;--- Extract and send the data

 . S RC=$$PROCESS(.REGLST)  Q:RC<0

 . S COUNTERS=RC,RC=0

 . ;--- Update registry parameters

 . S TMP=$$TMSTMP^ROREXTUT(.REGLST)

 ;--- Unlock parameters of processed registries

 S TMP=$$LOCKREG^RORUTL02(.REGLST,0)

 ;

 ;--- Statistics & Cleanup

 S TMP="DATA EXTRACTION "_$S(RC<0:"ABORTED",1:"COMPLETED")

 D CLOSE^RORLOG(TMP,$G(COUNTERS))

 D:'$G(RORPARM("DEBUG")) INIT^RORUTL01("ROREXT")

 K ^TMP("RORPTF",$J)

 ;---

 Q $S($G(RC)<0:RC,1:0)

 ;

 ;***** RETURNS THE NEXT PATIENT FOR DATA EXTRACTION

 ;

 ; PTIEN         Patient IEN (DFN)

 ;

 ; .RGIENLST     Reference to a local array containing registry

 ;               IENs as subscripts. The IENs of the corresponding

 ;               patient's registry records are returned as values.

 ;

 ; Return Values:

 ;        0  No more patients

 ;       >0  IEN (DFN) of the next patient who belongs to at least

 ;           one of the registries defined by the RGIENLST parameter.

 ;

NEXTPAT(PTIEN,RGIENLST) ;

 N CNT,IEN,REGIEN,STATUS

 S CNT=0

 F  S PTIEN=$O(^RORDATA(798,"KEY",PTIEN))  Q:PTIEN'>0  D  Q:CNT

 . S REGIEN=0

 . F  S REGIEN=$O(RGIENLST(REGIEN))  Q:REGIEN'>0  D

 . . S RGIENLST(REGIEN)=0

 . . S IEN=+$O(^RORDATA(798,"KEY",PTIEN,REGIEN,""))

 . . Q:IEN'>0

 . . ;--- Skip all inactive records except marked for deletion

 . . I '$$ACTIVE^RORDD(IEN,,.STATUS)  Q:STATUS'=5

 . . ;--- Skip a record tagged as "DON'T SEND"

 . . Q:$P($G(^RORDATA(798,IEN,2)),U,4)

 . . ;--- Consider the record

 . . S RGIENLST(REGIEN)=IEN,CNT=CNT+1

 Q $S(PTIEN>0:PTIEN,1:0)

 ;

 ;***** SCANS THE REGISTRY AND EXTRACTS THE DATA

 ;

 ; .REGLST       Reference to a local array containing registry

 ;               names as subscripts and registry IENs as values

 ;

 ; Return Values:

 ;       <0  Error Code

 ;      >=0  Statistics

 ;             ^1: Total number of processed patients

 ;             ^2: Number of patients processed with errors

 ;

 ; In normal mode this function processes all patients and returns

 ; total number of patients and number of patients processed with

 ; errors.

 ;

 ; However, in debug mode 3 the function stops after the first

 ; patient processed with error and returns an error code.

 ;

PROCESS(REGLST) ;

 N CNT,DTNEXT,ECNT,PTIEN,RC,REGIEN,REGNAME,RGIENLST,RORBUF,RORMSG,TH,TMP

 ;--- Prepare the list of registry IENs

 S REGNAME="",REGIEN=0

 F  S REGNAME=$O(REGLST(REGNAME))  Q:REGNAME=""  D  Q:REGIEN<0

 . S REGIEN=+REGLST(REGNAME)

 . S:REGIEN'>0 REGIEN=$$REGIEN^RORUTL02(REGNAME)

 . S:REGIEN>0 RGIENLST(REGIEN)=""

 Q:REGIEN<0 REGIEN

 ;--- Initialize environment variables

 S RC=$$INIT^RORHL7()  Q:RC<0 RC

 ;

 ;--- Generate the registry state message

 S RC=$$CREATE^RORHL7()  Q:RC<0 RC

 S REGIEN=0

 F  S REGIEN=$O(RGIENLST(REGIEN))  Q:REGIEN'>0  D  Q:RC<0

 . S RC=$$REGSTATE^ROREXT03(REGIEN)

 Q:RC<0 RC

 ;

 ;--- Loop through the patients of the registries

 S (CNT,ECNT,PTIEN,RC)=0

 F  S PTIEN=$$NEXTPAT(PTIEN,.RGIENLST)  Q:PTIEN'>0  D  Q:RC

 . ;--- For a queued task only

 . I $D(ZTQUEUED)  S RC=0  D  Q:RC<0

 . . ;--- Check if task stop has been requested

 . . I $$S^%ZTLOAD  S RC=$$ERROR^RORERR(-42)  Q

 . . ;--- Check if the task should be suspended

 . . Q:'$G(ROREXT("SUSPEND"))

 . . Q:$$NOW^XLFDT<$G(DTNEXT)

 . . Q:'$$SUSPEND(.DTNEXT)

 . . ;--- Suspend the task during the peak hours

 . . F  D  Q:'TH!(RC<0)

 . . . S TH=$$FMDIFF^XLFDT(DTNEXT,$$NOW^XLFDT,2)

 . . . I TH<60  S TH=0  Q       ; Do not HANG for less than a

 . . . H $S(TH>3600:3600,1:TH)  ; minute and more than an hour

 . . . ;--- Check if task stop has been requested

 . . . S:$$S^%ZTLOAD RC=$$ERROR^RORERR(-42)

 . ;--- Process the patient's records

 . S CNT=CNT+1

 . I $G(RORPARM("DEBUG"))>1  W:$E($G(IOST),1,2)="C-" *13,CNT

 . S RC=$$PROCPAT(PTIEN,.RGIENLST)

 . ;--- Process the error (if any)

 . I RC<0  D  S:$G(RORPARM("DEBUG"))<3 RC=0  Q

 . . S ECNT=ECNT+1,RC=$$ERROR^RORERR(-15,,,$G(PTIEN))

 . ;--- Send the batch HL7 message when the maximum size is reached

 . S:$$ISMAXSZ^RORHL7() RC=$$SEND^ROREXT03(.RGIENLST)

 Q:RC<0 RC

 ;

 ;--- Send the remaining data (flush the buffer)

 S RC=$$SEND^ROREXT03(.RGIENLST)  Q:RC<0 RC

 ;

 ;--- Return number of processed patients and number of errors

 Q CNT_U_ECNT

 ;

 ;***** PROCESS THE PATIENT'S REGISTRY RECORDS

 ;

 ; PTIEN         Patient IEN (DFN)

 ;

 ; .RGIENLST     Reference to a local array containing registry

 ;               IENs as subscripts and IENs of the corresponding

 ;               patient's registry records as values.

 ;

 ; Return Values:

 ;       <0  Error Code

 ;        0  Ok

 ;

PROCPAT(PTIEN,RGIENLST) ;

 N RORERRDL      ; Default error location

 ;

 N BATCHID,CNT,DXDTS,IEN,MSHPTR,RC,REGIEN,RORMSH,TMP

 D CLEAR^RORERR("PROCPAT^ROREXT01")

 ;

 ;--- Compile the data extraction time frames

 S (CNT,RC,REGIEN)=0

 F  S REGIEN=$O(RGIENLST(REGIEN))  Q:REGIEN'>0  D  Q:RC<0

 . S IEN=+RGIENLST(REGIEN)  Q:IEN'>0

 . S RC=$$DXPERIOD^ROREXTUT(.DXDTS,IEN,PTIEN)

 . S:'RC CNT=CNT+1

 . S:RC>0 RGIENLST(REGIEN)=0

 Q:RC<0 RC

 ;--- If the patient should be skipped in all registries

 ;    that are being processed, then do not perform the data

 ;--- extraction for this patient at all.

 I 'CNT  D:$G(RORPARM("DEBUG"))  Q 0

 . D LOG^RORLOG(4,"There is no data to extract.",PTIEN)

 ;

 ;--- Create an HL7 message for the patient

 S MSHPTR=$$CREATE^RORHL7(.RORMSH)  Q:MSHPTR<0 MSHPTR

 S RC=$$MESSAGE^ROREXT02(PTIEN,.RGIENLST,.DXDTS,$G(ROREXT("HDTIEN")))

 ;

 ;--- Delete the unfinished message from the ^TMP("HLS",$J)

 ;    if there is no data to send (RC>0) or there was an error

 ;    during the data extraction (RC<0). Return the error code

 ;--- in the latter case.

 I RC!($O(^TMP("HLS",$J,""),-1)=MSHPTR)  D  Q:RC<0 RC

 . D ROLLBACK^RORHL7(MSHPTR)  S:'RC RC=1

 ;

 ;--- Do not change state of the record(s) during the

 ;--- historical data extraction

 I $G(ROREXT("HDTIEN"))'>0  D  Q:RC<0 RC

 . S TMP=$S('RC:$P(RORMSH,$E(RORMSH,4),10),1:"")

 . S RC=$$UPDRECS^ROREXT03(PTIEN,.RGIENLST,TMP,$P(DXDTS,U,2))

 ;---

 Q 0

 ;

 ;***** CHECKS IF THE TASK SHOULD BE SUSPENDED

 ;

 ; .DTNEXT       Date/Time of the next event (suspend/resume)

 ;               is returned via this parameter

 ;

 ; Return Values:

 ;        0  Continue/Resume

 ;        1  Suspend

 ;

SUSPEND(DTNEXT) ;

 N DATE,NOW,SUSPEND,TIME,TS,TR

 S TS=$P(ROREXT("SUSPEND"),U,1)

 S TR=$P(ROREXT("SUSPEND"),U,2)

 S NOW=$$NOW^XLFDT,DATE=NOW\1

 ;--- A work day

 I $$WDCHK^RORUTL01(DATE)  D  Q SUSPEND

 . S TIME=NOW-DATE,SUSPEND=0

 . I TIME<TS   S DTNEXT=DATE+TS  Q

 . I TIME'<TR  S DTNEXT=$$WDNEXT^RORUTL01(DATE)+TS  Q

 . S DTNEXT=DATE+TR,SUSPEND=1

 ;--- Saturday, Sunday or Holiday

 S DTNEXT=$$WDNEXT^RORUTL01(DATE)+TS

 Q 0