- RORUPD01 ;HCIOFO/SG - PROCESSING OF THE FILES ;7/21/03 10:19am
- ;;1.5;CLINICAL CASE REGISTRIES;**14,26,37**;Feb 17, 2006;Build 9
- ;
- ; This routine uses the following IA's:
- ;
- ; #3646 $$EMPL^DGSEC4
- ; #10035 Browse through IENs of the file #2
- Q
- ;******************************************************************************
- ;******************************************************************************
- ; --- ROUTINE MODIFICATION LOG ---
- ;
- ;PKG/PATCH DATE DEVELOPER MODIFICATION
- ;----------- ---------- ----------- ----------------------------------------
- ;ROR*1.5*14 APR 2011 A SAUNDERS Tags HCVLOAD and HCVLIST added for auto-
- ; confirm functionality. PROCESS: call
- ; to tag HCVLOAD is added.
- ;ROR*1.5*26 APR 2015 T KOPP Added check that if the job is scheduled
- ; to start within the SUSPEND start-stop
- ; timeframe, it will immediately suspend
- ; until the suspend stop time has been
- ; reached. (SUSPEND tag)
- ;ROR*1.5*37 SEP 2020 F TRAXLER Added call to LAST2YRS^RORUPDUT to update
- ; STATUS field for VA RECENT PATIENTS registry.
- ;******************************************************************************
- ;******************************************************************************
- ;
- ;
- ;***** CHECKS FOR A STOP REQUESTS (TASKMAN & PROPRIETARY)
- ;
- ; Return Values:
- ; 0 Continue running
- ; 1 Stop the subtask
- ;
- CHKSTOP() ;
- Q:'$G(RORUPD("JOB")) $$S^%ZTLOAD
- L +@RORUPDPI@("T",0):0
- I L -@RORUPDPI@("T",0) Q 1
- Q $$S^%ZTLOAD
- ;
- ;***** LOAD DATA ELEMENTS
- ;
- ; IENS IENS of the current record
- ;
- ; Return values:
- ; <0 Error code
- ; 0 Ok
- ;
- LOAD(IENS) ;
- N RC S RC=0
- ;--- API #1
- I $D(RORUPD("SR",2,"F",1)) D Q:RC<0 RC
- . S RC=$$LOADFLDS^RORUPDUT(2,IENS)
- ;--- API #2
- Q 0
- ;
- ;***** INITIALIZES LOOP CONTROL LISTS
- ;
- ; PATIEN Patient IEN
- ;
- ; Return Values:
- ; <0 Error code
- ; 0 Ok
- ;
- ; The RORUPD("LM",1,Rule Name) list contains names of the top level
- ; rules that have not been triggered by now.
- ;
- ; The RORUPD("LM",2,Registry#) list contains IENs of the registries
- ; that do not contain the patient by now.
- ;
- ; If the patient is an employee and the registry must not include
- ; employees (see the EXCLUDE EMPLOYEES field of the ROR REGISTRY
- ; PARAMETERS file), the function initializes the corresponding items
- ; of control lists as if the patient were already in the registry.
- ; Therefore, the patient will not be added to this registry.
- ;
- LOOPINIT(PATIEN) ;
- N I,EMPL,REGIEN
- K RORUPD("LM",1),RORUPD("LM",2)
- S EMPL=$$EMPL^DGSEC4(PATIEN,"P")
- M RORUPD("LM",1)=RORUPD("LM1")
- S REGIEN=""
- F S REGIEN=$O(RORUPD("LM2",REGIEN)) Q:REGIEN="" D
- . S $P(RORUPD("LM2",REGIEN),U)=0
- . ;--- Check if the patient is already in the registry
- . Q:$D(^RORDATA(798,"KEY",PATIEN,REGIEN))
- . ;--- Check if the patient is an employee and the
- . ;--- employees must not be added to the registry
- . I EMPL Q:$P(RORUPD("LM2",REGIEN),U,2)
- . ;--- Initialize the items of control lists
- . S $P(RORUPD("LM2",REGIEN),U)=1,RORUPD("LM",2,REGIEN)=""
- Q 0
- ;
- ;***** PROCESS EVERY PATIENT IN THE 'PATIENT' FILE
- ;
- ; BEGIEN Start IEN in the PATIENT file
- ; ENDIEN End IEN in the PATIENT file
- ;
- ; Return Values:
- ; <0 Error code
- ; >=0 Statistics
- ; ^1: Total number of processed patients
- ; ^2: Number of patients processed with errors
- ;
- ; If there is an error in processing of a patient, routine behavior
- ; depends on the mode of execution:
- ;
- ; In the normal mode program logs the errors, adds a record to the
- ; ROR PATIENT EVENTS file (#798.3), and continues processing of
- ; the remaining patients. Next registry update wil start data scan
- ; for this patient from the date stored in the file #798.3.
- ;
- ; In the debug mode 3 program is aborted if there is an error
- ; during processing of a patient.
- ;
- PROCESS(BEGIEN,ENDIEN) ;
- ;Patch 14 adds functionality to automatically confirm patients with
- ;certain HCV LOINCs. A list of the LOINCs are loaded into an array
- ;for future comparison
- D HCVLOAD ;Load list of HCV LOINCs into an array for use in HCV^RORUPD04
- N CNT,DTNEXT,ECNT,EXIT,PATIEN,RC,TH,TMP
- ;--- Loop through the patients
- S:$G(ENDIEN)'>0 ENDIEN=0
- S PATIEN=$S($G(BEGIEN)>0:$O(^DPT(BEGIEN),-1),1:0)
- S (CNT,ECNT,EXIT,RC)=0
- F S PATIEN=$O(^DPT(PATIEN)) Q:PATIEN'>0 D Q:EXIT!(RC<0)
- . I ENDIEN,PATIEN'<ENDIEN S EXIT=1 Q
- . ;--- For a queued task only
- . I $D(ZTQUEUED) S RC=0 D Q:RC<0
- . . ;--- Check if task stop has been requested
- . . I $$CHKSTOP() S RC=$$ERROR^RORERR(-42) Q
- . . ;--- Check if the task should be suspended
- . . Q:'$G(RORUPD("SUSPEND"))
- . . Q:$$NOW^XLFDT<$G(DTNEXT)
- . . Q:'$$SUSPEND(.DTNEXT)
- . . ;--- Suspend the task during the peak hours
- . . F D Q:'TH!(RC<0)
- . . . S TH=$$FMDIFF^XLFDT(DTNEXT,$$NOW^XLFDT,2)
- . . . I TH<60 S TH=0 Q ; Do not HANG for less than a
- . . . H $S(TH>3600:3600,1:TH) ; minute and more than an hour
- . . . ;--- Check if task stop has been requested
- . . . S:$$CHKSTOP() RC=$$ERROR^RORERR(-42)
- . ;--- Update the progress indicator
- . S CNT=CNT+1
- . I $G(RORPARM("DEBUG"))>1 W:$E($G(IOST),1,2)="C-" *13,CNT
- . ;--- Process the patient
- . S RC=$$PROCPAT(PATIEN)
- . I $G(RORPARM("SETUP")) D:'(CNT#1000)
- . . D LOG^RORLOG(2,"Number of patients processed by now: "_CNT)
- . ;--- Process the error (if any)
- . I RC<0 D S:$G(RORPARM("DEBUG"))<3 RC=0
- . . I RC=-66 S RC=0 Q ; Counter in the file #798.3
- . . S ECNT=ECNT+1
- . . S RC=$$ERROR^RORERR(-15,,,PATIEN)
- . . ;--- Create a record in the file #798.3
- . . S TMP=$$ADD^RORUPP01(PATIEN,RORUPD("DSBEG"))
- . . S:TMP<0 RC=TMP
- K ^TMP("ROR HCV LIST"),^TMP("ROR HCV CONFIRM")
- Q $S(RC<0:RC,1:CNT_"^"_ECNT)
- ;
- ;***** PROCESSES PATIENT'S DATA (EXCEPT DEMOGRAPHIC DATA)
- ;
- ; PATIEN Patient IEN
- ; [NOUPD] Disable registry update (0 by default)
- ;
- ; Return Values:
- ; <0 Error code
- ; 0 Ok
- ;
- ; If there is a record for the patient in the ROR PATIENT EVENTS
- ; file (#798.3) and date in that record is less than a value of the
- ; RORUPD("DSBEG") then it is used as a start date of the data scan
- ; for the patient. Otherwise, the RORUPD("DSBEG") is used.
- ;
- PROCPAT(PATIEN,NOUPD) ;
- ;--- Quit if the patient has already been processed
- Q:$D(@RORUPDPI@("U",PATIEN)) 0
- ;--- Quit if the patient's record has been merged
- Q:$G(^DPT(PATIEN,-9)) 0
- ;--- Do not update the registries with a "test patient"
- I '$G(NOUPD),$$TESTPAT^RORUTL01(PATIEN) D Q 0
- . S @RORUPDPI@("U",PATIEN)=""
- ;
- N RORERRDL ; Default error location
- ;
- N PATIENS,RC,RLST,RORMSG,RORRECENT,SDSDT,TMP,UPDREG,UPDSTART
- S PATIENS=PATIEN_",",RORRECENT=$$REGIEN^RORUTL02("VA RECENT PATIENTS")
- ;--- Initialize the variables
- D CLEAR^RORERR("PROCPAT^RORUPD01"),CLREC^RORUPDUT
- K RORVALS ; Clear all calculated values
- S RC=$$LOOPINIT(PATIEN) Q:RC<0 RC
- ;
- ;--- If the loop control list of registries is empty, the patient
- ; is already in all the registries that we are going to process.
- S UPDREG=0
- I $D(RORUPD("LM",2))>1 S RC=0 D G:RC<0 PPEX S UPDREG='$G(NOUPD)
- . ;--- Determine start date of the data scan
- . S UPDSTART=RORUPD("DSBEG")
- . S SDSDT=$$SDSDATE^RORUPP01(PATIEN)
- . I SDSDT<0 S RC=SDSDT Q
- . I SDSDT S:SDSDT<UPDSTART UPDSTART=SDSDT
- . S UPDSTART=$$FMADD^XLFDT(UPDSTART\1,-RORUPD("LD",1))
- . ;--- Load necessary data elements
- . I $D(RORUPD("SR",2,"F"))>1 D Q:RC<0
- . . S RC=$$LOAD(PATIENS)
- . D SETVAL^RORUPDUT("ROR DFN",PATIEN)
- . ;--- Apply "before" rules
- . S RC=$$APLRULES^RORUPDUT(2,PATIENS,"B") Q:RC
- . ;
- . ;--- Process patient data from other VistA files
- . I $D(RORUPD("SR",9000010)) D Q:RC
- . . S RC=$$VISIT^RORUPD08(UPDSTART,PATIEN)
- . I $D(RORUPD("SR",9000011)) D Q:RC
- . . S RC=$$PROBLEM^RORUPD07(UPDSTART,PATIEN)
- . I $D(RORUPD("SR",45)) D Q:RC
- . . S RC=$$PTF^RORUPD09(UPDSTART,PATIEN)
- . I $D(RORUPD("SR",63)) D Q:RC
- . . S RC=$$LAB^RORUPD04(UPDSTART,PATIEN)
- . ; <--- Insert processing of other files here. Do not forget to add
- . ; definitions of these files into the 'ROR METADATA' file.
- . ;
- . ;--- Apply "after" rules
- . S RC=$$APLRULES^RORUPDUT(2,PATIENS,"A") Q:RC
- . I +$$PRRIEN^RORUTL01(PATIEN,RORRECENT)_"," D
- . . S RC=$$LAST2YRS^RORUPDUT(PATIEN) ;Q:RC
- ;
- ;--- Update the registries if necessary
- I UPDREG S RC=$$UPDREG^RORUPD50(PATIEN) G:RC<0 PPEX
- ;--- Error processing
- I $$GETEC^RORUPDUT D S RC=-15
- . S RLST=$NA(@RORUPDPI@("U",PATIEN,2))
- E S RLST="",RC=0
- ;--- If there are records in the file #798.3 for the patient,
- ; remove them (log a warning if cannot remove). If the patient
- ; has been processed with errors, remove only records associated
- ;--- with the registries that the patient has been added to.
- D:$G(SDSDT)
- . S TMP=$$REMOVE^RORUPP01(PATIEN,RLST)
- . S:TMP<0 TMP=$$ERROR^RORERR(-31,,,PATIEN)
- ;--- Mark the patient as processed
- S @RORUPDPI@("U",PATIEN)=""
- PPEX ;--- Cleanup
- D CLRDES^RORUPDUT(2)
- Q RC
- ;
- ;***** CHECKS IF THE TASK SHOULD BE SUSPENDED
- ;
- ; .DTNEXT Date/Time of the next event (suspend/resume)
- ; is returned via this parameter
- ;
- ; Return Values:
- ; 0 Continue/Resume
- ; 1 Suspend
- ;
- SUSPEND(DTNEXT) ;
- N DATE,NOW,SUSPEND,TIME,TS,TR
- S TS=$P(RORUPD("SUSPEND"),U,1)
- S TR=$P(RORUPD("SUSPEND"),U,2)
- S NOW=$$NOW^XLFDT,DATE=NOW\1
- ;--- A working day
- I $$WDCHK^RORUTL01(DATE) D Q SUSPEND
- . S TIME=NOW#1,SUSPEND=0
- . I '$D(DTNEXT) D Q:SUSPEND=1
- .. ; Check that first start time is not within a suspend period
- .. I TIME'<TS,TIME<TR S DTNEXT=DATE+TR,SUSPEND=1
- . I TIME<TS S DTNEXT=DATE+TS Q
- . I TIME'<TR S DTNEXT=$$WDNEXT^RORUTL01(DATE)+TS Q
- . S DTNEXT=DATE+TR,SUSPEND=1
- ;--- Saturday, Sunday or Holiday
- S DTNEXT=$$WDNEXT^RORUTL01(DATE)+TS
- Q 0
- ;
- ;***** UPDATES REGISTRY UPDATE PARAMETERS
- ;
- ; .REGLST Reference to a local array containing registry names
- ; as subscripts and optional registry IENs as values
- ;
- ; Return values:
- ; <0 Error code
- ; 0 Ok
- ;
- TMSTMP(REGLST) ;
- N DATE,DIERR,RC,REGIEN,REGIENS,REGNAME,RORFDA,RORMSG,TMP
- S REGNAME="",RC=0
- F S REGNAME=$O(REGLST(REGNAME)) Q:REGNAME="" D Q:RC<0
- . S REGIEN=+$G(REGLST(REGNAME))
- . I REGIEN'>0 D I REGIEN'>0 S RC=+REGIEN Q
- . . S REGIEN=$$REGIEN^RORUTL02(REGNAME)
- . S REGIENS=REGIEN_","
- . ;--- Check if the new date until that registry is updated is
- . ; greater than that stored in the registry parameters
- . S TMP=$$GET1^DIQ(798.1,REGIENS,1,"I",,"RORMSG")
- . I $G(DIERR) D Q
- . . S RC=$$DBS^RORERR("RORMSG",-9,,,798.1,REGIENS)
- . S DATE=RORUPD("DSEND")\1
- . S:DATE>TMP RORFDA(798.1,REGIENS,1)=DATE
- . ;--- Update registry parameters (if necessary)
- . Q:$D(RORFDA)<10
- . D FILE^DIE("K","RORFDA","RORMSG")
- . I $G(DIERR) D Q
- . . S RC=$$DBS^RORERR("RORMSG",-9,,,798.1,REGIENS)
- Q $S(RC<0:RC,1:0)
- ;
- ;***** LOAD LIST OF HCV LOINCS INTO AN ARRAY FOR USE IN ADD^RORUPD50
- ;
- HCVLOAD ;
- K ^TMP("ROR HCV LIST") ;initialize HCV arrays
- N I,RORDONE,RORLOINC
- S RORDONE=0
- F I=1:1 S RORLOINC=$P($T(HCVLIST+I),";;",2) Q:RORDONE D
- . I (($G(RORLOINC)="END OF LIST")!($G(RORLOINC)="")) S RORDONE=1 Q
- . S ^TMP("ROR HCV LIST",$J,RORLOINC)="" ;add LOINC to array
- ;
- Q
- ;LIST OF HCV LOINCS
- ;Patients with a positive value in any of these HCV LOINCs will be confirmed into
- ;the registry during the nightly update. If a LOINC needs to be added to the
- ;list, add it above the 'end of list' entry.
- HCVLIST ;
- ;;11011-4
- ;;29609-5
- ;;34703-9
- ;;34704-7
- ;;10676-5
- ;;20416-4
- ;;20571-6
- ;;49758-6
- ;;50023-1
- ;;END OF LIST
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORUPD01 12173 printed Feb 18, 2025@23:10:02 Page 2
- RORUPD01 ;HCIOFO/SG - PROCESSING OF THE FILES ;7/21/03 10:19am
- +1 ;;1.5;CLINICAL CASE REGISTRIES;**14,26,37**;Feb 17, 2006;Build 9
- +2 ;
- +3 ; This routine uses the following IA's:
- +4 ;
- +5 ; #3646 $$EMPL^DGSEC4
- +6 ; #10035 Browse through IENs of the file #2
- +7 QUIT
- +8 ;******************************************************************************
- +9 ;******************************************************************************
- +10 ; --- ROUTINE MODIFICATION LOG ---
- +11 ;
- +12 ;PKG/PATCH DATE DEVELOPER MODIFICATION
- +13 ;----------- ---------- ----------- ----------------------------------------
- +14 ;ROR*1.5*14 APR 2011 A SAUNDERS Tags HCVLOAD and HCVLIST added for auto-
- +15 ; confirm functionality. PROCESS: call
- +16 ; to tag HCVLOAD is added.
- +17 ;ROR*1.5*26 APR 2015 T KOPP Added check that if the job is scheduled
- +18 ; to start within the SUSPEND start-stop
- +19 ; timeframe, it will immediately suspend
- +20 ; until the suspend stop time has been
- +21 ; reached. (SUSPEND tag)
- +22 ;ROR*1.5*37 SEP 2020 F TRAXLER Added call to LAST2YRS^RORUPDUT to update
- +23 ; STATUS field for VA RECENT PATIENTS registry.
- +24 ;******************************************************************************
- +25 ;******************************************************************************
- +26 ;
- +27 ;
- +28 ;***** CHECKS FOR A STOP REQUESTS (TASKMAN & PROPRIETARY)
- +29 ;
- +30 ; Return Values:
- +31 ; 0 Continue running
- +32 ; 1 Stop the subtask
- +33 ;
- CHKSTOP() ;
- +1 if '$GET(RORUPD("JOB"))
- QUIT $$S^%ZTLOAD
- +2 LOCK +@RORUPDPI@("T",0):0
- +3 IF $TEST
- LOCK -@RORUPDPI@("T",0)
- QUIT 1
- +4 QUIT $$S^%ZTLOAD
- +5 ;
- +6 ;***** LOAD DATA ELEMENTS
- +7 ;
- +8 ; IENS IENS of the current record
- +9 ;
- +10 ; Return values:
- +11 ; <0 Error code
- +12 ; 0 Ok
- +13 ;
- LOAD(IENS) ;
- +1 NEW RC
- SET RC=0
- +2 ;--- API #1
- +3 IF $DATA(RORUPD("SR",2,"F",1))
- Begin DoDot:1
- +4 SET RC=$$LOADFLDS^RORUPDUT(2,IENS)
- End DoDot:1
- if RC<0
- QUIT RC
- +5 ;--- API #2
- +6 QUIT 0
- +7 ;
- +8 ;***** INITIALIZES LOOP CONTROL LISTS
- +9 ;
- +10 ; PATIEN Patient IEN
- +11 ;
- +12 ; Return Values:
- +13 ; <0 Error code
- +14 ; 0 Ok
- +15 ;
- +16 ; The RORUPD("LM",1,Rule Name) list contains names of the top level
- +17 ; rules that have not been triggered by now.
- +18 ;
- +19 ; The RORUPD("LM",2,Registry#) list contains IENs of the registries
- +20 ; that do not contain the patient by now.
- +21 ;
- +22 ; If the patient is an employee and the registry must not include
- +23 ; employees (see the EXCLUDE EMPLOYEES field of the ROR REGISTRY
- +24 ; PARAMETERS file), the function initializes the corresponding items
- +25 ; of control lists as if the patient were already in the registry.
- +26 ; Therefore, the patient will not be added to this registry.
- +27 ;
- LOOPINIT(PATIEN) ;
- +1 NEW I,EMPL,REGIEN
- +2 KILL RORUPD("LM",1),RORUPD("LM",2)
- +3 SET EMPL=$$EMPL^DGSEC4(PATIEN,"P")
- +4 MERGE RORUPD("LM",1)=RORUPD("LM1")
- +5 SET REGIEN=""
- +6 FOR
- SET REGIEN=$ORDER(RORUPD("LM2",REGIEN))
- if REGIEN=""
- QUIT
- Begin DoDot:1
- +7 SET $PIECE(RORUPD("LM2",REGIEN),U)=0
- +8 ;--- Check if the patient is already in the registry
- +9 if $DATA(^RORDATA(798,"KEY",PATIEN,REGIEN))
- QUIT
- +10 ;--- Check if the patient is an employee and the
- +11 ;--- employees must not be added to the registry
- +12 IF EMPL
- if $PIECE(RORUPD("LM2",REGIEN),U,2)
- QUIT
- +13 ;--- Initialize the items of control lists
- +14 SET $PIECE(RORUPD("LM2",REGIEN),U)=1
- SET RORUPD("LM",2,REGIEN)=""
- End DoDot:1
- +15 QUIT 0
- +16 ;
- +17 ;***** PROCESS EVERY PATIENT IN THE 'PATIENT' FILE
- +18 ;
- +19 ; BEGIEN Start IEN in the PATIENT file
- +20 ; ENDIEN End IEN in the PATIENT file
- +21 ;
- +22 ; Return Values:
- +23 ; <0 Error code
- +24 ; >=0 Statistics
- +25 ; ^1: Total number of processed patients
- +26 ; ^2: Number of patients processed with errors
- +27 ;
- +28 ; If there is an error in processing of a patient, routine behavior
- +29 ; depends on the mode of execution:
- +30 ;
- +31 ; In the normal mode program logs the errors, adds a record to the
- +32 ; ROR PATIENT EVENTS file (#798.3), and continues processing of
- +33 ; the remaining patients. Next registry update wil start data scan
- +34 ; for this patient from the date stored in the file #798.3.
- +35 ;
- +36 ; In the debug mode 3 program is aborted if there is an error
- +37 ; during processing of a patient.
- +38 ;
- PROCESS(BEGIEN,ENDIEN) ;
- +1 ;Patch 14 adds functionality to automatically confirm patients with
- +2 ;certain HCV LOINCs. A list of the LOINCs are loaded into an array
- +3 ;for future comparison
- +4 ;Load list of HCV LOINCs into an array for use in HCV^RORUPD04
- DO HCVLOAD
- +5 NEW CNT,DTNEXT,ECNT,EXIT,PATIEN,RC,TH,TMP
- +6 ;--- Loop through the patients
- +7 if $GET(ENDIEN)'>0
- SET ENDIEN=0
- +8 SET PATIEN=$SELECT($GET(BEGIEN)>0:$ORDER(^DPT(BEGIEN),-1),1:0)
- +9 SET (CNT,ECNT,EXIT,RC)=0
- +10 FOR
- SET PATIEN=$ORDER(^DPT(PATIEN))
- if PATIEN'>0
- QUIT
- Begin DoDot:1
- +11 IF ENDIEN
- IF PATIEN'<ENDIEN
- SET EXIT=1
- QUIT
- +12 ;--- For a queued task only
- +13 IF $DATA(ZTQUEUED)
- SET RC=0
- Begin DoDot:2
- +14 ;--- Check if task stop has been requested
- +15 IF $$CHKSTOP()
- SET RC=$$ERROR^RORERR(-42)
- QUIT
- +16 ;--- Check if the task should be suspended
- +17 if '$GET(RORUPD("SUSPEND"))
- QUIT
- +18 if $$NOW^XLFDT<$G(DTNEXT)
- QUIT
- +19 if '$$SUSPEND(.DTNEXT)
- QUIT
- +20 ;--- Suspend the task during the peak hours
- +21 FOR
- Begin DoDot:3
- +22 SET TH=$$FMDIFF^XLFDT(DTNEXT,$$NOW^XLFDT,2)
- +23 ; Do not HANG for less than a
- IF TH<60
- SET TH=0
- QUIT
- +24 ; minute and more than an hour
- HANG $SELECT(TH>3600:3600,1:TH)
- +25 ;--- Check if task stop has been requested
- +26 if $$CHKSTOP()
- SET RC=$$ERROR^RORERR(-42)
- End DoDot:3
- if 'TH!(RC<0)
- QUIT
- End DoDot:2
- if RC<0
- QUIT
- +27 ;--- Update the progress indicator
- +28 SET CNT=CNT+1
- +29 IF $GET(RORPARM("DEBUG"))>1
- if $EXTRACT($GET(IOST),1,2)="C-"
- WRITE *13,CNT
- +30 ;--- Process the patient
- +31 SET RC=$$PROCPAT(PATIEN)
- +32 IF $GET(RORPARM("SETUP"))
- if '(CNT#1000)
- Begin DoDot:2
- +33 DO LOG^RORLOG(2,"Number of patients processed by now: "_CNT)
- End DoDot:2
- +34 ;--- Process the error (if any)
- +35 IF RC<0
- Begin DoDot:2
- +36 ; Counter in the file #798.3
- IF RC=-66
- SET RC=0
- QUIT
- +37 SET ECNT=ECNT+1
- +38 SET RC=$$ERROR^RORERR(-15,,,PATIEN)
- +39 ;--- Create a record in the file #798.3
- +40 SET TMP=$$ADD^RORUPP01(PATIEN,RORUPD("DSBEG"))
- +41 if TMP<0
- SET RC=TMP
- End DoDot:2
- if $GET(RORPARM("DEBUG"))<3
- SET RC=0
- End DoDot:1
- if EXIT!(RC<0)
- QUIT
- +42 KILL ^TMP("ROR HCV LIST"),^TMP("ROR HCV CONFIRM")
- +43 QUIT $SELECT(RC<0:RC,1:CNT_"^"_ECNT)
- +44 ;
- +45 ;***** PROCESSES PATIENT'S DATA (EXCEPT DEMOGRAPHIC DATA)
- +46 ;
- +47 ; PATIEN Patient IEN
- +48 ; [NOUPD] Disable registry update (0 by default)
- +49 ;
- +50 ; Return Values:
- +51 ; <0 Error code
- +52 ; 0 Ok
- +53 ;
- +54 ; If there is a record for the patient in the ROR PATIENT EVENTS
- +55 ; file (#798.3) and date in that record is less than a value of the
- +56 ; RORUPD("DSBEG") then it is used as a start date of the data scan
- +57 ; for the patient. Otherwise, the RORUPD("DSBEG") is used.
- +58 ;
- PROCPAT(PATIEN,NOUPD) ;
- +1 ;--- Quit if the patient has already been processed
- +2 if $DATA(@RORUPDPI@("U",PATIEN))
- QUIT 0
- +3 ;--- Quit if the patient's record has been merged
- +4 if $GET(^DPT(PATIEN,-9))
- QUIT 0
- +5 ;--- Do not update the registries with a "test patient"
- +6 IF '$GET(NOUPD)
- IF $$TESTPAT^RORUTL01(PATIEN)
- Begin DoDot:1
- +7 SET @RORUPDPI@("U",PATIEN)=""
- End DoDot:1
- QUIT 0
- +8 ;
- +9 ; Default error location
- NEW RORERRDL
- +10 ;
- +11 NEW PATIENS,RC,RLST,RORMSG,RORRECENT,SDSDT,TMP,UPDREG,UPDSTART
- +12 SET PATIENS=PATIEN_","
- SET RORRECENT=$$REGIEN^RORUTL02("VA RECENT PATIENTS")
- +13 ;--- Initialize the variables
- +14 DO CLEAR^RORERR("PROCPAT^RORUPD01")
- DO CLREC^RORUPDUT
- +15 ; Clear all calculated values
- KILL RORVALS
- +16 SET RC=$$LOOPINIT(PATIEN)
- if RC<0
- QUIT RC
- +17 ;
- +18 ;--- If the loop control list of registries is empty, the patient
- +19 ; is already in all the registries that we are going to process.
- +20 SET UPDREG=0
- +21 IF $DATA(RORUPD("LM",2))>1
- SET RC=0
- Begin DoDot:1
- +22 ;--- Determine start date of the data scan
- +23 SET UPDSTART=RORUPD("DSBEG")
- +24 SET SDSDT=$$SDSDATE^RORUPP01(PATIEN)
- +25 IF SDSDT<0
- SET RC=SDSDT
- QUIT
- +26 IF SDSDT
- if SDSDT<UPDSTART
- SET UPDSTART=SDSDT
- +27 SET UPDSTART=$$FMADD^XLFDT(UPDSTART\1,-RORUPD("LD",1))
- +28 ;--- Load necessary data elements
- +29 IF $DATA(RORUPD("SR",2,"F"))>1
- Begin DoDot:2
- +30 SET RC=$$LOAD(PATIENS)
- End DoDot:2
- if RC<0
- QUIT
- +31 DO SETVAL^RORUPDUT("ROR DFN",PATIEN)
- +32 ;--- Apply "before" rules
- +33 SET RC=$$APLRULES^RORUPDUT(2,PATIENS,"B")
- if RC
- QUIT
- +34 ;
- +35 ;--- Process patient data from other VistA files
- +36 IF $DATA(RORUPD("SR",9000010))
- Begin DoDot:2
- +37 SET RC=$$VISIT^RORUPD08(UPDSTART,PATIEN)
- End DoDot:2
- if RC
- QUIT
- +38 IF $DATA(RORUPD("SR",9000011))
- Begin DoDot:2
- +39 SET RC=$$PROBLEM^RORUPD07(UPDSTART,PATIEN)
- End DoDot:2
- if RC
- QUIT
- +40 IF $DATA(RORUPD("SR",45))
- Begin DoDot:2
- +41 SET RC=$$PTF^RORUPD09(UPDSTART,PATIEN)
- End DoDot:2
- if RC
- QUIT
- +42 IF $DATA(RORUPD("SR",63))
- Begin DoDot:2
- +43 SET RC=$$LAB^RORUPD04(UPDSTART,PATIEN)
- End DoDot:2
- if RC
- QUIT
- +44 ; <--- Insert processing of other files here. Do not forget to add
- +45 ; definitions of these files into the 'ROR METADATA' file.
- +46 ;
- +47 ;--- Apply "after" rules
- +48 SET RC=$$APLRULES^RORUPDUT(2,PATIENS,"A")
- if RC
- QUIT
- +49 IF +$$PRRIEN^RORUTL01(PATIEN,RORRECENT)_","
- Begin DoDot:2
- +50 ;Q:RC
- SET RC=$$LAST2YRS^RORUPDUT(PATIEN)
- End DoDot:2
- End DoDot:1
- if RC<0
- GOTO PPEX
- SET UPDREG='$GET(NOUPD)
- +51 ;
- +52 ;--- Update the registries if necessary
- +53 IF UPDREG
- SET RC=$$UPDREG^RORUPD50(PATIEN)
- if RC<0
- GOTO PPEX
- +54 ;--- Error processing
- +55 IF $$GETEC^RORUPDUT
- Begin DoDot:1
- +56 SET RLST=$NAME(@RORUPDPI@("U",PATIEN,2))
- End DoDot:1
- SET RC=-15
- +57 IF '$TEST
- SET RLST=""
- SET RC=0
- +58 ;--- If there are records in the file #798.3 for the patient,
- +59 ; remove them (log a warning if cannot remove). If the patient
- +60 ; has been processed with errors, remove only records associated
- +61 ;--- with the registries that the patient has been added to.
- +62 if $GET(SDSDT)
- Begin DoDot:1
- +63 SET TMP=$$REMOVE^RORUPP01(PATIEN,RLST)
- +64 if TMP<0
- SET TMP=$$ERROR^RORERR(-31,,,PATIEN)
- End DoDot:1
- +65 ;--- Mark the patient as processed
- +66 SET @RORUPDPI@("U",PATIEN)=""
- PPEX ;--- Cleanup
- +1 DO CLRDES^RORUPDUT(2)
- +2 QUIT RC
- +3 ;
- +4 ;***** CHECKS IF THE TASK SHOULD BE SUSPENDED
- +5 ;
- +6 ; .DTNEXT Date/Time of the next event (suspend/resume)
- +7 ; is returned via this parameter
- +8 ;
- +9 ; Return Values:
- +10 ; 0 Continue/Resume
- +11 ; 1 Suspend
- +12 ;
- SUSPEND(DTNEXT) ;
- +1 NEW DATE,NOW,SUSPEND,TIME,TS,TR
- +2 SET TS=$PIECE(RORUPD("SUSPEND"),U,1)
- +3 SET TR=$PIECE(RORUPD("SUSPEND"),U,2)
- +4 SET NOW=$$NOW^XLFDT
- SET DATE=NOW\1
- +5 ;--- A working day
- +6 IF $$WDCHK^RORUTL01(DATE)
- Begin DoDot:1
- +7 SET TIME=NOW#1
- SET SUSPEND=0
- +8 IF '$DATA(DTNEXT)
- Begin DoDot:2
- +9 ; Check that first start time is not within a suspend period
- +10 IF TIME'<TS
- IF TIME<TR
- SET DTNEXT=DATE+TR
- SET SUSPEND=1
- End DoDot:2
- if SUSPEND=1
- QUIT
- +11 IF TIME<TS
- SET DTNEXT=DATE+TS
- QUIT
- +12 IF TIME'<TR
- SET DTNEXT=$$WDNEXT^RORUTL01(DATE)+TS
- QUIT
- +13 SET DTNEXT=DATE+TR
- SET SUSPEND=1
- End DoDot:1
- QUIT SUSPEND
- +14 ;--- Saturday, Sunday or Holiday
- +15 SET DTNEXT=$$WDNEXT^RORUTL01(DATE)+TS
- +16 QUIT 0
- +17 ;
- +18 ;***** UPDATES REGISTRY UPDATE PARAMETERS
- +19 ;
- +20 ; .REGLST Reference to a local array containing registry names
- +21 ; as subscripts and optional registry IENs as values
- +22 ;
- +23 ; Return values:
- +24 ; <0 Error code
- +25 ; 0 Ok
- +26 ;
- TMSTMP(REGLST) ;
- +1 NEW DATE,DIERR,RC,REGIEN,REGIENS,REGNAME,RORFDA,RORMSG,TMP
- +2 SET REGNAME=""
- SET RC=0
- +3 FOR
- SET REGNAME=$ORDER(REGLST(REGNAME))
- if REGNAME=""
- QUIT
- Begin DoDot:1
- +4 SET REGIEN=+$GET(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 SET REGIENS=REGIEN_","
- +8 ;--- Check if the new date until that registry is updated is
- +9 ; greater than that stored in the registry parameters
- +10 SET TMP=$$GET1^DIQ(798.1,REGIENS,1,"I",,"RORMSG")
- +11 IF $GET(DIERR)
- Begin DoDot:2
- +12 SET RC=$$DBS^RORERR("RORMSG",-9,,,798.1,REGIENS)
- End DoDot:2
- QUIT
- +13 SET DATE=RORUPD("DSEND")\1
- +14 if DATE>TMP
- SET RORFDA(798.1,REGIENS,1)=DATE
- +15 ;--- Update registry parameters (if necessary)
- +16 if $DATA(RORFDA)<10
- QUIT
- +17 DO FILE^DIE("K","RORFDA","RORMSG")
- +18 IF $GET(DIERR)
- Begin DoDot:2
- +19 SET RC=$$DBS^RORERR("RORMSG",-9,,,798.1,REGIENS)
- End DoDot:2
- QUIT
- End DoDot:1
- if RC<0
- QUIT
- +20 QUIT $SELECT(RC<0:RC,1:0)
- +21 ;
- +22 ;***** LOAD LIST OF HCV LOINCS INTO AN ARRAY FOR USE IN ADD^RORUPD50
- +23 ;
- HCVLOAD ;
- +1 ;initialize HCV arrays
- KILL ^TMP("ROR HCV LIST")
- +2 NEW I,RORDONE,RORLOINC
- +3 SET RORDONE=0
- +4 FOR I=1:1
- SET RORLOINC=$PIECE($TEXT(HCVLIST+I),";;",2)
- if RORDONE
- QUIT
- Begin DoDot:1
- +5 IF (($GET(RORLOINC)="END OF LIST")!($GET(RORLOINC)=""))
- SET RORDONE=1
- QUIT
- +6 ;add LOINC to array
- SET ^TMP("ROR HCV LIST",$JOB,RORLOINC)=""
- End DoDot:1
- +7 ;
- +8 QUIT
- +9 ;LIST OF HCV LOINCS
- +10 ;Patients with a positive value in any of these HCV LOINCs will be confirmed into
- +11 ;the registry during the nightly update. If a LOINC needs to be added to the
- +12 ;list, add it above the 'end of list' entry.
- HCVLIST ;
- +1 ;;11011-4
- +2 ;;29609-5
- +3 ;;34703-9
- +4 ;;34704-7
- +5 ;;10676-5
- +6 ;;20416-4
- +7 ;;20571-6
- +8 ;;49758-6
- +9 ;;50023-1
- +10 ;;END OF LIST