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