RORSETU2 ;HCIOFO/SG - SETUP UTILITIES (REGISTRY) ; 1/23/06 10:35am
;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
;
Q
;
;***** DRAWS THE BOUNDARY BETWEEN HISTORICAL AND REGULAR EXTRACTIONS
;
; REGIEN Registry IEN
; .BNDRYDT Date that represents a boundary between historical
; data extraction and regular data extracts is returned
; via this parameter.
;
; Return Values:
; <0 Error code
; >=0 Statistics
; ^1: Total number of processed records
; ^2: Number of records processed with errors
;
; The function calculates a date that will be a boundary between
; historical data extraction and regular data extractions. This date
; is stored to all records of the registry. Moreover, the date is
; returned as a value of the second parameter.
;
BNDRYDT(REGIEN,BNDRYDT) ;
N CNT,DATE,ECNT,IEN,IENS,LD1,PATIEN,RC,ROOT,RORFDA,RORMSG,TMP
S ROOT=$$ROOT^DILFD(798,,1)
;--- Get the lag period
S LD1=$$GET1^DIQ(798.1,REGIEN_",",15.1,,,"RORMSG")
S RC=$$DBS^RORERR("RORMSG",-9) Q:RC<0 RC
;--- Calculate the date
S BNDRYDT=$$FMADD^XLFDT($$DT^XLFDT,-$S(LD1>0:LD1,1:1)-1)
;--- Store the date into the records of the registry
S IEN="",(CNT,ECNT)=0
F S IEN=$O(@ROOT@("AC",REGIEN,IEN)) Q:IEN="" D
. S CNT=CNT+1,IENS=IEN_",",DATE=BNDRYDT
. ;--- Update the record
. S RORFDA(798,IENS,9.1)=DATE
. S RORFDA(798,IENS,9.2)=DATE
. D FILE^DIE(,"RORFDA","RORMSG")
. I $G(DIERR) D S ECNT=ECNT+1 Q
. . S RC=$$DBS^RORERR("RORMSG",-9)
Q $S(RC<0:RC,1:CNT_U_ECNT)
;
;***** CHECKS THE LAB SEARCH CRITERION
;
; LSNAME Name of the Lab search criterion
;
; This function uses the ^TMP("DILIST",$J) global node.
;
; Return Values:
; <0 Error code
; 0 Ok
;
LABSRCH(LSNAME) ;
N IEN,IENS,IR,LSICNT,RC,RORMSG,TMP
;--- Find the definition
S IENS=$$FIND1^DIC(798.9,,"X",LSNAME,"B",,"RORMSG")_","
S RC=$$DBS^RORERR("RORMSG",-9) Q:RC<0 RC
Q:IENS'>0 $$ERROR^RORERR(-54,,,,LSNAME)
;--- Load the search indicators
D LIST^DIC(798.92,","_IENS,"@;1I",,,,,"B",,,,"RORMSG")
S RC=$$DBS^RORERR("RORMSG",-9) Q:RC<0 RC
;--- Check the search indicators
S IR="",LSICNT=0
F S IR=$O(^TMP("DILIST",$J,"ID",IR)) Q:IR="" D
. S:$G(^TMP("DILIST",$J,"ID",IR,1))>0 LSICNT=LSICNT+1
;--- Process the errors (if any)
Q:LSICNT'>0 $$ERROR^RORERR(-55,,,,LSNAME)
Q 0
;
;***** PREPARES REGISTRY RECORDS
;
; RORREG Registry IEN and registry name separated by the '^'
; (RegistryIEN^RegistryName).
;
; Return Values:
; <0 Error code
; 0 Ok
;
PREPARE(RORREG) ;
;;Data extraction boundary (historical/regular) has been established.
;;Parameters of the historical data extraction have been updated.
;
N DATE,RC,TMP
;--- Modify records of the registry
S RC=$$BNDRYDT(+RORREG,.DATE) Q:RC<0 RC
S TMP="Processed records: "_+RC_", Errors: "_+$P(RC,U,2)
D LOG^RORLOG(2,$P($T(PREPARE+1),";;",2),,TMP)
;--- Update the registry parameters of historical data extraction
S RC=$$UPDHDTRP(+RORREG,DATE) Q:RC<0 RC
D LOG^RORLOG(2,$P($T(PREPARE+2),";;",2))
Q 0
;
;***** UPDATES REGISTRY PARAMETERS OF THE HISTORICAL DATA EXTRACTION
;
; REGIEN Registry IEN
; HDTEDT Date that represents a boundary between historical
; data extraction and regular data extracts
;
; Return Values:
; <0 Error code
; 0 Ok
;
UPDHDTRP(REGIEN,HDTEDT) ;
N IENS,RC,RORFDA,RORMSG
S IENS=REGIEN_","
;--- Prepare the data
S RORFDA(798.1,IENS,21.05)=$$NOW^XLFDT ; Timestamp
;--- Update historical data extraction parameters
D FILE^DIE(,"RORFDA","RORMSG")
S RC=$$DBS^RORERR("RORMSG",-9)
Q $S(RC<0:RC,1:0)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORSETU2 3789 printed Oct 16, 2024@17:44:17 Page 2
RORSETU2 ;HCIOFO/SG - SETUP UTILITIES (REGISTRY) ; 1/23/06 10:35am
+1 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
+2 ;
+3 QUIT
+4 ;
+5 ;***** DRAWS THE BOUNDARY BETWEEN HISTORICAL AND REGULAR EXTRACTIONS
+6 ;
+7 ; REGIEN Registry IEN
+8 ; .BNDRYDT Date that represents a boundary between historical
+9 ; data extraction and regular data extracts is returned
+10 ; via this parameter.
+11 ;
+12 ; Return Values:
+13 ; <0 Error code
+14 ; >=0 Statistics
+15 ; ^1: Total number of processed records
+16 ; ^2: Number of records processed with errors
+17 ;
+18 ; The function calculates a date that will be a boundary between
+19 ; historical data extraction and regular data extractions. This date
+20 ; is stored to all records of the registry. Moreover, the date is
+21 ; returned as a value of the second parameter.
+22 ;
BNDRYDT(REGIEN,BNDRYDT) ;
+1 NEW CNT,DATE,ECNT,IEN,IENS,LD1,PATIEN,RC,ROOT,RORFDA,RORMSG,TMP
+2 SET ROOT=$$ROOT^DILFD(798,,1)
+3 ;--- Get the lag period
+4 SET LD1=$$GET1^DIQ(798.1,REGIEN_",",15.1,,,"RORMSG")
+5 SET RC=$$DBS^RORERR("RORMSG",-9)
if RC<0
QUIT RC
+6 ;--- Calculate the date
+7 SET BNDRYDT=$$FMADD^XLFDT($$DT^XLFDT,-$SELECT(LD1>0:LD1,1:1)-1)
+8 ;--- Store the date into the records of the registry
+9 SET IEN=""
SET (CNT,ECNT)=0
+10 FOR
SET IEN=$ORDER(@ROOT@("AC",REGIEN,IEN))
if IEN=""
QUIT
Begin DoDot:1
+11 SET CNT=CNT+1
SET IENS=IEN_","
SET DATE=BNDRYDT
+12 ;--- Update the record
+13 SET RORFDA(798,IENS,9.1)=DATE
+14 SET RORFDA(798,IENS,9.2)=DATE
+15 DO FILE^DIE(,"RORFDA","RORMSG")
+16 IF $GET(DIERR)
Begin DoDot:2
+17 SET RC=$$DBS^RORERR("RORMSG",-9)
End DoDot:2
SET ECNT=ECNT+1
QUIT
End DoDot:1
+18 QUIT $SELECT(RC<0:RC,1:CNT_U_ECNT)
+19 ;
+20 ;***** CHECKS THE LAB SEARCH CRITERION
+21 ;
+22 ; LSNAME Name of the Lab search criterion
+23 ;
+24 ; This function uses the ^TMP("DILIST",$J) global node.
+25 ;
+26 ; Return Values:
+27 ; <0 Error code
+28 ; 0 Ok
+29 ;
LABSRCH(LSNAME) ;
+1 NEW IEN,IENS,IR,LSICNT,RC,RORMSG,TMP
+2 ;--- Find the definition
+3 SET IENS=$$FIND1^DIC(798.9,,"X",LSNAME,"B",,"RORMSG")_","
+4 SET RC=$$DBS^RORERR("RORMSG",-9)
if RC<0
QUIT RC
+5 if IENS'>0
QUIT $$ERROR^RORERR(-54,,,,LSNAME)
+6 ;--- Load the search indicators
+7 DO LIST^DIC(798.92,","_IENS,"@;1I",,,,,"B",,,,"RORMSG")
+8 SET RC=$$DBS^RORERR("RORMSG",-9)
if RC<0
QUIT RC
+9 ;--- Check the search indicators
+10 SET IR=""
SET LSICNT=0
+11 FOR
SET IR=$ORDER(^TMP("DILIST",$JOB,"ID",IR))
if IR=""
QUIT
Begin DoDot:1
+12 if $GET(^TMP("DILIST",$JOB,"ID",IR,1))>0
SET LSICNT=LSICNT+1
End DoDot:1
+13 ;--- Process the errors (if any)
+14 if LSICNT'>0
QUIT $$ERROR^RORERR(-55,,,,LSNAME)
+15 QUIT 0
+16 ;
+17 ;***** PREPARES REGISTRY RECORDS
+18 ;
+19 ; RORREG Registry IEN and registry name separated by the '^'
+20 ; (RegistryIEN^RegistryName).
+21 ;
+22 ; Return Values:
+23 ; <0 Error code
+24 ; 0 Ok
+25 ;
PREPARE(RORREG) ;
+1 ;;Data extraction boundary (historical/regular) has been established.
+2 ;;Parameters of the historical data extraction have been updated.
+3 ;
+4 NEW DATE,RC,TMP
+5 ;--- Modify records of the registry
+6 SET RC=$$BNDRYDT(+RORREG,.DATE)
if RC<0
QUIT RC
+7 SET TMP="Processed records: "_+RC_", Errors: "_+$PIECE(RC,U,2)
+8 DO LOG^RORLOG(2,$PIECE($TEXT(PREPARE+1),";;",2),,TMP)
+9 ;--- Update the registry parameters of historical data extraction
+10 SET RC=$$UPDHDTRP(+RORREG,DATE)
if RC<0
QUIT RC
+11 DO LOG^RORLOG(2,$PIECE($TEXT(PREPARE+2),";;",2))
+12 QUIT 0
+13 ;
+14 ;***** UPDATES REGISTRY PARAMETERS OF THE HISTORICAL DATA EXTRACTION
+15 ;
+16 ; REGIEN Registry IEN
+17 ; HDTEDT Date that represents a boundary between historical
+18 ; data extraction and regular data extracts
+19 ;
+20 ; Return Values:
+21 ; <0 Error code
+22 ; 0 Ok
+23 ;
UPDHDTRP(REGIEN,HDTEDT) ;
+1 NEW IENS,RC,RORFDA,RORMSG
+2 SET IENS=REGIEN_","
+3 ;--- Prepare the data
+4 ; Timestamp
SET RORFDA(798.1,IENS,21.05)=$$NOW^XLFDT
+5 ;--- Update historical data extraction parameters
+6 DO FILE^DIE(,"RORFDA","RORMSG")
+7 SET RC=$$DBS^RORERR("RORMSG",-9)
+8 QUIT $SELECT(RC<0:RC,1:0)
