RORUPP02 ;HCIOFO/SG - PATIENT EVENTS (EVENTS) ; 1/20/06 1:55pm
;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
;
Q
;
;***** ADDS THE EVENT REFERENCE
;
; PATIEN Patient IEN
;
; AREA Data area of the event (see the DATA AREA field
; of the file #798.3 for details)
;
; [DATE] Date/Time associated with the event (the current
; date/time is used by default).
;
; Return Values:
; <0 Error code
; 0 Ok
;
ADD(PATIEN,AREA,DATE) ;
N IEN,IENS,RORFDA,RORIEN,RORMSG
S:$G(DATE)'>0 DATE=$$NOW^XLFDT
;--- Do not record more than one reference per associated date.
; Maybe in the future all references will be recorded but we
; need only daily precision at the moment. If the reference
; exists already, update it with the earlier associated date
;--- and the latter timestamp if necessary.
S IEN=$O(^RORDATA(798.3,+PATIEN,2,"AD",AREA,DATE\1,""))
I IEN K DIERR D Q $S('$G(DIERR):0,1:-9)
. N BUF,NOW
. S IENS=IEN_","_(+PATIEN)_",",NOW=$$NOW^XLFDT
. S BUF=$G(^RORDATA(798.3,+PATIEN,2,IEN,0))
. S:NOW>$P(BUF,"^") RORFDA(798.32,IENS,.01)=NOW
. S:DATE<$P(BUF,"^",3) RORFDA(798.32,IENS,2)=DATE
. D:$D(RORFDA)>1 FILE^DIE(,"RORFDA","RORMSG")
;--- Create the new event reference
S (RORFDA(798.3,"?+1,",.01),RORIEN(1))=+PATIEN
S IENS="+2,?+1,"
S RORFDA(798.32,IENS,.01)=$$NOW^XLFDT
S RORFDA(798.32,IENS,1)=AREA
S RORFDA(798.32,IENS,2)=DATE
D UPDATE^DIE(,"RORFDA","RORIEN","RORMSG")
Q $S('$G(DIERR):0,1:-9)
;
;***** CHECKS THE EVENTS
;
; PATIEN Patient IEN
;
; AREA Data area of the event (see the DATA AREA field
; of the file #798.3 for details)
;
; .SDT Reference to a local variable containing the start
; date. The date can be modified by the function and
; returned via this parameter.
;
; .EDT Reference to a local variable containing the end
; date. The date can be modified by the function and
; returned via this parameter.
;
; Return Values:
; <0 Error code
; 0 No events (skip)
; 1 Events have been found (proceed)
; 2 The same as 1 + dates (SDT & EDT) have been modified
;
GET(PATIEN,AREA,SDT,EDT) ;
N ED,FDTC,FEVT,IEN,NEWEDT,NEWSDT,ROOT,TMP
S ROOT=$NA(^RORDATA(798.3,+PATIEN,2))
S NEWSDT=999999999,NEWEDT=0,(FDTC,FEVT)=0
;--- If the data search time frame is too wide and some of the
; event references have been purged already then the time
; frame cannot be shrinked according to the references and the
;--- patient cannot be skipped if there are no references at all.
S:SDT<$G(RORUPD("EETS")) NEWSDT=SDT,NEWEDT=EDT,FEVT=1
;--- Browse through the event references
S ED=$O(@ROOT@("AT",AREA,SDT),-1)
F S ED=$O(@ROOT@("AT",AREA,ED)) Q:(ED="")!(ED'<EDT) D
. S IEN=""
. F S IEN=$O(@ROOT@("AT",AREA,ED,IEN)) Q:IEN="" D
. . S TMP=$P($G(@ROOT@(IEN,0)),"^",3),FEVT=1
. . Q:TMP'>0
. . S:TMP<NEWSDT NEWSDT=TMP,FDTC=1
. . S:TMP>NEWEDT NEWEDT=TMP,FDTC=1
Q:'FEVT 0
I FDTC S SDT=NEWSDT,EDT=NEWEDT Q 2
Q 1
;
;***** PURGES THE OLD EVENT REFERENCES
;
; DATE Keep the references starting from this date
;
; Return Values:
; <0 Error code
; 0 Ok
;
PURGE(DATE) ;
N CNT,DA,DIK,IEN,IEN1,IENS,RC,REINDEX,ROOT,RORFDA,RORMSG
S ROOT=$$ROOT^DILFD(798.3,,1)
S DATE=DATE\1,(CNT,RC)=0
F S DATE=$O(@ROOT@("AT",DATE),-1) Q:DATE="" D Q:RC<0
. S IEN=""
. F S IEN=$O(@ROOT@("AT",DATE,IEN)) Q:IEN="" D Q:RC<0
. . S IEN1="",REINDEX=0
. . F S IEN1=$O(@ROOT@("AT",DATE,IEN,IEN1)) Q:IEN1="" D Q:RC<0
. . . ;---Check if the corresponding record exists
. . . I '$D(@ROOT@(IEN,2,IEN1,0)) D Q
. . . . ;--- Delete the "stray" entry from the cross-reference
. . . . K @ROOT@("AT",DATE,IEN,IEN1)
. . . ;--- Delete the record
. . . S IENS=IEN1_","_IEN_","
. . . S RORFDA(798.32,IENS,.01)="@"
. . . D FILE^DIE(,"RORFDA","RORMSG")
. . . I $G(DIERR) D Q
. . . . S RC=$$DBS^RORERR("RORMSG",-9,,,798.32,IENS)
. . . S CNT=CNT+1
. . ;--- Re-index the main record if necessary
. . I REINDEX K DA S DIK=$$OREF^DILF(ROOT),DA=IEN D IX^DIK
D:CNT>0 LOG^RORLOG(2,CNT_" events were purged from the file #798.3")
Q $S(RC<0:RC,1:0)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORUPP02 4359 printed Dec 13, 2024@01:43:52 Page 2
RORUPP02 ;HCIOFO/SG - PATIENT EVENTS (EVENTS) ; 1/20/06 1:55pm
+1 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
+2 ;
+3 QUIT
+4 ;
+5 ;***** ADDS THE EVENT REFERENCE
+6 ;
+7 ; PATIEN Patient IEN
+8 ;
+9 ; AREA Data area of the event (see the DATA AREA field
+10 ; of the file #798.3 for details)
+11 ;
+12 ; [DATE] Date/Time associated with the event (the current
+13 ; date/time is used by default).
+14 ;
+15 ; Return Values:
+16 ; <0 Error code
+17 ; 0 Ok
+18 ;
ADD(PATIEN,AREA,DATE) ;
+1 NEW IEN,IENS,RORFDA,RORIEN,RORMSG
+2 if $GET(DATE)'>0
SET DATE=$$NOW^XLFDT
+3 ;--- Do not record more than one reference per associated date.
+4 ; Maybe in the future all references will be recorded but we
+5 ; need only daily precision at the moment. If the reference
+6 ; exists already, update it with the earlier associated date
+7 ;--- and the latter timestamp if necessary.
+8 SET IEN=$ORDER(^RORDATA(798.3,+PATIEN,2,"AD",AREA,DATE\1,""))
+9 IF IEN
KILL DIERR
Begin DoDot:1
+10 NEW BUF,NOW
+11 SET IENS=IEN_","_(+PATIEN)_","
SET NOW=$$NOW^XLFDT
+12 SET BUF=$GET(^RORDATA(798.3,+PATIEN,2,IEN,0))
+13 if NOW>$PIECE(BUF,"^")
SET RORFDA(798.32,IENS,.01)=NOW
+14 if DATE<$PIECE(BUF,"^",3)
SET RORFDA(798.32,IENS,2)=DATE
+15 if $DATA(RORFDA)>1
DO FILE^DIE(,"RORFDA","RORMSG")
End DoDot:1
QUIT $SELECT('$GET(DIERR):0,1:-9)
+16 ;--- Create the new event reference
+17 SET (RORFDA(798.3,"?+1,",.01),RORIEN(1))=+PATIEN
+18 SET IENS="+2,?+1,"
+19 SET RORFDA(798.32,IENS,.01)=$$NOW^XLFDT
+20 SET RORFDA(798.32,IENS,1)=AREA
+21 SET RORFDA(798.32,IENS,2)=DATE
+22 DO UPDATE^DIE(,"RORFDA","RORIEN","RORMSG")
+23 QUIT $SELECT('$GET(DIERR):0,1:-9)
+24 ;
+25 ;***** CHECKS THE EVENTS
+26 ;
+27 ; PATIEN Patient IEN
+28 ;
+29 ; AREA Data area of the event (see the DATA AREA field
+30 ; of the file #798.3 for details)
+31 ;
+32 ; .SDT Reference to a local variable containing the start
+33 ; date. The date can be modified by the function and
+34 ; returned via this parameter.
+35 ;
+36 ; .EDT Reference to a local variable containing the end
+37 ; date. The date can be modified by the function and
+38 ; returned via this parameter.
+39 ;
+40 ; Return Values:
+41 ; <0 Error code
+42 ; 0 No events (skip)
+43 ; 1 Events have been found (proceed)
+44 ; 2 The same as 1 + dates (SDT & EDT) have been modified
+45 ;
GET(PATIEN,AREA,SDT,EDT) ;
+1 NEW ED,FDTC,FEVT,IEN,NEWEDT,NEWSDT,ROOT,TMP
+2 SET ROOT=$NAME(^RORDATA(798.3,+PATIEN,2))
+3 SET NEWSDT=999999999
SET NEWEDT=0
SET (FDTC,FEVT)=0
+4 ;--- If the data search time frame is too wide and some of the
+5 ; event references have been purged already then the time
+6 ; frame cannot be shrinked according to the references and the
+7 ;--- patient cannot be skipped if there are no references at all.
+8 if SDT<$GET(RORUPD("EETS"))
SET NEWSDT=SDT
SET NEWEDT=EDT
SET FEVT=1
+9 ;--- Browse through the event references
+10 SET ED=$ORDER(@ROOT@("AT",AREA,SDT),-1)
+11 FOR
SET ED=$ORDER(@ROOT@("AT",AREA,ED))
if (ED="")!(ED'<EDT)
QUIT
Begin DoDot:1
+12 SET IEN=""
+13 FOR
SET IEN=$ORDER(@ROOT@("AT",AREA,ED,IEN))
if IEN=""
QUIT
Begin DoDot:2
+14 SET TMP=$PIECE($GET(@ROOT@(IEN,0)),"^",3)
SET FEVT=1
+15 if TMP'>0
QUIT
+16 if TMP<NEWSDT
SET NEWSDT=TMP
SET FDTC=1
+17 if TMP>NEWEDT
SET NEWEDT=TMP
SET FDTC=1
End DoDot:2
End DoDot:1
+18 if 'FEVT
QUIT 0
+19 IF FDTC
SET SDT=NEWSDT
SET EDT=NEWEDT
QUIT 2
+20 QUIT 1
+21 ;
+22 ;***** PURGES THE OLD EVENT REFERENCES
+23 ;
+24 ; DATE Keep the references starting from this date
+25 ;
+26 ; Return Values:
+27 ; <0 Error code
+28 ; 0 Ok
+29 ;
PURGE(DATE) ;
+1 NEW CNT,DA,DIK,IEN,IEN1,IENS,RC,REINDEX,ROOT,RORFDA,RORMSG
+2 SET ROOT=$$ROOT^DILFD(798.3,,1)
+3 SET DATE=DATE\1
SET (CNT,RC)=0
+4 FOR
SET DATE=$ORDER(@ROOT@("AT",DATE),-1)
if DATE=""
QUIT
Begin DoDot:1
+5 SET IEN=""
+6 FOR
SET IEN=$ORDER(@ROOT@("AT",DATE,IEN))
if IEN=""
QUIT
Begin DoDot:2
+7 SET IEN1=""
SET REINDEX=0
+8 FOR
SET IEN1=$ORDER(@ROOT@("AT",DATE,IEN,IEN1))
if IEN1=""
QUIT
Begin DoDot:3
+9 ;---Check if the corresponding record exists
+10 IF '$DATA(@ROOT@(IEN,2,IEN1,0))
Begin DoDot:4
+11 ;--- Delete the "stray" entry from the cross-reference
+12 KILL @ROOT@("AT",DATE,IEN,IEN1)
End DoDot:4
QUIT
+13 ;--- Delete the record
+14 SET IENS=IEN1_","_IEN_","
+15 SET RORFDA(798.32,IENS,.01)="@"
+16 DO FILE^DIE(,"RORFDA","RORMSG")
+17 IF $GET(DIERR)
Begin DoDot:4
+18 SET RC=$$DBS^RORERR("RORMSG",-9,,,798.32,IENS)
End DoDot:4
QUIT
+19 SET CNT=CNT+1
End DoDot:3
if RC<0
QUIT
+20 ;--- Re-index the main record if necessary
+21 IF REINDEX
KILL DA
SET DIK=$$OREF^DILF(ROOT)
SET DA=IEN
DO IX^DIK
End DoDot:2
if RC<0
QUIT
End DoDot:1
if RC<0
QUIT
+22 if CNT>0
DO LOG^RORLOG(2,CNT_" events were purged from the file #798.3")
+23 QUIT $SELECT(RC<0:RC,1:0)
