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

RORUPD01.m

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