- 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 Jan 18, 2025@02:45:06 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)