| [613] | 1 | RORUPD51 ;HCIOFO/SG - UPDATE PATIENT'S DEMOGRAPHIC DATA (1) ; 7/6/06 11:15am
|
|---|
| 2 | ;;1.5;CLINICAL CASE REGISTRIES;**1**;Feb 17, 2006;Build 24
|
|---|
| 3 | ;
|
|---|
| 4 | Q
|
|---|
| 5 | ;
|
|---|
| 6 | ;***** MARKS REGISTRIES (UPDATE DEMOGRAPHICS)
|
|---|
| 7 | ;
|
|---|
| 8 | ; PTIEN Patient IEN
|
|---|
| 9 | ; [DOD] Date of death
|
|---|
| 10 | ;
|
|---|
| 11 | ; Return Values:
|
|---|
| 12 | ; <0 Error code
|
|---|
| 13 | ; 0 Ok
|
|---|
| 14 | ;
|
|---|
| 15 | MARKREGS(PTIEN,DOD) ;
|
|---|
| 16 | N ACTIVE,ECNT,I,IENS,RC,RI,TMP
|
|---|
| 17 | N RORBUF,RORFDA,RORMSG,RORSRC
|
|---|
| 18 | ;--- Compile a list of associated registries
|
|---|
| 19 | D FIND^DIC(798,,"@","QUX",PTIEN,,"B",,,"RORBUF","RORMSG")
|
|---|
| 20 | Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,PTIEN,798)
|
|---|
| 21 | ;--- Mark patient records of the registries
|
|---|
| 22 | S RI="",ECNT=0
|
|---|
| 23 | F S RI=$O(RORBUF("DILIST",2,RI)) Q:RI="" D L -^RORDATA(798,+IENS)
|
|---|
| 24 | . S IENS=RORBUF("DILIST",2,RI)_","
|
|---|
| 25 | . K RORFDA,RORSRC
|
|---|
| 26 | . ;--- Try to lock the record; if this fails, continue anyway
|
|---|
| 27 | . L +^RORDATA(798,+IENS):3
|
|---|
| 28 | . ;--- Load the field values
|
|---|
| 29 | . D GETS^DIQ(798,IENS,"4;8","EI","RORSRC","RORMSG")
|
|---|
| 30 | . I $G(DIERR) D S ECNT=ECNT+1 Q
|
|---|
| 31 | . . S RC=$$DBS^RORERR("RORMSG",-9,,PTIEN,798,IENS)
|
|---|
| 32 | . S ACTIVE=+$G(RORSRC(798,IENS,8,"E"))
|
|---|
| 33 | . ;--- Do not mark again if already marked
|
|---|
| 34 | . I '$G(RORSRC(798,IENS,4,"I")) S RC=0 D Q:RC<0
|
|---|
| 35 | . . ;--- Mark only active records
|
|---|
| 36 | . . S:ACTIVE RORFDA(798,IENS,4)=1
|
|---|
| 37 | . ;--- Update registry data record
|
|---|
| 38 | . I $D(RORFDA)>1 S RC=0 D Q:RC<0
|
|---|
| 39 | . . D FILE^DIE(,"RORFDA","RORMSG")
|
|---|
| 40 | . . I $G(DIERR) D S ECNT=ECNT+1
|
|---|
| 41 | . . . S RC=$$DBS^RORERR("RORMSG",-9,,PTIEN,798,IENS)
|
|---|
| 42 | Q $S(ECNT>0:-9,1:0)
|
|---|
| 43 | ;
|
|---|
| 44 | ;***** PROCESSES THE MERGED PATIENT RECORD
|
|---|
| 45 | ;
|
|---|
| 46 | ; DFN IEN of the merged record (medrged from)
|
|---|
| 47 | ; NEWDFN New patient IEN (merged to)
|
|---|
| 48 | ;
|
|---|
| 49 | ; Return values:
|
|---|
| 50 | ; <0 Error code
|
|---|
| 51 | ; 0 Ok
|
|---|
| 52 | ;
|
|---|
| 53 | MERGE(DFN,NEWDFN) ;
|
|---|
| 54 | N DA,DIK,DTNEW,DTOLD,IEN,IENS,IR,PTIEN,REGIEN,REGLST,RORBUF,RORFDA,RORMSG,TMP
|
|---|
| 55 | D LOG^RORERR(-111,,,DFN,NEWDFN)
|
|---|
| 56 | ;=== Get the lists of registry records associated with the
|
|---|
| 57 | ;=== merged from ("from") and merged to ("to") patient data
|
|---|
| 58 | F PTIEN=DFN,NEWDFN D Q:RC<0
|
|---|
| 59 | . K RORBUF,RORMSG
|
|---|
| 60 | . D FIND^DIC(798,,"@;.02I;1I","QUX",PTIEN,,"B",,,"RORBUF","RORMSG")
|
|---|
| 61 | . I $G(DIERR) S RC=$$DBS^RORERR("RORMSG",-9,,PTIEN,798) Q
|
|---|
| 62 | . S IR=0
|
|---|
| 63 | . F S IR=$O(RORBUF("DILIST",2,IR)) Q:IR'>0 D Q:RC<0
|
|---|
| 64 | . . S IEN=+RORBUF("DILIST",2,IR)
|
|---|
| 65 | . . S REGIEN=+$G(RORBUF("DILIST","ID",IR,.02))
|
|---|
| 66 | . . I REGIEN'>0 S RC=$$ERROR^RORERR(-95,,,PTIEN,798,IEN_",",.02) Q
|
|---|
| 67 | . . S TMP=+$G(RORBUF("DILIST","ID",IR,1))
|
|---|
| 68 | . . I TMP'>0 S RC=$$ERROR^RORERR(-95,,,PTIEN,798,IEN_",",1) Q
|
|---|
| 69 | . . S REGLST(PTIEN,REGIEN)=IEN_U_TMP
|
|---|
| 70 | Q:RC<0 RC
|
|---|
| 71 | ;=== Compare the "from" and "to" registry records
|
|---|
| 72 | S REGIEN=0
|
|---|
| 73 | F S REGIEN=$O(REGLST(DFN,REGIEN)) Q:REGIEN'>0 D
|
|---|
| 74 | . K RORFDA,RORMSG S RC=0
|
|---|
| 75 | . S DTOLD=+$P(REGLST(DFN,REGIEN),U,2)
|
|---|
| 76 | . S DTNEW=+$P($G(REGLST(NEWDFN,REGIEN)),U,2)
|
|---|
| 77 | . I (DTNEW'>0)!(DTOLD<DTNEW) D Q:RC<0
|
|---|
| 78 | . . ;--- Make sure that the "to" patient has a record
|
|---|
| 79 | . . ;--- in the ROR PATIENT file.
|
|---|
| 80 | . . S RC=$$ADDPDATA^RORUPD50(NEWDFN) Q:RC<0
|
|---|
| 81 | . . ;--- Replace the .01 value in the "from" registry record with
|
|---|
| 82 | . . ; the new patient pointer since there is either no other
|
|---|
| 83 | . . ;--- record for this patient or it is newer than the "from" one.
|
|---|
| 84 | . . S IENS=+$P(REGLST(DFN,REGIEN),U)_","
|
|---|
| 85 | . . S RORFDA(798,IENS,.01)=NEWDFN
|
|---|
| 86 | . . D FILE^DIE(,"RORFDA","RORMSG")
|
|---|
| 87 | . . I $G(DIERR) S RC=$$DBS^RORERR("RORMSG",-9,,DFN,798,IENS) Q
|
|---|
| 88 | . . ;--- Delete the "to" registry record. It was created after
|
|---|
| 89 | . . ;--- the original ("from") one and we should keep the latter.
|
|---|
| 90 | . . S DA=+$P($G(REGLST(NEWDFN,REGIEN)),U)
|
|---|
| 91 | . . I DA>0 S DIK=$$ROOT^DILFD(798) D ^DIK
|
|---|
| 92 | . E D
|
|---|
| 93 | . . ;--- Delete the "from" registry record since
|
|---|
| 94 | . . ;--- the "to" record is actually older
|
|---|
| 95 | . . S DIK=$$ROOT^DILFD(798),DA=+$P(REGLST(DFN,REGIEN),U) D ^DIK
|
|---|
| 96 | . ;--- Indicate successful merge
|
|---|
| 97 | . K REGLST(DFN,REGIEN)
|
|---|
| 98 | ;=== Done
|
|---|
| 99 | Q 0
|
|---|
| 100 | ;
|
|---|
| 101 | ;***** SCANS PATIENTS AND UPDATES DEMOGRAPHIC DATA (IF NECESSARY)
|
|---|
| 102 | ;
|
|---|
| 103 | ; .REGLST Reference to a local array containing
|
|---|
| 104 | ; registry names as subscripts
|
|---|
| 105 | ;
|
|---|
| 106 | ; Return Values:
|
|---|
| 107 | ; <0 Error code
|
|---|
| 108 | ; 0 Ok
|
|---|
| 109 | ;
|
|---|
| 110 | UPDDEM(REGLST) ;
|
|---|
| 111 | N CNT,IR,PTIEN,RC,REGIEN,REGNAME,ROOT,SCR,UPD,UPDCNT
|
|---|
| 112 | N RORLOR,RORLST,RORMSG
|
|---|
| 113 | S ROOT=$$ROOT^DILFD(798,,1)
|
|---|
| 114 | ;--- Compile a list of registry internal entry numbers
|
|---|
| 115 | S REGNAME="",RC=0
|
|---|
| 116 | F S REGNAME=$O(REGLST(REGNAME)) Q:REGNAME="" D Q:RC<0
|
|---|
| 117 | . S RC=+$G(REGLST(REGNAME))
|
|---|
| 118 | . S:RC'>0 RC=$$REGIEN^RORUTL02(REGNAME)
|
|---|
| 119 | . S:RC>0 RORLOR(+RC)=""
|
|---|
| 120 | Q:RC<0 RC
|
|---|
| 121 | ;--- Loop through the patients of the registries
|
|---|
| 122 | S PTIEN="",(CNT,RC)=0
|
|---|
| 123 | F S PTIEN=$O(@ROOT@("B",PTIEN)) Q:PTIEN="" D Q:RC<0
|
|---|
| 124 | . ;--- Check if task stop has been requested
|
|---|
| 125 | . I $D(ZTQUEUED),$$S^%ZTLOAD D Q
|
|---|
| 126 | . . S RC=$$ERROR^RORERR(-42)
|
|---|
| 127 | . S CNT=CNT+1
|
|---|
| 128 | . I $G(RORPARM("DEBUG"))>1 W:$E($G(IOST),1,2)="C-" *13,CNT
|
|---|
| 129 | . ;--- Check for "stray" items in the cross-reference
|
|---|
| 130 | . S IR=""
|
|---|
| 131 | . F S IR=$O(@ROOT@("B",PTIEN,IR)) Q:IR="" D
|
|---|
| 132 | . . K:$P($G(@ROOT@(IR,0)),U)'>0 @ROOT@("B",PTIEN,IR)
|
|---|
| 133 | . Q:$D(@ROOT@("B",PTIEN))<10
|
|---|
| 134 | . ;--- Check for a merged patient record
|
|---|
| 135 | . S RC=$$MERGED^RORUTL18(PTIEN)
|
|---|
| 136 | . I RC S:RC>0 RC=$$MERGE(PTIEN,RC) S RC=0 Q
|
|---|
| 137 | . ;--- Load a list of patient's registry records
|
|---|
| 138 | . S SCR="S Y=+$P($G(^(0)),U,2) I Y,$D(RORLOR(Y))"
|
|---|
| 139 | . D FIND^DIC(798,,"@;.02I;3I;8E","QUX",PTIEN,,"B",SCR,,"RORLST","RORMSG")
|
|---|
| 140 | . I $G(DIERR) D Q
|
|---|
| 141 | . . S RC=$$DBS^RORERR("RORMSG",-9,,PTIEN,798)
|
|---|
| 142 | . ;--- Demographic data should be checked only if at least one of
|
|---|
| 143 | . ;--- the registry records of the patient is active.
|
|---|
| 144 | . S IR="",UPDCNT=0
|
|---|
| 145 | . F S IR=$O(RORLST("DILIST","ID",IR)) Q:IR="" D
|
|---|
| 146 | . . S UPD=+$G(RORLST("DILIST","ID",IR,8))
|
|---|
| 147 | . . S REGIEN=+$G(RORLST("DILIST","ID",IR,.02))
|
|---|
| 148 | . . S TMP=+$G(RORLST("DILIST","ID",IR,3)) ; STATUS
|
|---|
| 149 | . . S CNT(REGIEN,TMP)=$G(CNT(REGIEN,TMP))+1
|
|---|
| 150 | . . S:UPD UPDCNT=UPDCNT+1
|
|---|
| 151 | . S:UPDCNT RC=$$UPDPTDEM(PTIEN)
|
|---|
| 152 | D:RC'<0 UPDRCNT(.CNT)
|
|---|
| 153 | ;---
|
|---|
| 154 | Q $S(RC<0:RC,1:0)
|
|---|
| 155 | ;
|
|---|
| 156 | ;***** UPDATES DEMOGRAPHIC DATA OF THE PATIENT (IF NECESSARY)
|
|---|
| 157 | ;
|
|---|
| 158 | ; PTIEN Patient IEN
|
|---|
| 159 | ;
|
|---|
| 160 | ; Return Values:
|
|---|
| 161 | ; <0 Error code
|
|---|
| 162 | ; 0 Ok
|
|---|
| 163 | ;
|
|---|
| 164 | UPDPTDEM(PTIEN) ;
|
|---|
| 165 | N CF,DOD,IENS,RC,RORMSG,RORPAT
|
|---|
| 166 | S IENS=PTIEN_",",CF=0
|
|---|
| 167 | ;--- Try to lock the record of the ROR PATIENT file
|
|---|
| 168 | L +^RORDATA(798.4,PTIEN):3
|
|---|
| 169 | E Q $$ERROR^RORERR(-11,,,PTIEN,"file #798.4")
|
|---|
| 170 | D
|
|---|
| 171 | . ;--- Compare demographic data
|
|---|
| 172 | . S RC=$$PATDATA^RORUPD52(IENS,.RORPAT,IENS,.DOD) Q:RC<0
|
|---|
| 173 | . S:RC CF=1
|
|---|
| 174 | . ;--- Mark registry records of the patient
|
|---|
| 175 | . I CF S RC=$$MARKREGS(PTIEN,$G(DOD)) Q:RC<0
|
|---|
| 176 | . ;--- Update demographic data
|
|---|
| 177 | . I CF,$D(RORPAT)>1 S RC=0 D Q:RC<0
|
|---|
| 178 | . . D FILE^DIE(,"RORPAT","RORMSG") Q:'$G(DIERR)
|
|---|
| 179 | . . S RC=$$DBS^RORERR("RORMSG",-9,,PTIEN,798.4)
|
|---|
| 180 | ;
|
|---|
| 181 | L -^RORDATA(798.4,PTIEN)
|
|---|
| 182 | Q 0
|
|---|
| 183 | ;
|
|---|
| 184 | ;***** UPDATES RECORD COUNTERS IN THE 'ROR REGISTRY PARAMETERS' FILE
|
|---|
| 185 | ;
|
|---|
| 186 | ; .CNT( Reference to a local array containg registry
|
|---|
| 187 | ; record counters
|
|---|
| 188 | ; Registry#,
|
|---|
| 189 | ; 0) Number of confirmed records
|
|---|
| 190 | ; 4) Number of pending records
|
|---|
| 191 | ;
|
|---|
| 192 | UPDRCNT(CNT) ;
|
|---|
| 193 | N IENS,RC,REGIEN,RORFDA,RORMSG
|
|---|
| 194 | S REGIEN=0
|
|---|
| 195 | F S REGIEN=$O(CNT(REGIEN)) Q:REGIEN="" D
|
|---|
| 196 | . S IENS=REGIEN_","
|
|---|
| 197 | . S RORFDA(798.1,IENS,19.1)=$G(CNT(REGIEN,0))
|
|---|
| 198 | . S RORFDA(798.1,IENS,19.2)=$G(CNT(REGIEN,4))
|
|---|
| 199 | . D FILE^DIE("K","RORFDA","RORMSG")
|
|---|
| 200 | . I $G(DIERR) D Q
|
|---|
| 201 | . . S RC=$$DBS^RORERR("RORMSG",-9,,798.1,IENS)
|
|---|
| 202 | Q
|
|---|
