122 lines
4.1 KiB
Mathematica
122 lines
4.1 KiB
Mathematica
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)
|