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

RORHDT06.m

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