RORUPP01 ;HCIOFO/SG - PATIENT EVENTS (ERRORS) ; 1/20/06 1:55pm
;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
;
; RORUPD("LM2", Static list of registries must be defined
; Registry#) if you are going to use these functions.
;
; RORUPD("MAXPPCNT") This node should have a positive value if
; you are going to use these functions.
; Otherwise, 14 will be used by default.
;
; See source code of the ^RORUPD routine for detailed description
; of these nodes.
;
Q
;
;***** ADDS THE REFERENCES TO THE LIST
;
; PATIEN Patient IEN
; DATE Date to start next registry update
;
; Return Values:
; <0 Error code
; 0 Ok
;
ADD(PATIEN,DATE) ;
N I,IENS,MAXCNT,RC,REGIEN,RORBUF,RORFDA,RORIEN,RORMSG,TMP,URLST
S MAXCNT=$$MAXCNT()
I $D(^RORDATA(798.3,PATIEN,1,"B"))>1 S RC=0 D Q:RC<0 RC
. ;--- Get a list of existing patient error records
. S IENS=","_PATIEN_",",I="I $D(RORUPD(""LM2"",+$P(^(0),U)))"
. D LIST^DIC(798.31,IENS,"@;.01I;1I;2",,,,,"B",I,,"RORBUF","RORMSG")
. I $G(DIERR) D Q
. . S RC=$$DBS^RORERR("RORMSG",-9,,,798.31,IENS)
. Q:'$G(RORBUF("DILIST",0))
. ;--- Prepare FDA for records to update
. S I=""
. F S I=$O(RORBUF("DILIST",2,I)) Q:I="" D
. . S REGIEN=+$G(RORBUF("DILIST","ID",I,.01))
. . S URLST(REGIEN)=""
. . Q:$G(RORBUF("DILIST","ID",I,2))'<MAXCNT
. . S IENS=RORBUF("DILIST",2,I)_","_PATIEN_","
. . S TMP=$G(RORBUF("DILIST","ID",I,1))
. . S RORFDA(798.31,IENS,1)=$S(TMP&(TMP<DATE):TMP,1:DATE)
. . S RORFDA(798.31,IENS,2)=$G(RORBUF("DILIST","ID",I,2))+1
. Q:$D(RORFDA)<10
. ;--- Update the records
. D FILE^DIE("K","RORFDA","RORMSG")
. S:$G(DIERR) RC=$$DBS^RORERR("RORMSG",-9,,,798.31)
;--- Prepare FDA for records to create
S REGIEN="",I=1
F S REGIEN=$O(RORUPD("LM2",REGIEN)) Q:REGIEN="" D
. Q:$D(URLST(REGIEN))
. S I=I+1,IENS="+"_I_",?+1,"
. S RORFDA(798.31,IENS,.01)=REGIEN
. S RORFDA(798.31,IENS,1)=DATE
. S RORFDA(798.31,IENS,2)=1
;--- Create the records
I $D(RORFDA)>1 S RC=0 D Q:RC<0 RC
. S (RORFDA(798.3,"?+1,",.01),RORIEN(1))=PATIEN
. D UPDATE^DIE(,"RORFDA","RORIEN","RORMSG")
. S:$G(DIERR) RC=$$DBS^RORERR("RORMSG",-9,,,798.31)
Q 0
;
;***** RETURNS THE THRESHOLD VALUE OF THE ERROR COUNTER
MAXCNT() ;
Q $S($G(RORUPD("MAXPPCNT"))>0:+RORUPD("MAXPPCNT"),1:14)
;
;***** REMOVES THE REFERNCES FROM THE LIST
;
; PATIEN Patient IEN
; [ROR8LST] Closed root of an array containg list of registry
; IENs as subscripts. $NA(RORUPD("LM2")) is used
; by default. Only records associated with these
; registries will be removed.
;
; Return Values:
; <0 Error code
; 0 Ok
;
REMOVE(PATIEN,ROR8LST) ;
Q:$D(^RORDATA(798.3,PATIEN,1,"B"))<10 0
N I,IENS,RC,RORBUF,RORFDA,RORMSG
S:$G(ROR8LST)="" ROR8LST=$NA(RORUPD("LM2"))
S IENS=","_PATIEN_",",I="I $D(@ROR8LST@(+$P(^(0),U)))"
D LIST^DIC(798.31,IENS,"@",,,,,"B",I,,"RORBUF","RORMSG")
I $G(DIERR) D Q RC
. S RC=$$DBS^RORERR("RORMSG",-9,,,798.31,IENS)
Q:'$G(RORBUF("DILIST",0)) 0
S I=""
F S I=$O(RORBUF("DILIST",2,I)) Q:I="" D
. S IENS=RORBUF("DILIST",2,I)_","_PATIEN_","
. S RORFDA(798.31,IENS,.01)="@"
D FILE^DIE("K","RORFDA","RORMSG")
Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,,798.31)
Q 0
;
;***** RETURNS START DATE FOR THE DATA SCAN (IF ANY)
;
; PATIEN Patient IEN
;
; Return Values:
; <0 Error code
; "" There is no date for the patient in the file
; >0 Start date
;
SDSDATE(PATIEN) ;
Q:$D(^RORDATA(798.3,PATIEN,1,"B"))<10 ""
N CNT,DATE,I,IENS,MAXCNT,RC,RORBUF,RORMSG,TMP
;--- Load the pending references (in chronological order)
S IENS=","_PATIEN_",",I="I $D(RORUPD(""LM2"",+$P(^(0),U)))"
D LIST^DIC(798.31,IENS,"@;1I;2",,,,,"AD",I,,"RORBUF","RORMSG")
I $G(DIERR) D Q RC
. S RC=$$DBS^RORERR("RORMSG",-9,,,798.31,IENS)
Q:'$G(RORBUF("DILIST",0)) ""
;--- Get and return the earliest date
S MAXCNT=$$MAXCNT()
S (DATE,I)="",CNT=0
F S I=$O(RORBUF("DILIST","ID",I)) Q:I="" D Q:CNT&DATE
. S:$G(RORBUF("DILIST","ID",I,2))<MAXCNT CNT=CNT+1
. S:'DATE DATE=$G(RORBUF("DILIST","ID",I,1))
Q $S('CNT:$$ERROR^RORERR(-66,,,PATIEN),1:DATE)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORUPP01 4320 printed Sep 23, 2025@19:19:50 Page 2
RORUPP01 ;HCIOFO/SG - PATIENT EVENTS (ERRORS) ; 1/20/06 1:55pm
+1 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
+2 ;
+3 ; RORUPD("LM2", Static list of registries must be defined
+4 ; Registry#) if you are going to use these functions.
+5 ;
+6 ; RORUPD("MAXPPCNT") This node should have a positive value if
+7 ; you are going to use these functions.
+8 ; Otherwise, 14 will be used by default.
+9 ;
+10 ; See source code of the ^RORUPD routine for detailed description
+11 ; of these nodes.
+12 ;
+13 QUIT
+14 ;
+15 ;***** ADDS THE REFERENCES TO THE LIST
+16 ;
+17 ; PATIEN Patient IEN
+18 ; DATE Date to start next registry update
+19 ;
+20 ; Return Values:
+21 ; <0 Error code
+22 ; 0 Ok
+23 ;
ADD(PATIEN,DATE) ;
+1 NEW I,IENS,MAXCNT,RC,REGIEN,RORBUF,RORFDA,RORIEN,RORMSG,TMP,URLST
+2 SET MAXCNT=$$MAXCNT()
+3 IF $DATA(^RORDATA(798.3,PATIEN,1,"B"))>1
SET RC=0
Begin DoDot:1
+4 ;--- Get a list of existing patient error records
+5 SET IENS=","_PATIEN_","
SET I="I $D(RORUPD(""LM2"",+$P(^(0),U)))"
+6 DO LIST^DIC(798.31,IENS,"@;.01I;1I;2",,,,,"B",I,,"RORBUF","RORMSG")
+7 IF $GET(DIERR)
Begin DoDot:2
+8 SET RC=$$DBS^RORERR("RORMSG",-9,,,798.31,IENS)
End DoDot:2
QUIT
+9 if '$GET(RORBUF("DILIST",0))
QUIT
+10 ;--- Prepare FDA for records to update
+11 SET I=""
+12 FOR
SET I=$ORDER(RORBUF("DILIST",2,I))
if I=""
QUIT
Begin DoDot:2
+13 SET REGIEN=+$GET(RORBUF("DILIST","ID",I,.01))
+14 SET URLST(REGIEN)=""
+15 if $GET(RORBUF("DILIST","ID",I,2))'<MAXCNT
QUIT
+16 SET IENS=RORBUF("DILIST",2,I)_","_PATIEN_","
+17 SET TMP=$GET(RORBUF("DILIST","ID",I,1))
+18 SET RORFDA(798.31,IENS,1)=$SELECT(TMP&(TMP<DATE):TMP,1:DATE)
+19 SET RORFDA(798.31,IENS,2)=$GET(RORBUF("DILIST","ID",I,2))+1
End DoDot:2
+20 if $DATA(RORFDA)<10
QUIT
+21 ;--- Update the records
+22 DO FILE^DIE("K","RORFDA","RORMSG")
+23 if $GET(DIERR)
SET RC=$$DBS^RORERR("RORMSG",-9,,,798.31)
End DoDot:1
if RC<0
QUIT RC
+24 ;--- Prepare FDA for records to create
+25 SET REGIEN=""
SET I=1
+26 FOR
SET REGIEN=$ORDER(RORUPD("LM2",REGIEN))
if REGIEN=""
QUIT
Begin DoDot:1
+27 if $DATA(URLST(REGIEN))
QUIT
+28 SET I=I+1
SET IENS="+"_I_",?+1,"
+29 SET RORFDA(798.31,IENS,.01)=REGIEN
+30 SET RORFDA(798.31,IENS,1)=DATE
+31 SET RORFDA(798.31,IENS,2)=1
End DoDot:1
+32 ;--- Create the records
+33 IF $DATA(RORFDA)>1
SET RC=0
Begin DoDot:1
+34 SET (RORFDA(798.3,"?+1,",.01),RORIEN(1))=PATIEN
+35 DO UPDATE^DIE(,"RORFDA","RORIEN","RORMSG")
+36 if $GET(DIERR)
SET RC=$$DBS^RORERR("RORMSG",-9,,,798.31)
End DoDot:1
if RC<0
QUIT RC
+37 QUIT 0
+38 ;
+39 ;***** RETURNS THE THRESHOLD VALUE OF THE ERROR COUNTER
MAXCNT() ;
+1 QUIT $SELECT($GET(RORUPD("MAXPPCNT"))>0:+RORUPD("MAXPPCNT"),1:14)
+2 ;
+3 ;***** REMOVES THE REFERNCES FROM THE LIST
+4 ;
+5 ; PATIEN Patient IEN
+6 ; [ROR8LST] Closed root of an array containg list of registry
+7 ; IENs as subscripts. $NA(RORUPD("LM2")) is used
+8 ; by default. Only records associated with these
+9 ; registries will be removed.
+10 ;
+11 ; Return Values:
+12 ; <0 Error code
+13 ; 0 Ok
+14 ;
REMOVE(PATIEN,ROR8LST) ;
+1 if $DATA(^RORDATA(798.3,PATIEN,1,"B"))<10
QUIT 0
+2 NEW I,IENS,RC,RORBUF,RORFDA,RORMSG
+3 if $GET(ROR8LST)=""
SET ROR8LST=$NAME(RORUPD("LM2"))
+4 SET IENS=","_PATIEN_","
SET I="I $D(@ROR8LST@(+$P(^(0),U)))"
+5 DO LIST^DIC(798.31,IENS,"@",,,,,"B",I,,"RORBUF","RORMSG")
+6 IF $GET(DIERR)
Begin DoDot:1
+7 SET RC=$$DBS^RORERR("RORMSG",-9,,,798.31,IENS)
End DoDot:1
QUIT RC
+8 if '$GET(RORBUF("DILIST",0))
QUIT 0
+9 SET I=""
+10 FOR
SET I=$ORDER(RORBUF("DILIST",2,I))
if I=""
QUIT
Begin DoDot:1
+11 SET IENS=RORBUF("DILIST",2,I)_","_PATIEN_","
+12 SET RORFDA(798.31,IENS,.01)="@"
End DoDot:1
+13 DO FILE^DIE("K","RORFDA","RORMSG")
+14 if $GET(DIERR)
QUIT $$DBS^RORERR("RORMSG",-9,,,798.31)
+15 QUIT 0
+16 ;
+17 ;***** RETURNS START DATE FOR THE DATA SCAN (IF ANY)
+18 ;
+19 ; PATIEN Patient IEN
+20 ;
+21 ; Return Values:
+22 ; <0 Error code
+23 ; "" There is no date for the patient in the file
+24 ; >0 Start date
+25 ;
SDSDATE(PATIEN) ;
+1 if $DATA(^RORDATA(798.3,PATIEN,1,"B"))<10
QUIT ""
+2 NEW CNT,DATE,I,IENS,MAXCNT,RC,RORBUF,RORMSG,TMP
+3 ;--- Load the pending references (in chronological order)
+4 SET IENS=","_PATIEN_","
SET I="I $D(RORUPD(""LM2"",+$P(^(0),U)))"
+5 DO LIST^DIC(798.31,IENS,"@;1I;2",,,,,"AD",I,,"RORBUF","RORMSG")
+6 IF $GET(DIERR)
Begin DoDot:1
+7 SET RC=$$DBS^RORERR("RORMSG",-9,,,798.31,IENS)
End DoDot:1
QUIT RC
+8 if '$GET(RORBUF("DILIST",0))
QUIT ""
+9 ;--- Get and return the earliest date
+10 SET MAXCNT=$$MAXCNT()
+11 SET (DATE,I)=""
SET CNT=0
+12 FOR
SET I=$ORDER(RORBUF("DILIST","ID",I))
if I=""
QUIT
Begin DoDot:1
+13 if $GET(RORBUF("DILIST","ID",I,2))<MAXCNT
SET CNT=CNT+1
+14 if 'DATE
SET DATE=$GET(RORBUF("DILIST","ID",I,1))
End DoDot:1
if CNT&DATE
QUIT
+15 QUIT $SELECT('CNT:$$ERROR^RORERR(-66,,,PATIEN),1:DATE)
