[613] | 1 | RORUPP02 ;HCIOFO/SG - PATIENT EVENTS (EVENTS) ; 1/20/06 1:55pm
|
---|
| 2 | ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
|
---|
| 3 | ;
|
---|
| 4 | Q
|
---|
| 5 | ;
|
---|
| 6 | ;***** ADDS THE EVENT REFERENCE
|
---|
| 7 | ;
|
---|
| 8 | ; PATIEN Patient IEN
|
---|
| 9 | ;
|
---|
| 10 | ; AREA Data area of the event (see the DATA AREA field
|
---|
| 11 | ; of the file #798.3 for details)
|
---|
| 12 | ;
|
---|
| 13 | ; [DATE] Date/Time associated with the event (the current
|
---|
| 14 | ; date/time is used by default).
|
---|
| 15 | ;
|
---|
| 16 | ; Return Values:
|
---|
| 17 | ; <0 Error code
|
---|
| 18 | ; 0 Ok
|
---|
| 19 | ;
|
---|
| 20 | ADD(PATIEN,AREA,DATE) ;
|
---|
| 21 | N IEN,IENS,RORFDA,RORIEN,RORMSG
|
---|
| 22 | S:$G(DATE)'>0 DATE=$$NOW^XLFDT
|
---|
| 23 | ;--- Do not record more than one reference per associated date.
|
---|
| 24 | ; Maybe in the future all references will be recorded but we
|
---|
| 25 | ; need only daily precision at the moment. If the reference
|
---|
| 26 | ; exists already, update it with the earlier associated date
|
---|
| 27 | ;--- and the latter timestamp if necessary.
|
---|
| 28 | S IEN=$O(^RORDATA(798.3,+PATIEN,2,"AD",AREA,DATE\1,""))
|
---|
| 29 | I IEN K DIERR D Q $S('$G(DIERR):0,1:-9)
|
---|
| 30 | . N BUF,NOW
|
---|
| 31 | . S IENS=IEN_","_(+PATIEN)_",",NOW=$$NOW^XLFDT
|
---|
| 32 | . S BUF=$G(^RORDATA(798.3,+PATIEN,2,IEN,0))
|
---|
| 33 | . S:NOW>$P(BUF,"^") RORFDA(798.32,IENS,.01)=NOW
|
---|
| 34 | . S:DATE<$P(BUF,"^",3) RORFDA(798.32,IENS,2)=DATE
|
---|
| 35 | . D:$D(RORFDA)>1 FILE^DIE(,"RORFDA","RORMSG")
|
---|
| 36 | ;--- Create the new event reference
|
---|
| 37 | S (RORFDA(798.3,"?+1,",.01),RORIEN(1))=+PATIEN
|
---|
| 38 | S IENS="+2,?+1,"
|
---|
| 39 | S RORFDA(798.32,IENS,.01)=$$NOW^XLFDT
|
---|
| 40 | S RORFDA(798.32,IENS,1)=AREA
|
---|
| 41 | S RORFDA(798.32,IENS,2)=DATE
|
---|
| 42 | D UPDATE^DIE(,"RORFDA","RORIEN","RORMSG")
|
---|
| 43 | Q $S('$G(DIERR):0,1:-9)
|
---|
| 44 | ;
|
---|
| 45 | ;***** CHECKS THE EVENTS
|
---|
| 46 | ;
|
---|
| 47 | ; PATIEN Patient IEN
|
---|
| 48 | ;
|
---|
| 49 | ; AREA Data area of the event (see the DATA AREA field
|
---|
| 50 | ; of the file #798.3 for details)
|
---|
| 51 | ;
|
---|
| 52 | ; .SDT Reference to a local variable containing the start
|
---|
| 53 | ; date. The date can be modified by the function and
|
---|
| 54 | ; returned via this parameter.
|
---|
| 55 | ;
|
---|
| 56 | ; .EDT Reference to a local variable containing the end
|
---|
| 57 | ; date. The date can be modified by the function and
|
---|
| 58 | ; returned via this parameter.
|
---|
| 59 | ;
|
---|
| 60 | ; Return Values:
|
---|
| 61 | ; <0 Error code
|
---|
| 62 | ; 0 No events (skip)
|
---|
| 63 | ; 1 Events have been found (proceed)
|
---|
| 64 | ; 2 The same as 1 + dates (SDT & EDT) have been modified
|
---|
| 65 | ;
|
---|
| 66 | GET(PATIEN,AREA,SDT,EDT) ;
|
---|
| 67 | N ED,FDTC,FEVT,IEN,NEWEDT,NEWSDT,ROOT,TMP
|
---|
| 68 | S ROOT=$NA(^RORDATA(798.3,+PATIEN,2))
|
---|
| 69 | S NEWSDT=999999999,NEWEDT=0,(FDTC,FEVT)=0
|
---|
| 70 | ;--- If the data search time frame is too wide and some of the
|
---|
| 71 | ; event references have been purged already then the time
|
---|
| 72 | ; frame cannot be shrinked according to the references and the
|
---|
| 73 | ;--- patient cannot be skipped if there are no references at all.
|
---|
| 74 | S:SDT<$G(RORUPD("EETS")) NEWSDT=SDT,NEWEDT=EDT,FEVT=1
|
---|
| 75 | ;--- Browse through the event references
|
---|
| 76 | S ED=$O(@ROOT@("AT",AREA,SDT),-1)
|
---|
| 77 | F S ED=$O(@ROOT@("AT",AREA,ED)) Q:(ED="")!(ED'<EDT) D
|
---|
| 78 | . S IEN=""
|
---|
| 79 | . F S IEN=$O(@ROOT@("AT",AREA,ED,IEN)) Q:IEN="" D
|
---|
| 80 | . . S TMP=$P($G(@ROOT@(IEN,0)),"^",3),FEVT=1
|
---|
| 81 | . . Q:TMP'>0
|
---|
| 82 | . . S:TMP<NEWSDT NEWSDT=TMP,FDTC=1
|
---|
| 83 | . . S:TMP>NEWEDT NEWEDT=TMP,FDTC=1
|
---|
| 84 | Q:'FEVT 0
|
---|
| 85 | I FDTC S SDT=NEWSDT,EDT=NEWEDT Q 2
|
---|
| 86 | Q 1
|
---|
| 87 | ;
|
---|
| 88 | ;***** PURGES THE OLD EVENT REFERENCES
|
---|
| 89 | ;
|
---|
| 90 | ; DATE Keep the references starting from this date
|
---|
| 91 | ;
|
---|
| 92 | ; Return Values:
|
---|
| 93 | ; <0 Error code
|
---|
| 94 | ; 0 Ok
|
---|
| 95 | ;
|
---|
| 96 | PURGE(DATE) ;
|
---|
| 97 | N CNT,DA,DIK,IEN,IEN1,IENS,RC,REINDEX,ROOT,RORFDA,RORMSG
|
---|
| 98 | S ROOT=$$ROOT^DILFD(798.3,,1)
|
---|
| 99 | S DATE=DATE\1,(CNT,RC)=0
|
---|
| 100 | F S DATE=$O(@ROOT@("AT",DATE),-1) Q:DATE="" D Q:RC<0
|
---|
| 101 | . S IEN=""
|
---|
| 102 | . F S IEN=$O(@ROOT@("AT",DATE,IEN)) Q:IEN="" D Q:RC<0
|
---|
| 103 | . . S IEN1="",REINDEX=0
|
---|
| 104 | . . F S IEN1=$O(@ROOT@("AT",DATE,IEN,IEN1)) Q:IEN1="" D Q:RC<0
|
---|
| 105 | . . . ;---Check if the corresponding record exists
|
---|
| 106 | . . . I '$D(@ROOT@(IEN,2,IEN1,0)) D Q
|
---|
| 107 | . . . . ;--- Delete the "stray" entry from the cross-reference
|
---|
| 108 | . . . . K @ROOT@("AT",DATE,IEN,IEN1)
|
---|
| 109 | . . . ;--- Delete the record
|
---|
| 110 | . . . S IENS=IEN1_","_IEN_","
|
---|
| 111 | . . . S RORFDA(798.32,IENS,.01)="@"
|
---|
| 112 | . . . D FILE^DIE(,"RORFDA","RORMSG")
|
---|
| 113 | . . . I $G(DIERR) D Q
|
---|
| 114 | . . . . S RC=$$DBS^RORERR("RORMSG",-9,,,798.32,IENS)
|
---|
| 115 | . . . S CNT=CNT+1
|
---|
| 116 | . . ;--- Re-index the main record if necessary
|
---|
| 117 | . . I REINDEX K DA S DIK=$$OREF^DILF(ROOT),DA=IEN D IX^DIK
|
---|
| 118 | D:CNT>0 LOG^RORLOG(2,CNT_" events were purged from the file #798.3")
|
---|
| 119 | Q $S(RC<0:RC,1:0)
|
---|