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

RORUPD51.m

Go to the documentation of this file.
  1. RORUPD51 ;HCIOFO/SG - UPDATE PATIENT'S DEMOGRAPHIC DATA (1) ; 7/6/06 11:15am
  1. ;;1.5;CLINICAL CASE REGISTRIES;**1**;Feb 17, 2006;Build 24
  1. ;
  1. Q
  1. ;
  1. ;***** MARKS REGISTRIES (UPDATE DEMOGRAPHICS)
  1. ;
  1. ; PTIEN Patient IEN
  1. ; [DOD] Date of death
  1. ;
  1. ; Return Values:
  1. ; <0 Error code
  1. ; 0 Ok
  1. ;
  1. MARKREGS(PTIEN,DOD) ;
  1. N ACTIVE,ECNT,I,IENS,RC,RI,TMP
  1. N RORBUF,RORFDA,RORMSG,RORSRC
  1. ;--- Compile a list of associated registries
  1. D FIND^DIC(798,,"@","QUX",PTIEN,,"B",,,"RORBUF","RORMSG")
  1. Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,PTIEN,798)
  1. ;--- Mark patient records of the registries
  1. S RI="",ECNT=0
  1. F S RI=$O(RORBUF("DILIST",2,RI)) Q:RI="" D L -^RORDATA(798,+IENS)
  1. . S IENS=RORBUF("DILIST",2,RI)_","
  1. . K RORFDA,RORSRC
  1. . ;--- Try to lock the record; if this fails, continue anyway
  1. . L +^RORDATA(798,+IENS):3
  1. . ;--- Load the field values
  1. . D GETS^DIQ(798,IENS,"4;8","EI","RORSRC","RORMSG")
  1. . I $G(DIERR) D S ECNT=ECNT+1 Q
  1. . . S RC=$$DBS^RORERR("RORMSG",-9,,PTIEN,798,IENS)
  1. . S ACTIVE=+$G(RORSRC(798,IENS,8,"E"))
  1. . ;--- Do not mark again if already marked
  1. . I '$G(RORSRC(798,IENS,4,"I")) S RC=0 D Q:RC<0
  1. . . ;--- Mark only active records
  1. . . S:ACTIVE RORFDA(798,IENS,4)=1
  1. . ;--- Update registry data record
  1. . I $D(RORFDA)>1 S RC=0 D Q:RC<0
  1. . . D FILE^DIE(,"RORFDA","RORMSG")
  1. . . I $G(DIERR) D S ECNT=ECNT+1
  1. . . . S RC=$$DBS^RORERR("RORMSG",-9,,PTIEN,798,IENS)
  1. Q $S(ECNT>0:-9,1:0)
  1. ;
  1. ;***** PROCESSES THE MERGED PATIENT RECORD
  1. ;
  1. ; DFN IEN of the merged record (medrged from)
  1. ; NEWDFN New patient IEN (merged to)
  1. ;
  1. ; Return values:
  1. ; <0 Error code
  1. ; 0 Ok
  1. ;
  1. MERGE(DFN,NEWDFN) ;
  1. N DA,DIK,DTNEW,DTOLD,IEN,IENS,IR,PTIEN,REGIEN,REGLST,RORBUF,RORFDA,RORMSG,TMP
  1. D LOG^RORERR(-111,,,DFN,NEWDFN)
  1. ;=== Get the lists of registry records associated with the
  1. ;=== merged from ("from") and merged to ("to") patient data
  1. F PTIEN=DFN,NEWDFN D Q:RC<0
  1. . K RORBUF,RORMSG
  1. . D FIND^DIC(798,,"@;.02I;1I","QUX",PTIEN,,"B",,,"RORBUF","RORMSG")
  1. . I $G(DIERR) S RC=$$DBS^RORERR("RORMSG",-9,,PTIEN,798) Q
  1. . S IR=0
  1. . F S IR=$O(RORBUF("DILIST",2,IR)) Q:IR'>0 D Q:RC<0
  1. . . S IEN=+RORBUF("DILIST",2,IR)
  1. . . S REGIEN=+$G(RORBUF("DILIST","ID",IR,.02))
  1. . . I REGIEN'>0 S RC=$$ERROR^RORERR(-95,,,PTIEN,798,IEN_",",.02) Q
  1. . . S TMP=+$G(RORBUF("DILIST","ID",IR,1))
  1. . . I TMP'>0 S RC=$$ERROR^RORERR(-95,,,PTIEN,798,IEN_",",1) Q
  1. . . S REGLST(PTIEN,REGIEN)=IEN_U_TMP
  1. Q:RC<0 RC
  1. ;=== Compare the "from" and "to" registry records
  1. S REGIEN=0
  1. F S REGIEN=$O(REGLST(DFN,REGIEN)) Q:REGIEN'>0 D
  1. . K RORFDA,RORMSG S RC=0
  1. . S DTOLD=+$P(REGLST(DFN,REGIEN),U,2)
  1. . S DTNEW=+$P($G(REGLST(NEWDFN,REGIEN)),U,2)
  1. . I (DTNEW'>0)!(DTOLD<DTNEW) D Q:RC<0
  1. . . ;--- Make sure that the "to" patient has a record
  1. . . ;--- in the ROR PATIENT file.
  1. . . S RC=$$ADDPDATA^RORUPD50(NEWDFN) Q:RC<0
  1. . . ;--- Replace the .01 value in the "from" registry record with
  1. . . ; the new patient pointer since there is either no other
  1. . . ;--- record for this patient or it is newer than the "from" one.
  1. . . S IENS=+$P(REGLST(DFN,REGIEN),U)_","
  1. . . S RORFDA(798,IENS,.01)=NEWDFN
  1. . . D FILE^DIE(,"RORFDA","RORMSG")
  1. . . I $G(DIERR) S RC=$$DBS^RORERR("RORMSG",-9,,DFN,798,IENS) Q
  1. . . ;--- Delete the "to" registry record. It was created after
  1. . . ;--- the original ("from") one and we should keep the latter.
  1. . . S DA=+$P($G(REGLST(NEWDFN,REGIEN)),U)
  1. . . I DA>0 S DIK=$$ROOT^DILFD(798) D ^DIK
  1. . E D
  1. . . ;--- Delete the "from" registry record since
  1. . . ;--- the "to" record is actually older
  1. . . S DIK=$$ROOT^DILFD(798),DA=+$P(REGLST(DFN,REGIEN),U) D ^DIK
  1. . ;--- Indicate successful merge
  1. . K REGLST(DFN,REGIEN)
  1. ;=== Done
  1. Q 0
  1. ;
  1. ;***** SCANS PATIENTS AND UPDATES DEMOGRAPHIC DATA (IF NECESSARY)
  1. ;
  1. ; .REGLST Reference to a local array containing
  1. ; registry names as subscripts
  1. ;
  1. ; Return Values:
  1. ; <0 Error code
  1. ; 0 Ok
  1. ;
  1. UPDDEM(REGLST) ;
  1. N CNT,IR,PTIEN,RC,REGIEN,REGNAME,ROOT,SCR,UPD,UPDCNT
  1. N RORLOR,RORLST,RORMSG
  1. S ROOT=$$ROOT^DILFD(798,,1)
  1. ;--- Compile a list of registry internal entry numbers
  1. S REGNAME="",RC=0
  1. F S REGNAME=$O(REGLST(REGNAME)) Q:REGNAME="" D Q:RC<0
  1. . S RC=+$G(REGLST(REGNAME))
  1. . S:RC'>0 RC=$$REGIEN^RORUTL02(REGNAME)
  1. . S:RC>0 RORLOR(+RC)=""
  1. Q:RC<0 RC
  1. ;--- Loop through the patients of the registries
  1. S PTIEN="",(CNT,RC)=0
  1. F S PTIEN=$O(@ROOT@("B",PTIEN)) Q:PTIEN="" D Q:RC<0
  1. . ;--- Check if task stop has been requested
  1. . I $D(ZTQUEUED),$$S^%ZTLOAD D Q
  1. . . S RC=$$ERROR^RORERR(-42)
  1. . S CNT=CNT+1
  1. . I $G(RORPARM("DEBUG"))>1 W:$E($G(IOST),1,2)="C-" *13,CNT
  1. . ;--- Check for "stray" items in the cross-reference
  1. . S IR=""
  1. . F S IR=$O(@ROOT@("B",PTIEN,IR)) Q:IR="" D
  1. . . K:$P($G(@ROOT@(IR,0)),U)'>0 @ROOT@("B",PTIEN,IR)
  1. . Q:$D(@ROOT@("B",PTIEN))<10
  1. . ;--- Check for a merged patient record
  1. . S RC=$$MERGED^RORUTL18(PTIEN)
  1. . I RC S:RC>0 RC=$$MERGE(PTIEN,RC) S RC=0 Q
  1. . ;--- Load a list of patient's registry records
  1. . S SCR="S Y=+$P($G(^(0)),U,2) I Y,$D(RORLOR(Y))"
  1. . D FIND^DIC(798,,"@;.02I;3I;8E","QUX",PTIEN,,"B",SCR,,"RORLST","RORMSG")
  1. . I $G(DIERR) D Q
  1. . . S RC=$$DBS^RORERR("RORMSG",-9,,PTIEN,798)
  1. . ;--- Demographic data should be checked only if at least one of
  1. . ;--- the registry records of the patient is active.
  1. . S IR="",UPDCNT=0
  1. . F S IR=$O(RORLST("DILIST","ID",IR)) Q:IR="" D
  1. . . S UPD=+$G(RORLST("DILIST","ID",IR,8))
  1. . . S REGIEN=+$G(RORLST("DILIST","ID",IR,.02))
  1. . . S TMP=+$G(RORLST("DILIST","ID",IR,3)) ; STATUS
  1. . . S CNT(REGIEN,TMP)=$G(CNT(REGIEN,TMP))+1
  1. . . S:UPD UPDCNT=UPDCNT+1
  1. . S:UPDCNT RC=$$UPDPTDEM(PTIEN)
  1. D:RC'<0 UPDRCNT(.CNT)
  1. ;---
  1. Q $S(RC<0:RC,1:0)
  1. ;
  1. ;***** UPDATES DEMOGRAPHIC DATA OF THE PATIENT (IF NECESSARY)
  1. ;
  1. ; PTIEN Patient IEN
  1. ;
  1. ; Return Values:
  1. ; <0 Error code
  1. ; 0 Ok
  1. ;
  1. UPDPTDEM(PTIEN) ;
  1. N CF,DOD,IENS,RC,RORMSG,RORPAT
  1. S IENS=PTIEN_",",CF=0
  1. ;--- Try to lock the record of the ROR PATIENT file
  1. L +^RORDATA(798.4,PTIEN):3
  1. E Q $$ERROR^RORERR(-11,,,PTIEN,"file #798.4")
  1. D
  1. . ;--- Compare demographic data
  1. . S RC=$$PATDATA^RORUPD52(IENS,.RORPAT,IENS,.DOD) Q:RC<0
  1. . S:RC CF=1
  1. . ;--- Mark registry records of the patient
  1. . I CF S RC=$$MARKREGS(PTIEN,$G(DOD)) Q:RC<0
  1. . ;--- Update demographic data
  1. . I CF,$D(RORPAT)>1 S RC=0 D Q:RC<0
  1. . . D FILE^DIE(,"RORPAT","RORMSG") Q:'$G(DIERR)
  1. . . S RC=$$DBS^RORERR("RORMSG",-9,,PTIEN,798.4)
  1. ;
  1. L -^RORDATA(798.4,PTIEN)
  1. Q 0
  1. ;
  1. ;***** UPDATES RECORD COUNTERS IN THE 'ROR REGISTRY PARAMETERS' FILE
  1. ;
  1. ; .CNT( Reference to a local array containg registry
  1. ; record counters
  1. ; Registry#,
  1. ; 0) Number of confirmed records
  1. ; 4) Number of pending records
  1. ;
  1. UPDRCNT(CNT) ;
  1. N IENS,RC,REGIEN,RORFDA,RORMSG
  1. S REGIEN=0
  1. F S REGIEN=$O(CNT(REGIEN)) Q:REGIEN="" D
  1. . S IENS=REGIEN_","
  1. . S RORFDA(798.1,IENS,19.1)=$G(CNT(REGIEN,0))
  1. . S RORFDA(798.1,IENS,19.2)=$G(CNT(REGIEN,4))
  1. . D FILE^DIE("K","RORFDA","RORMSG")
  1. . I $G(DIERR) D Q
  1. . . S RC=$$DBS^RORERR("RORMSG",-9,,798.1,IENS)
  1. Q