RORHDT06 ;HCIOFO/SG - HISTORICAL DATA EXTRACTION PARAMETERS ; 11/30/05 10:03am
;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
;
Q
;
;***** UPDATES COMPLETION DATE FOR THE REGISTRY
;
; HDTIEN IEN of the data extraction definition
; REGNAME Registry name
; [DATE] Completion date/time (current, if omitted)
;
; Return Values:
; <0 Error code
; 0 Ok
;
COMPLETE(HDTIEN,REGNAME,DATE) ;
Q:HDTIEN'>0 0
Q:$G(^RORDATA(799.6,+HDTIEN,0))="" 0
N IEN,IENS,INFO,RORFDA,RORMSG,TMP,TYPE
;--- Search for the registry record in the backpull definition
S IENS=","_(+HDTIEN)_","
S IEN=$$FIND1^DIC(799.63,IENS,"QX",REGNAME,"B",,"RORMSG")
Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,,799.63,IENS)
Q:IEN'>0 0
;--- Update the completion date
S DATE=$S($G(DATE,-1)<0:$$NOW^XLFDT,'DATE:"",1:DATE)
S RORFDA(799.63,IEN_IENS,.02)=DATE
D FILE^DIE(,"RORFDA","RORMSG")
Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,,799.63,IEN_IENS)
;--- Success
S TMP=$$MSG^RORERR20(-109,.TYPE)
S INFO(1)=$$GET1^DIQ(799.6,(+HDTIEN)_",",.01,,,"RORMSG")
S INFO(2)=REGNAME
D LOG^RORLOG(TYPE,TMP,,.INFO)
Q 0
;
;***** SEARCHES FOR A PENDING HISTORICAL DATA EXTRACTION
;
; .RORGLST Reference to a local array containing registry names
; as subscripts and optional registry IENs as values.
;
; If a definition of a pending historical data
; extraction is found, then the function removes
; the registries, which are not referenced by the
; definition, from this list.
;
; [.SDT] Reference to a local variable where the start
; date of the main time frame for the historical
; extraction will be returned.
;
; [.EDT] Reference to a local variable where the end
; date of the main time frame for the historical
; extraction will be returned.
;
; Return Values:
; <0 Error code
; 0 There are no pending historical data extractions
; >0 IEN of the data extraction definition
;
FIND(RORGLST,SDT,EDT) ;
N HDTIEN,NODE,REGNAME,RORBUF,RORMSG,SCR,TMP
S (EDT,SDT)=""
;--- Search for a pending historical data extraction
S TMP="@;.03I;.04I"
S SCR="I $P($G(^(0)),U,7)\1'>DT,$$FINDSCR^RORHDT06(Y)"
D LIST^DIC(799.6,,TMP,"Q",1,,,"ADNAUTO",SCR,,"RORBUF","RORMSG")
Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,,799.6)
Q:$G(RORBUF("DILIST",0))'>0 0
S HDTIEN=+$G(RORBUF("DILIST",2,1))
Q:HDTIEN'>0 0
;--- Keep only the registries referenced by the definition
S NODE=$$ROOT^DILFD(799.63,","_HDTIEN_",",1)
S REGNAME=""
F S REGNAME=$O(RORGLST(REGNAME)) Q:REGNAME="" D
. K:'$D(@NODE@("ANC",REGNAME)) RORGLST(REGNAME)
;--- Return the dates and IEN
S SDT=$G(RORBUF("DILIST","ID",1,.03))
S EDT=$G(RORBUF("DILIST","ID",1,.04))
Q HDTIEN
;
;***** CHECKS IF THE BACKPULL SHOULD BE PROCESSED BY THE TASK
;
; HDTIEN IEN of the data extraction definition
;
; Return Values:
; 0 Skip
; 1 Include
;
FINDSCR(HDTIEN) ;
N REGNAME S REGNAME=""
F D Q:REGNAME="" Q:$D(RORGLST(REGNAME))
. S REGNAME=$O(^RORDATA(799.6,HDTIEN,3,"ANC",REGNAME))
Q (REGNAME'="")
;
;***** PREPARES HISTORICAL DATA EXTRACTION PARAMETERS
;
; HDTIEN IEN of the data extraction definition
;
; Return Values:
; 0 Ok
; <0 Error code
;
PREPARE(HDTIEN) ;
N DAC,HDTNAME,IENS,NODE,RC,RORBUF,RORMSG,SCR,SDT,TMP,TYPE
I $G(HDTIEN)'>0 D Q 0
. K ROREXT("HDTIEN")
S ROREXT("HDTIEN")=+HDTIEN,RC=0
;--- Load the parameters
S IENS=+HDTIEN_","
D GETS^DIQ(799.6,IENS,".01;.06;1*","I","RORBUF","RORMSG")
Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,,799.6,IENS)
S HDTNAME=$G(RORBUF(799.6,IENS,.01,"I"))
;--- Override the maximum message size (if requested)
S TMP=$G(RORBUF(799.6,IENS,.06,"I"))
I TMP>0 S ROREXT("MAXHL7SIZE")=(TMP*1048576)\1
E K:TMP=0 ROREXT("MAXHL7SIZE")
;--- Override the data areas
K ROREXT("DTAR")
S NODE=$$ROOT^DILFD(799.33,,1)
S IENS=""
F S IENS=$O(RORBUF(799.61,IENS)) Q:IENS="" D
. S DAC=+$G(RORBUF(799.61,IENS,.01,"I"))
. Q:'$D(@NODE@(DAC))
. S SDT=+$G(RORBUF(799.61,IENS,.02,"I")) ; Start Date
. I SDT'>0 S ROREXT("DTAR",DAC)="" Q
. S TMP=+$G(RORBUF(799.61,IENS,.03,"I")) ; End Date
. S:TMP>0 ROREXT("DTAR",DAC)=SDT_U_TMP
;--- Ignore the lag days
K ROREXT("LD")
;--- Set the special batch message date (BHS-6) to make
; sure that timestamps of historical clinical units are
;--- earlier than those of the regular ones.
S ROREXT("HL7DT")=$$FMADD^XLFDT(ROREXT("DXEND")\1,,,1)
;--- Success
S TMP=$$MSG^RORERR20(-108,.TYPE)
D LOG^RORLOG(TYPE,TMP,,HDTNAME)
Q 0
;
;***** STORES THE BACKPULL REFERENCE INTO THE REGISTRY PARAMETERS
;
; .REGLST Reference to a local array containing registry
; names as subscripts and registry IENs as values.
;
; HDTIEN IEN of the data extraction definition
;
REGREF(REGLST,HDTIEN) ;
N RC,REGIEN,REGNAME,RORFDA,RORMSG
S REGNAME="",RC=0
F S REGNAME=$O(REGLST(REGNAME)) Q:REGNAME="" D Q:RC<0
. S REGIEN=+REGLST(REGNAME)
. I REGIEN'>0 D I REGIEN'>0 S RC=REGIEN Q
. . S REGIEN=$$REGIEN^RORUTL02(REGNAME)
. K RORFDA,RORMSG
. S RORFDA(798.1,REGIEN_",",21.01)=$S(HDTIEN>0:+HDTIEN,1:"@")
. D FILE^DIE(,"RORFDA","RORMSG")
. S:$G(DIERR) RC=$$DBS^RORERR("RORMSG",-9,,,798.1,REGIEN_",")
;---
Q $S(RC<0:RC,1:0)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORHDT06 5502 printed Dec 13, 2024@01:41:38 Page 2
RORHDT06 ;HCIOFO/SG - HISTORICAL DATA EXTRACTION PARAMETERS ; 11/30/05 10:03am
+1 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
+2 ;
+3 QUIT
+4 ;
+5 ;***** UPDATES COMPLETION DATE FOR THE REGISTRY
+6 ;
+7 ; HDTIEN IEN of the data extraction definition
+8 ; REGNAME Registry name
+9 ; [DATE] Completion date/time (current, if omitted)
+10 ;
+11 ; Return Values:
+12 ; <0 Error code
+13 ; 0 Ok
+14 ;
COMPLETE(HDTIEN,REGNAME,DATE) ;
+1 if HDTIEN'>0
QUIT 0
+2 if $GET(^RORDATA(799.6,+HDTIEN,0))=""
QUIT 0
+3 NEW IEN,IENS,INFO,RORFDA,RORMSG,TMP,TYPE
+4 ;--- Search for the registry record in the backpull definition
+5 SET IENS=","_(+HDTIEN)_","
+6 SET IEN=$$FIND1^DIC(799.63,IENS,"QX",REGNAME,"B",,"RORMSG")
+7 if $GET(DIERR)
QUIT $$DBS^RORERR("RORMSG",-9,,,799.63,IENS)
+8 if IEN'>0
QUIT 0
+9 ;--- Update the completion date
+10 SET DATE=$SELECT($GET(DATE,-1)<0:$$NOW^XLFDT,'DATE:"",1:DATE)
+11 SET RORFDA(799.63,IEN_IENS,.02)=DATE
+12 DO FILE^DIE(,"RORFDA","RORMSG")
+13 if $GET(DIERR)
QUIT $$DBS^RORERR("RORMSG",-9,,,799.63,IEN_IENS)
+14 ;--- Success
+15 SET TMP=$$MSG^RORERR20(-109,.TYPE)
+16 SET INFO(1)=$$GET1^DIQ(799.6,(+HDTIEN)_",",.01,,,"RORMSG")
+17 SET INFO(2)=REGNAME
+18 DO LOG^RORLOG(TYPE,TMP,,.INFO)
+19 QUIT 0
+20 ;
+21 ;***** SEARCHES FOR A PENDING HISTORICAL DATA EXTRACTION
+22 ;
+23 ; .RORGLST Reference to a local array containing registry names
+24 ; as subscripts and optional registry IENs as values.
+25 ;
+26 ; If a definition of a pending historical data
+27 ; extraction is found, then the function removes
+28 ; the registries, which are not referenced by the
+29 ; definition, from this list.
+30 ;
+31 ; [.SDT] Reference to a local variable where the start
+32 ; date of the main time frame for the historical
+33 ; extraction will be returned.
+34 ;
+35 ; [.EDT] Reference to a local variable where the end
+36 ; date of the main time frame for the historical
+37 ; extraction will be returned.
+38 ;
+39 ; Return Values:
+40 ; <0 Error code
+41 ; 0 There are no pending historical data extractions
+42 ; >0 IEN of the data extraction definition
+43 ;
FIND(RORGLST,SDT,EDT) ;
+1 NEW HDTIEN,NODE,REGNAME,RORBUF,RORMSG,SCR,TMP
+2 SET (EDT,SDT)=""
+3 ;--- Search for a pending historical data extraction
+4 SET TMP="@;.03I;.04I"
+5 SET SCR="I $P($G(^(0)),U,7)\1'>DT,$$FINDSCR^RORHDT06(Y)"
+6 DO LIST^DIC(799.6,,TMP,"Q",1,,,"ADNAUTO",SCR,,"RORBUF","RORMSG")
+7 if $GET(DIERR)
QUIT $$DBS^RORERR("RORMSG",-9,,,799.6)
+8 if $GET(RORBUF("DILIST",0))'>0
QUIT 0
+9 SET HDTIEN=+$GET(RORBUF("DILIST",2,1))
+10 if HDTIEN'>0
QUIT 0
+11 ;--- Keep only the registries referenced by the definition
+12 SET NODE=$$ROOT^DILFD(799.63,","_HDTIEN_",",1)
+13 SET REGNAME=""
+14 FOR
SET REGNAME=$ORDER(RORGLST(REGNAME))
if REGNAME=""
QUIT
Begin DoDot:1
+15 if '$DATA(@NODE@("ANC",REGNAME))
KILL RORGLST(REGNAME)
End DoDot:1
+16 ;--- Return the dates and IEN
+17 SET SDT=$GET(RORBUF("DILIST","ID",1,.03))
+18 SET EDT=$GET(RORBUF("DILIST","ID",1,.04))
+19 QUIT HDTIEN
+20 ;
+21 ;***** CHECKS IF THE BACKPULL SHOULD BE PROCESSED BY THE TASK
+22 ;
+23 ; HDTIEN IEN of the data extraction definition
+24 ;
+25 ; Return Values:
+26 ; 0 Skip
+27 ; 1 Include
+28 ;
FINDSCR(HDTIEN) ;
+1 NEW REGNAME
SET REGNAME=""
+2 FOR
Begin DoDot:1
+3 SET REGNAME=$ORDER(^RORDATA(799.6,HDTIEN,3,"ANC",REGNAME))
End DoDot:1
if REGNAME=""
QUIT
if $DATA(RORGLST(REGNAME))
QUIT
+4 QUIT (REGNAME'="")
+5 ;
+6 ;***** PREPARES HISTORICAL DATA EXTRACTION PARAMETERS
+7 ;
+8 ; HDTIEN IEN of the data extraction definition
+9 ;
+10 ; Return Values:
+11 ; 0 Ok
+12 ; <0 Error code
+13 ;
PREPARE(HDTIEN) ;
+1 NEW DAC,HDTNAME,IENS,NODE,RC,RORBUF,RORMSG,SCR,SDT,TMP,TYPE
+2 IF $GET(HDTIEN)'>0
Begin DoDot:1
+3 KILL ROREXT("HDTIEN")
End DoDot:1
QUIT 0
+4 SET ROREXT("HDTIEN")=+HDTIEN
SET RC=0
+5 ;--- Load the parameters
+6 SET IENS=+HDTIEN_","
+7 DO GETS^DIQ(799.6,IENS,".01;.06;1*","I","RORBUF","RORMSG")
+8 if $GET(DIERR)
QUIT $$DBS^RORERR("RORMSG",-9,,,799.6,IENS)
+9 SET HDTNAME=$GET(RORBUF(799.6,IENS,.01,"I"))
+10 ;--- Override the maximum message size (if requested)
+11 SET TMP=$GET(RORBUF(799.6,IENS,.06,"I"))
+12 IF TMP>0
SET ROREXT("MAXHL7SIZE")=(TMP*1048576)\1
+13 IF '$TEST
if TMP=0
KILL ROREXT("MAXHL7SIZE")
+14 ;--- Override the data areas
+15 KILL ROREXT("DTAR")
+16 SET NODE=$$ROOT^DILFD(799.33,,1)
+17 SET IENS=""
+18 FOR
SET IENS=$ORDER(RORBUF(799.61,IENS))
if IENS=""
QUIT
Begin DoDot:1
+19 SET DAC=+$GET(RORBUF(799.61,IENS,.01,"I"))
+20 if '$DATA(@NODE@(DAC))
QUIT
+21 ; Start Date
SET SDT=+$GET(RORBUF(799.61,IENS,.02,"I"))
+22 IF SDT'>0
SET ROREXT("DTAR",DAC)=""
QUIT
+23 ; End Date
SET TMP=+$GET(RORBUF(799.61,IENS,.03,"I"))
+24 if TMP>0
SET ROREXT("DTAR",DAC)=SDT_U_TMP
End DoDot:1
+25 ;--- Ignore the lag days
+26 KILL ROREXT("LD")
+27 ;--- Set the special batch message date (BHS-6) to make
+28 ; sure that timestamps of historical clinical units are
+29 ;--- earlier than those of the regular ones.
+30 SET ROREXT("HL7DT")=$$FMADD^XLFDT(ROREXT("DXEND")\1,,,1)
+31 ;--- Success
+32 SET TMP=$$MSG^RORERR20(-108,.TYPE)
+33 DO LOG^RORLOG(TYPE,TMP,,HDTNAME)
+34 QUIT 0
+35 ;
+36 ;***** STORES THE BACKPULL REFERENCE INTO THE REGISTRY PARAMETERS
+37 ;
+38 ; .REGLST Reference to a local array containing registry
+39 ; names as subscripts and registry IENs as values.
+40 ;
+41 ; HDTIEN IEN of the data extraction definition
+42 ;
REGREF(REGLST,HDTIEN) ;
+1 NEW RC,REGIEN,REGNAME,RORFDA,RORMSG
+2 SET REGNAME=""
SET RC=0
+3 FOR
SET REGNAME=$ORDER(REGLST(REGNAME))
if REGNAME=""
QUIT
Begin DoDot:1
+4 SET REGIEN=+REGLST(REGNAME)
+5 IF REGIEN'>0
Begin DoDot:2
+6 SET REGIEN=$$REGIEN^RORUTL02(REGNAME)
End DoDot:2
IF REGIEN'>0
SET RC=REGIEN
QUIT
+7 KILL RORFDA,RORMSG
+8 SET RORFDA(798.1,REGIEN_",",21.01)=$SELECT(HDTIEN>0:+HDTIEN,1:"@")
+9 DO FILE^DIE(,"RORFDA","RORMSG")
+10 if $GET(DIERR)
SET RC=$$DBS^RORERR("RORMSG",-9,,,798.1,REGIEN_",")
End DoDot:1
if RC<0
QUIT
+11 ;---
+12 QUIT $SELECT(RC<0:RC,1:0)
