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)
|
---|