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

RORUPD50.m

Go to the documentation of this file.
  1. RORUPD50 ;HCIOFO/SG - UPDATE THE PATIENT IN THE REGISTRIES ;8/2/05 9:14am
  1. ;;1.5;CLINICAL CASE REGISTRIES;**10,14,18**;Feb 17, 2006;Build 25
  1. ;
  1. ; This routine uses the following IAs:
  1. ;
  1. ; #2051 FIND^DIC (supported)
  1. ; #10013 ^DIK (supported)
  1. ; #2056 $$GET1^DIQ (supported)
  1. ; #2055 $$ROOT^DILFD (supported)
  1. ; #2053 UPDATE^DIE (supported)
  1. ; #2053 FILE^DIE (supported)
  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 ADD: add patient as confirmed if they
  1. ; are in the "ROR HCV CONFIRM" array,
  1. ; created in HCV^RORUPD04.
  1. ;ROR*1.5*18 APR 2012 C RAY Added logic to set confirm date to
  1. ; date of oldest selection rule
  1. ;******************************************************************************
  1. ;******************************************************************************
  1. ;
  1. ;***** ADDS THE PATIENT TO THE REGISTRY
  1. ;
  1. ; PATIEN Patient IEN
  1. ; REGIEN Registry IEN
  1. ;
  1. ; [ROR8RULS] Closed root of a local array containing list of
  1. ; triggered selection rules:
  1. ; @ROR8RULS@(RuleIEN)=Date
  1. ; If this parameter is not defined or equals to
  1. ; an empty string, selection rules are loaded from
  1. ; corresponding sub-node of the ^TMP("RORUPD",$J,"U").
  1. ;
  1. ; [[.]DOD] Date of death. If this parameter is undefined,
  1. ; its value will be taken from the ROR PATIENT file.
  1. ; If you are going to call this function several times
  1. ; for the same patient (for different registries),
  1. ; pass a reference to undefined local variable (the
  1. ; DOD will be read from the file only once).
  1. ;
  1. ; Return values:
  1. ; <0 Error code
  1. ; 0 Ok
  1. ; 1 Patient has already existed in the registry
  1. ;
  1. ;NOTE: Patch 14 includes functionality to automatically confirm a HEPC patient
  1. ;into the registry if the patient had a positive test result for any 1 of
  1. ;the 9 new HCV LOINCS added with the patch.
  1. ;
  1. ADD(PATIEN,REGIEN,ROR8RULS,DOD) ;
  1. N I,IENS,IENS01,RC,RORFDA,RORIEN,RORMSG,RULEIEN,TMP,ROREDT
  1. ;--- Quit if the patient is already in the registry
  1. Q:$$PRRIEN^RORUTL01(PATIEN,REGIEN)>0 1
  1. ;
  1. ;--- Prepare registry data
  1. K RORFDA S IENS="+1,"
  1. S RORFDA(798,IENS,.01)=PATIEN ; Patient Name
  1. S RORFDA(798,IENS,.02)=REGIEN ; Registry
  1. ;set status confirmed if registry is auto-confirm
  1. S RORFDA(798,IENS,3)=$S($D(^ROR(798.1,"C",1,+REGIEN)):0,1:4) ;patch 18 cdate set to now ; Pending
  1. ;add patient as "confirmed" if patient had + HCV test (HEPC registry only)
  1. I REGIEN=1,$D(^TMP("ROR HCV CONFIRM",$J,PATIEN)) S RORFDA(798,IENS,3)=0 ;Confirmed
  1. S RORFDA(798,IENS,4)=1 ; Update Demographics
  1. S RORFDA(798,IENS,5)=1 ; Update Local Data
  1. I $$TESTPAT^RORUTL01(PATIEN) S RORFDA(798,IENS,11)=1 ; Don't Send = 1 if test patient
  1. ;--- Get the date of death
  1. S:'($D(DOD)#10) DOD=$$GET1^DIQ(798.4,PATIEN_",",.351,"I",,"RORMSG")
  1. ;--- Load list of triggered rules
  1. S:$G(ROR8RULS)="" ROR8RULS=$NA(@RORUPDPI@("U",PATIEN,2,REGIEN))
  1. S RULEIEN="",ROREDT=DT ;new variable for earliest rule date
  1. F I=1:1 S RULEIEN=$O(@ROR8RULS@(RULEIEN)) Q:RULEIEN="" D
  1. . S IENS01="+"_(1000+I)_","_IENS
  1. . S RORFDA(798.01,IENS01,.01)=RULEIEN ; SELECTION RULE
  1. . S TMP=$P(@ROR8RULS@(RULEIEN),U)\1
  1. . ;--- Get date if earliest rule
  1. . I TMP>0 D
  1. . . S RORFDA(798.01,IENS01,1)=TMP
  1. . . S ROREDT=$S(TMP<ROREDT:TMP,1:ROREDT)
  1. . S TMP=+$P(@ROR8RULS@(RULEIEN),U,2)
  1. . S:TMP>0 RORFDA(798.01,IENS01,2)=TMP ; LOCATION
  1. ;
  1. ;--- Registry update transaction
  1. S RC=0 D
  1. . ;--- Call "before update" entry point
  1. . S ENTRY=$G(RORUPD("UPD",REGIEN,1))
  1. . I ENTRY'="" X "S RC="_ENTRY_"(.RORFDA,PATIEN,REGIEN)" Q:RC<0
  1. . ;--- Make sure that the DON'T SEND flag is set for 'test' patient
  1. . S:$$TESTPAT^RORUTL01(PATIEN) RORFDA(798,IENS,11)=1
  1. . ;--- Update the registry
  1. . D UPDATE^DIE(,"RORFDA","RORIEN","RORMSG")
  1. . I $G(RORMSG("DIERR")) S RC=$$DBS^RORERR("RORMSG",-9) Q
  1. . ;--- Overwrite triggered Confirmation date for Auto confirm registries
  1. . I $D(^ROR(798.1,"C",1,REGIEN)) D
  1. . . K RORFDA,RORMSG S RORFDA(798,RORIEN(1)_",",2)=ROREDT
  1. . . D FILE^DIE(,"RORFDA","RORMSG")
  1. . . I $G(RORMSG("DIERR")) S RC=$$DBS^RORERR("RORMSG",-9) Q
  1. . ;--- Call "after update" entry point
  1. . S ENTRY=$G(RORUPD("UPD",REGIEN,2))
  1. . I ENTRY'="" X "S RC="_ENTRY_"(RORIEN(1),PATIEN,REGIEN)" Q:RC<0
  1. Q:RC'<0 0
  1. ;
  1. ;--- Rollback the update in case of error(s)
  1. N DA,DIK
  1. S DIK=$$ROOT^DILFD(798),DA=$G(RORIEN(1))
  1. D:DA>0 ^DIK
  1. Q RC
  1. ;
  1. ;***** ADDS PATIENT DATA TO THE 'ROR PATIENT' FILE
  1. ;
  1. ; PATIEN Patient IEN
  1. ;
  1. ; Return values:
  1. ; <0 Error code
  1. ; 0 Ok
  1. ; 1 Patient data have already existed
  1. ;
  1. ADDPDATA(PATIEN) ;
  1. N IENS,RC,RORBUF,RORPAT,RORIEN,RORMSG
  1. ;--- Try to find patient data
  1. D FIND^DIC(798.4,,"@","QUX",PATIEN,1,"B",,,"RORBUF","RORMSG")
  1. Q:$G(RORMSG("DIERR")) $$DBS^RORERR("RORMSG",-9,,,798.4)
  1. ;--- Patient data already exists in the file
  1. Q:$G(RORBUF("DILIST",0)) 1
  1. ;--- Check if the patient record in the file #2 is valid
  1. S RC=$$CHKPTR^RORUTL05(PATIEN) Q:RC<0 RC
  1. ;--- Prepare patient data
  1. S IENS="+1,"
  1. S RC=$$PATDATA^RORUPD52(PATIEN_",",.RORPAT,IENS) Q:RC<0 RC
  1. S RORIEN(1)=PATIEN ; IEN of the new record
  1. S RORPAT(798.4,IENS,.01)=PATIEN ; Patient Name
  1. ;--- Add the patient record to the file
  1. D UPDATE^DIE(,"RORPAT","RORIEN","RORMSG")
  1. I $G(RORMSG("DIERR")) D Q:RC
  1. . S RC=$$DBS^RORERR("RORMSG",-9,,PATIEN,798.4)
  1. Q 0
  1. ;
  1. ;***** ADDS THE PATIENT TO MARKED REGISTRIES
  1. ;
  1. ; PATIEN Patient IEN
  1. ;
  1. ; Return values:
  1. ; <0 Error code
  1. ; 0 Patient should not be added to the registry
  1. ; >0 Patient has been added to the registry
  1. ;
  1. UPDREG(PATIEN) ;
  1. N DOD,ENTRY,INCTVDT,RC,REGIEN
  1. ;--- Check if patient should be added to any registry
  1. Q:$D(@RORUPDPI@("U",PATIEN,2))<10 0
  1. ;--- Add patient data
  1. S RC=$$ADDPDATA(PATIEN) Q:RC<0 RC
  1. ;--- Update all marked registries
  1. S REGIEN="",RC=0
  1. F D Q:REGIEN="" S RC=$$ADD(PATIEN,REGIEN,,.DOD) Q:RC<0
  1. . S REGIEN=$O(@RORUPDPI@("U",PATIEN,2,REGIEN))
  1. Q $S(RC<0:RC,1:1)