- 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 Feb 18, 2025@23:08:01 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)