ROREXT01 ;HCIOFO/SG - EXTRACTION & TRANSMISSION PROCESS ;1/22/06 12:40pm
;;1.5;CLINICAL CASE REGISTRIES;**10,21,28**;Feb 17, 2006;Build 66
;
; This routine uses the following IAs:
;
; #10063 $$S^%ZTLOAD (supported)
; #10103 $$FMDIFF^XLFDT (supported)
; #10103 $$NOW^XLFDT (supported)
;
;******************************************************************************
;******************************************************************************
; --- ROUTINE MODIFICATION LOG ---
;
;PKG/PATCH DATE DEVELOPER MODIFICATION
;----------- ---------- ----------- ----------------------------------------
;ROR*1.5*21 NOV 2013 T KOPP Output # of reports run for all local
; registries
;ROR*1.5*28 APR 2016 T KOPP Kill flag for one time extract to
; retrieve problem list entries missed
; from 2009-2011 for HIV/HEPC registries
;******************************************************************************
;******************************************************************************
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")
I RC'<0,$D(^XTMP("ROR_ONETIME_PROBLEM_LIST_EXTRACT")) K ^XTMP("ROR_ONETIME_PROBLEM_LIST_EXTRACT")
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 in file #2)
;
; .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
. . ;With patch 10, status is irrelevant
. . ;I '$$ACTIVE^RORDD(IEN,,.STATUS) Q:STATUS'=5
. . ;--- Skip a record tagged as "DON'T SEND" or if test patient
. . I (($P($G(^RORDATA(798,IEN,2)),U,4))!($$TESTPAT^RORUTL01(PTIEN))) Q
. . ;--- 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
;
;Output # of reports run for all local registries
S REGIEN=0
F S REGIEN=$O(^ROR(798.1,REGIEN)) Q:REGIEN'>0 D Q:RC<0
. I '$D(RGIENLST(REGIEN)) 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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HROREXT01 10269 printed Apr 09, 2024@20:50:15 Page 2
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
+2 ;
+3 ; This routine uses the following IAs:
+4 ;
+5 ; #10063 $$S^%ZTLOAD (supported)
+6 ; #10103 $$FMDIFF^XLFDT (supported)
+7 ; #10103 $$NOW^XLFDT (supported)
+8 ;
+9 ;******************************************************************************
+10 ;******************************************************************************
+11 ; --- ROUTINE MODIFICATION LOG ---
+12 ;
+13 ;PKG/PATCH DATE DEVELOPER MODIFICATION
+14 ;----------- ---------- ----------- ----------------------------------------
+15 ;ROR*1.5*21 NOV 2013 T KOPP Output # of reports run for all local
+16 ; registries
+17 ;ROR*1.5*28 APR 2016 T KOPP Kill flag for one time extract to
+18 ; retrieve problem list entries missed
+19 ; from 2009-2011 for HIV/HEPC registries
+20 ;******************************************************************************
+21 ;******************************************************************************
+22 QUIT
+23 ;
+24 ;***** INTERNAL ENTRY POINT FOR DATA EXTRACTION
+25 ;
+26 ; .REGLST Reference to a local array containing registry
+27 ; names as subscripts and registry IENs as values
+28 ;
+29 ; [RORTASK] Task Number (if the data extraction is performed
+30 ; by a separate process)
+31 ;
+32 ; Return Values:
+33 ; <0 Error code (see MSGLIST^RORERR20)
+34 ; 0 Ok
+35 ;
+36 ; NOTE: The ROREXT and RORPARM local arrays must be properly
+37 ; initialized before calling this function.
+38 ;
INTEXT(REGLST,RORTASK) ;
+1 ; HL7 variables
NEW RORHL
+2 ; Log subsystem constants & variables
NEW RORLOG
+3 ; List of codes of Lab results to be extracted
NEW RORLRC
+4 ;
+5 NEW COUNTERS,DXBEG,DXEND,HDTIEN,MID,RC,TMP
+6 DO INIT^RORUTL01("ROREXT")
+7 SET DXBEG=$GET(ROREXT("DXBEG"))
SET DXEND=""
SET HDTIEN=0
+8 KILL ^TMP("RORPTF",$JOB)
+9 ;--- Open a new log
+10 SET TMP=$$SETUP^RORLOG(.REGLST)
+11 SET TMP=$SELECT($GET(RORTASK)'="":" TASK #"_RORTASK,1:"")
+12 SET TMP=$$OPEN^RORLOG(.REGLST,2,"DATA EXTRACTION"_TMP_" STARTED")
+13 Begin DoDot:1
+14 ;--- Check the list of registries
+15 IF $DATA(REGLST)<10
Begin DoDot:2
+16 SET RC=$$ERROR^RORERR(-28,,,,"extract data")
End DoDot:2
QUIT
+17 ;--- Lock parameters of the registries being processed
+18 SET RC=$$LOCKREG^RORUTL02(.REGLST,1,,"DATA EXTRACTION")
if RC<0
QUIT
+19 IF 'RC
Begin DoDot:2
+20 SET RC=$$ERROR^RORERR(-11,,,,"registries being processed")
End DoDot:2
QUIT
+21 ;--- Check for pending historical data extraction
+22 IF DXBEG'>0
Begin DoDot:2
+23 SET HDTIEN=$$FIND^RORHDT06(.REGLST,.DXBEG,.DXEND)
End DoDot:2
IF HDTIEN<0
SET RC=+HDTIEN
QUIT
+24 ;--- Load and process data extraction rules
+25 SET RC=$$PREPARE^ROREXPR(.REGLST,DXBEG,DXEND)
+26 IF RC<0
SET RC=$$ERROR^RORERR(-22)
QUIT
+27 ;--- Load and process the historical data extraction parameters
+28 IF HDTIEN>0
Begin DoDot:2
+29 SET RC=$$PREPARE^RORHDT06(HDTIEN)
End DoDot:2
if RC<0
QUIT
+30 ;--- Reference the historical data extraction definition
+31 SET RC=$$REGREF^RORHDT06(.REGLST,HDTIEN)
if RC<0
QUIT
+32 ;--- Display the debug information
+33 if $GET(RORPARM("DEBUG"))>1
DO DEBUG^ROREXTUT
+34 ;--- Extract and send the data
+35 SET RC=$$PROCESS(.REGLST)
if RC<0
QUIT
+36 SET COUNTERS=RC
SET RC=0
+37 ;--- Update registry parameters
+38 SET TMP=$$TMSTMP^ROREXTUT(.REGLST)
End DoDot:1
+39 ;--- Unlock parameters of processed registries
+40 SET TMP=$$LOCKREG^RORUTL02(.REGLST,0)
+41 ;
+42 ;--- Statistics & Cleanup
+43 SET TMP="DATA EXTRACTION "_$SELECT(RC<0:"ABORTED",1:"COMPLETED")
+44 IF RC'<0
IF $DATA(^XTMP("ROR_ONETIME_PROBLEM_LIST_EXTRACT"))
KILL ^XTMP("ROR_ONETIME_PROBLEM_LIST_EXTRACT")
+45 DO CLOSE^RORLOG(TMP,$GET(COUNTERS))
+46 if '$GET(RORPARM("DEBUG"))
DO INIT^RORUTL01("ROREXT")
+47 KILL ^TMP("RORPTF",$JOB)
+48 ;---
+49 QUIT $SELECT($GET(RC)<0:RC,1:0)
+50 ;
+51 ;***** RETURNS THE NEXT PATIENT FOR DATA EXTRACTION
+52 ;
+53 ; PTIEN Patient IEN (DFN in file #2)
+54 ;
+55 ; .RGIENLST Reference to a local array containing registry
+56 ; IENs as subscripts. The IENs of the corresponding
+57 ; patient's registry records are returned as values.
+58 ;
+59 ; Return Values:
+60 ; 0 No more patients
+61 ; >0 IEN (DFN) of the next patient who belongs to at least
+62 ; one of the registries defined by the RGIENLST parameter.
+63 ;
NEXTPAT(PTIEN,RGIENLST) ;
+1 NEW CNT,IEN,REGIEN,STATUS
+2 SET CNT=0
+3 FOR
SET PTIEN=$ORDER(^RORDATA(798,"KEY",PTIEN))
if PTIEN'>0
QUIT
Begin DoDot:1
+4 SET REGIEN=0
+5 FOR
SET REGIEN=$ORDER(RGIENLST(REGIEN))
if REGIEN'>0
QUIT
Begin DoDot:2
+6 SET RGIENLST(REGIEN)=0
+7 SET IEN=+$ORDER(^RORDATA(798,"KEY",PTIEN,REGIEN,""))
+8 if IEN'>0
QUIT
+9 ;With patch 10, status is irrelevant
+10 ;I '$$ACTIVE^RORDD(IEN,,.STATUS) Q:STATUS'=5
+11 ;--- Skip a record tagged as "DON'T SEND" or if test patient
+12 IF (($PIECE($GET(^RORDATA(798,IEN,2)),U,4))!($$TESTPAT^RORUTL01(PTIEN)))
QUIT
+13 ;--- Consider the record
+14 SET RGIENLST(REGIEN)=IEN
SET CNT=CNT+1
End DoDot:2
End DoDot:1
if CNT
QUIT
+15 QUIT $SELECT(PTIEN>0:PTIEN,1:0)
+16 ;
+17 ;***** SCANS THE REGISTRY AND EXTRACTS THE DATA
+18 ;
+19 ; .REGLST Reference to a local array containing registry
+20 ; names as subscripts and registry IENs as values
+21 ;
+22 ; Return Values:
+23 ; <0 Error Code
+24 ; >=0 Statistics
+25 ; ^1: Total number of processed patients
+26 ; ^2: Number of patients processed with errors
+27 ;
+28 ; In normal mode this function processes all patients and returns
+29 ; total number of patients and number of patients processed with
+30 ; errors.
+31 ;
+32 ; However, in debug mode 3 the function stops after the first
+33 ; patient processed with error and returns an error code.
+34 ;
PROCESS(REGLST) ;
+1 NEW CNT,DTNEXT,ECNT,PTIEN,RC,REGIEN,REGNAME,RGIENLST,RORBUF,RORMSG,TH,TMP
+2 ;--- Prepare the list of registry IENs
+3 SET REGNAME=""
SET REGIEN=0
+4 FOR
SET REGNAME=$ORDER(REGLST(REGNAME))
if REGNAME=""
QUIT
Begin DoDot:1
+5 SET REGIEN=+REGLST(REGNAME)
+6 if REGIEN'>0
SET REGIEN=$$REGIEN^RORUTL02(REGNAME)
+7 if REGIEN>0
SET RGIENLST(REGIEN)=""
End DoDot:1
if REGIEN<0
QUIT
+8 if REGIEN<0
QUIT REGIEN
+9 ;--- Initialize environment variables
+10 SET RC=$$INIT^RORHL7()
if RC<0
QUIT RC
+11 ;
+12 ;--- Generate the registry state message
+13 SET RC=$$CREATE^RORHL7()
if RC<0
QUIT RC
+14 SET REGIEN=0
+15 FOR
SET REGIEN=$ORDER(RGIENLST(REGIEN))
if REGIEN'>0
QUIT
Begin DoDot:1
+16 SET RC=$$REGSTATE^ROREXT03(REGIEN)
End DoDot:1
if RC<0
QUIT
+17 if RC<0
QUIT RC
+18 ;
+19 ;Output # of reports run for all local registries
+20 SET REGIEN=0
+21 FOR
SET REGIEN=$ORDER(^ROR(798.1,REGIEN))
if REGIEN'>0
QUIT
Begin DoDot:1
+22 IF '$DATA(RGIENLST(REGIEN))
SET RC=$$REGSTATE^ROREXT03(REGIEN)
End DoDot:1
if RC<0
QUIT
+23 if RC<0
QUIT RC
+24 ;
+25 ;--- Loop through the patients of the registries
+26 SET (CNT,ECNT,PTIEN,RC)=0
+27 FOR
SET PTIEN=$$NEXTPAT(PTIEN,.RGIENLST)
if PTIEN'>0
QUIT
Begin DoDot:1
+28 ;--- For a queued task only
+29 IF $DATA(ZTQUEUED)
SET RC=0
Begin DoDot:2
+30 ;--- Check if task stop has been requested
+31 IF $$S^%ZTLOAD
SET RC=$$ERROR^RORERR(-42)
QUIT
+32 ;--- Check if the task should be suspended
+33 if '$GET(ROREXT("SUSPEND"))
QUIT
+34 if $$NOW^XLFDT<$G(DTNEXT)
QUIT
+35 if '$$SUSPEND(.DTNEXT)
QUIT
+36 ;--- Suspend the task during the peak hours
+37 FOR
Begin DoDot:3
+38 SET TH=$$FMDIFF^XLFDT(DTNEXT,$$NOW^XLFDT,2)
+39 ; Do not HANG for less than a
IF TH<60
SET TH=0
QUIT
+40 ; minute and more than an hour
HANG $SELECT(TH>3600:3600,1:TH)
+41 ;--- Check if task stop has been requested
+42 if $$S^%ZTLOAD
SET RC=$$ERROR^RORERR(-42)
End DoDot:3
if 'TH!(RC<0)
QUIT
End DoDot:2
if RC<0
QUIT
+43 ;--- Process the patient's records
+44 SET CNT=CNT+1
+45 IF $GET(RORPARM("DEBUG"))>1
if $EXTRACT($GET(IOST),1,2)="C-"
WRITE *13,CNT
+46 SET RC=$$PROCPAT(PTIEN,.RGIENLST)
+47 ;--- Process the error (if any)
+48 IF RC<0
Begin DoDot:2
+49 SET ECNT=ECNT+1
SET RC=$$ERROR^RORERR(-15,,,$GET(PTIEN))
End DoDot:2
if $GET(RORPARM("DEBUG"))<3
SET RC=0
QUIT
+50 ;--- Send the batch HL7 message when the maximum size is reached
+51 if $$ISMAXSZ^RORHL7()
SET RC=$$SEND^ROREXT03(.RGIENLST)
End DoDot:1
if RC
QUIT
+52 if RC<0
QUIT RC
+53 ;
+54 ;--- Send the remaining data (flush the buffer)
+55 SET RC=$$SEND^ROREXT03(.RGIENLST)
if RC<0
QUIT RC
+56 ;
+57 ;--- Return number of processed patients and number of errors
+58 QUIT CNT_U_ECNT
+59 ;
+60 ;***** PROCESS THE PATIENT'S REGISTRY RECORDS
+61 ;
+62 ; PTIEN Patient IEN (DFN)
+63 ;
+64 ; .RGIENLST Reference to a local array containing registry
+65 ; IENs as subscripts and IENs of the corresponding
+66 ; patient's registry records as values.
+67 ;
+68 ; Return Values:
+69 ; <0 Error Code
+70 ; 0 Ok
+71 ;
PROCPAT(PTIEN,RGIENLST) ;
+1 ; Default error location
NEW RORERRDL
+2 ;
+3 NEW BATCHID,CNT,DXDTS,IEN,MSHPTR,RC,REGIEN,RORMSH,TMP
+4 DO CLEAR^RORERR("PROCPAT^ROREXT01")
+5 ;
+6 ;--- Compile the data extraction time frames
+7 SET (CNT,RC,REGIEN)=0
+8 FOR
SET REGIEN=$ORDER(RGIENLST(REGIEN))
if REGIEN'>0
QUIT
Begin DoDot:1
+9 SET IEN=+RGIENLST(REGIEN)
if IEN'>0
QUIT
+10 SET RC=$$DXPERIOD^ROREXTUT(.DXDTS,IEN,PTIEN)
+11 if 'RC
SET CNT=CNT+1
+12 if RC>0
SET RGIENLST(REGIEN)=0
End DoDot:1
if RC<0
QUIT
+13 if RC<0
QUIT RC
+14 ;--- If the patient should be skipped in all registries
+15 ; that are being processed, then do not perform the data
+16 ;--- extraction for this patient at all.
+17 IF 'CNT
if $GET(RORPARM("DEBUG"))
Begin DoDot:1
+18 DO LOG^RORLOG(4,"There is no data to extract.",PTIEN)
End DoDot:1
QUIT 0
+19 ;
+20 ;--- Create an HL7 message for the patient
+21 SET MSHPTR=$$CREATE^RORHL7(.RORMSH)
if MSHPTR<0
QUIT MSHPTR
+22 SET RC=$$MESSAGE^ROREXT02(PTIEN,.RGIENLST,.DXDTS,$GET(ROREXT("HDTIEN")))
+23 ;
+24 ;--- Delete the unfinished message from the ^TMP("HLS",$J)
+25 ; if there is no data to send (RC>0) or there was an error
+26 ; during the data extraction (RC<0). Return the error code
+27 ;--- in the latter case.
+28 IF RC!($ORDER(^TMP("HLS",$JOB,""),-1)=MSHPTR)
Begin DoDot:1
+29 DO ROLLBACK^RORHL7(MSHPTR)
if 'RC
SET RC=1
End DoDot:1
if RC<0
QUIT RC
+30 ;
+31 ;--- Do not change state of the record(s) during the
+32 ;--- historical data extraction
+33 IF $GET(ROREXT("HDTIEN"))'>0
Begin DoDot:1
+34 SET TMP=$SELECT('RC:$PIECE(RORMSH,$EXTRACT(RORMSH,4),10),1:"")
+35 SET RC=$$UPDRECS^ROREXT03(PTIEN,.RGIENLST,TMP,$PIECE(DXDTS,U,2))
End DoDot:1
if RC<0
QUIT RC
+36 ;---
+37 QUIT 0
+38 ;
+39 ;***** CHECKS IF THE TASK SHOULD BE SUSPENDED
+40 ;
+41 ; .DTNEXT Date/Time of the next event (suspend/resume)
+42 ; is returned via this parameter
+43 ;
+44 ; Return Values:
+45 ; 0 Continue/Resume
+46 ; 1 Suspend
+47 ;
SUSPEND(DTNEXT) ;
+1 NEW DATE,NOW,SUSPEND,TIME,TS,TR
+2 SET TS=$PIECE(ROREXT("SUSPEND"),U,1)
+3 SET TR=$PIECE(ROREXT("SUSPEND"),U,2)
+4 SET NOW=$$NOW^XLFDT
SET DATE=NOW\1
+5 ;--- A work day
+6 IF $$WDCHK^RORUTL01(DATE)
Begin DoDot:1
+7 SET TIME=NOW-DATE
SET SUSPEND=0
+8 IF TIME<TS
SET DTNEXT=DATE+TS
QUIT
+9 IF TIME'<TR
SET DTNEXT=$$WDNEXT^RORUTL01(DATE)+TS
QUIT
+10 SET DTNEXT=DATE+TR
SET SUSPEND=1
End DoDot:1
QUIT SUSPEND
+11 ;--- Saturday, Sunday or Holiday
+12 SET DTNEXT=$$WDNEXT^RORUTL01(DATE)+TS
+13 QUIT 0
