| 1 | RORUPP01 ;HCIOFO/SG - PATIENT EVENTS (ERRORS) ; 1/20/06 1:55pm
|
|---|
| 2 | ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
|
|---|
| 3 | ;
|
|---|
| 4 | ; RORUPD("LM2", Static list of registries must be defined
|
|---|
| 5 | ; Registry#) if you are going to use these functions.
|
|---|
| 6 | ;
|
|---|
| 7 | ; RORUPD("MAXPPCNT") This node should have a positive value if
|
|---|
| 8 | ; you are going to use these functions.
|
|---|
| 9 | ; Otherwise, 14 will be used by default.
|
|---|
| 10 | ;
|
|---|
| 11 | ; See source code of the ^RORUPD routine for detailed description
|
|---|
| 12 | ; of these nodes.
|
|---|
| 13 | ;
|
|---|
| 14 | Q
|
|---|
| 15 | ;
|
|---|
| 16 | ;***** ADDS THE REFERENCES TO THE LIST
|
|---|
| 17 | ;
|
|---|
| 18 | ; PATIEN Patient IEN
|
|---|
| 19 | ; DATE Date to start next registry update
|
|---|
| 20 | ;
|
|---|
| 21 | ; Return Values:
|
|---|
| 22 | ; <0 Error code
|
|---|
| 23 | ; 0 Ok
|
|---|
| 24 | ;
|
|---|
| 25 | ADD(PATIEN,DATE) ;
|
|---|
| 26 | N I,IENS,MAXCNT,RC,REGIEN,RORBUF,RORFDA,RORIEN,RORMSG,TMP,URLST
|
|---|
| 27 | S MAXCNT=$$MAXCNT()
|
|---|
| 28 | I $D(^RORDATA(798.3,PATIEN,1,"B"))>1 S RC=0 D Q:RC<0 RC
|
|---|
| 29 | . ;--- Get a list of existing patient error records
|
|---|
| 30 | . S IENS=","_PATIEN_",",I="I $D(RORUPD(""LM2"",+$P(^(0),U)))"
|
|---|
| 31 | . D LIST^DIC(798.31,IENS,"@;.01I;1I;2",,,,,"B",I,,"RORBUF","RORMSG")
|
|---|
| 32 | . I $G(DIERR) D Q
|
|---|
| 33 | . . S RC=$$DBS^RORERR("RORMSG",-9,,,798.31,IENS)
|
|---|
| 34 | . Q:'$G(RORBUF("DILIST",0))
|
|---|
| 35 | . ;--- Prepare FDA for records to update
|
|---|
| 36 | . S I=""
|
|---|
| 37 | . F S I=$O(RORBUF("DILIST",2,I)) Q:I="" D
|
|---|
| 38 | . . S REGIEN=+$G(RORBUF("DILIST","ID",I,.01))
|
|---|
| 39 | . . S URLST(REGIEN)=""
|
|---|
| 40 | . . Q:$G(RORBUF("DILIST","ID",I,2))'<MAXCNT
|
|---|
| 41 | . . S IENS=RORBUF("DILIST",2,I)_","_PATIEN_","
|
|---|
| 42 | . . S TMP=$G(RORBUF("DILIST","ID",I,1))
|
|---|
| 43 | . . S RORFDA(798.31,IENS,1)=$S(TMP&(TMP<DATE):TMP,1:DATE)
|
|---|
| 44 | . . S RORFDA(798.31,IENS,2)=$G(RORBUF("DILIST","ID",I,2))+1
|
|---|
| 45 | . Q:$D(RORFDA)<10
|
|---|
| 46 | . ;--- Update the records
|
|---|
| 47 | . D FILE^DIE("K","RORFDA","RORMSG")
|
|---|
| 48 | . S:$G(DIERR) RC=$$DBS^RORERR("RORMSG",-9,,,798.31)
|
|---|
| 49 | ;--- Prepare FDA for records to create
|
|---|
| 50 | S REGIEN="",I=1
|
|---|
| 51 | F S REGIEN=$O(RORUPD("LM2",REGIEN)) Q:REGIEN="" D
|
|---|
| 52 | . Q:$D(URLST(REGIEN))
|
|---|
| 53 | . S I=I+1,IENS="+"_I_",?+1,"
|
|---|
| 54 | . S RORFDA(798.31,IENS,.01)=REGIEN
|
|---|
| 55 | . S RORFDA(798.31,IENS,1)=DATE
|
|---|
| 56 | . S RORFDA(798.31,IENS,2)=1
|
|---|
| 57 | ;--- Create the records
|
|---|
| 58 | I $D(RORFDA)>1 S RC=0 D Q:RC<0 RC
|
|---|
| 59 | . S (RORFDA(798.3,"?+1,",.01),RORIEN(1))=PATIEN
|
|---|
| 60 | . D UPDATE^DIE(,"RORFDA","RORIEN","RORMSG")
|
|---|
| 61 | . S:$G(DIERR) RC=$$DBS^RORERR("RORMSG",-9,,,798.31)
|
|---|
| 62 | Q 0
|
|---|
| 63 | ;
|
|---|
| 64 | ;***** RETURNS THE THRESHOLD VALUE OF THE ERROR COUNTER
|
|---|
| 65 | MAXCNT() ;
|
|---|
| 66 | Q $S($G(RORUPD("MAXPPCNT"))>0:+RORUPD("MAXPPCNT"),1:14)
|
|---|
| 67 | ;
|
|---|
| 68 | ;***** REMOVES THE REFERNCES FROM THE LIST
|
|---|
| 69 | ;
|
|---|
| 70 | ; PATIEN Patient IEN
|
|---|
| 71 | ; [ROR8LST] Closed root of an array containg list of registry
|
|---|
| 72 | ; IENs as subscripts. $NA(RORUPD("LM2")) is used
|
|---|
| 73 | ; by default. Only records associated with these
|
|---|
| 74 | ; registries will be removed.
|
|---|
| 75 | ;
|
|---|
| 76 | ; Return Values:
|
|---|
| 77 | ; <0 Error code
|
|---|
| 78 | ; 0 Ok
|
|---|
| 79 | ;
|
|---|
| 80 | REMOVE(PATIEN,ROR8LST) ;
|
|---|
| 81 | Q:$D(^RORDATA(798.3,PATIEN,1,"B"))<10 0
|
|---|
| 82 | N I,IENS,RC,RORBUF,RORFDA,RORMSG
|
|---|
| 83 | S:$G(ROR8LST)="" ROR8LST=$NA(RORUPD("LM2"))
|
|---|
| 84 | S IENS=","_PATIEN_",",I="I $D(@ROR8LST@(+$P(^(0),U)))"
|
|---|
| 85 | D LIST^DIC(798.31,IENS,"@",,,,,"B",I,,"RORBUF","RORMSG")
|
|---|
| 86 | I $G(DIERR) D Q RC
|
|---|
| 87 | . S RC=$$DBS^RORERR("RORMSG",-9,,,798.31,IENS)
|
|---|
| 88 | Q:'$G(RORBUF("DILIST",0)) 0
|
|---|
| 89 | S I=""
|
|---|
| 90 | F S I=$O(RORBUF("DILIST",2,I)) Q:I="" D
|
|---|
| 91 | . S IENS=RORBUF("DILIST",2,I)_","_PATIEN_","
|
|---|
| 92 | . S RORFDA(798.31,IENS,.01)="@"
|
|---|
| 93 | D FILE^DIE("K","RORFDA","RORMSG")
|
|---|
| 94 | Q:$G(DIERR) $$DBS^RORERR("RORMSG",-9,,,798.31)
|
|---|
| 95 | Q 0
|
|---|
| 96 | ;
|
|---|
| 97 | ;***** RETURNS START DATE FOR THE DATA SCAN (IF ANY)
|
|---|
| 98 | ;
|
|---|
| 99 | ; PATIEN Patient IEN
|
|---|
| 100 | ;
|
|---|
| 101 | ; Return Values:
|
|---|
| 102 | ; <0 Error code
|
|---|
| 103 | ; "" There is no date for the patient in the file
|
|---|
| 104 | ; >0 Start date
|
|---|
| 105 | ;
|
|---|
| 106 | SDSDATE(PATIEN) ;
|
|---|
| 107 | Q:$D(^RORDATA(798.3,PATIEN,1,"B"))<10 ""
|
|---|
| 108 | N CNT,DATE,I,IENS,MAXCNT,RC,RORBUF,RORMSG,TMP
|
|---|
| 109 | ;--- Load the pending references (in chronological order)
|
|---|
| 110 | S IENS=","_PATIEN_",",I="I $D(RORUPD(""LM2"",+$P(^(0),U)))"
|
|---|
| 111 | D LIST^DIC(798.31,IENS,"@;1I;2",,,,,"AD",I,,"RORBUF","RORMSG")
|
|---|
| 112 | I $G(DIERR) D Q RC
|
|---|
| 113 | . S RC=$$DBS^RORERR("RORMSG",-9,,,798.31,IENS)
|
|---|
| 114 | Q:'$G(RORBUF("DILIST",0)) ""
|
|---|
| 115 | ;--- Get and return the earliest date
|
|---|
| 116 | S MAXCNT=$$MAXCNT()
|
|---|
| 117 | S (DATE,I)="",CNT=0
|
|---|
| 118 | F S I=$O(RORBUF("DILIST","ID",I)) Q:I="" D Q:CNT&DATE
|
|---|
| 119 | . S:$G(RORBUF("DILIST","ID",I,2))<MAXCNT CNT=CNT+1
|
|---|
| 120 | . S:'DATE DATE=$G(RORBUF("DILIST","ID",I,1))
|
|---|
| 121 | Q $S('CNT:$$ERROR^RORERR(-66,,,PATIEN),1:DATE)
|
|---|
