- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORUPD51 7259 printed Feb 18, 2025@23:10:09 Page 2
- 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
- +2 ;
- +3 QUIT
- +4 ;
- +5 ;***** MARKS REGISTRIES (UPDATE DEMOGRAPHICS)
- +6 ;
- +7 ; PTIEN Patient IEN
- +8 ; [DOD] Date of death
- +9 ;
- +10 ; Return Values:
- +11 ; <0 Error code
- +12 ; 0 Ok
- +13 ;
- MARKREGS(PTIEN,DOD) ;
- +1 NEW ACTIVE,ECNT,I,IENS,RC,RI,TMP
- +2 NEW RORBUF,RORFDA,RORMSG,RORSRC
- +3 ;--- Compile a list of associated registries
- +4 DO FIND^DIC(798,,"@","QUX",PTIEN,,"B",,,"RORBUF","RORMSG")
- +5 if $GET(DIERR)
- QUIT $$DBS^RORERR("RORMSG",-9,,PTIEN,798)
- +6 ;--- Mark patient records of the registries
- +7 SET RI=""
- SET ECNT=0
- +8 FOR
- SET RI=$ORDER(RORBUF("DILIST",2,RI))
- if RI=""
- QUIT
- Begin DoDot:1
- +9 SET IENS=RORBUF("DILIST",2,RI)_","
- +10 KILL RORFDA,RORSRC
- +11 ;--- Try to lock the record; if this fails, continue anyway
- +12 LOCK +^RORDATA(798,+IENS):3
- +13 ;--- Load the field values
- +14 DO GETS^DIQ(798,IENS,"4;8","EI","RORSRC","RORMSG")
- +15 IF $GET(DIERR)
- Begin DoDot:2
- +16 SET RC=$$DBS^RORERR("RORMSG",-9,,PTIEN,798,IENS)
- End DoDot:2
- SET ECNT=ECNT+1
- QUIT
- +17 SET ACTIVE=+$GET(RORSRC(798,IENS,8,"E"))
- +18 ;--- Do not mark again if already marked
- +19 IF '$GET(RORSRC(798,IENS,4,"I"))
- SET RC=0
- Begin DoDot:2
- +20 ;--- Mark only active records
- +21 if ACTIVE
- SET RORFDA(798,IENS,4)=1
- End DoDot:2
- if RC<0
- QUIT
- +22 ;--- Update registry data record
- +23 IF $DATA(RORFDA)>1
- SET RC=0
- Begin DoDot:2
- +24 DO FILE^DIE(,"RORFDA","RORMSG")
- +25 IF $GET(DIERR)
- Begin DoDot:3
- +26 SET RC=$$DBS^RORERR("RORMSG",-9,,PTIEN,798,IENS)
- End DoDot:3
- SET ECNT=ECNT+1
- End DoDot:2
- if RC<0
- QUIT
- End DoDot:1
- LOCK -^RORDATA(798,+IENS)
- +27 QUIT $SELECT(ECNT>0:-9,1:0)
- +28 ;
- +29 ;***** PROCESSES THE MERGED PATIENT RECORD
- +30 ;
- +31 ; DFN IEN of the merged record (medrged from)
- +32 ; NEWDFN New patient IEN (merged to)
- +33 ;
- +34 ; Return values:
- +35 ; <0 Error code
- +36 ; 0 Ok
- +37 ;
- MERGE(DFN,NEWDFN) ;
- +1 NEW DA,DIK,DTNEW,DTOLD,IEN,IENS,IR,PTIEN,REGIEN,REGLST,RORBUF,RORFDA,RORMSG,TMP
- +2 DO LOG^RORERR(-111,,,DFN,NEWDFN)
- +3 ;=== Get the lists of registry records associated with the
- +4 ;=== merged from ("from") and merged to ("to") patient data
- +5 FOR PTIEN=DFN,NEWDFN
- Begin DoDot:1
- +6 KILL RORBUF,RORMSG
- +7 DO FIND^DIC(798,,"@;.02I;1I","QUX",PTIEN,,"B",,,"RORBUF","RORMSG")
- +8 IF $GET(DIERR)
- SET RC=$$DBS^RORERR("RORMSG",-9,,PTIEN,798)
- QUIT
- +9 SET IR=0
- +10 FOR
- SET IR=$ORDER(RORBUF("DILIST",2,IR))
- if IR'>0
- QUIT
- Begin DoDot:2
- +11 SET IEN=+RORBUF("DILIST",2,IR)
- +12 SET REGIEN=+$GET(RORBUF("DILIST","ID",IR,.02))
- +13 IF REGIEN'>0
- SET RC=$$ERROR^RORERR(-95,,,PTIEN,798,IEN_",",.02)
- QUIT
- +14 SET TMP=+$GET(RORBUF("DILIST","ID",IR,1))
- +15 IF TMP'>0
- SET RC=$$ERROR^RORERR(-95,,,PTIEN,798,IEN_",",1)
- QUIT
- +16 SET REGLST(PTIEN,REGIEN)=IEN_U_TMP
- End DoDot:2
- if RC<0
- QUIT
- End DoDot:1
- if RC<0
- QUIT
- +17 if RC<0
- QUIT RC
- +18 ;=== Compare the "from" and "to" registry records
- +19 SET REGIEN=0
- +20 FOR
- SET REGIEN=$ORDER(REGLST(DFN,REGIEN))
- if REGIEN'>0
- QUIT
- Begin DoDot:1
- +21 KILL RORFDA,RORMSG
- SET RC=0
- +22 SET DTOLD=+$PIECE(REGLST(DFN,REGIEN),U,2)
- +23 SET DTNEW=+$PIECE($GET(REGLST(NEWDFN,REGIEN)),U,2)
- +24 IF (DTNEW'>0)!(DTOLD<DTNEW)
- Begin DoDot:2
- +25 ;--- Make sure that the "to" patient has a record
- +26 ;--- in the ROR PATIENT file.
- +27 SET RC=$$ADDPDATA^RORUPD50(NEWDFN)
- if RC<0
- QUIT
- +28 ;--- Replace the .01 value in the "from" registry record with
- +29 ; the new patient pointer since there is either no other
- +30 ;--- record for this patient or it is newer than the "from" one.
- +31 SET IENS=+$PIECE(REGLST(DFN,REGIEN),U)_","
- +32 SET RORFDA(798,IENS,.01)=NEWDFN
- +33 DO FILE^DIE(,"RORFDA","RORMSG")
- +34 IF $GET(DIERR)
- SET RC=$$DBS^RORERR("RORMSG",-9,,DFN,798,IENS)
- QUIT
- +35 ;--- Delete the "to" registry record. It was created after
- +36 ;--- the original ("from") one and we should keep the latter.
- +37 SET DA=+$PIECE($GET(REGLST(NEWDFN,REGIEN)),U)
- +38 IF DA>0
- SET DIK=$$ROOT^DILFD(798)
- DO ^DIK
- End DoDot:2
- if RC<0
- QUIT
- +39 IF '$TEST
- Begin DoDot:2
- +40 ;--- Delete the "from" registry record since
- +41 ;--- the "to" record is actually older
- +42 SET DIK=$$ROOT^DILFD(798)
- SET DA=+$PIECE(REGLST(DFN,REGIEN),U)
- DO ^DIK
- End DoDot:2
- +43 ;--- Indicate successful merge
- +44 KILL REGLST(DFN,REGIEN)
- End DoDot:1
- +45 ;=== Done
- +46 QUIT 0
- +47 ;
- +48 ;***** SCANS PATIENTS AND UPDATES DEMOGRAPHIC DATA (IF NECESSARY)
- +49 ;
- +50 ; .REGLST Reference to a local array containing
- +51 ; registry names as subscripts
- +52 ;
- +53 ; Return Values:
- +54 ; <0 Error code
- +55 ; 0 Ok
- +56 ;
- UPDDEM(REGLST) ;
- +1 NEW CNT,IR,PTIEN,RC,REGIEN,REGNAME,ROOT,SCR,UPD,UPDCNT
- +2 NEW RORLOR,RORLST,RORMSG
- +3 SET ROOT=$$ROOT^DILFD(798,,1)
- +4 ;--- Compile a list of registry internal entry numbers
- +5 SET REGNAME=""
- SET RC=0
- +6 FOR
- SET REGNAME=$ORDER(REGLST(REGNAME))
- if REGNAME=""
- QUIT
- Begin DoDot:1
- +7 SET RC=+$GET(REGLST(REGNAME))
- +8 if RC'>0
- SET RC=$$REGIEN^RORUTL02(REGNAME)
- +9 if RC>0
- SET RORLOR(+RC)=""
- End DoDot:1
- if RC<0
- QUIT
- +10 if RC<0
- QUIT RC
- +11 ;--- Loop through the patients of the registries
- +12 SET PTIEN=""
- SET (CNT,RC)=0
- +13 FOR
- SET PTIEN=$ORDER(@ROOT@("B",PTIEN))
- if PTIEN=""
- QUIT
- Begin DoDot:1
- +14 ;--- Check if task stop has been requested
- +15 IF $DATA(ZTQUEUED)
- IF $$S^%ZTLOAD
- Begin DoDot:2
- +16 SET RC=$$ERROR^RORERR(-42)
- End DoDot:2
- QUIT
- +17 SET CNT=CNT+1
- +18 IF $GET(RORPARM("DEBUG"))>1
- if $EXTRACT($GET(IOST),1,2)="C-"
- WRITE *13,CNT
- +19 ;--- Check for "stray" items in the cross-reference
- +20 SET IR=""
- +21 FOR
- SET IR=$ORDER(@ROOT@("B",PTIEN,IR))
- if IR=""
- QUIT
- Begin DoDot:2
- +22 if $PIECE($GET(@ROOT@(IR,0)),U)'>0
- KILL @ROOT@("B",PTIEN,IR)
- End DoDot:2
- +23 if $DATA(@ROOT@("B",PTIEN))<10
- QUIT
- +24 ;--- Check for a merged patient record
- +25 SET RC=$$MERGED^RORUTL18(PTIEN)
- +26 IF RC
- if RC>0
- SET RC=$$MERGE(PTIEN,RC)
- SET RC=0
- QUIT
- +27 ;--- Load a list of patient's registry records
- +28 SET SCR="S Y=+$P($G(^(0)),U,2) I Y,$D(RORLOR(Y))"
- +29 DO FIND^DIC(798,,"@;.02I;3I;8E","QUX",PTIEN,,"B",SCR,,"RORLST","RORMSG")
- +30 IF $GET(DIERR)
- Begin DoDot:2
- +31 SET RC=$$DBS^RORERR("RORMSG",-9,,PTIEN,798)
- End DoDot:2
- QUIT
- +32 ;--- Demographic data should be checked only if at least one of
- +33 ;--- the registry records of the patient is active.
- +34 SET IR=""
- SET UPDCNT=0
- +35 FOR
- SET IR=$ORDER(RORLST("DILIST","ID",IR))
- if IR=""
- QUIT
- Begin DoDot:2
- +36 SET UPD=+$GET(RORLST("DILIST","ID",IR,8))
- +37 SET REGIEN=+$GET(RORLST("DILIST","ID",IR,.02))
- +38 ; STATUS
- SET TMP=+$GET(RORLST("DILIST","ID",IR,3))
- +39 SET CNT(REGIEN,TMP)=$GET(CNT(REGIEN,TMP))+1
- +40 if UPD
- SET UPDCNT=UPDCNT+1
- End DoDot:2
- +41 if UPDCNT
- SET RC=$$UPDPTDEM(PTIEN)
- End DoDot:1
- if RC<0
- QUIT
- +42 if RC'<0
- DO UPDRCNT(.CNT)
- +43 ;---
- +44 QUIT $SELECT(RC<0:RC,1:0)
- +45 ;
- +46 ;***** UPDATES DEMOGRAPHIC DATA OF THE PATIENT (IF NECESSARY)
- +47 ;
- +48 ; PTIEN Patient IEN
- +49 ;
- +50 ; Return Values:
- +51 ; <0 Error code
- +52 ; 0 Ok
- +53 ;
- UPDPTDEM(PTIEN) ;
- +1 NEW CF,DOD,IENS,RC,RORMSG,RORPAT
- +2 SET IENS=PTIEN_","
- SET CF=0
- +3 ;--- Try to lock the record of the ROR PATIENT file
- +4 LOCK +^RORDATA(798.4,PTIEN):3
- +5 IF '$TEST
- QUIT $$ERROR^RORERR(-11,,,PTIEN,"file #798.4")
- +6 Begin DoDot:1
- +7 ;--- Compare demographic data
- +8 SET RC=$$PATDATA^RORUPD52(IENS,.RORPAT,IENS,.DOD)
- if RC<0
- QUIT
- +9 if RC
- SET CF=1
- +10 ;--- Mark registry records of the patient
- +11 IF CF
- SET RC=$$MARKREGS(PTIEN,$GET(DOD))
- if RC<0
- QUIT
- +12 ;--- Update demographic data
- +13 IF CF
- IF $DATA(RORPAT)>1
- SET RC=0
- Begin DoDot:2
- +14 DO FILE^DIE(,"RORPAT","RORMSG")
- if '$GET(DIERR)
- QUIT
- +15 SET RC=$$DBS^RORERR("RORMSG",-9,,PTIEN,798.4)
- End DoDot:2
- if RC<0
- QUIT
- End DoDot:1
- +16 ;
- +17 LOCK -^RORDATA(798.4,PTIEN)
- +18 QUIT 0
- +19 ;
- +20 ;***** UPDATES RECORD COUNTERS IN THE 'ROR REGISTRY PARAMETERS' FILE
- +21 ;
- +22 ; .CNT( Reference to a local array containg registry
- +23 ; record counters
- +24 ; Registry#,
- +25 ; 0) Number of confirmed records
- +26 ; 4) Number of pending records
- +27 ;
- UPDRCNT(CNT) ;
- +1 NEW IENS,RC,REGIEN,RORFDA,RORMSG
- +2 SET REGIEN=0
- +3 FOR
- SET REGIEN=$ORDER(CNT(REGIEN))
- if REGIEN=""
- QUIT
- Begin DoDot:1
- +4 SET IENS=REGIEN_","
- +5 SET RORFDA(798.1,IENS,19.1)=$GET(CNT(REGIEN,0))
- +6 SET RORFDA(798.1,IENS,19.2)=$GET(CNT(REGIEN,4))
- +7 DO FILE^DIE("K","RORFDA","RORMSG")
- +8 IF $GET(DIERR)
- Begin DoDot:2
- +9 SET RC=$$DBS^RORERR("RORMSG",-9,,798.1,IENS)
- End DoDot:2
- QUIT
- End DoDot:1
- +10 QUIT