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